<<>>
    <<ParseIntCodeImpl.mesa>>
        <<Copyright Ó 1986, 1987, 1988, 1989, 1991, 1993 by Xerox Corporation.  All rights reserved.>>
        <<Russ Atkinson (RRA) November 20, 1989 6:19:51 pm PST>>
        <<JKF March 7, 1989 12:57:10 pm PST>>
        <<Christian Jacobi, May 4, 1993 7:23 pm PDT>>
        <<>>
        DIRECTORY
            Atom USING [MakeAtom],
            ConvertUnsafe USING [ToRope],
            IntCodeDefs USING [Align, ArithClass, ArithClassKind, ArithSelector, BoolClass, ByteSequence, CaseList, CaseListRep, CedarSelector, 
            Comparator, Count, FileId, Handler, HandlerRep, Label, LabelRep, LambdaKind, Location, LocationRep, LogicalId, 
            MesaSelector, Node, NodeList, NodeListRep, NodeRep, nullFileId, nullVariableFlags, nullVariableId, Offset, OperRep, 
            SourceRange, Var, VariableFlag, VariableFlags, VariableId, VarList, VarListRep, Word],
            IntCodeUtils USING [Fetch, IdTab, IntToWord, NewIdTab, Store, WordToInt, zone],
            IO USING [EndOfStream, GetChar, GetID, GetInt, GetRopeLiteral, PeekChar, PutChar, PutF1, PutRope, PutText, RopeFromROS, ROS, 
            SkipWhitespace, STREAM, Value],
            ParseIntCode USING [],
            Rope USING [ActionType, Concat, FromChar, Length, Map, ROPE],
            Target: TYPE MachineParms USING [bitsPerRef, bitsPerWord];

ParseIntCodeImpl: CEDAR PROGRAM
    IMPORTS Atom, ConvertUnsafe, IntCodeUtils, IO, Rope
    EXPORTS ParseIntCode
    = BEGIN OPEN IntCodeDefs;

    ROPE: TYPE = Rope.ROPE;
    STREAM: TYPE = IO.STREAM;

<<Types & errors>>
    SyntaxError: PUBLIC ERROR [why: ROPE] = CODE;

    signalStrange: BOOL Ź FALSE;

    StrangeCondition: SIGNAL = CODE;
        <<For debugging>>

    ParseContext: TYPE = REF ParseContextRep;
    ParseContextRep: TYPE = RECORD [
        stream: STREAM Ź NIL,
        idTab: IntCodeUtils.IdTab Ź NIL,
        labelTab: IntCodeUtils.IdTab Ź NIL
        ];

    bitsPerRef: NAT = Target.bitsPerRef;
    defaultBits: NAT = Target.bitsPerWord;

<<The zone>>
    z: ZONE Ź IntCodeUtils.zone;

<<Testing routines>>
    FromStream: PUBLIC PROC [st: STREAM] RETURNS [nodes: NodeList Ź NIL] = {
        idTab: IntCodeUtils.IdTab Ź IntCodeUtils.NewIdTab[];
        labelTab: IntCodeUtils.IdTab Ź IntCodeUtils.NewIdTab[];
        pc: ParseContext Ź z.NEW[ParseContextRep Ź [st, idTab, labelTab]];
        tail: NodeList Ź NIL;
        DO
            ENABLE IO.EndOfStream => EXIT;
            list: NodeList Ź z.NEW[NodeListRep Ź [first: ParseNode[pc], rest: NIL]];
            IF tail = NIL THEN nodes Ź list ELSE tail.rest Ź list;
            tail Ź list;
            ENDLOOP;
        };

    ToRope: PROC [node: Node] RETURNS [ROPE] = {
        ros: STREAM Ź IO.ROS[];
        out: OutputContext Ź CreateOutputContext[ros];
        PutNode[out, node];
        RETURN [IO.RopeFromROS[ros]];
        };

    ToStream: PUBLIC PROC [st: STREAM, nodes: NodeList] = {
        out: OutputContext Ź CreateOutputContext[st];
        FOR each: NodeList Ź nodes, each.rest WHILE each # NIL DO
            StartLine[out];
            EndLine[out];
            PutNode[out, each.first];
            ENDLOOP;
        };

