1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
############################################################################
#
# File: evaltree.icn
#
# Subject: Procedures to maintain activation tree
#
# Author: Clinton Jeffery
#
# Date: June 19, 1994
#
###########################################################################
#
# This file is in the public domain.
#
############################################################################
#
# Usage: evaltree(cset, procedure, record constructor)
#
# The record type must have fields node, parent, children
#
# See "A Framework for Monitoring Program Execution", Clinton L. Jeffery,
# TR 93-21, Department of Computer Science, The University of Arizona,
# July 30, 1993.
#
############################################################################
#
# Requires: MT Icon and event monitoring
#
############################################################################
$include "evdefs.icn"
record __evaltree_node(node,parent,children)
global CallCodes,
SuspendCodes,
ResumeCodes,
ReturnCodes,
FailCodes,
RemoveCodes
procedure evaltree(mask, callback, activation_record)
local c, current, p, child
/activation_record := __evaltree_node
CallCodes := string(mask ** cset(E_Pcall || E_Fcall || E_Ocall || E_Snew))
SuspendCodes := string(mask ** cset(E_Psusp || E_Fsusp ||
E_Osusp || E_Ssusp))
ResumeCodes := string(mask ** cset(E_Presum || E_Fresum || E_Oresum ||
E_Sresum))
ReturnCodes := string(mask ** cset(E_Pret || E_Fret || E_Oret))
FailCodes := string(mask ** cset(E_Pfail || E_Ffail || E_Ofail || E_Sfail))
RemoveCodes := string(mask ** cset(E_Prem || E_Frem || E_Orem || E_Srem))
current := activation_record()
current.parent := activation_record()
current.children := []
current.parent.children := []
while EvGet(mask) do {
case &eventcode of {
!CallCodes: {
c := activation_record()
c.node := &eventvalue
c.parent := current
c.children := []
put(current.children, c)
current := c
callback(current, current.parent)
}
!ReturnCodes | !FailCodes: {
p := pull(current.parent.children)
current := current.parent
callback(current, p)
}
!SuspendCodes: {
current := current.parent
callback(current, current.children[-1])
}
!ResumeCodes: {
current := current.children[-1]
callback(current, current.parent)
}
!RemoveCodes: {
if child := pull(current.children) then {
while put(current.children, pop(child.children))
callback(current, child)
}
else {
if current === current.parent.children[-1] then {
p := pull(current.parent.children)
current := current.parent
callback(current, p)
next
}
else stop("evaltree: unknown removal")
}
}
default: {
callback(current, current)
}
}
}
end
|
