
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] ~ {
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 {
thread.tree _ v;
threadlist _ CONS[thread, threadlist];
thread _ NEW[ThreadsVisPrivate.ThreadRep];
thread.name _ NIL;
thread.idList _ CardTab.Create[];
thread.nameTable _ SymTab.Create[];
};
};
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 {
} 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];
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;
[eventFacts, commentText] _ ReadEvents[stream, commentText, throwAwayUnix];
IO.Close[stream];
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;
UNTIL workHead = NIL DO
workItem: ThreadsVisPrivate.WorkItem _ NARROW[workHead.first];
tmpResult _ workItem.doneAlready;
currentWork _ workItem.toDo;
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;
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;
};

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.

  0  
ThreadsVisReadImpl.mesa
Copyright ╙1992 by Xerox Corporation.  All rights reserved.
Weiser, March 13, 1993 9:36 am PST
Does not handle multi-character escaped things.
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]]]]];
SimpleFeedback.Append[$ThreadsVis, oneLiner, $Complaint, IO.PutFR1["list2 size %g.", IO.card[CardTab.GetSize[NARROW[thread.idList]]]]];
PrintThreadEvents[threadlist];
PrintThreadInfo[threadlist];
SimpleFeedback.Append[$ThreadsVis, oneLiner, $Complaint, IO.PutFR1["Storing %g in cardtab", IO.card[c]]];
We canonicalize these, because we expect lots of repeats.
Read events now
Link events with threads
step through to the bottom of each stack
follow one stack all the way
if we see extra children, add them to the list of further stacks to follow
event order was reversed on reading, then reversed again here.  Thus t.elist is in correct order for all t.
Э╩ф  ХNewlineDelimiter
Щ codeЩKЪЬ
╧eЬ0Щ;KЩ"ЧKШ KЪ╧k	Ь.ЮЬЮЬ:ШxKШ KЪ╧nЬЮЬЮШ!KЪЮЬ<ЮЬЮЬ,ШvKЪЮЬШЪЬЮШKШ KЪЮЬЮЬЮЬШKШ ЧЪЯЬЮЬЮЬЮЬШ-JЩ/KЪЬЮЬШЪЮЬЮШЪЮЬ	ЮШKШKЪЬЮЬЮЬЮЬ(ШYKЪЮЬ0Ш7ЧKЪЮЬШЧKШKЪЬШKШ ЧЪ
ЯЬЮЬЮЬЮЬЮЬШ2KЪЮЬ&Ш,KЪЬШKШ ЧЪЯЬЮЬЮЬ
ЮЬЮЬЮЬ;ЮЬЮЬШzKЪ	ЬЮЬЮЬЮЬЮЬШ!KЪЬЮЬ╧c2ШFKЪЬЮЬШKЪЬЮЬШKЪЬЮЬШKЪЬЮЬЮЬЮЬЮЬЮЬЮЬШ!KЪЬЮЬЮЬЮЬЮЬЮЬШKЪЬЮЬЮЬЮЬШKЪЬЮЬЮЬЮЬШ3KЪЬ#ЮЬШDKШ!KШ#KЪЬЮЬ#Ш4ЪЮШKЪЬЮЬЮЬШKЪЬ+ЮЬ>ЮЬШrЪЮЬЮШЪЬШЪЮЬЮШШЪЮЬЮЬЮЬЮЬШ>KЪЮЬ+ЮЬШGЧKЪЮШKШЧЪЬШKЪЬШKЪЬЮЬШKЪЬЮЬЮЬШKЪЬЮЬШKЪЮЬШKЪЬШЧЪЬШKЪЬШKЪЬШKЪЬШKЪЬЮЬШKЪЬЮЬШЪ
ЮЬ	ЮЬЮЬЮЬЮЬШ*KЩ%KЩEKЪЬ9ЮЬЮЬЮЬЩЗKШKЪЬЮЬШ&KЪЬ	ЮЬШ*KЪЬЮЬШKШ!KШ#KЪЬ9ЮЬЮЬЮЬЩЗKЩKЩKШЧKЪЬШЧKЪЮЬЮЬШЧKЪЬШЧЪЬШKЪЬЮЬ9Ш@KЪЬЮЬЮЬШЪЮЬЮЬШKЪЬЮЬШЪЮЬЮЬЮЬЮЬШ6KЪЬ9ЮЬ!ЮЬЩiKЪЬЮЬШKШPKШЧKШЧKШЧЪЬШKЪЬ%Ш%KЪЬШЧЪЬШKЪЬЮЬШKЪЬЮЬШKЪЬШKШ%KШKЩ9KШKЪЮЬЮЬЮЬШ*KЪЬЮЬЮЬШ5KЪЬШЧKЪЮЬЮЬШЧЪЮЬ	ЮЬЮЬЮШKШKШKЪЮЬШ"KШЧKЪЬЮЬШKЪЮЬШЧKЪЮЬ$ЮЬ(ЮЬШkKЪЬШKШ ЧЪ
ЮЬЮЬЮЬЮЬЮЬШKШ ЧЪ
ЯЬЮЬЮЬЮЬЮЬШ/KЪ
ЮЬЮЬЮЬЮЬЮЬШCKЪЬШЧЪЯ
ЬЮЬЮЬЮЬЮЬЮЬЮЬШ:KЪЮЬЮЬЮЬ	ЮЬШHKЪЬШЧШ KШ ЧЪЯЬЮЬЮЬЮЬЮЬЮЬeЮЬШ║KЪЮЬЮЬ5Ш?KЪ	ЬЮЬЮЬЮЬЮЬШ?KЪЬ	ЮЬШKШ!KЪЬЮЬЮЬШ-KЪЬЮЬШKШGKШ;KШ@ЪЮШKЪЬЮЬЮЬЮЬШ7ЪЮЬ)ЮЬШ2ЪЮЬЮЬЮЬШ,KЪЮЬ1Ш5ЧKШЧKЪЮЬ3ЮЬЮЬШ?KЪЮЬШЧKЩKШKKЪЮЬШKЩKШBKЪЮЬ'Ш-ЪЬШKШ ЧЧЪЯ
ЬЮЬ
ЮЬЮЬЮЬЮЬЮЬ5ЮЬШФKШKЪЬЮЬШKЪЬЮЬЮЬШKЪ	ЬЮЬЮЬЮЬЮЬШ!KШKЪЬ	ЮЬ"Ш.KЪЬЮЬШKЪЬЮЬЮЬШKШ%KШЪЮШKЪЬЮЬЮЬЮЬШ7ЪЮЬ)ЮЬШ2ЪЮЬЮЬЮЬШ,KЪЮЬ1Ш5ЧKЪЮЬШKШЧKЪЬЮЬЮЬШKЪЬЮЬШ(KЪЬЮЬЮЬЮЬШ@KШ+KЪЬЮЬШ$KЪЬЮЬШ$KЪЬЮЬШ(KЪЬЮЬШ)KЪЬЮЬШKШ1KЪ	ЮЬЮЬ(ЮЬЮЬа?ШЖKЪЬЮЬШ)KЪЮЬЮЬЮЬШKKЪЮЬЮЬШ8KЪЮЬЮЬЮЬШWKЪЮЬЮЬЮЬШWKЪЬЮЬ&Ш?KЪЮЬШЧKЪЮЬЮШKШKШ ЧЪ	ЬЮЬЮЬЮЬЮЬШ!KШ ЧЪЯ	ЬЮЬЮЬЮЬ
ЮЬЮЬЮЬЮЬШFKЪЬЮЬЮЬШ'KШ%KШШ KШ ЧЧЪЯЬЮЬЮЬЮЬЮЬЮЬЮЬШMЪЯЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШ1KЪЬ*ЮЬШ4KШ-KШЧЪЯЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШ3KЪЬ	ЮЬЮЬЮЬЮЬЮЬШ%KШKШЧKШKШKЪЮЬШKШKШ ЧЪЯЬЮЬЮЬЮЬ
ЮЬЮЬЮЬЮЬШEKЪ	Ь7ЮЬЮЬЮЬЮЬШGKШ$KЪЬЮЬЮЬ"ЮЬЮЬЮЬЮЬЮЬЮЬШXKШKЪЬ	ЮЬШKЩ(ЪЮЬЮ	ШKЪЬ'ЮЬШ>KШ!KШKЩЪЮЬЮЬЮШKЪЬЮЬ"Ш-KШ3KЪЬЮЬЮЬЮЬШ0KЪЬЮЬШ#KЪ
ЮЬ-ЮЬЮЬ2ЮЬЮЬШ~KЩJЪЮЬ	Ю	ШKЪЬЮЬ"ЮЬЮЬЮЬЮЬЮЬШ|KШKЪЮЬШЧKЪЮЬ-ЮЬЮЬЮЬ2ЮЬЮЬШХKЪЮЬШЧKЪЬ	ЮЬШ!KШKЪЮЬШЧKШKШ ЧKШ ЪЯЬЮЬOЮЬЮЬШВKЪЬЮЬЮЬ)Ш7KЪЬЮЬЮЬ(Ш6KЪЬЮЬШKШKШKЪЬЮЬЮЬ"Ш4KШЪЮЬ	ЮЬЮШKШKЪЬ
ЮЬШKШKЪЮЬШЧЪЮЬ	ЮЬЮШKШKЪЬЮЬШKШЪЮЬ	ЮЬЮШKШЪЮЬЮЬЮЬШ7KШKЪЬ	ЮЬШKЪЬ-ЮЬШPKЪЬ
ЮЬШKЪЬЮЬШKЪЮЬШKШЧKШKЪЮЬШЧЪЮЬЮЬЮЬШKЪЬ8ЮЬ*ЮЬШtKШЧKШKЪЮЬШЧKЩkKШKШ ЧЪЯЬЮЬ	ЮЬЮЬШEKШKШЪЮЬЮЬЮШKШKЪЬ8ЮЬЮЬЮЬШ{KШKЪЮЬШЧKШKШ ЧЪЯЬЮЬ	ЮЬЮЬШCKШKШЪЮЬЮЬЮШKШKЪЬ8ЮЬЮЬЮЬШzKШKЪЮЬШЧKШKШ ЧKШ KШ KЪЮЬШJШ Ч ЕЧ    %j  6~  