<<>>
    <<ThreadsVisReadImpl.mesa>>
        <<Copyright Ó1992 by Xerox Corporation.  All rights reserved.>>
        <<Weiser, March 13, 1993 9:36 am PST>>

    DIRECTORY List, CardTab, Convert, Rope, RefText, Atom, IO, PFS, CommanderOps, ThreadsVisPrivate, SimpleFeedback, SymTab;

    ThreadsVisReadImpl: CEDAR PROGRAM
    IMPORTS List, CardTab, Rope, CommanderOps, Convert, RefText, Atom, IO, PFS, SimpleFeedback, ThreadsVisPrivate,  SymTab
    EXPORTS ThreadsVisPrivate
    ~ BEGIN

        ROPE: TYPE ~ Rope.ROPE;

    StripQuotes: PUBLIC PROC [text: REF TEXT] ~ {
    <<Does not handle multi-character escaped things.>>
        i, j: NAT Ź 0;
        UNTIL i = text.length DO
            SELECT text[i] FROM
                '" => { i Ź i + 1 };
                '\\ => { i Ź i + 1; IF i = text.length THEN ERROR; text[j] Ź text[i]; i Ź i+1; j Ź j+1 };
                ENDCASE => { text[j] Ź text[i]; i Ź i + 1; j Ź j + 1 };
            ENDLOOP;
        text.length Ź j;
        };

    Canon: PUBLIC PROC [rope: ROPE] RETURNS [ROPE] ~ {
        RETURN [Atom.GetPName[Atom.MakeAtom[rope]]];
        };

    ReadAny: PUBLIC PROC [stream: IO.STREAM] RETURNS [threadFacts: ThreadsVisPrivate.ThreadFacts, commentText: ROPE _ NIL] ~ {
        buffer: REF TEXT Ź NEW[TEXT[80]];
        firstRecord: BOOL;  -- the first decimal after a paren is the uniqueID
        tokenKind: IO.TokenKind;
        charsSkipped: INT;
        error: IO.TokenError;
        stack: LIST OF LIST OF REF Ź NIL;
        head: LIST OF REF Ź LIST[NIL];
        last: LIST OF REF Ź head;
        threadlist: LIST OF ThreadsVisPrivate.Thread _ NIL;
        thread: ThreadsVisPrivate.Thread _ NEW[ThreadsVisPrivate.ThreadRep];
        thread.idList _ CardTab.Create[];
        thread.nameTable _ SymTab.Create[];
        threadFacts _ NEW[ThreadsVisPrivate.ThreadFactsRep];
        DO
            v: REF Ź NIL;
            [tokenKind, buffer, charsSkipped, error] Ź IO.GetCedarToken[stream: stream, buffer: buffer, flushComments: FALSE];
            SELECT tokenKind FROM
                tokenSINGLE => {
                    SELECT buffer[0] FROM
                        '; => {
                            IF commentText = NIL THEN commentText _ IO.GetLineRope[stream]
                                ELSE commentText _ Rope.Cat[commentText, "\n", IO.GetLineRope[stream]];
                            LOOP
                            };
                        '( => {
                            head.first Ź last;
                            stack Ź CONS[head, stack];
                            last Ź head Ź LIST[NIL];
                            firstRecord _ TRUE;
                            LOOP;
                            };
                        ') => {
                            v Ź head.rest;
                            head Ź stack.first;
                            stack Ź stack.rest;
                            last Ź NARROW[head.first];
                            head.first Ź NIL;
                            IF stack # NIL AND stack.rest = NIL THEN {
                                <<leaving a new thread, record the info>>
                                <<SimpleFeedback.Append[$ThreadsVis, oneLiner, $Feedback, "new stack"];>>
                                <<SimpleFeedback.Append[$ThreadsVis, oneLiner, $Complaint, IO.PutFR1["list1 size %g.", 
                                IO.card[CardTab.GetSize[NARROW[thread.idList]]]]];>>
                                thread.tree _ v;
                                threadlist _ CONS[thread, threadlist];
                                thread _ NEW[ThreadsVisPrivate.ThreadRep];
                                thread.name _ NIL;
                                thread.idList _ CardTab.Create[];
                                thread.nameTable _ SymTab.Create[];
                                <<SimpleFeedback.Append[$ThreadsVis, oneLiner, $Complaint, IO.PutFR1["list2 size %g.", 
                                IO.card[CardTab.GetSize[NARROW[thread.idList]]]]];>>
                                <<PrintThreadEvents[threadlist];>>
                                <<PrintThreadInfo[threadlist];>>
                                };
                            };
                        ENDCASE => GOTO ParseFailed;
                    };
                tokenDECIMAL => {
                    c: CARD Ź Convert.CardFromRope[RefText.TrustTextAsRope[buffer]];
                    v Ź NEW[CARD Ź c];
                    IF firstRecord THEN {
                        firstRecord _ FALSE;
                        IF CardTab.Store[NARROW[thread.idList], c, NIL] THEN {
                            <<SimpleFeedback.Append[$ThreadsVis, oneLiner, $Complaint, IO.PutFR1["Storing %g in cardtab", IO.card[c]]];>>
                            } ELSE {
                            SimpleFeedback.Append[$ThreadsVis, oneLiner, $Complaint, "duplicate thread ID"];
                            };
                        };
                    };
                tokenID => {
                    v Ź Atom.MakeAtomFromRefText[buffer];
                    };
                tokenROPE => {
                    a: ATOM;
                    r: ROPE;
                    StripQuotes[buffer];
                    a _ Atom.MakeAtomFromRefText[buffer];
                    r _ Rope.FromRefText[buffer];
                    <<We canonicalize these, because we expect lots of repeats.>>
                    v Ź Atom.GetPName[a];
                    IF thread.name = NIL THEN thread.name _ r;
                    [] _ SymTab.Insert[NARROW[thread.nameTable], r, NIL];
                    };
                ENDCASE => GOTO ParseFailed;
            IF stack = NIL THEN {
                threadFacts.tlist _ threadlist;
                threadFacts.tree _ v;
                RETURN [threadFacts, commentText];
                };
            last Ź last.rest Ź LIST[v];
            ENDLOOP;
        EXITS ParseFailed => CommanderOps.Failed[IO.PutFR1["Parse error near %g", [integer[IO.GetIndex[stream]]]]];
        };

    ST: TYPE ~ LIST OF REF;

    STName: PUBLIC PROC [st: ST] RETURNS [ROPE] ~ {
        RETURN [IF st.first = $Merged THEN "*" ELSE NARROW[st.rest.first]];
        };
    STChildren: PUBLIC PROC [st: ST] RETURNS [LIST OF REF] ~ {
        RETURN [IF st.first = $Merged THEN st.rest ELSE st.rest.rest.rest.rest];
        };


    ReadTreeFromFile: PUBLIC PROC [fileName: ROPE, throwAwayUnix: BOOL] RETURNS [threadFacts: ThreadsVisPrivate.ThreadFacts, 
    eventFacts: ThreadsVisPrivate.EventFacts, commentText: ROPE ] ~ {
        ENABLE PFS.Error => { CommanderOps.Failed[error.explanation] };
        stream: IO.STREAM ~ PFS.StreamOpen[PFS.PathFromRope[fileName]];
        spyTree: ST;
        thread: ThreadsVisPrivate.Thread;
        threadlist: LIST OF ThreadsVisPrivate.Thread;
        line: ROPE;
        [threadFacts: threadFacts, commentText: commentText] Ź ReadAny[stream];
        threadFacts.stackList _ InvertThreadTree[threadFacts.tree];
        threadFacts.stackTable _ BuildStackTable[threadFacts.stackList];
        DO
            line _ IO.GetLineRope[stream ! IO.EndOfStream => EXIT];
            IF Rope.Equal[Rope.Substr[line, 0, 1], ";"] THEN {
                IF commentText = NIL THEN commentText _ line
                    ELSE commentText _ Rope.Cat[commentText, "\n", line];
                };
            IF Rope.Equal[Rope.Substr[line, 0, 9], ";;; Event"]  THEN EXIT;
            ENDLOOP;
        <<Read events now>>
        [eventFacts, commentText] _ ReadEvents[stream, commentText, throwAwayUnix];
        IO.Close[stream];
        <<Link events with threads>>
        eventFacts.nameTable _ BuildThreadsLists[threadFacts, eventFacts];
        RETURN [threadFacts, eventFacts, commentText]
        };

    ReadEvents: PROC [stream: IO.STREAM, inCommentText: ROPE, throwAwayUnix: BOOL] RETURNS [efacts: ThreadsVisPrivate.EventFacts, 
    commentText: ROPE] ~ {
        event: ThreadsVisPrivate.Event;
        line: ROPE;
        streamRope: IO.STREAM;
        buffer: REF TEXT Ź NEW[TEXT[80]];
        commentText _ inCommentText;
        efacts _ NEW[ThreadsVisPrivate.EventFactsRep];
        efacts.elist _ NIL;
        efacts.min _ LAST[CARD];
        efacts.eventTable _ CardTab.Create[];
        efacts.max _ 0;
        DO
            line _ IO.GetLineRope[stream ! IO.EndOfStream => EXIT];
            IF Rope.Equal[Rope.Substr[line, 0, 1], ";"] THEN {
                IF commentText = NIL THEN commentText _ line
                    ELSE commentText _ Rope.Cat[commentText, "\n", line];
                LOOP;
                };
            streamRope _ IO.RIS[line];
            event _ NEW[ThreadsVisPrivate.EventRep];
            event.id _ IO.GetCard[streamRope ! IO.EndOfStream => GOTO Done];
            event.type _ MyGetAtom[streamRope, buffer];
            event.time _ IO.GetCard[streamRope];
            event.node _ IO.GetCard[streamRope];
            event.wakeTime _ IO.GetCard[streamRope];
            event.wakeEvent _ IO.GetCard[streamRope];
            event.drawn _ FALSE;
            event.xstartpos _ event.xendpos _ event.ypos _ 0;
            IF throwAwayUnix AND Atom.GetPName[event.type].Length[] > 1 THEN LOOP; -- hack to throw away unix kernel events that aren't 
            understood
            efacts.elist _ CONS[event, efacts.elist];
            IF efacts.min > event.time AND event.time # 0 THEN efacts.min _ event.time;
            IF efacts.max < event.time THEN efacts.max _ event.time;
            IF efacts.min > event.wakeTime AND event.wakeTime # 0 THEN efacts.min _ event.wakeTime;
            IF efacts.max < event.wakeTime AND event.wakeTime # 0 THEN efacts.max _ event.wakeTime;
            [] _ CardTab.Store[NARROW[efacts.eventTable], event.id, event];
            ENDLOOP;
        EXITS Done => RETURN;
        };

    buffer: REF TEXT Ź NEW[TEXT[80]];

    MyGetAtom: PROC [s: IO.STREAM, buffer: REF TEXT] RETURNS [a: ATOM] ~ {
        [] _ IO.GetToken[s, IO.IDProc, buffer];
        a _ Atom.MakeAtomFromRefText[buffer];
        };


    BuildStackTable: PROC [t: LIST OF REF ANY] RETURNS [idTable: CardTab.Ref] ~ {
        DoItem: PROC [s: REF ANY, r: LIST OF REF ANY] ~ {
            stackItem: ThreadsVisPrivate.StackEntry _ NARROW[s];
            [] _ CardTab.Store[idTable, stackItem.id, r];
            };
        DoStack: PROC  [s: REF ANY, r: LIST OF REF ANY] ~ {
            myStack: LIST OF REF ANY _ NARROW[s];
            List.Map[myStack, DoItem];
            };
        idTable _ CardTab.Create[];
        List.Map[t, DoStack];
        RETURN [idTable];
        };

    InvertThreadTree: PROC [t: REF] RETURNS [result: LIST OF REF ANY] ~ {
        workHead, workTail, tmpResult, currentWork, extraWork: LIST OF REF ANY;
        stack: ThreadsVisPrivate.StackEntry;
        workHead _ LIST[NEW[ThreadsVisPrivate.WorkItemRep _ [NARROW[t, LIST OF REF ANY], NIL]]];
        workTail _ workHead;
        result _ NIL;
        <<step through to the bottom of each stack>>
        UNTIL workHead = NIL DO
            workItem: ThreadsVisPrivate.WorkItem _ NARROW[workHead.first];
            tmpResult _ workItem.doneAlready;
            currentWork _ workItem.toDo;
            <<follow one stack all the way>>
            UNTIL currentWork = NIL DO
                stack _ NEW[ThreadsVisPrivate.StackEntryRep];
                stack.name _ ThreadsVisPrivate.STName[currentWork];
                stack.id _ NARROW[currentWork.first, REF CARD]^;
                tmpResult _ CONS[stack, tmpResult];
                IF ThreadsVisPrivate.STChildren[currentWork] # NIL THEN extraWork _ currentWork.rest.rest.rest.rest.rest ELSE extraWork _ NIL;
                <<if we see extra children, add them to the list of further stacks to follow>>
                UNTIL extraWork = NIL DO
                    workTail _ workTail.rest _ LIST[NEW[ThreadsVisPrivate.WorkItemRep _ [NARROW[extraWork.first, LIST OF REF ANY], tmpResult]]];
                    extraWork _ extraWork.rest;
                    ENDLOOP;
                IF ThreadsVisPrivate.STChildren[currentWork] # NIL THEN currentWork _ NARROW[ThreadsVisPrivate.STChildren[currentWork].first] ELSE 
                currentWork _ NIL;
                ENDLOOP;
            result _ CONS[tmpResult, result];
            workHead _ workHead.rest;
            ENDLOOP;
        };


    BuildThreadsLists: PROC [tfacts: ThreadsVisPrivate.ThreadFacts, efacts: ThreadsVisPrivate.EventFacts] RETURNS [nameTable: REF] ~ {
        tlist: LIST OF ThreadsVisPrivate.Thread _ tfacts.tlist;
        elist: LIST OF ThreadsVisPrivate.Event _ efacts.elist;
        done: BOOL;
        t: ThreadsVisPrivate.Thread;
        e: ThreadsVisPrivate.Event;
        origTlist: LIST OF ThreadsVisPrivate.Thread = tlist;
        nameTable _ SymTab.Create[];
        WHILE tlist # NIL DO
            t _ tlist.first;
            t.elist _ NIL;
            tlist _ tlist.rest;
            ENDLOOP;
        WHILE elist # NIL DO
            e _ elist.first;
            done _ FALSE;
            tlist _ origTlist;
            WHILE tlist # NIL DO
                t _ tlist.first;
                IF CardTab.Fetch[NARROW[t.idList], e.node].found THEN {
                    myval: CardTab.Val;
                    myfound: BOOL;
                    [val: myval, found: myfound] _ CardTab.Fetch[NARROW[tfacts.stackTable], e.node];
                    t.elist _ CONS[e, t.elist];
                    done _ TRUE;
                    EXIT;
                    };
                tlist _ tlist.rest;
                ENDLOOP;
            IF NOT done THEN {
                SimpleFeedback.Append[$ThreadsVis, oneLiner, $Feedback, IO.PutFR1["event %g references no thread.", IO.card[e.id]]];
                };
            elist _ elist.rest;
            ENDLOOP;
        <<event order was reversed on reading, then reversed again here.  Thus t.elist is in correct order for all t.>>
        };

    PrintThreadEvents: PROC [tlist: LIST OF ThreadsVisPrivate.Thread] = {
        t: ThreadsVisPrivate.Thread;
        t _ tlist.first;
        WHILE tlist.rest # NIL DO
            t _ tlist.first;
            SimpleFeedback.Append[$ThreadsVis, oneLiner, $Feedback, IO.PutFR1["size %g.", IO.card[CardTab.GetSize[NARROW[t.idList]]]]];
            tlist _ tlist.rest;
            ENDLOOP;
        };

    PrintThreadInfo: PROC [tlist: LIST OF ThreadsVisPrivate.Thread] = {
        t: ThreadsVisPrivate.Thread;
        t _ tlist.first;
        WHILE tlist.rest # NIL DO
            t _ tlist.first;
            SimpleFeedback.Append[$ThreadsVis, oneLiner, $Feedback, IO.PutFR1["Tree size %g.", IO.card[List.Length[NARROW[t.tree]]]]];
            tlist _ tlist.rest;
            ENDLOOP;
        };


    END.