<<Parsing routines (a parsing context is needed)>>
    ParseNode: PROC [pc: ParseContext] RETURNS [node: Node Ź NIL] = {
        st: STREAM = pc.stream;
        IF Insist[st, '{] THEN {
            bits: INT Ź ScanInt[st, -1];
            IF PeekChar[st] # '} THEN {
                kind: ATOM Ź ScanKind[st];
                SELECT kind FROM
                    $var => {
                        flags: VariableFlags Ź ScanVariableFlags[st];
                        id: VariableId Ź ParseVarId[pc];
                        loc: Location Ź ParseLocation[pc];
                        useCache: BOOL Ź FALSE;
                        IF bits < 0 THEN bits Ź defaultBits;
                        IF id # nullVariableId AND (loc = NIL OR loc.kind = localVar) THEN {
                            <<This variable is a candidate for cacheing>>
                            prev: Var Ź IF id = nullVariableId THEN NIL
                            ELSE NARROW[IntCodeUtils.Fetch[pc.idTab, id]];
                            IF prev # NIL AND prev.location # NIL THEN {
                                IF loc = NIL THEN {node Ź prev; GO TO oldVar};
                                NoteStrange[];
                                    <<This is a conflicting location for a local variable!>>
                                };
                            IF prev # NIL THEN {
                                <<We just found the location!>>
                                prev.location Ź loc;
                                node Ź prev;
                                GO TO oldVar;
                                };
                            useCache Ź TRUE;
                            };
                        node Ź z.NEW[NodeRep.var Ź [bits, var[flags, id, loc]]];
                        IF useCache THEN [] Ź IntCodeUtils.Store[pc.idTab, id, node];
                        EXITS oldVar => {};
                        };
                    $const => {
                        constKind: ATOM Ź ScanKind[st];
                        SELECT constKind FROM
                            $word => {
                                IF bits < 0 THEN bits Ź defaultBits;
                                node Ź z.NEW[NodeRep.const.word
                                Ź [bits, const[word[ScanWord[st]]]]];
                                };
                            $bytes => {
                                align: Align Ź ScanInt[st];
                                byteSeq: ByteSequence Ź ParseBytes[pc];
                                IF bits < 0 THEN node.bits Ź 8*Rope.Length[byteSeq];
                                node Ź z.NEW[NodeRep.const.bytes
                                Ź [bits, const[bytes[align, byteSeq]]]];
                                };
                            $refLiteral => {
                                const: REF NodeRep.const.refLiteral Ź z.NEW[NodeRep.const.refLiteral
                                Ź [bitsPerRef, const[refLiteral[rope, NIL]]]];
                                refLitKind: ATOM Ź ScanKind[st];
                                const.litKind Ź SELECT refLitKind FROM
                                    $rope => rope, $atom => atom, $refText => refText, $other => other,
                                    ENDCASE => ERROR SyntaxError["illegal refLitKind"];
                                const.contents Ź ParseBytes[pc];
                                node Ź const;
                                };
                            $numLiteral => {
                                class: ArithClass Ź ScanArithClass[st];
                                contents: ROPE Ź ParseBytes[pc];
                                IF bits < 0 THEN bits Ź defaultBits;
                                node Ź z.NEW[NodeRep.const.numLiteral
                                Ź [bits, const[numLiteral[class, contents]]]];
                                };
                            ENDCASE => ERROR SyntaxError["illegal constant kind"];
                        };
                    $block => {
                        nodes: NodeList Ź ParseNodeList[pc, '}];
                        IF bits < 0 THEN bits Ź 0;
                        node Ź z.NEW[NodeRep.block Ź [bits, block[nodes]]];
                        };
                    $enable => {
                        handlerContext: Node Ź ParseNode[pc];
                        handlerProc: Node Ź ParseNode[pc];
                        handler: Handler Ź z.NEW[HandlerRep
                        Ź [context: handlerContext, proc: handlerProc]];
                        nodes: NodeList Ź ParseNodeList[pc, '}];
                        IF bits < 0 THEN bits Ź 0;
                        node Ź z.NEW[NodeRep.enable Ź [bits, enable[handler, nodes]]];
                        };
                    $decl => {
                        var: Var Ź ParseVar[pc];
                        init: Node Ź ParseNode[pc];
                        node Ź z.NEW[NodeRep.decl Ź [0, decl[var: var, init: init]]];
                        };
                    $assign => {
                        lhs: Var Ź ParseVar[pc];
                        rhs: Node Ź ParseNode[pc];
                        IF bits < 0 THEN bits Ź 0;
                        node Ź z.NEW[NodeRep.assign Ź [bits, assign[lhs: lhs, rhs: rhs]]];
                        };
                    $cond => {
                        caseHead: CaseList Ź NIL;
                        caseTail: CaseList Ź NIL;
                        WHILE PeekChar[st] # '} DO
                            IF Insist[st, '(] THEN {
                                key: ATOM Ź ScanKind[st];
                                IF key = $test
                                    THEN {
                                        tests: NodeList Ź ParseNodeList[pc, ')];
                                        body: Node Ź IF Insist[st, ')] THEN ParseNode[pc] ELSE NIL;
                                        new: CaseList Ź z.NEW[CaseListRep Ź [tests, body, NIL]];
                                        IF caseTail = NIL THEN caseHead Ź new ELSE caseTail.rest Ź new;
                                        caseTail Ź new;
                                        }
                                    ELSE ERROR SyntaxError["'test' expected"];
                                };
                            ENDLOOP;
                        IF bits < 0 THEN bits Ź 0;
                        node Ź z.NEW[NodeRep.cond Ź [bits, cond[caseHead]]];
                        };
                    $label => {
                        label: Label Ź ParseLabel[pc];
                        labNode: Node Ź IF PeekChar[st] = '} THEN NIL ELSE ParseNode[pc];
                        IF bits < 0 THEN bits Ź 0;
                        IF labNode # NIL THEN label.node Ź labNode;
                        node Ź z.NEW[NodeRep.label Ź [bits, label[label]]];
                        };
                    $goto => {
                        dest: Label Ź ParseLabel[pc, FALSE, TRUE];
                        backwards: BOOL Ź ScanFlag[st];
                        IF backwards THEN dest.backTarget Ź TRUE;
                        dest.jumpedTo Ź TRUE;
                        node Ź z.NEW[NodeRep.goto Ź
                        [0, goto[dest: dest, backwards: backwards]]];
                        };
                    $apply => {
                        proc: Node Ź ParseNode[pc];
                        args: NodeList Ź ParseNodeList[pc, '}, '!];
                        handler: Handler Ź NIL;
                        IF Accept[st, '!] THEN {
                            handler Ź z.NEW[HandlerRep];
                            handler.context Ź ParseNode[pc];
                            handler.proc Ź ParseNode[pc];
                            };
                        IF bits < 0 THEN bits Ź defaultBits;
                        node Ź z.NEW[NodeRep.apply Ź
                        [bits, apply[proc: proc, args: args, handler: handler]]];
                        };
                    $lambda => {
                        parent: Label Ź ParseLabel[pc, TRUE, TRUE];
                        descBody: Var Ź IF PeekChar[st] = '{ THEN ParseVar[pc] ELSE NIL;
                        kind: LambdaKind = SELECT ScanKind[st] FROM
                            $outer => outer,
                            $inner => inner,
                            $install => install,
                            $init => init,
                            $catch => catch,
                            $scope => scope,
                            $fork => fork,
                            ENDCASE => unknown;
                        bitsOut: INT Ź ScanInt[st];
                        formalArgs: VarList Ź ParseVarList[pc];
                        body: NodeList Ź ParseNodeList[pc, '}];
                        node Ź z.NEW[NodeRep.lambda Ź [defaultBits, lambda[
                        parent: parent, kind: kind, descBody: descBody,
                        bitsOut: bitsOut, formalArgs: formalArgs, body: body]]];
                        };
                    $return =>
                        node Ź z.NEW[NodeRep.return Ź
                        [0, return[ParseNodeList[pc, '}] ]]];
                    $oper => {
                        IF bits < 0 THEN bits Ź 0;
                        node Ź z.NEW[NodeRep.oper Ź
                        [bits, oper[z.NEW[OperRep Ź ParseOperRep[pc]]]]];
                        };
                    $machineCode => {
                        IF bits < 0 THEN bits Ź 0;
                        node Ź z.NEW[NodeRep.machineCode Ź
                        [bits, machineCode[ ParseBytes[pc] ]]];
                        };
                    $module => {
                        vars: VarList Ź ParseVarList[pc];
                        procs: NodeList Ź ParseNodeList[pc, '}];
                        node Ź z.NEW[NodeRep.module Ź
                        [0, module[vars: vars, procs: procs]]];
                        };
                    $source => {
                        source: SourceRange Ź ScanSourceRange[st];
                        nodes: NodeList Ź ParseNodeList[pc, '}];
                        IF bits < 0 THEN bits Ź 0;
                        node Ź z.NEW[NodeRep.source Ź
                        [bits, source[source: source, nodes: nodes]]];
                        };
                    $comment => {
                        msg: ByteSequence Ź ParseBytes[pc];
                        node Ź z.NEW[NodeRep.comment Ź [0, comment[msg]]];
                        };
                    ENDCASE => ERROR SyntaxError ["illegal node kind"];
                };
            };
        [] Ź Insist[st, '}];
        };

    ParseNodeList: PROC [pc: ParseContext, stop1: CHAR Ź '}, stop2: CHAR Ź '!] RETURNS [head: NodeList Ź NIL] = {
        st: STREAM = pc.stream;
        tail: NodeList Ź NIL;
        DO
            SELECT PeekChar[st] FROM
                stop1, stop2 => RETURN;
                ENDCASE => {
                    node: Node Ź ParseNode[pc];
                    new: NodeList Ź z.NEW[NodeListRep Ź [node, NIL]];
                    IF tail = NIL THEN head Ź new ELSE tail.rest Ź new;
                    tail Ź new;
                    };
            ENDLOOP;
        };

    ParseVar: PROC [pc: ParseContext] RETURNS [Var Ź NIL] = {
        node: Node Ź ParseNode[pc];
        IF node # NIL THEN
            WITH node SELECT FROM
                var: Var => RETURN [var];
                ENDCASE => ERROR SyntaxError["var expected, node found"];
        };

    ParseVarList: PROC [pc: ParseContext] RETURNS [head: VarList Ź NIL] = {
        st: STREAM = pc.stream;
        tail: VarList Ź NIL;
        [] Ź Insist[st, '(];
        WHILE NOT Accept[st, ')] DO
            new: VarList Ź z.NEW[VarListRep Ź [ParseVar[pc], NIL]];
            IF tail = NIL THEN head Ź new ELSE tail.rest Ź new;
            tail Ź new;
            ENDLOOP;
        };

    ParseBytes: PROC [pc: ParseContext] RETURNS [ROPE Ź NIL] = {
        st: STREAM = pc.stream;
        [] Ź IO.SkipWhitespace[st];
        SELECT IO.PeekChar[st] FROM
            '" => RETURN [IO.GetRopeLiteral[st]];
            ENDCASE;
        };

    ParseVarId: PROC [pc: ParseContext] RETURNS [VariableId] = {
        st: STREAM = pc.stream;
        RETURN [ScanInt[st]];
        };

    ParseLabel: PROC [pc: ParseContext, optional: BOOL Ź FALSE, forceUsed: BOOL Ź FALSE]
    RETURNS [label: Label Ź NIL] = {
        st: STREAM = pc.stream;
        SELECT TRUE FROM
            Accept[st, '%] => {
                id: LogicalId Ź ScanId[st];
                WITH IntCodeUtils.Fetch[pc.labelTab, id] SELECT FROM
                    lab: Label => {
                        IF forceUsed THEN lab.used Ź TRUE;
                        RETURN [lab];
                        };
                    ENDCASE;
                label Ź z.NEW[LabelRep Ź [
                id: id, node: NIL, backTarget: FALSE, jumpedTo: FALSE, used: forceUsed]];
                [] Ź IntCodeUtils.Store[pc.labelTab, id, label];
                RETURN [label];
                };
            NOT optional => ERROR SyntaxError["label expected"];
            ENDCASE;
        };

    MesaSelectorFromSKind: PROC [sKind: ATOM] RETURNS [mesa: MesaSelector] = {
        mesa Ź SELECT sKind FROM
        $addr => addr, $all => all,
        $equal => equal, $notEqual => notEqual, $nilck => nilck,
        $alloc => alloc, $free => free, $fork => fork, $join => join,
        $monitorEntry => monitorEntry, $monitorExit => monitorExit, 
        $notify => notify, $broadcast => broadcast, $wait => wait,
        $unnamedError => unnamedError, $unwindError => unwindError, 
        $abortedError => abortedError, $uncaughtError => uncaughtError, 
        $boundsError => boundsError, $narrowFault => narrowFault,
        $signal => signal, $error => error,
        $unwind => unwind, $resume => resume, $reject => reject,
        $copyGlobal => copyGlobal, $startGlobal => startGlobal, 
        $restartGlobal => restartGlobal, $stopGlobal => stopGlobal, $checkInit => checkInit,
        $globalFrame => globalFrame,
        ENDCASE => ERROR SyntaxError["illegal mesa selector"];
        RETURN[mesa];
        };

    ParseOperRep: PROC [pc: ParseContext] RETURNS [OperRep] = {
        st: STREAM = pc.stream;
        kind: ATOM Ź ScanKind[st];
        SELECT kind FROM
            $arith => {
                class: ArithClass Ź ScanArithClass[st];
                sKind: ATOM Ź ScanKind[st];
                select: ArithSelector Ź SELECT sKind FROM
                    $add => add, $sub => sub, $mul => mul, $div => div, 
                    $mod => mod, $pow => pow, $abs => abs, $neg => neg, 
                    $min => min, $max => max,
                    ENDCASE => ERROR SyntaxError["illegal arith selector"];
                RETURN [[arith[class, select]]];
                };
            $boolean => {
                kind: ATOM Ź ScanKind[st];
                class: BoolClass Ź SELECT kind FROM
                    $and => and, $not => not, $or => or, $xor => xor,
                    ENDCASE => ERROR SyntaxError["illegal boolean class"];
                bits: Count Ź ScanInt[st, defaultBits];
                RETURN [[boolean[class, bits]]];
                };
            $code => {
                label: Label Ź ParseLabel[pc, FALSE, TRUE];
                offset: INT Ź ScanInt[st];
                direct: BOOL Ź ScanFlag[st, TRUE];
                RETURN [[code[label, offset, direct]]];
                };
            $convert => {
                to: ArithClass Ź ScanArithClass[st];
                from: ArithClass Ź ScanArithClass[st];
                RETURN [[convert[to: to, from: from]]];
                };
            $check => {
                class: ArithClass Ź ScanArithClass[st];
                sKind: ATOM Ź ScanKind[st];
                sense: Comparator Ź SELECT sKind FROM
                    $eq => eq, $lt => lt, $le => le, $ne => ne, $ge => ge, $gt => gt, 
                    ENDCASE => ERROR SyntaxError["illegal comparator"];
                RETURN [[check[class, sense]]];
                };
            $compare => {
                class: ArithClass Ź ScanArithClass[st];
                sKind: ATOM Ź ScanKind[st];
                sense: Comparator Ź SELECT sKind FROM
                    $eq => eq, $lt => lt, $le => le, $ne => ne, $ge => ge, $gt => gt, 
                    ENDCASE => ERROR SyntaxError["illegal comparator"];
                RETURN [[compare[class, sense]]];
                };
            $mesa => {
                sKind: ATOM Ź ScanKind[st];
                mesa: MesaSelector Ź MesaSelectorFromSKind[sKind];
                RETURN [[mesa[mesa, ScanInt[st]]]]; 
                };
            $cedar => {
                sKind: ATOM Ź ScanKind[st];
                cedar: CedarSelector Ź SELECT sKind FROM
                    $simpleAssign => simpleAssign, $simpleAssignInit => simpleAssignInit,
                    $complexAssign => complexAssign, $complexAssignInit => complexAssignInit,
                    $new => new, $code => code,
                    $narrow => narrow, $referentType => referentType, $procCheck => procCheck,
                    ENDCASE => ERROR SyntaxError["illegal Cedar selector"];
                RETURN [[cedar[cedar, ScanInt[st]]]]; 
                };
            $escape => {
                id: LogicalId Ź ScanId[st];
                RETURN [[escape[id, ScanInt[st]]]]; 
                };
            ENDCASE => ERROR SyntaxError["illegal oper kind"];
        };

    ParseLocation: PROC [pc: ParseContext] RETURNS [loc: Location Ź NIL] = {
        st: STREAM = pc.stream;
        IF Accept[st, '(] THEN {
            kind: ATOM Ź ScanKind[st];
            SELECT kind FROM
                $system => {
                    id: LogicalId Ź ScanId[st];
                    loc Ź z.NEW[LocationRep.system Ź [system[id]]];
                    };
                $globalVar => {
                    id: LogicalId Ź ScanId[st];
                    loc Ź z.NEW[LocationRep.globalVar Ź [globalVar[id]]];
                    };
                $localVar => {
                    id: LogicalId Ź ScanId[st];
                    parent: Label Ź ParseLabel[pc];
                    loc Ź z.NEW[LocationRep.localVar Ź [localVar[id, parent]]];
                    };
                $register => {
                    id: LogicalId Ź ScanId[st];
                    loc Ź z.NEW[LocationRep.register Ź [register[id]]];
                    };
                $link => {
                    id: LogicalId Ź ScanId[st];
                    loc Ź z.NEW[LocationRep.link Ź [link[id]]];
                    };
                $stack => {
                    offset: Offset Ź ScanOffset[st];
                    loc Ź z.NEW[LocationRep.stack Ź [stack[offset]]];
                    };
                $deref => {
                    node: Node Ź ParseNode[pc];
                    align: INT Ź ScanInt[st, defaultBits];
                    loc Ź z.NEW[LocationRep.deref Ź [deref[node, align]]];
                    };
                $indexed => {
                    base: Node Ź ParseNode[pc];
                    index: Node Ź ParseNode[pc];
                    loc Ź z.NEW[LocationRep.indexed Ź [indexed[base, index]]];
                    };
                $field => {
                    offset: Offset Ź ScanOffset[st];
                    node: Node Ź ParseNode[pc];
                    loc Ź z.NEW[LocationRep.field Ź [field[node, offset, FALSE]]];
                    };
                $xfield => {
                    <<This is only used by the little endian compiler>>
                    <<Added, ChJ, May 4, 1993>>
                    offset: Offset Ź ScanOffset[st];
                    node: Node Ź ParseNode[pc];
                    loc Ź z.NEW[LocationRep.field Ź [field[node, offset, TRUE]]];
                    };
                $upLevel => {
                    link: Var Ź ParseVar[pc];
                    reg: Var Ź ParseVar[pc];
                    format: LogicalId Ź ScanId[st];
                    loc Ź z.NEW[LocationRep.upLevel Ź [upLevel[link, reg, format]]];
                    };
                $composite => {
                    list: NodeList Ź ParseNodeList[pc, ')];
                    loc Ź z.NEW[LocationRep.composite Ź [composite[list]]];
                    };
                $escape => {
                    id: LogicalId Ź ScanId[st];
                    offset: Offset Ź ScanOffset[st];
                    base: Node Ź ParseNode[pc];
                    loc Ź z.NEW[LocationRep.escape Ź [escape[id, base, offset ]]];
                    };
                $dummy =>
                    loc Ź z.NEW[LocationRep Ź [dummy[]]];
                ENDCASE => ERROR SyntaxError["illegal location kind"];
            [] Ź Insist[st, ')];
            };
        };

<<Scanning routines (only a stream is needed)>>
    ScanArithClass: PROC [st: STREAM] RETURNS [ArithClass] = {
        kind: ArithClassKind Ź signed;
        precision: NAT Ź 0;
        checked: BOOL Ź TRUE;
        [] Ź IO.SkipWhitespace[st];
        SELECT IO.PeekChar[st] FROM
            's, 'S => {kind Ź signed; checked Ź TRUE};
            'u, 'U => {kind Ź unsigned; checked Ź FALSE};
            'a, 'A => {kind Ź address; checked Ź FALSE};
            'r, 'R => {kind Ź real; checked Ź TRUE};
            'x, 'X => {
                k: [0..ORD[LAST[ArithClassKind]]] Ź 0;
                [] Ź IO.GetChar[st];
                k Ź ScanInt[st, ORD[LAST[ArithClassKind]] ];
                kind Ź VAL[k];
                checked Ź TRUE;
                };
            ENDCASE => ERROR SyntaxError["illegal arith class"];
        [] Ź IO.GetChar[st];
        precision Ź ScanInt[st, defaultBits];
        checked Ź ScanFlag[st, checked];
        RETURN [[kind, checked, precision]];
        };

    ScanSourceRange: PROC [st: STREAM] RETURNS [SourceRange] = {
        start: Offset Ź ScanInt[st];
        chars: Offset Ź ScanInt[st];
        fileNum: INT Ź ScanInt[st];
        file: FileId Ź nullFileId;
        RETURN [[start: start, chars: chars, file: fileNum]];
        };

    ScanInt: PROC [st: STREAM, default: INT Ź 0] RETURNS [INT] = {
        [] Ź IO.SkipWhitespace[st];
        SELECT IO.PeekChar[st] FROM
            '-, IN ['0..'9] => {
                RETURN [IO.GetInt[st]];
                };
            ENDCASE => RETURN [default];
        };

    ScanId: PROC [st: STREAM] RETURNS [LogicalId] = {
        RETURN [ScanInt[st]];
            <<Temporary!>>
        };

    ScanWord: PROC [st: STREAM] RETURNS [Word] = {
        RETURN [IntCodeUtils.IntToWord[ScanInt[st]]];
            <<Temporary!>>
        };

    ScanOffset: PROC [st: STREAM] RETURNS [Offset] = {
        RETURN [ScanInt[st]];
            <<Temporary!>>
        };

    ScanCount: PROC [st: STREAM] RETURNS [Offset] = {
        card: LONG CARDINAL Ź ScanInt[st];
        RETURN [card];
            <<Temporary!>>
        };

    ScanKind: PROC [st: STREAM, optional: BOOL Ź FALSE] RETURNS [ATOM Ź NIL] = {
        [] Ź IO.SkipWhitespace[st];
        SELECT IO.PeekChar[st] FROM
            IN ['A..'Z], IN ['a..'z] => {
                id: ROPE Ź IO.GetID[st];
                RETURN [Atom.MakeAtom[id]];
                };
            ENDCASE => IF NOT optional THEN ERROR SyntaxError["number expected"];
        };

    ScanFlag: PROC [st: STREAM, default: BOOL Ź FALSE] RETURNS [BOOL] = {
        SELECT PeekChar[st] FROM
            'T, 't => {[] Ź IO.GetChar[st]; RETURN [TRUE]};
            'F, 'f => {[] Ź IO.GetChar[st]; RETURN [FALSE]};
            ENDCASE => RETURN [default];
        };

    ScanVariableFlags: PROC [st: STREAM] RETURNS [VariableFlags] = {
        flags: VariableFlags Ź nullVariableFlags;
        FOR flag: VariableFlag IN VariableFlag DO
            SELECT PeekChar[st] FROM
                'T, 't => flags[flag] Ź TRUE;
                'F, 'f => {};
                ENDCASE => EXIT;
            [] Ź IO.GetChar[st];
            ENDLOOP;
        RETURN [flags];
        };

    PeekChar: PROC [st: STREAM] RETURNS [CHAR] = {
        [] Ź IO.SkipWhitespace[st];
        RETURN [IO.PeekChar[st]];
        };

    Accept: PROC [st: STREAM, c: CHAR] RETURNS [BOOL] = {
        [] Ź IO.SkipWhitespace[st];
        IF IO.PeekChar[st] = c THEN {[] Ź IO.GetChar[st]; RETURN [TRUE]};
        RETURN [FALSE];
        };

    Insist: PROC [st: STREAM, c: CHAR] RETURNS [BOOL] = {
        [] Ź IO.SkipWhitespace[st];
        IF IO.PeekChar[st] = c THEN {[] Ź IO.GetChar[st]; RETURN [TRUE]};
        ERROR SyntaxError[Rope.Concat[Rope.FromChar[c], " expected"]];
        };

<<Node output routines>>
    PutNodeAuto: PROC [out: OutputContext, node: Node, break: BOOL Ź FALSE] = {
        PutNode[out, node, break OR IsComplex[node]];
        };

    PutNode: PROC
    [out: OutputContext, node: Node, newLine: BOOL Ź FALSE, space: BOOL Ź TRUE] = {
        IF newLine THEN EndLine[out];
        IF space AND NOT out.empty THEN PutRopeLit[out, " "];
        IF node = NIL THEN {PutRopeLit[out, "{}"]; RETURN};
        PutRopeLit[out, "{"];
        out.nodeLevel Ź out.nodeLevel + 1;
        SELECT node.kind FROM
            var, apply =>
                IF node.bits # defaultBits THEN PutInt[out, node.bits, "%g "];
            block, enable, oper, machineCode, source, assign, cond =>
                IF node.bits > 0 THEN PutInt[out, node.bits, "%g "];
            ENDCASE => {};
        WITH node SELECT FROM
            var: REF NodeRep.var => PutVar[out, var, FALSE];
            const: REF NodeRep.const => {
                WITH const SELECT FROM
                    word: REF NodeRep.const.word => {
                        IF node.bits = defaultBits
                            THEN PutRopeLit[out, "const word "]
                            ELSE PutInt[out, node.bits, "%g const word "];
                        PutWord[out, word.word];
                        };
                    bytes: REF NodeRep.const.bytes => {
                        PutInt[out, node.bits, "%g const bytes "];
                        PutInt[out, bytes.align, "%g "];
                        PutBytes[out, bytes.bytes];
                        };
                    refLiteral: REF NodeRep.const.refLiteral => {
                        PutInt[out, node.bits, "%g const refLiteral "];
                        SELECT refLiteral.litKind FROM
                            rope => PutRopeLit[out, "rope "];
                            atom => PutRopeLit[out, "atom "];
                            refText => PutRopeLit[out, "refText "];
                            other => PutRopeLit[out, "other "];
                            ENDCASE => ERROR;
                        PutBytes[out, refLiteral.contents];
                        };
                    numLiteral: REF NodeRep.const.numLiteral => {
                        PutInt[out, node.bits, "%g const numLiteral "];
                        PutArithClass[out, numLiteral.class];
                        PutBytes[out, numLiteral.contents];
                        };
                    ENDCASE => ERROR;
                };
            block: REF NodeRep.block => {
                nodeList: NodeList Ź block.nodes;
                PutRopeLit[out, "block"];
                PutNodeList[out, block.nodes, TRUE];
                };
            enable: REF NodeRep.enable => {
                PutRopeLit[out, "enable"];
                PutNode[out, enable.handle.context, TRUE];
                PutNode[out, enable.handle.proc, TRUE];
                PutNodeList[out, enable.scope, TRUE];
                };
            decl: REF NodeRep.decl => {
                var: Var = decl.var;
                init: Node = decl.init;
                SELECT TRUE FROM
                    decl.bits # 0 => NoteStrange[];
                    var = NIL => NoteStrange[];
                    init # NIL AND var.bits # init.bits => NoteStrange[];
                    ENDCASE;
                PutRopeLit[out, "decl "];
                PutVar[out, var, TRUE];
                SELECT TRUE FROM
                    init = NIL => PutRopeLit[out, " {}"];
                    ENDCASE => PutNodeAuto[out, init];
                };
            assign: REF NodeRep.assign => {
                break: BOOL Ź IsComplex[assign.lhs, TRUE] OR IsComplex[assign.rhs, TRUE];
                lhs: Node = assign.lhs;
                rhs: Node = assign.rhs;
                SELECT TRUE FROM
                    lhs = NIL => NoteStrange[];
                    rhs # NIL AND rhs.bits # lhs.bits => NoteStrange[];
                    ENDCASE;
                PutRopeLit[out, "assign"];
                PutNode[out, lhs, break];
                PutNode[out, rhs, break];
                };
            cond: REF NodeRep.cond => {
                delta: INTEGER Ź 1;
                PutRopeLit[out, "cond"];
                FOR each: CaseList Ź cond.cases, each.rest WHILE each # NIL DO
                    tests: NodeList Ź each.tests;
                    EndLine[out];
                    IF tests # NIL
                        THEN {
                            first: Node Ź tests.first;
                            break: BOOL Ź tests.rest # NIL OR IsComplex[first, FALSE];
                            PutRopeLit[out, "(test"];
                            out.nodeLevel Ź out.nodeLevel + 1;
                            FOR eachTest: NodeList Ź tests, eachTest.rest WHILE eachTest # NIL DO
                                PutNode[out, eachTest.first, break];
                                ENDLOOP;
                            PutRopeLit[out, ")"];
                            out.nodeLevel Ź out.nodeLevel - 1;
                            }
                        ELSE
                            PutRopeLit[out, "(test)"];
                    PutNode[out, each.body, TRUE];
                    EndLine[out];
                    ENDLOOP;
                GO TO closeBlock;
                };
            label: REF NodeRep.label => {
                lab: Label Ź label.label;
                PutRopeLit[out, "label "];
                PutLabel[out, lab];
                IF lab.node # NIL THEN PutNode[out, lab.node, TRUE];
                };
            goto: REF NodeRep.goto => {
                PutRopeLit[out, "goto "];
                PutLabel[out, goto.dest];
                IF goto.dest = NIL THEN NoteStrange[];
                IF goto.backwards THEN PutRopeLit[out, " T"];
                };
            apply: REF NodeRep.apply => {
                handler: Handler Ź apply.handler;
                hasHandler: BOOL Ź handler # NIL;
                PutRopeLit[out, "apply"];
                IF apply.proc = NIL THEN NoteStrange[];
                PutNodeAuto[out, apply.proc, hasHandler];
                IF apply.args # NIL THEN PutNodeList[out, apply.args, hasHandler];
                IF hasHandler THEN {
                    EndLine[out];
                    PutRopeLit[out, "! "];
                    PutNodeAuto[out, handler.context, FALSE];
                    PutNodeAuto[out, handler.proc, FALSE];
                    };
                };
            lambda: REF NodeRep.lambda => {
                PutRopeLit[out, "lambda "];
                IF lambda.parent # NIL THEN {
                    PutLabel[out, lambda.parent];
                    PutRopeLit[out, " "];
                    };
                IF lambda.descBody # NIL THEN {
                    PutRopeLit[out, "{"];
                    PutVar[out, lambda.descBody, FALSE];
                    PutRopeLit[out, "} "];
                    };
                SELECT lambda.kind FROM
                    outer => PutRopeLit[out, "outer "];
                    inner => PutRopeLit[out, "inner "];
                    install => PutRopeLit[out, "install "];
                    init => PutRopeLit[out, "init "];
                    catch => PutRopeLit[out, "catch "];
                    scope => PutRopeLit[out, "scope "];
                    fork => PutRopeLit[out, "fork "];
                    ENDCASE => PutRopeLit[out, "unknown "];
                PutInt[out, lambda.bitsOut, "%g "];
                PutVarList[out, lambda.formalArgs, TRUE];
                PutNodeList[out, lambda.body, TRUE];
                };
            return: REF NodeRep.return => {
                IF return.bits # 0 THEN NoteStrange[];
                PutRopeLit[out, "return"];
                PutNodeList[out, return.rets];
                };
            oper: REF NodeRep.oper => {
                PutRopeLit[out, "oper "];
                WITH oper.oper SELECT FROM
                    arith: REF arith OperRep => {
                        PutRopeLit[out, "arith "];
                        PutArithClass[out, arith.class];
                        PutRopeLit[out, SELECT arith.select FROM
                            add => " add", sub => " sub", mul => " mul", div => " div",
                            mod => " mod", pow => " pow", abs => " abs", neg => " neg",
                            min => " min", max => " max",
                            ENDCASE => ERROR
                            ];
                        };
                    boolean: REF boolean OperRep => {
                        PutRopeLit[out, "boolean "];
                        PutRopeLit[out, SELECT boolean.class FROM
                            and => "and", not => "not", or => "or", xor => "xor",
                            ENDCASE => ERROR
                            ];
                        IF boolean.bits # defaultBits THEN PutInt[out, boolean.bits, " %g"];
                        };
                    code: REF code OperRep => {
                        PutRopeLit[out, "code "];
                        PutLabel[out, code.label];
                        IF code.offset # 0 THEN PutInt[out, code.offset, " %g"];
                        IF NOT code.direct THEN PutRopeLit[out, " F"];
                        };
                    convert: REF convert OperRep => {
                        PutRopeLit[out, "convert "];
                        PutArithClass[out, convert.to];
                        PutRopeLit[out, " "];
                        PutArithClass[out, convert.from];
                        };
                    check: REF check OperRep => {
                        PutRopeLit[out, "check "];
                        PutArithClass[out, check.class];
                        PutRopeLit[out, SELECT check.sense FROM
                            eq => " eq", lt => " lt", le => " le", ne => " ne", ge => " ge", gt => " gt",
                            ENDCASE => ERROR
                            ];
                        };
                    compare: REF compare OperRep => {
                        PutRopeLit[out, "compare "];
                        PutArithClass[out, compare.class];
                        PutRopeLit[out, SELECT compare.sense FROM
                            eq => " eq", lt => " lt", le => " le", ne => " ne", ge => " ge", gt => " gt",
                            ENDCASE => ERROR
                            ];
                        };
                    mesa: REF mesa OperRep => {
                        s: LONG STRING;
                        SELECT mesa.mesa FROM
                            addr => s Ź "addr"; all => s Ź "all"; equal => s Ź "equal"; 
                            notEqual => s Ź "notEqual"; nilck => s Ź "nilck";
                            alloc => s Ź "alloc"; free => s Ź "free"; fork => s Ź "fork"; join => s Ź "join";
                            monitorEntry => s Ź "monitorEntry"; monitorExit => s Ź "monitorExit";
                            notify => s Ź "notify"; broadcast => s Ź "broadcast"; wait => s Ź "wait";
                            unnamedError => s Ź "unnamedError"; unwindError => s Ź "unwindError"; 
                            abortedError => s Ź "abortedError"; uncaughtError => s Ź "uncaughtError"; 
                            boundsError => s Ź "boundsError"; narrowFault => s Ź "narrowFault";
                            signal => s Ź "signal"; error => s Ź "error";
                            unwind => s Ź "unwind"; resume => s Ź "resume"; reject => s Ź "reject";
                            copyGlobal => s Ź "copyGlobal"; startGlobal => s Ź "startGlobal"; 
                            restartGlobal => s Ź "restartGlobal"; stopGlobal => s Ź "stopGlobal"; 
                            checkInit => s Ź "checkInit"; globalFrame => s Ź "globalFrame";
                            ENDCASE => ERROR;
                        PutRopeLit[out, "mesa "];
                        PutRopeLit[out, s];
                        IF mesa.info # 0 THEN PutInt[out, mesa.info, " %g"];
                        };
                    cedar: REF cedar OperRep => {
                        PutRopeLit[out, "cedar "];
                        PutRopeLit[out, SELECT cedar.cedar FROM
                            simpleAssign => "simpleAssign", simpleAssignInit => "simpleAssignInit",
                            complexAssign => "complexAssign", complexAssignInit => "complexAssignInit",
                            new => "new", code => "code",
                            narrow => "narrow", referentType => "referentType", procCheck => "procCheck",
                            ENDCASE => ERROR
                            ];
                        IF cedar.info # 0 THEN PutInt[out, cedar.info, " %g"];
                        };
                    escape: REF escape OperRep => {
                        PutRopeLit[out, "escape "];
                        PutId[out, escape.escape];
                        IF escape.info # 0 THEN PutInt[out, escape.info, " %g"];
                        };
                    ENDCASE => ERROR;
                };
            machineCode: REF NodeRep.machineCode => {
                PutRopeLit[out, "machineCode "];
                PutBytes[out, machineCode.bytes];
                };
            module: REF NodeRep.module => {
                PutRopeLit[out, "module "];
                PutVarList[out, module.vars, TRUE];
                PutNodeList[out, module.procs, TRUE];
                EndLine[out];
                GO TO closeBlock;
                };
            source: REF NodeRep.source => {
                PutRopeLit[out, "source "];
                PutInt[out, source.source.start];
                PutRopeLit[out, " "];
                PutInt[out, source.source.chars];
                PutRopeLit[out, " "];
                PutInt[out, source.source.file];
                PutNodeList[out, source.nodes, TRUE];
                GO TO closeBlock;
                };
            comment: REF NodeRep.comment => {
                PutRopeLit[out, "comment "];
                PutBytes[out, comment.bytes];
                };
            ENDCASE => ERROR;
        PutRopeLit[out, "}"];
        out.nodeLevel Ź out.nodeLevel - 1;
        EXITS closeBlock => {
            PutRopeLit[out, "}"];
            EndLine[out];
            out.nodeLevel Ź out.nodeLevel - 1;
            };
        };

    PutNodeList: PROC [out: OutputContext, nodeList: NodeList, newLine: BOOL Ź FALSE] = {
        IF NOT newLine THEN newLine Ź IsComplexList[nodeList];
        WHILE nodeList # NIL DO
            PutNode[out, nodeList.first, newLine];
            nodeList Ź nodeList.rest;
            ENDLOOP;
        };

    PutVar: PROC [out: OutputContext, var: Var, defn: BOOL Ź FALSE] = {
        flags: VariableFlags Ź var.flags;
        loc: Location Ź var.location;
        showDetails: BOOL Ź defn OR (loc # NIL AND loc.kind # localVar);
        IF defn THEN {
            PutRopeLit[out, "{"];
            IF var.bits # defaultBits THEN PutInt[out, var.bits, "%g "];
            };
        PutRopeLit[out, "var"];
        IF showDetails AND flags # nullVariableFlags THEN {
            PutRopeLit[out, " "];
            FOR flag: VariableFlag IN VariableFlag WHILE flags # nullVariableFlags DO
                PutFlag[out, flags[flag]];
                flags[flag] Ź FALSE;
                ENDLOOP;
            };
        PutVarId[out, var.id];
        IF loc = NIL THEN NoteStrange[];
        IF showDetails THEN PutLocation[out, var.location];
        IF defn THEN PutRopeLit[out, "}"];
        };

    PutVarList: PROC [out: OutputContext, varList: VarList, defn: BOOL Ź FALSE] = {
        space: BOOL Ź FALSE;
        PutRopeLit[out, "("];
        WHILE varList # NIL DO
            IF defn
                THEN {
                    IF space THEN PutRopeLit[out, " "];
                    PutVar[out, varList.first, TRUE]
                    }
                ELSE PutNode[out, varList.first, FALSE, space];
            varList Ź varList.rest;
            space Ź TRUE;
            ENDLOOP;
        PutRopeLit[out, ")"];
        };

    PutArithClass: PROC [out: OutputContext, class: ArithClass] = {
        checked: BOOL Ź FALSE;
        SELECT class.kind FROM
            signed => PutRopeLit[out, "S"];
            unsigned => PutRopeLit[out, "U"];
            address => PutRopeLit[out, "A"];
            real => {PutRopeLit[out, "R"]; checked Ź TRUE};
            ENDCASE => PutF1[out, "X%g ", [integer[ORD[class.kind]]]];
        IF class.precision # defaultBits THEN
            PutInt[out, class.precision];
        IF class.checked # checked THEN
            PutRopeLit[out, IF class.checked THEN "T" ELSE "F"];
        };

    PutFlag: PROC [out: OutputContext, flag: BOOL] = {
        PutRopeLit[out, IF flag THEN "T" ELSE "F"];
        };

    PutVarId: PROC [out: OutputContext, varId: VariableId] = {
        IF varId # nullVariableId THEN PutInt[out, varId, " %g"];
        };

    PutId: PROC [out: OutputContext, id: LogicalId] = {
        PutInt[out, id];
            <<Temporary!>>
        };

    PutLabel: PROC [out: OutputContext, label: Label] = {
        IF label = NIL THEN PutRopeLit[out, "%0"] ELSE PutInt[out, label.id, "%%%g"];
        };

    PutInt: PROC [out: OutputContext, int: INT, form: ROPE Ź NIL] = {
        PutF1[out, IF form = NIL THEN "%g" ELSE form, [integer[int]] ];
        };

    PutWord: PROC [out: OutputContext, word: Word] = {
        PutInt[out, IntCodeUtils.WordToInt[word]];
            <<Temporary!>>
        };

    PutBytes: PROC [out: OutputContext, bytes: ByteSequence] = {
        each: Rope.ActionType = {
            <<[c: CHAR] RETURNS [quit: BOOL _ FALSE]>>
            SELECT c FROM
                '\", '\', '\\ => {IO.PutChar[st, '\\]; IO.PutChar[st, c]};
                IN [040C..176C] => IO.PutChar[st, c];
                ENDCASE => {
                    IO.PutChar[st, '\\];
                    IO.PutChar[st, '0+(ORD[c] / 100b)];
                    IO.PutChar[st, '0+((ORD[c] MOD 100b) / 10b)];
                    IO.PutChar[st, '0+(ORD[c] MOD 10b)];
                    };
            };
        st: STREAM = out.st;
        IO.PutChar[st, '\"];
        [] Ź Rope.Map[base: bytes, action: each];
        IO.PutChar[st, '\"];
        };

    PutLocation: PROC [out: OutputContext, loc: Location] = {
        IF loc # NIL THEN {
            PutRopeLit[out, " ("];
            WITH loc SELECT FROM
                system: REF LocationRep.system => {
                    PutRopeLit[out, "system "];
                    PutId[out, system.id];
                    };
                globalVar: REF LocationRep.globalVar => {
                    PutRopeLit[out, "globalVar "];
                    PutId[out, globalVar.id];
                    };
                localVar: REF LocationRep.localVar => {
                    PutRopeLit[out, "localVar "];
                    PutId[out, localVar.id];
                    PutRopeLit[out, " "];
                    PutLabel[out, localVar.parent];
                    };
                register: REF LocationRep.register => {
                    PutRopeLit[out, "register "];
                    PutId[out, register.id];
                    };
                link: REF LocationRep.link => {
                    PutRopeLit[out, "link "];
                    PutId[out, link.id];
                    };
                stack: REF LocationRep.stack => {
                    PutRopeLit[out, "stack"];
                    IF stack.offset # 0 THEN PutInt[out, stack.offset, " %g"];
                    };
                deref: REF LocationRep.deref => {
                    PutRopeLit[out, "deref"];
                    PutNode[out, deref.addr];
                    IF deref.align # defaultBits THEN PutInt[out, deref.align, " %g"];
                    };
                indexed: REF LocationRep.indexed => {
                    PutRopeLit[out, "indexed"];
                    PutNode[out, indexed.base, TRUE];
                    PutNode[out, indexed.index, TRUE];
                    };
                field: REF LocationRep.field => {
                    IF field.cross 
                        THEN PutRopeLit[out, "xfield"] --little endian only ChJ, May 4, 1993
                        ELSE PutRopeLit[out, "field"];
                    PutInt[out, field.start, " %g"];
                    PutNode[out, field.base, TRUE];
                    };
                upLevel: REF LocationRep.upLevel => {
                    PutRopeLit[out, "upLevel {"];
                    PutVar[out, upLevel.link, FALSE];
                    PutRopeLit[out, "} {"];
                    PutVar[out, upLevel.reg, FALSE];
                    PutInt[out, upLevel.format, "} %g"];
                    };
                composite: REF LocationRep.composite => {
                    PutRopeLit[out, "composite"];
                    PutNodeList[out, composite.parts, TRUE];
                    };
                escape: REF LocationRep.escape => {
                    PutRopeLit[out, "escape "];
                    PutId[out, escape.id];
                    IF escape.offset # 0 THEN PutInt[out, escape.offset, " %g"];
                    PutNode[out, escape.base, TRUE];
                    };
                dummy: REF LocationRep.dummy => {
                    PutRopeLit[out, "dummy"];
                    };
                ENDCASE => ERROR;
            PutRopeLit[out, ")"];
            };
        };

    IsComplexList: PROC [list: NodeList] RETURNS [BOOL] = {
        count: NAT Ź 0;
        FOR each: NodeList Ź list, each.rest WHILE each # NIL DO
            IF IsComplex[each.first, TRUE] THEN RETURN [TRUE];
            IF (count Ź count + 1) > 3 THEN RETURN [TRUE];
            ENDLOOP;
        RETURN [FALSE];
        };

    IsComplex: PROC [node: Node, inList: BOOL Ź FALSE] RETURNS [BOOL] = {
        IF node = NIL THEN RETURN [FALSE];
        WITH node SELECT FROM
            var: REF NodeRep.var => RETURN [IsComplexLocation[var.location, inList]];
            const: REF NodeRep.const => RETURN [FALSE];
            decl: REF NodeRep.decl => RETURN [IsComplex[decl.init]];
            assign: REF NodeRep.assign => RETURN [inList OR IsComplex[assign.rhs]];
            label: REF NodeRep.label => RETURN [label.label # NIL AND IsComplex[label.label.node]];
            goto: REF NodeRep.goto => RETURN [FALSE];
            return: REF NodeRep.return => RETURN [IsComplexList[return.rets]];
            oper: REF NodeRep.oper => RETURN [FALSE];
            source: REF NodeRep.source => RETURN [IsComplexList[source.nodes]];
            ENDCASE => RETURN [TRUE];
        };

    IsComplexLocation: PROC [location: Location, inList: BOOL Ź FALSE] RETURNS [BOOL] = {
        IF location = NIL THEN RETURN [FALSE];
        WITH location SELECT FROM
            deref: REF LocationRep.deref => RETURN [inList OR IsComplex[deref.addr, TRUE]];
            indexed: REF LocationRep.indexed => RETURN [TRUE];
            field: REF LocationRep.field => RETURN [TRUE];
            upLevel: REF LocationRep.upLevel => RETURN [TRUE];
            composite: REF LocationRep.composite => RETURN [TRUE];
            escape: REF LocationRep.escape => RETURN [TRUE];
            ENDCASE => RETURN [FALSE];
        };

<<Basic output routines>>
    OutputContext: TYPE = REF OutputContextRep;
    OutputContextRep: TYPE = RECORD [
        nodeLevel: INTEGER Ź 0,
        writtenLevel: INTEGER Ź 0,
        empty: BOOL Ź TRUE,
        st: STREAM Ź NIL,
        text: REF TEXT Ź NIL,
        tos: STREAM Ź NIL
        ];

    CreateOutputContext: PROC [st: STREAM] RETURNS [OutputContext] = {
        out: OutputContext Ź z.NEW[OutputContextRep];
        IF st # NIL
            THEN {
                out.st Ź st;
                }
            ELSE {
                ERROR;
                };
        RETURN [out];
        };

    EndLine: PROC [out: OutputContext, comment: BOOL Ź FALSE] = {
        SELECT TRUE FROM
            out.st # NIL => IO.PutChar[out.st, '\n];
            ENDCASE => ERROR;
        out.empty Ź TRUE;
        };

    StartLine: PROC [out: OutputContext] = {
        SELECT TRUE FROM
            out.st # NIL => {
                st: STREAM Ź out.st;
                THROUGH [out.writtenLevel..out.nodeLevel) DO
                    IO.PutChar[st, ' ];
                    IO.PutChar[st, ' ];
                    ENDLOOP;
                };
            ENDCASE => ERROR;
        out.empty Ź FALSE;
        };

    PutChar: PROC [out: OutputContext, char: CHAR] = {
        IF out.empty THEN StartLine[out];
        SELECT TRUE FROM
            out.st # NIL =>
                IO.PutChar[out.st, char];
            ENDCASE => ERROR;
        };

    PutRopeLit: PROC [out: OutputContext, s: LONG STRING] = {
        IF out.empty THEN StartLine[out];
        SELECT TRUE FROM
            out.st # NIL =>
                IO.PutRope[out.st, ConvertUnsafe.ToRope[s]];
            ENDCASE => ERROR;
        };

    PutText: PROC [out: OutputContext, text: REF TEXT] = {
        IF out.empty THEN StartLine[out];
        SELECT TRUE FROM
            out.st # NIL =>
                IO.PutText[out.st, text];
            ENDCASE => ERROR;
        };

    PutF1: PROC [out: OutputContext, format: ROPE, value: IO.Value] = {
        IF out.empty THEN StartLine[out];
        SELECT TRUE FROM
            out.st # NIL =>
                IO.PutF1[out.st, format, value];
            ENDCASE => ERROR;
        };

    NoteStrange: PROC = {
        IF signalStrange THEN SIGNAL StrangeCondition;
        };


    END.