diff options
Diffstat (limited to 'ipl/mprogs')
33 files changed, 0 insertions, 4844 deletions
diff --git a/ipl/mprogs/alcscope.icn b/ipl/mprogs/alcscope.icn deleted file mode 100644 index 2629cf6..0000000 --- a/ipl/mprogs/alcscope.icn +++ /dev/null @@ -1,312 +0,0 @@ -############################################################################ -# -# File: alcscope.icn -# -# Subject: Program to visualize allocation as a kaleidoscopic display -# -# Author: Ralph E. Griswold -# -# Date: July 14, 1997 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This program displays kaleidoscopic images. The controls on the -# user interface are relatively intuitive -- trying them will give -# a better idea of what's possible than a prose description here. -# -# This program is based on an earlier one by Steve Wampler, which in -# turn was based on a C program by Lorraine Callahan. -# -# This version is adapted to visualize storage management. -# -############################################################################ -# -# Requires: Version 9 graphics -# -############################################################################ -# -# Links: interact, random, vsetup -# -############################################################################ - -link interact -link vsetup -link colormap -link evinit - -# Interface globals - -global vidgets # table of vidgets -global root # the root vidget -global size # size of view area (width & height) -global half # half size of view area -global pane # graphics context for viewing - -# Parameters that can be set from the interface - -global delayval # delay between drawing circles -global density # number of circles in steady state -global draw_proc # drawing procedure -global max_off # maximum offset of circle -global min_off # minimum offset of circle -global scale # scaling factor for sizes -global color # color table - -# State information - -global draw_list # list of pending drawing parameters -global reset # nonnull when view area needs resetting -global state # nonnull when display paused - -$include "evdefs.icn" - -procedure main(args) - - init(args) - - kaleidoscope() - -end - -procedure init(args) - - color := colormap() - - vidgets := ui() - - root := vidgets["root"] - size := vidgets["region"].uw - if vidgets["region"].uh ~= size then stop("*** improper interface layout") - -# Set initial values. - - draw_proc := FillCircle - - state := &null - -# Initialize vidget values. - - density := VGetState(vidgets["density"]) - delayval := VGetState(vidgets["speed"]) - scale := VGetState(vidgets["scale"]) - VSetState(vidgets["shape"], "rings") - -# Get graphics context for drawing. - - half := size / 2 - - pane := Clone("bg=black", "dx=" || (vidgets["region"].ux + half), - "dy=" || (vidgets["region"].uy + half), "drawop=reverse") - Clip(pane, -half, -half, size, size) - - EvInit(args) | ExitNotice("Cannot load SP.") - - every variable("write" | "writes", &eventsource) := -1 - - return - -end - -procedure kaleidoscope() - - # Each time through this loop, the display is cleared and a - # new drawing is started. - - repeat { - - EraseArea(pane, -half, -half, size, size) # clear display - draw_list := [] # new drawing list - reset := &null - - # In this loop a new circle is drawn and an old one erased, once the - # specified density has been reached. This maintains a steady state. - - repeat { - while (*Pending() > 0) | \state do { - ProcessEvent(root, , shortcuts) - if \reset then break break next - } - putcircle() - WDelay(delayval) - - # Don't start clearing circles until the specified density has - # reached. (The drawing list has four elements for each circle.) - - if *draw_list > (4 * density) then clrcircle() - } - } - -end - -procedure putcircle() - local off1, off2, radius, fg - - EvGet(AllocMask) | ExitNotice("SP terminated.") - - fg := color[&eventcode] - radius := sqrt(&eventvalue * scale) - - # get a random center point and radius - - off1 := ?size % half - off2 := ?size % half - - put(draw_list, off1, off2, radius, fg) - - outcircle(off1, off2, radius, fg) - - return - -end - -procedure clrcircle() - - outcircle( - get(draw_list), # off1 - get(draw_list), # off2 - get(draw_list), # radius - get(draw_list) # color - ) - - return - -end - -procedure outcircle(off1, off2, radius, color) - - Fg(pane, color) - - # Draw in symmetric positions. - - draw_proc(pane, off1, off2, radius) - draw_proc(pane, off1, -off2, radius) - draw_proc(pane, -off1, off2, radius) - draw_proc(pane, -off1,-off2, radius) - draw_proc(pane, off2, off1, radius) - draw_proc(pane, off2, -off1, radius) - draw_proc(pane, -off2, off1, radius) - draw_proc(pane, -off2,-off1, radius) - - return - -end - -procedure density_cb(vidget, value) - - density := value - - reset := 1 - -end - -procedure speed_cb(vidget, value) - - delayval := value - - return - -end - -procedure file_cb(vidget, value) - - case value[1] of { - "snapshot @S": snapshot(pane, -half, -half, size, size) - "quit @Q": exit() - } - - return - -end - -procedure scale_cb(vidget, value) - - scale := value - - return - -end - -procedure pause_cb(vidget, value) - - state := value - - return - -end - -procedure reset_cb(vidget, value) - - reset := 1 - - return - -end - -procedure shape_cb(vidget, value) - - draw_proc := case value of { - "discs": FillCircle - "rings": DrawCircle - } - - reset := 1 - - return - -end - -procedure shortcuts(e) - - if &meta then - case map(e) of { # fold case - "q": exit() - "s": snapshot(pane, -half, -half, size, size) - } - - return - -end - -#===<<vib:begin>>=== modify using vib; do not remove this marker line -procedure ui_atts() - return ["size=600,455", "bg=gray-white", "label=kaleido"] -end - -procedure ui(win, cbk) -return vsetup(win, cbk, - [":Sizer:::0,0,600,455:kaleido",], - ["density:Slider:h:1:41,171,100,15:10,100,50",density_cb], - ["file:Menu:pull::12,3,36,21:File",file_cb, - ["snapshot @S","quit @Q"]], - ["label07:Label:::7,120,28,13:slow",], - ["label08:Label:::151,120,28,13:fast",], - ["label10:Label:::64,270,7,13:1",], - ["label11:Label:::124,270,7,13:5",], - ["label12:Label:::47,200,14,13:10",], - ["label13:Label:::116,200,21,13:100",], - ["label14:Label:::78,200,14,13:50",], - ["label9:Label:::43,270,14,13:.2",], - ["lbl_density:Label:::67,151,49,13:density",], - ["lbl_scale:Label:::74,220,35,13:scale",], - ["lbl_speed:Label:::74,100,35,13:speed",], - ["line:Line:::0,30,600,30:",], - ["line1:Line:::68,256,68,266:",], - ["line2:Line:::128,256,128,266:",], - ["line3:Line:::54,256,54,266:",], - ["line4:Line:::128,186,128,196:",], - ["line5:Line:::55,186,55,196:",], - ["line6:Line:::86,186,86,196:",], - ["pause:Button:regular:1:33,55,45,20:pause",pause_cb], - ["reset:Button:regular::111,55,45,20:reset",reset_cb], - ["scale:Slider:h:1:42,240,100,15:0.1,5,1",scale_cb], - ["shape:Choice::2:64,330,64,42:",shape_cb, - ["discs","rings"]], - ["speed:Slider:h:1:41,121,100,15:100,0,0",speed_cb], - ["region:Rect:raised::187,42,400,400:",], - ) -end -#===<<vib:end>>=== end of section maintained by vib diff --git a/ipl/mprogs/alcview.icn b/ipl/mprogs/alcview.icn deleted file mode 100644 index 85a007a..0000000 --- a/ipl/mprogs/alcview.icn +++ /dev/null @@ -1,258 +0,0 @@ -########################################################################### -# -# File: alcview.icn -# -# Subject: Program to display allocation events in various ways -# -# Author: Ralph E. Griswold -# -# Date: February 16, 1998 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This program maps allocation events into colors and provides various -# abstract visualizations of them. -# -# Several visualizations are available: -# -# beacon blinking light -# curves random closed curves -# haystack* randomly oriented lines -# nova* radiating lines -# pinwheel revolving sequence of sectors in a circle -# polygons random polygons -# splatter* randomly placed dots -# strip scrolling strip of vertical lines -# symplat as splatter, but in symmetric pattern -# vortex* expanding/contracting square vortex -# web* random walk -# -# The visualizations marked with asterisks use the size information. The -# others do not. -# -# In terms of the monitoring framework terminology, this program -# provides abstract visualizations for in an event space consisting -# of category/size pairs -- 2CS -- in which the categories are colors. -# -# The interface controls provide for: -# -# control of the display speed -# pausing the display -# resetting the display -# setting the period between automatic resetting -# changing the view -# -############################################################################ -# -# Requires: MT Icon, event monitoring, Version 9 graphics -# -############################################################################ -# -# Links: colormap, evinit, interact, viewpack, vsetup -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -link colormap -link evinit -link interact -link viewpack -link vsetup - -$include "evdefs.icn" - -global color -global vidgets -global viewer -global root -global pane -global state -global reset # vidget for resetting callback -global snap -global name -global point -global count # drawing count -global done -global default_color # default in case of bad color specification -global draw # drawing procedure for visualization -global width -global height -global period # automatic resetting count -global refresh # resetting switch - -# Prevent linker from deleting procedures that are not explicitly referenced. -invocable "beacon" -invocable "curves" -invocable "haystack" -invocable "nova" -invocable "pinwheel" -invocable "polygons" -invocable "splatter" -invocable "strip" -invocable "symsplat" -invocable "vortex" -invocable "web" - -# Main procedure - -procedure main(args) - - init(args) - - display() - -end - -# Initialization - -procedure init(args) - - EvInit(args) | stop("*** cannot load SP.") - - vidgets := ui() - - root := vidgets["root"] - reset := vidgets["reset"] - - state := &null - - width := vidgets["pane"].uw - height := vidgets["pane"].uh - - default_color := "black" - - refresh := period := -1 - count := 0 - done := &null - - viewer := "symsplat" - - color := colormap() - - draw := proc(viewer) | stop("*** internal inconsistency") - - pane := Clone("dx=" || vidgets["pane"].ux, "dy=" || vidgets["pane"].uy, - "bg=" || default_color) - Clip(pane, 0, 0, width, height) - - reset_cb() - -end - -# Display driver - -procedure display() - - repeat { - if period = 0 then reset_cb() - while (*Pending() > 0) | \state do - ProcessEvent(root, , shortcuts) - EvGet(AllocMask) | exit() - draw(pane, color[&eventcode], &eventvalue) - period -:= 1 - } - -end - -# Callbacks - -procedure quit_cb() - - exit() - -end - -procedure snapshot_cb() - - snapshot(pane, 0, 0, width, height) - - return - -end - -procedure period_cb() - - repeat { - if TextDialog("Reset period (negative value disables _ - automatic resetting:", , refresh, 6) == "Cancel" then fail - if refresh := period := integer(dialog_value[1]) then return - else { - Notice("Invalid period specification.") - next - } - } - -end - -procedure reset_cb() - - EraseArea(pane, 0, 0, width, height) - - period := refresh - - return - -end - -procedure view_cb() - static views - - initial { - views := [ - "beacon", - "curves", - "haystack", - "nova", - "pinwheel", - "polygons", - "splatter", - "strip", - "symsplat", - "vortex", - "web" - ] - } - - if SelectDialog("Select viewer:", views, viewer) == "Cancel" then fail - viewer := dialog_value - draw := proc(viewer) | - return FailNotice("Internal inconsistency; viewer not found.") - reset_cb() - - return - -end - -procedure shortcuts(e) - - if &meta then - case map(e) of { - "q": exit() - "r": reset_cb() - } - -end - -#===<<vib:begin>>=== modify using vib; do not remove this marker line -procedure ui_atts() - return ["size=311,210", "bg=pale gray"] -end - -procedure ui(win, cbk) -return vsetup(win, cbk, - [":Sizer:::0,0,311,210:",], - ["period:Button:regular::11,96,91,20:reset period",period_cb], - ["quit:Button:regular::34,19,42,20:quit",quit_cb], - ["reset:Button:regular::34,55,42,20:reset",reset_cb], - ["view:Button:regular::15,133,84,20:select view",view_cb], - ["pane:Rect:grooved::113,9,190,190:",], - ) -end -#===<<vib:end>>=== end of section maintained by vib diff --git a/ipl/mprogs/algae.icn b/ipl/mprogs/algae.icn deleted file mode 100644 index 1a92952..0000000 --- a/ipl/mprogs/algae.icn +++ /dev/null @@ -1,356 +0,0 @@ -######################################################################### -# -# File: algae.icn -# -# Subject: Program to show expression evaluation as ``algae'' -# -# Author: Clinton Jeffery -# -# Date: November 22, 1997 -# -######################################################################### -# -# This file is in the public domain. -# -############################################################################ -# -# Press ESC or q to quit -# Left mouse assigns specific (row,column) break "points" -# Middle mouse assigns absolute depth and width break lines -# Right button erases assigned break "points" -# -# When paused due to a break, you can: -# -# c to continue -# s to single step -# C to clear one point and continue -# " " to clear everything and continue -# -######################################################################### -# -# Requires: Version 9 graphics -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -$include "evdefs.icn" - -link evinit -link evutils -link options -link optwindw -link hexlib -link evaltree - -global scale, # cell (hexagon or square) size - step, # single step mode - numrows, # number of cell rows - numcols, # number of cell columns - spot, # cell-fill procedure (hex or square) - mouse, # cell-mouse-locator procedure - Visualization, # the window - wHexOutline, # binding for drawing cell outlines - depthbound, # call-depth on which to break - breadthbound, # suspension-width on which to break - hotspots # table of individual cells on which to break - -record algae_activation(node, row, column, parent, children, color) - - -# -# main() - program entry point. The main loop is in evaltree(). -# -procedure main(av) - local codes, algaeoptions - # - # pull off algae options (don't consume child's options in this call - # to options()). - # - algaeoptions := [] - while av[1][1] == "-" do { - put(algaeoptions, pop(av)) - if algaeoptions[-1] == "-f" then put(algaeoptions, pop(av)) - } - EvInit(av) | stop("Can't EvInit ",av[1]) - codes := algae_init(algaeoptions) - evaltree(codes, algae_callback, algae_activation) - WAttrib("windowlabel=Algae: finished") - EvTerm(&window) -end - -# -# algae_init() - initialization and command-line processing. -# This procedure supplies default behavior and handles options. -# -procedure algae_init(algaeoptions) - local t, position, geo, codes, i, cb, coord, e, s, x, y, m, row, column - t := options(algaeoptions, - winoptions() || "P:S:-geo:-square!-func!-scan!-op!-noproc!") - /t["L"] := "Algae" - /t["B"] := "cyan" - scale := \t["S"] | 12 - if \t["square"] then { - spot := square_spot - mouse := square_mouse - } - else { - scale /:= 4 - spot := hex_spot - mouse := hex_mouse - } - codes := cset(E_MXevent) - if /t["noproc"] then codes ++:= ProcMask - if \t["scan"] then codes ++:= ScanMask - if \t["func"] then codes ++:= FncMask - if \t["op"] then codes ++:= OperMask - hotspots := table() - &window := Visualization := optwindow(t) | stop("no window") - numrows := (XHeight() / (scale * 4)) - numcols := (XWidth() / (scale * 4)) - wHexOutline := Color("white") # used by the hexagon library - if /t["square"] then starthex(Color("black")) - return codes -end - -# -# algae_callback() - evaltree callback procedure for algae. -# Called for each event, it updates the screen to correspond -# to the change in the activation tree. -# -procedure algae_callback(new, old) - local coord, e - initial { - old.row := old.parent.row := 0; old.column := old.parent.column := 1 - } - case &eventcode of { - !CallCodes: { - new.column := (old.children[-2].column + 1 | computeCol(old)) | stop("eh?") - new.row := old.row + 1 - new.color := Color(&eventcode) - spot(\old.color, old.row, old.column) - } - !ReturnCodes | - !FailCodes: spot(Color("light blue"), old.row, old.column) - !SuspendCodes | - !ResumeCodes: spot(old.color, old.row, old.column) - !RemoveCodes: { - spot(Color("black"), old.row, old.column) - WFlush(Color("black")) - delay(100) - spot(Color("light blue"), old.row, old.column) - } - E_MXevent: do1event(&eventvalue, new) - } - spot(Color("yellow"), new.row, new.column) - coord := location(new.column, new.row) - if \step | (\breadthbound <= new.column) | (\depthbound <= new.row) | - \ hotspots[coord] then { - step := &null - WAttrib("windowlabel=Algae stopped: (s)tep (c)ont ( )clear ") - while e := Event() do - if do1event(e, new) then break - WAttrib("windowlabel=Algae") - if \ hotspots[coord] then spot(Color("light blue"), new.row, new.column) - } -end - - -# -# procedures for the "-square" option, display Algae using squares -# instead of hexagons. -# - -# Draw a square at (row, column) -procedure square_spot(w, row, column) - FillRectangle(w, (column - 1) * scale, (row - 1) * scale, scale, scale) -end - - -# encode a location value (base 1) for a given x and y pixel -procedure square_mouse(y, x) - return location(x / scale + 1, y / scale + 1) -end - -# -# clearspot() removes a "breakpoint" at (x,y) -# -procedure clearspot(spot) - local x, y, s2, x2, y2 - - hotspots[spot] := &null - y := vertical(spot) - x := horizontal(spot) - every s2 := \!hotspots do { - x2 := horizontal(s2) - y2 := vertical(s2) - } - spot(Visualization, y, x) -end - -# -# setspot() sets a breakpoint at (x,y) and marks it orange -# -procedure setspot(loc) - local x, y - - hotspots[loc] := loc - y := vertical(loc) - x := horizontal(loc) - spot(Color("orange"), y, x) -end - -# -# do1event() processes a single user input event. -# -procedure do1event(e, new) - local m, xbound, ybound, row, column, x, y, s, p - - case e of { - "q" | - "\e": exit() - "s": { # execute a single step - step := 1 - return - } - "C": { # clear a single break point - clearspot(location(new.column, new.row)) - return - } - " ": { # space character: clear all break points - if \depthbound then { - every y := 1 to numcols do { - if not who_is_at(depthbound, y, new) then - spot(Visualization, depthbound, y) - } - } - if \breadthbound then { - every x := 1 to numrows do { - if not who_is_at(x, breadthbound, new) then - spot(Visualization, x, breadthbound) - } - } - every s := \!hotspots do { - x := horizontal(s) - y := vertical(s) - spot(Visualization, y, x) - } - hotspots := table() - depthbound := breadthbound := &null - return - } - &mpress | &mdrag: { # middle button: set bound box break lines - if m := mouse(&y, &x) then { - row := vertical(m) - column := horizontal(m) - if \depthbound then { # erase previous bounding box, if any - every spot(Visualization, depthbound, 1 to breadthbound) - every spot(Visualization, 1 to depthbound, breadthbound) - } - depthbound := row - breadthbound := column - # - # draw new bounding box - # - every x := 1 to breadthbound do { - if not who_is_at(depthbound, x, new) then - spot(Color("orange"), depthbound, x) - } - every y := 1 to depthbound - 1 do { - if not who_is_at(y, breadthbound, new) then - spot(Color("orange"), y, breadthbound) - } - } - } - &lpress | &ldrag: { # left button: toggle single cell breakpoint - if m := mouse(&y, &x) then { - xbound := horizontal(m) - ybound := vertical(m) - if hotspots[m] === m then - clearspot(m) - else - setspot(m) - } - } - &rpress | &rdrag: { # right button: report node at mouse location - if m := mouse(&y, &x) then { - column := horizontal(m) - row := vertical(m) - if p := who_is_at(row, column, new) then - WAttrib("windowlabel=Algae " || image(p.node)) - } - } - } -end - -# -# who_is_at() - find the activation tree node at a given (row, column) location -# -procedure who_is_at(row, col, node) - while node.row > 1 & \node.parent do - node := node.parent - return sub_who(row, col, node) # search children -end - -# -# sub_who() - recursive search for the tree node at (row, column) -# -procedure sub_who(row, column, p) - local k - if p.column === column & p.row === row then return p - else { - every k := !p.children do - if q := sub_who(row, column, k) then return q - } -end - -# -# computeCol() - determine the correct column for a new child of a node. -# -procedure computeCol(parent) - local col, x, node - node := parent - while \node.row > 1 do # find root - node := \node.parent - if node === parent then return parent.column - if col := subcompute(node, parent.row + 1) then { - return max(col, parent.column) - } - else return parent.column -end - -# -# subcompute() - recursive search for the leftmost tree node at depth row -# -procedure subcompute(node, row) - # check this level for correct depth - if \node.row = row then return node.column + 1 - # search children from right to left - return subcompute(node.children[*node.children to 1 by -1], row) -end - -# -# Color(s) - return a binding of &window with foreground color s; -# allocate at most one binding per color. -# -procedure Color(s) - static t, magenta - initial { - magenta := Clone(&window, "fg=magenta") | stop("no magenta") - t := table() - /t[E_Fcall] := Clone(&window, "fg=red") | stop("no red") - /t[E_Ocall] := Clone(&window, "fg=chocolate") | stop("no chocolate") - /t[E_Snew] := Clone(&window, "fg=purple") | stop("no purple") - } - if *s > 1 then - / t[s] := Clone(&window, "fg=" || s) | stop("no ",image(s)) - else - / t[s] := magenta - return t[s] -end - -procedure max(x,y) - if x < y then return y else return x -end diff --git a/ipl/mprogs/allocwrl.icn b/ipl/mprogs/allocwrl.icn deleted file mode 100644 index 8521a8f..0000000 --- a/ipl/mprogs/allocwrl.icn +++ /dev/null @@ -1,167 +0,0 @@ -############################################################################ -# -# File: allocwrl.icn -# -# Subject: Program to display storage allocation in VRML -# -# Author: Ralph E. Griswold -# -# Date: March 26, 2002 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This program produces VRML 1.0 worlds with shapes representing storage -# allocation in the program it monitors. -# -# The structures normally are laid out in the x-z plane along a path with -# the shapes rising in the y direction. The size of the allocation -# determines the size of the shapes. The same shape is used for all -# allocations, but the color indicates the type of allocation. -# -# The kinds of allocation modeled are given by masks: -# -# structs only allocation related to Icon's structure types -# blocks all allocations in the block region -# non-structs all allocations except for structures -# -# The supported shapes are: -# -# cylinder -# cuboid -# cone -# -# In this version, if the path file is exhausted before the SP terminates, -# the path file is closed and reopened. -# -############################################################################ -# -# Requires: MT Icon -# -############################################################################ -# -# Links: colormap, dialog, emutils, evinit, interact, options, vrml, -# vrml1lib -# -############################################################################ - -link colormap -link dialog -link emutils -link evinit -link interact -link vrml -link vrml1lib - -$include "evdefs.icn" - -procedure main(args) - local model, color_table, code, object_list, trans, mask, object - local path, input, scale, steps, symbol, hfactor, color, shape - local ashape, output - - if TextDialog("Configuration:", - ["SP", "path file", "coordinate scale", "shape scale", - "number of events", "mask", "shape", "world file"], - ["structalc", "line.path", 10.0, 0.2, - 200, "structs", "cylinder", "alloc.wrl"], - [15, 30, 5, 5, 5, 10, 10, 20] - ) == "Cancel" then exit() - - args := [dialog_value[1]] - path := dialog_value[2] - scale := dialog_value[3] - hfactor := dialog_value[4] - steps := dialog_value[5] - mask := case dialog_value[6] of { - "structs" | &null: cset(E_List || E_Lelem || E_Record || E_Selem || - E_Set || E_Slots || E_Table || E_Telem || E_Tvtbl) - "blocks": AllocMask -- (E_String || E_Coexpr) - "strings": cset(E_String) - default: ExitNotice("Invalid mask.") - } - ashape := case dialog_value[7] of { - "cylinder" | &null: Cylinder(2, 2) - "cuboid": Cube(4, 2, 4) - "cone": Cone(2, 2) - default: ExitNotice("Invalid shape.") - } - output := open(dialog_value[8], "w") | - ExitNotice("Cannot open " || dialog_value[8]) - - EvInit(args) | ExitNotice("Cannot load SP.") - - variable("write", &eventsource) := -1 # turn off output in SP - variable("writes", &eventsource) := -1 - - model := [] # list of children - - color_table := colormap() # standard colors - - every code := key(color_table) do { # convert colors to shapes - color := vrml_color(color_table[code]) # standard color - symbol := evsym(code) # use event code name - shape := Separator([ - Material(color), # diffuse color only - Translation("0 1 0"), - ashape, - Translation("0 -1 0") - ]) - - color_table[code] := USE(symbol) # put USE node in table - put(model, DEF(symbol, shape)) # create DEF node - } - - model := [Switch(-1, model)] - - input := open(path) | ExitNotice("Cannot open path file.") - - trans := "0 0 0" # initial "translation" - - every 1 to steps do { - EvGet(mask) | { # get allocation event - write(&errout, "*** event stream terminated") - break - } - object := \color_table[&eventcode] | { # get shape - write(&errout, "*** no entry for ", evsym(&eventcode)) - next - } - trans := Translation(scale_translate(read(input), scale)) | { - Notice("Path ended.") - break - } - put( - model, - Separator([ - trans, - Transform(, , "1.0 " || (&eventvalue * hfactor) || " 1.0"), - object - ]) - ) - } - - vrml1(Group(model), output) # generate world - -end - -procedure scale_translate(s, n) - local x, y, z - - s ? { - x := tab(find(" ")) - move(1) - y := tab(find(" ")) - move(1) - z := tab(0) - } - - return (x * n) || " " || (y * n) || " " || (z * n) - -end - - - diff --git a/ipl/mprogs/anim.icn b/ipl/mprogs/anim.icn deleted file mode 100644 index 604acca..0000000 --- a/ipl/mprogs/anim.icn +++ /dev/null @@ -1,254 +0,0 @@ -############################################################################ -# -# File: anim.icn -# -# Subject: Program to show animated display of Icon source code -# -# Author: Gregg M. Townsend, modified by Ralph E. Griswold -# -# Date: February 28, 1997 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# anim displays a miniaturized program listing, highlighting each -# line as it is executed. -# -# Two accompanying barcharts display execution profiles. The one on -# the extreme left shows the number of clock ticks attributable to each -# source line. The second chart shows the number of times each line was -# executed. -# -# A chart to the right of the listing displays a time-based history -# similar to that of the "roll" program (q.v.). -# -# usage: anim [options] [arg...] -# -# -d n decay after n new line events -# -b n length of barcharts (0 to disable) -# -z n length of history (0 to disable) -# -t n ticks per history pixel -# -# -s n vertical line spacing, in pixels -# -w n width of one character, in pixels -# -h n height of one character, in pixels -# -p n set in pointsize n (OpenWindows only; overrides -w and -h) -# -# -P x program text color -# -C x comment color -# -A x active text color -# -O x old-text color (after fading) -# -R x background color for barcharts and history -# -S n spacing between sections of the display -# -# plus standard options from optwindow.icn -# (-F sets the color used for the barcharts and history) -# -# Setting -s or -p establishes good defaults for the other sizes. -# -# It is assumed that the program source file can be found by appending -# ".icn" to the icode file name. -# -############################################################################ -# -# Requires: Version 9 graphics -# -############################################################################ -# -# Links: em_setup, evinit, evmux, barchart, decay, options, optwindw, -# strpchrt -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -$include "evdefs.icn" - -link em_setup -link evinit -link evmux -link barchart -link decay -link options -link optwindw -link strpchrt - -global progname, opttab, ifile, font -global gcP, gcC, gcA, gcO, gcR -global margin, gutter, textx -global code, pos1, pos2 -global xsiz, ysiz, spacing, dp - -procedure main(args) - local win, len, lno, cs, i, maxlines, lifetime - local hchart, hlength, hscale - local barlength, barwidth, linescale, linecount, linebars - local nticks, tickscale, tickcount, tickbars - local src, linemask - - linemask := 2 ^ 16 -1 - progname := "anim" - maxlines := 1000 - opttab := options (args, winoptions() || "d+b+z+t+s+w+h+p+P:C:A:O:R:S:") - lifetime := \opttab["d"] | 3 - barlength := \opttab["b"] | 40 - hlength := \opttab["z"] | 90 - tickscale := 1.00 - linescale := 0.25 - hscale := \opttab["t"] | 10 - gutter := \opttab["S"] | 10 - - # default to tiny-text mode under OpenWindows - if (not \opttab[!"swhp"]) & getenv ("NEWSSERVER") then - opttab["p"] := 6 - - if i := \opttab["p"] then { - i >:= 13 # maximum size - font := "lucidasanstypewriter-" || i - # -p 1 2 3 4 5 6 7 8 9 10 11 12 13 - xsiz := [1,1,2,2,3,4,4, 5, 5 ,6, 7, 7, 8] [i] - ysiz := [2,3,4,5,7,8,9,10,11,11,12,13,14] [i] - spacing := \opttab["s"] | i - } - else { - spacing := \opttab["s"] | \opttab["h"] + 1 | 4 - xsiz := \opttab["w"] | 0 < integer (0.6 * spacing + 0.5) | 1 - ysiz := \opttab["h"] | 0 < spacing - 1 | 1 - } - - EvInit (args) | stop ("can't load icode file") - - # read source file into memory - - src := prog_name() - ifile := open(src) | stop (progname, ": can't open ", src) - every put(code := [], detab(trim(!ifile \ maxlines))) - - pos1 := list(*code) - pos2 := list(*code) - every i := 1 to *code do - code[i] ? { - tab(many(' ')) - if pos(0) | ="#" then next - pos1[i] := &pos - pos2[i] := pos1[i] + *trim(tab(upto('#')|0)) - } - - if /opttab["W"] then { # calculate window width if not specified - len := 0 - every len <:= *!code - len *:= xsiz - if barlength > 0 then - len +:= 2 * barlength + 2 * gutter - if hlength > 0 then - len +:= gutter + hlength - opttab["W"] := len - } - - /opttab["H"] := spacing * *code - /opttab["L"] := "Anim" - /opttab["F"] := "goldenrod" - /opttab["R"] := "floralwhite" - /opttab["M"] := -1 - win := optwindow (opttab, "cursor=off", "echo=off") - if \font then - Font (win, font) | stop ("can't set font ", font) - margin := opttab["M"] - - Bg (gcR := Clone(win), opttab["R"]) - - if barlength = 0 then - textx := margin - else { - barwidth := spacing - 1 - if barwidth = 0 then - barwidth := 1 - tickcount := list (*code, 0) - tickbars := barchart (gcR, margin+barlength-1, margin, - 0, spacing, -tickscale, *code, barlength, barwidth) - linecount := list (*code, 0) - linebars := barchart (gcR, margin+barlength+gutter+barlength-1, margin, - 0, spacing, -linescale, *code, barlength, barwidth) - textx := margin + 2 * gutter + 2 * barlength - } - - if hlength > 0 then { - hchart := stripchart (gcR, margin + opttab["W"] - hlength, margin, - hlength, spacing * *code) - } - - if \font then { - Fg (gcP := Clone(win), \opttab["P"] | "gray70") - Fg (gcC := Clone(win), \opttab["C"] | "gray90") - Fg (gcO := Clone(win), \opttab["O"] | "black") - Bg (gcA := Clone(gcO), \opttab["A"] | "red") - } - else { - Fg (gcP := Clone(win), \opttab["P"] | "gray70") - Fg (gcC := Clone(win), \opttab["C"] | "gray90") - Fg (gcA := Clone(win), \opttab["P"] | "indianred") - Fg (gcO := Clone(win), \opttab["O"] | "peachpuff") - } - - every i := 1 to *code do { - docmt (gcC, i) # show comments - docode (gcP, i) # show initial code listing - } - - dp := dpipe (docode, lifetime, gcA, gcO) # initialize decay pipe - cs := E_Loc ++ E_Tick - nticks := 0 - - while EvGet (cs) do # for each line event - if &eventcode === E_Loc then { - decay (dp, lno := iand(&eventvalue, linemask)) # mark line - setbar (\linebars, lno, linecount[lno] +:= 1) - smark (\hchart, margin + spacing * (lno-1), margin + spacing * lno - 1) - } - else if &eventcode === E_Tick then { - setbar (\tickbars, \lno, tickcount[\lno] +:= 1) - if (nticks +:= 1) % hscale = 0 then - sadvance (\hchart) - } - - every 1 to lifetime do - decay (dp) # flush decay pipe - quitsensor (win, 1) # wait for quit signal - end - -procedure docode (gc, lno) - doblock (gc, lno, \pos1[lno], pos2[lno]); - return - end - -procedure docmt (gc, lno) - local p - code[lno] ? { - tab(upto('#')) | return - while not pos(0) do { - p := &pos - doblock (gc, lno, p, tab(upto(' ')|0) & &pos) - tab(many(' ')) - } - } - return - end - -procedure doblock (gc, lno, pos1, pos2) - local x - - x := textx + xsiz * (pos1 - 1) - if \font then { - GotoXY(gc, x, margin + spacing * lno - 1) - writes(gc, code[lno][pos1:pos2]) - } - else { - FillRectangle(gc, x, margin + spacing*(lno-1), xsiz*(pos2-pos1), ysiz) - } - return - end diff --git a/ipl/mprogs/callcnt.icn b/ipl/mprogs/callcnt.icn deleted file mode 100644 index c4063cf..0000000 --- a/ipl/mprogs/callcnt.icn +++ /dev/null @@ -1,122 +0,0 @@ -############################################################################ -# -# File: callcnt.icn -# -# Subject: Program to count calls -# -# Author: Ralph E. Griswold -# -# Date: June 8, 1994 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This program tabulates calls in a monitored program. -# -############################################################################ -# -# Links: evinit, opsyms -# -############################################################################ -# -# Requires: MT Icon and event monitoring -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -link evinit -link opsyms - -$include "evdefs.icn" - -procedure main(args) - local opertable, fnctable, rectable, proctable, opmap, output, mask, oper - local count, fnc - - EvInit(args) - - opertable := table(0) - fnctable := table(0) - proctable := table(0) - - opmap := opsyms() - - output := open("callcnt", "x", "height=800", # If this fails, output goes to - "width=200") # standard output - - write(output, " Tabulating calls for ", args[1]) - - mask := E_Ocall ++ E_Fcall ++ E_Pcall - - while EvGet(mask) do - case &eventcode of { - E_Ocall: opertable[&eventvalue] +:= 1 - E_Fcall: fnctable[&eventvalue] +:= 1 - E_Pcall: proctable[&eventvalue] +:= 1 - } - - opertable := sort(opertable,3) - fnctable := sort(fnctable,3) - rectable :=copy(fnctable) - proctable := sort(proctable,3) - - write(output, "\n operation calls\n") - while oper := get(opertable) do { - count := get(opertable) - write(output, " ", left(\opmap[oper], 20), right(count, 7)) - } - - write(output, "\n function calls\n") - while fnc := get(fnctable) do { - count := get(fnctable) - write(output, " ", left(fname(fnc), 20), right(count, 7)) - } - - write(output, "\n record constructor calls\n") - while fnc := get(rectable) do { - count := get(rectable) - write(output, " ", left(cname(fnc), 20), right(count, 7)) - } - - write(output, "\n procedure calls\n") - while write(output, " ", left(pname(get(proctable)), 20), - right(get(proctable), 7)) - - Event(\output) # wait for event if window - -end - -procedure cname(f) - - return image(f) ? { - ="function " - if ="record constructor " then return tab(0) - else fail - } - -end - -procedure fname(f) - - return image(f) ? { - ="function " - if ="record constructor " then fail - else tab(0) - } - -end - -procedure pname(p) - - return image(p) ? { - ="procedure " - tab(0) - } - -end diff --git a/ipl/mprogs/cmpsum.icn b/ipl/mprogs/cmpsum.icn deleted file mode 100644 index 79fdf8f..0000000 --- a/ipl/mprogs/cmpsum.icn +++ /dev/null @@ -1,106 +0,0 @@ -############################################################################ -# -# File: cmpsum.icn -# -# Subject: Program to tabulate comparisons -# -# Author: Ralph E. Griswold -# -# Date: September 27, 1994 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This tool tabulates comparisons. It is called as -# -# cmpsum prog -# -# where prog is a program compiled under MT Icon whose events are to -# be tabulated. -# -# The options supported are: -# -# -o s write output to file s; default &output. -# -# -t record time spent in monitoring. -# -############################################################################ -# -# Requires: MT Icon and event monitoring. -# -############################################################################ -# -# Links: evinit, options, procname -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -link evinit -link options -link procname - -$include "evdefs.icn" - -procedure main(args) - local opts, itime, output, succtbl, failtbl, cmask, rmask, cmplist, op - local greater, greatereq, noteql, eql, less, lesseq, valeql, valnoteql - local strgreater, strgreatereq, strnoteql, streql, strless, strlesseq - - opts := options(args, "o:t") - - output := open(\opts["o"], "w") | &output - - if \opts["t"] then itime := &time - - EvInit(args) | stop("*** cannot load program") # initialize interface - - succtbl := table(0) - failtbl := table(0) - - cmask := E_Ocall - rmask := E_Oret ++ E_Ofail - - eql := proc("=", 2) - less := proc("<", 2) - lesseq := proc("<=", 2) - greater := proc(">", 2) - greatereq := proc(">=", 2) - noteql := proc("~=", 2) - streql := proc("==", 2) - strless := proc("<<", 2) - strlesseq := proc("<<=", 2) - strgreater := proc(">>", 2) - strgreatereq := proc(">>=", 2) - strnoteql := proc("~==", 2) - valeql := proc("===", 2) - valnoteql := proc("~===", 2) - - while EvGet(cmask) do { - if (op := &eventvalue) === ( - eql | less | lesseq | greater | greatereq | noteql | - streql | strless | strlesseq | strgreater | strgreatereq | strnoteql | - valeql | valnoteql - ) then { - EvGet(rmask) - if &eventcode === E_Oret then succtbl[op] +:= 1 - else failtbl[op] +:= 1 - } - } - - write(output, "\nSuccessful comparisons:\n") - cmplist := sort(succtbl, 3) - while write(output, left(procname(get(cmplist)), 6), right(get(cmplist), 7)) - - write(output, "\nFailed comparisons:\n") - cmplist := sort(failtbl, 3) - while write(output, left(procname(get(cmplist)), 6), right(get(cmplist), 7)) - - write(output, "\nelapsed time: ", &time - \itime, "ms") - -end diff --git a/ipl/mprogs/cnvsum.icn b/ipl/mprogs/cnvsum.icn deleted file mode 100644 index b5e446a..0000000 --- a/ipl/mprogs/cnvsum.icn +++ /dev/null @@ -1,117 +0,0 @@ -############################################################################ -# -# File: cnvsum.icn -# -# Subject: Program to tabulate type-conversion activity -# -# Author: Ralph E. Griswold -# -# Date: August 13, 1994 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This tool tabulates type-conversion activity. It is called as -# -# cnvsum prog -# -# where prog is a program compiled under MT Icon whose events are to -# be tabulated. -# -# The options supported are: -# -# -o s write output to file s; default &output. -# -# -t record time spent in monitoring. -# -############################################################################ -# -# Requires: MT Icon and event monitoring. -# -############################################################################ -# -# Links: evinit, options, procname, typecode -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -link evinit -link options -link procname -link typecode - -$include "evdefs.icn" - -procedure main(args) - local opts, itime, cnvlist, esucctbl, efailtbl, isucctbl, ifailtbl, output - local mmask, cmask, in, pair, name - - opts := options(args, "o:t") - - output := open(\opts["o"], "w") | &output - - if \opts["t"] then itime := &time - - EvInit(args) | stop("*** cannot load program") # initialize interface - - esucctbl := table(0) - efailtbl := table(0) - isucctbl := table(0) - ifailtbl := table(0) - - mmask := E_Fcall ++ E_Aconv - cmask := E_Fconv ++ E_Sconv ++ E_Nconv - - while EvGet(mmask) do { - case &eventcode of { - E_Fcall: { - if (name := procname(&eventvalue)) == - ("integer" | "string" | "cset" | "real") then { - in := name[1] - EvGet(E_Tconv) - pair := in || typecode(&eventvalue) - EvGet(cmask) - case &eventcode of { - E_Sconv: esucctbl[pair] +:= 1 - E_Fconv: efailtbl[pair] +:= 1 - } - } - } - E_Aconv: { - in := typecode(&eventvalue) - EvGet(E_Tconv) - pair := in || typecode(&eventvalue) - EvGet(cmask) - case &eventcode of { - E_Sconv: isucctbl[pair] +:= 1 - E_Fconv: ifailtbl[pair] +:= 1 - } - } - } - } - - cnvlist := sort(esucctbl, 3) - write(output, "\nExplicit successful conversions:\n") - while write(output, get(cnvlist), right(get(cnvlist), 7)) - - cnvlist := sort(efailtbl, 3) - write(output, "\nExplicit failed conversions:\n") - while write(output, get(cnvlist), right(get(cnvlist), 7)) - - cnvlist := sort(isucctbl, 3) - write(output, "\nImplicit successful conversions:\n") - while write(output, get(cnvlist), right(get(cnvlist), 7)) - - cnvlist := sort(ifailtbl, 3) - write(output, "\nImplicit failed conversions:\n") - while write(output, get(cnvlist), right(get(cnvlist), 7)) - - write(output, "\nelapsed time: ", &time - \itime, "ms") - -end diff --git a/ipl/mprogs/cvtsum.icn b/ipl/mprogs/cvtsum.icn deleted file mode 100644 index 9e6dfc8..0000000 --- a/ipl/mprogs/cvtsum.icn +++ /dev/null @@ -1,79 +0,0 @@ -############################################################################ -# -# File: cvtsum.icn -# -# Subject: Program to count conversion event tuples -# -# Author: Ralph E. Griswold -# -# Date: November 25, 1996 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This program counts conversion events that occur during the monitoring -# of Icon program execution. -# -############################################################################ -# -# Requires: MT Icon and event monitoring -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -link evinit -link numbers -link typecode - -$include "evdefs.icn" - -procedure main(args) - local counts, total, futile, triple, target, value, failure - - EvInit(args) - - counts := table(0) - total := -1 # account for first vacuous entry - futile := 0 - failure := 0 - - while EvGet(ConvMask) do - case &eventcode of { - E_Aconv: { - total +:= 1 - if total % 1000 = 0 then writes(&errout, ".") - counts[triple] +:= 1 - target := typecode(&eventvalue) - triple := target - } - E_Tconv: { - value := typecode(&eventvalue) - if value == target then futile +:= 1 - triple ||:= value - } - E_Nconv: triple ||:= " S" - E_Sconv: triple ||:= " S" - E_Fconv: { - failure +:= 1 - triple ||:= " F" - } - default: stop("*** illegal event code") - } - - delete(counts,&null) - - counts := sort(counts, 3) - - while write(get(counts), right(get(counts),6)) - - write("\ntotal = ",total,"\n") - write(fix(futile / real(total), .01, 3, 2),"% futile") - write(fix(failure / real(total), .01, 3, 2),"% failed") - -end diff --git a/ipl/mprogs/events.icn b/ipl/mprogs/events.icn deleted file mode 100644 index 624c1cb..0000000 --- a/ipl/mprogs/events.icn +++ /dev/null @@ -1,59 +0,0 @@ -############################################################################ -# -# File: events.icn -# -# Subject: Program to show events -# -# Author: Ralph E. Griswold -# -# Date: September 20, 1994 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This program lists the events that occur in the execution of the icode -# file given as the first argument on the command line. Any other command- -# line arguments are passed to the icode file. -# -# The image of the event code is given in the first column, its -# description is given in the second column, and an image of the -# event value is given in the third column. -# -# The following option is supported: -# -# -o s direct output to file named s; default &output -# -############################################################################ -# -# Requires: MT-Icon and event monitoring. -# -############################################################################ -# -# Links: evinit, evnames, evsyms, options -# -############################################################################ - -link evinit -link evnames -link evsyms -link options - -procedure main(args) - local opts, output, symmap - - symmap := evsyms() - - opts := options(args, "o:") - output := open(\opts["o"], "w") | &output - - EvInit(args) | stop("*** cannot open icode file ***") - - - while EvGet() do - write(output, left(\symmap[&eventcode], 14), - left(evnames(&eventcode), 35), image(&eventvalue)) - -end diff --git a/ipl/mprogs/evstream.icn b/ipl/mprogs/evstream.icn deleted file mode 100644 index 4773b40..0000000 --- a/ipl/mprogs/evstream.icn +++ /dev/null @@ -1,60 +0,0 @@ -############################################################################ -# -# File: evstream.icn -# -# Subject: Program to show events -# -# Author: Ralph E. Griswold -# -# Date: June 8, 1994 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This program lists the events that occur in the execution of the icode -# file given as the first argument on the command line. Any other command- -# line arguments are passed to the icode file. -# -# The image of the event code is given in the first column, its -# description is given in the second column, and an image of the -# event value is given in the third column. -# -############################################################################ -# -# Requires: MT Icon and event monitoring. -# -############################################################################ -# -# Links: evinit, evnames, convert -# -############################################################################ - -link evinit -link evnames -link convert - -procedure main(args) - local name - - EvInit(args) | stop("*** cannot open icode file ***") - - name := evnames() - - while EvGet() do - write(left(rimage(&eventcode), 8), - left(\name[&eventcode] | "unknown event",35), image(&eventvalue)) - -end - -procedure rimage(s) - local i - - i := ord(s) - - if 32 <= i <= 126 then return image(s) - else return "\"\\" || exbase10(i, 8) || "\"" - -end diff --git a/ipl/mprogs/evsum.icn b/ipl/mprogs/evsum.icn deleted file mode 100644 index c5cf228..0000000 --- a/ipl/mprogs/evsum.icn +++ /dev/null @@ -1,107 +0,0 @@ -############################################################################ -# -# File: evsum.icn -# -# Subject: Program to tabulate event codes -# -# Author: Ralph E. Griswold -# -# Date: March 26, 2002 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This tool tabulates event codes. It is called as -# -# evsum prog -# -# where prog is a program compiled under MT Icon whose events are to -# be tabulated. -# -# The options supported are: -# -# -m s sets the event mask named s. If no mask is specified, all -# events are tabulated. (See evdefs.icn for a list of event -# mask names.) -# -# -o s write output to file s; default &output. -# -# -t record time spent in monitoring. -# -############################################################################ -# -# Requires: MT Icon and event monitoring. -# -############################################################################ -# -# Links: evinit, evnames, numbers, options -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -link evinit -link evnames -link numbers -link options - -$include "evdefs.icn" - -procedure main(args) - local summary, total, i, subscr, opts, mask, output, alltotal - local itime - - opts := options(args, "m:o:t") - - mask := &cset - mask := case \opts["m"] of { - "AllocMask": AllocMask - "AssignMask": AssignMask - "TypeMask": TypeMask - "ConvMask": ConvMask - "ProcMask": ProcMask - "FncMask": FncMask - "OperMask": OperMask - "ListMask": ListMask - "RecordMask": RecordMask - "ScanMask": ScanMask - "SetMask": SetMask - "TableMask": TableMask - "StructMask": StructMask - default: stop("*** invalid event mask name") - } - - output := open(\opts["o"], "w") | &output - - if \opts["t"] then itime := &time - - EvInit(args) | stop("*** cannot load program") # initialize interface - - summary := table(0) - total := 0 - - while EvGet(mask) do - summary[&eventcode] +:= 1 - - every total +:= !summary - alltotal := total - total /:= 100.0 - - summary := sort(summary, 4) - - write(output, left("event",45), right("count",9), right("percent",10)) - write(output) - while i := pull(summary) do - write(output, left(evnames(pull(summary)), 45), - right(i, 9), " ", fix(i, total, 5, 2)) - - write(output, "\n", left("total:", 45), right(alltotal, 9)) - - write(output, "\nelapsed time: ", &time - \itime, "ms") - -end diff --git a/ipl/mprogs/exprsum.icn b/ipl/mprogs/exprsum.icn deleted file mode 100644 index 802d3b6..0000000 --- a/ipl/mprogs/exprsum.icn +++ /dev/null @@ -1,162 +0,0 @@ -############################################################################ -# -# File: exprsum.icn -# -# Subject: Program to tabulate operator and function evaluation -# -# Author: Ralph E. Griswold -# -# Date: February 20, 1995 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This tool tabulates operator and function activity. It is called as -# -# exprsum prog -# -# where prog is a program compiled under MT Icon whose events are to -# be tabulated. -# -# The options supported are: -# -# -o s write output to file s; default &output. -# -# -t record time spent in monitoring. -# -############################################################################ -# -# Requires: Version 9 MT Icon and event monitoring. -# -############################################################################ -# -# Links: evinit, evnames, options, procname -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -link evaltree # maintenance of call tree -link evinit # event monitoring initialization -link evnames # mapping of events to names -link options # command-line options -link procname # string name for procedure - -$include "evdefs.icn" # event code and mask definitions - -global callcount -global calltbl -global failtbl -global namemap -global names -global output -global remvtbl -global resmtbl -global retntbl -global susptbl - -$define NameColumn 14 -$define ValueColumn 10 - -procedure main(args) - local opts, itime - - namemap := evnames() - - opts := options(args, "o:t") - - output := open(\opts["o"], "w") | &output - if \opts["t"] then itime := &time - - # Load and initialize the source program. - - EvInit(args) | stop("*** cannot load source program") - - # Assign tables to for the various kinds of activity. - - every calltbl | retntbl | susptbl | failtbl | resmtbl | remvtbl := table(0) - - # Process the events using the procedure note(). - - evaltree(FncMask ++ OperMask, note) - - # Format the results. - - format(output) - - write(output, "\nelapsed time: ", &time - \itime, "ms") - -end - -procedure format(output) - - write(output, - left("name", NameColumn), - right("calls", ValueColumn), - right("returns", ValueColumn), - right("suspends", ValueColumn), - right("failures", ValueColumn), - right("resumps", ValueColumn), - right("removals", ValueColumn) - ) - write(output) - - # sort names by number of calls - - names := sort(calltbl, 4) - - while callcount := pull(names) do { - name := pull(names) - write(output, - left(name, NameColumn), - right(callcount, ValueColumn), - right(retntbl[name], ValueColumn), - right(susptbl[name], ValueColumn), - right(failtbl[name], ValueColumn), - right(resmtbl[name], ValueColumn), - right(remvtbl[name], ValueColumn) - ) - } - - write(output, - "\n", - left("total", NameColumn), - right(tblsum(calltbl), ValueColumn), - right(tblsum(retntbl), ValueColumn), - right(tblsum(susptbl), ValueColumn), - right(tblsum(failtbl), ValueColumn), - right(tblsum(resmtbl), ValueColumn), - right(tblsum(remvtbl), ValueColumn) - ) - -end - -procedure note(new, old) - - case &eventcode of { - !CallCodes: calltbl[procname(new.node, 1)] +:= 1 - !ReturnCodes: retntbl[procname(old.node, 1)] +:= 1 - !SuspendCodes: susptbl[procname(old.node, 1)] +:= 1 - !FailCodes: failtbl[procname(old.node, 1)] +:= 1 - !ResumeCodes: resmtbl[procname(new.node, 1)] +:= 1 - !RemoveCodes: remvtbl[procname(old.node, 1)] +:= 1 - } - - return - -end - -procedure tblsum(tbl) - local count - - count := 0 - every count +:= !tbl - - return count - -end diff --git a/ipl/mprogs/listev.icn b/ipl/mprogs/listev.icn deleted file mode 100644 index 6372ac0..0000000 --- a/ipl/mprogs/listev.icn +++ /dev/null @@ -1,46 +0,0 @@ -############################################################################ -# -# File: listev.icn -# -# Subject: Program to list events -# -# Author: Ralph E. Griswold -# -# Date: August 16, 1994 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This program list events. Event information is written -# by using image(). -# -# This program is called as -# -# listev tp args -# -############################################################################ -# -# Requires: Version 9.0 MT Icon with event monitoring -# -############################################################################ -# -# Links: evinit, options -# -############################################################################ - -$include "etdefs.icn" - -link evinit -link options - -procedure main(args) - - EvInit(args) | stop("*** cannot load TP") - - while EvGet(T_Mask1) do - write(image(&eventcode), " : ", image(&eventvalue)) - -end diff --git a/ipl/mprogs/locus.icn b/ipl/mprogs/locus.icn deleted file mode 100644 index 8e1581a..0000000 --- a/ipl/mprogs/locus.icn +++ /dev/null @@ -1,126 +0,0 @@ -############################################################################ -# -# File: locus.icn -# -# Subject: Program to trace execution locus -# -# Author: Ralph E. Griswold -# -# Date: March 4, 1997 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This program traces the locus of program execution. -# -############################################################################ -# -# Requires: Version 9 graphics -# -############################################################################ -# -# Links: em_setup, evinit, xcompat, wopen -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -$include "evdefs.icn" - -link em_setup -link evinit -link wopen -link xcompat - -global Visualization, Limit - -procedure main(args) - local program_name, Width, Height, x, y, blowup, i, Context, value - local program, line, progarray, Color, ymul, maxheight - local colmask, linemask, mask - - colmask := 2 ^ 16 - linemask := colmask - 1 - - maxheight := 500 - - EvInit(args) | stop("*** cannot load program to monitor") - - program_name := prog_name() - - program := open(program_name) | stop("*** cannot open ", program_name) - - Height := 0 - Width := 0 - - while line := read(program) do { - Height +:= 1 - Width <:= *line - } - - if Height < maxheight / 2 then blowup := 4 - else if Height < maxheight / 4 then blowup := 2 - else blowup := 1 - - progarray := list(Height) - every !progarray := list(Width, 0) - - if Height > maxheight then { - ymul := real(maxheight) / Height - Height := maxheight - } - else ymul := 1 - - Width *:= blowup - Height *:= blowup - - close(program) - - Visualization := WOpen("label=locus", "bg=white", "width=" || Width, - "height=" || Height) | stop("*** cannot open window for visualization") - - Color := list(6) - Color[6] := XBind(Visualization, , "fg=red") - Color[5] := XBind(Visualization, , "fg=orange") - Color[4] := XBind(Visualization, , "fg=yellow") - Color[3] := XBind(Visualization, , "fg=green") - Color[2] := XBind(Visualization, , "fg=blue") - Color[1] := XBind(Visualization, , "fg=gray") - - mask := cset(E_Loc) - - x := y := -10 - - Limit := 10 - i := 0 - - repeat { - - i := (i + 1) % Limit - if i = 0 then { - while *Pending(Visualization) > 0 do - if Event(Visualization) === (&lpress | &mpress | &rpress) then { - event(E_ALoc, (&x / blowup + 1) * colmask + - (&y / blowup) / ymul + 1) - } - } - - EvGet(mask) | break - y := iand(&eventvalue, linemask) - x := &eventvalue / colmask - value := progarray[y, x] +:= 1 - value := integer(log(value, 6)) + 1 - Context := Color[value | *Color] - y := (y * ymul - 1) * blowup - x := (x - 1) * blowup - FillRectangle(Visualization, x, y, blowup, blowup) - FillRectangle(Context, x, y, blowup, blowup) - - } - -end diff --git a/ipl/mprogs/memsum.icn b/ipl/mprogs/memsum.icn deleted file mode 100644 index 95ef2c1..0000000 --- a/ipl/mprogs/memsum.icn +++ /dev/null @@ -1,158 +0,0 @@ -############################################################################ -# -# File: memsum.icn -# -# Subject: Program to tabulate memory allocation -# -# Author: Ralph E. Griswold -# -# Date: August 17, 1994 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This tool tabulates storage allocation. It is called as -# -# memsum prog -# -# where prog is a program compiled under MT Icon whose events are to -# be tabulated. -# -# The options supported are: -# -# -o s write output to file s; default &output. -# -# -t record time spent in monitoring. -# -############################################################################ -# -# Requires: MT Icon and event monitoring. -# -############################################################################ -# -# Links: evinit, evnames, numbers, options -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -link evinit -link evnames -link numbers -link options - -$include "evdefs.icn" - -global highlights, alloccnt, alloctot, collections, output - -procedure main(args) - local opts, itime, mask - - opts := options(args, "to:") - output := open(\opts["o"], "w") | &output - if \opts["t"] then itime := &time - - EvInit(args) | stop("*** cannot load program") # initialize interface - - alloccnt := table(0) # count of allocations - alloctot := table(0) # total allocation - collections := table(0) # garbage collection counts - - # Be sure all allocation types are listed even if there is no allocation - # for them. - - every alloccnt[!AllocMask] := 0 - every alloctot[!AllocMask] := 0 - - mask := AllocMask ++ E_Collect - - while EvGet(mask) do - if &eventcode === E_Collect then collections[&eventvalue] +:= 1 - else { - alloccnt[&eventcode] +:= 1 - alloctot[&eventcode] +:= &eventvalue - } - - report() - - write(output, "\nelapsed time: ", &time - \itime, "ms") - -end - -# Display a table of allocation data -# -procedure report() - local i, cnttotal, tottotal, cnt, tot, totalcoll - - static col1, col2, gutter # column widths - - initial { - col1 := 20 # name field - col2 := 10 # number field - gutter := " " - } - - write(output, "\n", # write column headings - left("type",col1), right("number",col2), gutter, - right("bytes",col2), gutter, right("average",col2), gutter, - right("% bytes",col2), "\n" - ) - - alloccnt := sort(alloccnt, 3) # get the data - alloctot := sort(alloctot, 3) - - cnttotal := 0 - tottotal := 0 - - every i := 2 to *alloccnt by 2 do { - cnttotal +:= alloccnt[i] - tottotal +:= alloctot[i] - } - - while write(output, # write the data - left(name(get(alloccnt)), col1), - right(cnt := get(alloccnt), col2), gutter, - get(alloctot) & right(tot := get(alloctot), col2), gutter, - fix(tot, cnt, col2, 2) | right("0.00", col2), gutter, - fix(100.0 * tot, tottotal, col2, 2) | right("0.00", col2) - ) - - write(output, "\n", # write totals - left("total:",col1), right(cnttotal,col2), gutter, right(tottotal,col2), - gutter, fix(tottotal,cnttotal,col2) | repl(" ",col2) - ) - - totalcoll := 0 # garbage collections - every totalcoll +:= !collections - write(output,"\n",left("collections:",col1),right(totalcoll,col2)) - if totalcoll > 0 then { - write(output,left(" static region:",col1),right(collections[1],col2)) - write(output,left(" string region:",col1),right(collections[2],col2)) - write(output,left(" block region:",col1),right(collections[3],col2)) - write(output,left(" no region:",col1),right(collections[0],col2)) - } - - return -end - -# Produce event name -# -procedure name(code) - local result - - result := evnames(code) - - result ?:= tab(find(" allocation")) - - result ?:= { - tab(find("trapped variable")) || "tv" - } - - return result - -end diff --git a/ipl/mprogs/mmm.icn b/ipl/mprogs/mmm.icn deleted file mode 100644 index a9688cd..0000000 --- a/ipl/mprogs/mmm.icn +++ /dev/null @@ -1,139 +0,0 @@ -############################################################################ -# -# File: mmm.icn -# -# Subject: Program to show allocation as a miniature "MemMon" -# -# Author: Clinton Jeffery -# -# Date: August 12, 1994 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# Displays a tiny rendition of internal heap allocation. -# -############################################################################ -# -# Requires: Version 9 graphics -# -############################################################################ -# -# Links: evinit, options, optwindw, typebind, colormap, wipe, xcompat -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -$include "evdefs.icn" - -link evinit -link options -link optwindw -link typebind -link colormap -link wipe -link xcompat - -global Visualization, contexts -global t, sum, threesixty, wid, hei - -procedure main(av) - local c_string, lines, mymask, allocstr, blockall, sum1, sum2, row1, row2, - Regions, c, start, sum2div4, verbose - if *av>0 then - EvInit(av) | stop("EvInit() can't load ",av[1]) - else - EvInit() | stop("can't EvInit()") - - threesixty := 360 * 64 - t := options(av) - /t["W"] := 650 - /t["H"] := 50 - &window := optwindow(t) | stop("no window") - Visualization := &window - contexts := itypebind(&window) - c_string := contexts[E_String] | stop("eh?") - / contexts[E_Tvsubs] := c_string - - wid := WAttrib("width") - hei := WAttrib("height") - lines := WAttrib("lines") - - mymask := AllocMask ++ cset("\360"||E_Collect||E_BlkDeAlc||E_StrDeAlc) - allocstr := string(AllocMask) - blockall := 0 - - sum1 := 0 - sum2 := 0 - row1 := 0 - row2 := hei/2+1 - - Regions := [] - every put(Regions,keyword("regions",EventSource)) - pop(Regions) - - while EvGet(mymask) do { - if &eventcode === E_Lelem then &eventcode := E_List - if &eventcode === (E_Telem|E_Tvtbl|E_Slots) then &eventcode := E_Table - if &eventcode === E_Selem then &eventcode := E_Set - if &eventcode === E_Refresh then &eventcode := E_Coexpr - case &eventcode of { - E_Collect: { - wipe(&window) - sum1 := sum2 := 0 - row1 := 0 - row2 := hei/2+1 - } - E_EndCollect: { - } - E_String: { - DrawLine(c_string,sum1/4,row1,(sum1+&eventvalue)/4,row1) - sum1 +:= &eventvalue - while sum1/4 >= wid do { - sum1 -:= wid * 4 - row1 +:= 1 - if row1 > hei/2 then { - EraseArea(0,0,wid,hei/2) - row1 := 0 - } - DrawLine(c_string,0,row1,sum1/4,row1) - } - } - !.allocstr: { - c := \contexts[&eventcode] | stop("what is ",&eventcode) - start := sum2/4 - sum2 +:= &eventvalue - sum2div4 := sum2/4 - DrawLine(c,start,row2,sum2div4,row2) - while sum2div4 >= wid do { - sum2 -:= wid * 4 - sum2div4 := sum2/4 - row2 +:= 1 - DrawLine(c,0,row2,sum2div4,row2) - } - } - default: { - if \verbose then write("unknown event code ",&eventcode) - } - } - } - -end - -procedure itypebind(z) - static t - initial { - t := table() - } - /(t[z]):=typebind(z,E_Integer||E_Real||E_Record||E_Set||E_String||E_Cset|| - E_File||E_List||E_Null||E_Proc||E_Table,table()) -# if type(t[z][E_Proc])=="file" then close(t[z][E_Proc]) - t[z][E_Proc] := XBind(z,"fg=#999") - return t[z] -end diff --git a/ipl/mprogs/mtutils.icn b/ipl/mprogs/mtutils.icn deleted file mode 100644 index 3fe42ac..0000000 --- a/ipl/mprogs/mtutils.icn +++ /dev/null @@ -1,40 +0,0 @@ -############################################################################ -# -# File: mtutils.icn -# -# Subject: Program fpr MT Icon -# -# Author: Ralph E. Griswold -# -# Date: March 3, 1997 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# Utility procedures for use with MT Icon programs (threads) -# -############################################################################ -# -# Requires: MT Icon -# -############################################################################ - -procedure root() - - C := &main - - while C := parent(C) - - return C - -end - -procedure main() - - if root(&main) === &main then write("safe to talk") - else write("someone may be listening") - -end diff --git a/ipl/mprogs/napoleon.icn b/ipl/mprogs/napoleon.icn deleted file mode 100644 index 026a2ea..0000000 --- a/ipl/mprogs/napoleon.icn +++ /dev/null @@ -1,168 +0,0 @@ -############################################################################ -# -# File: napoleon.icn -# -# Subject: Program to track memory usage by type -# -# Author: Clinton Jeffery -# -# Date: August 12, 1994 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# Displays an animated chart showing recent memory usage by Icon type. -# -# Currently not interactive, hence, keys and clicks don't do anything. -# Resizes are handled. -# -# usage: napoleon [-r | -c] prog [args...] -# -# -r provides a regions view, separating the string and block regions -# and displaying memory quantities proportional to the total region size -# rather than the total amount allocated -# -# -c provides continuous updates on each allocation, instead of updating -# only when a change is significant (i.e. when proportions change by >= 1%). -# -############################################################################ -# -# Requires: Version 9 graphics -# -############################################################################ -# -# Links: evinit, options, optwindw, typebind -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -$include "evdefs.icn" - -link evinit -link options -link optwindw -link typebind - -global Visualization, contexts -global t, sum, wid, hei, realhei, x, optable - -procedure main(av) - local lines, mymask, allocstr, p, update, e - optable := options(av,"c!r!") - - if *av>0 then - EvInit(av) | stop("EvInit() can't load ",av[1]) - else - EvInit() | stop("can't EvInit()") - - /optable["W"] := 100 - /optable["H"] := 400 - &window := optwindow(optable) | stop("no window") - - Visualization := &window - contexts := typebind(&window,E_Integer||E_Real||E_Record||E_Set||E_String|| - E_Cset||E_File||E_List||E_Null||E_Proc||E_Table|| - E_Tvsubs, table()) - - wid := WAttrib("width") - hei := WAttrib("height") - realhei := real(hei) - if \optable["r"] then { - realhei /:= 2 - sum := 65000 - } - else { - sum := 0 - } - - lines := WAttrib("lines") - - mymask := AllocMask ++ cset(E_EndCollect||E_Collect) - allocstr := string(AllocMask) - - t := table(0.0) - p := table(0) - - update := 1 - - while EvGet(mymask) do { - if &eventcode === E_Lelem then &eventcode := E_List - if &eventcode === (E_Telem|E_Tvtbl|E_Slots) then &eventcode := E_Table - if &eventcode === E_Selem then &eventcode := E_Set - if &eventcode === E_Refresh then &eventcode := E_Coexpr - case &eventcode of { - E_Collect: { - EraseArea(x,0) - every !t := 0.0 - if /optable["r"] then sum := 0 - update := &null - } - E_EndCollect: { - update := 1 - if sum=0 then sum := 1 - redraw() - } - !.allocstr: { - t[&eventcode] +:= &eventvalue - if /optable["r"] then sum +:= &eventvalue - if \optable["c"] | - p[&eventcode] ~=:= integer(t[&eventcode] / (0<sum) * 100) then { - if \update then redraw() - } - } - default: { - write("unknown event code ",&eventcode) - } - } - if Pending()[1] then { - e := Event() - case e of { - &resize: { - wid := &x - hei := &y - EraseArea() - realhei := real(hei) - if \optable["r"] then { - realhei /:= 2 - } - if \update then redraw() - } - } - } - } - EvTerm() - close(&window) -end - -procedure redraw() - local start, fract, k, path - initial { - x := 0 - } - if \optable["r"] then - start := integer(realhei) - else - start := 0 - fract := realhei / sum - every k := key(t) do { - path := fract * t[k] - if \optable["r"] & k==E_String then - FillRectangle(\contexts[k]|Visualization, x, 0, 1, path) - else { - FillRectangle(\contexts[k]|Visualization, x, start, 1, path) - start +:= path - } - } - x +:= 1 - if x > wid then { - x := 0 - EraseArea(0,0,5) - } - EraseArea(x+3,0,1) -end diff --git a/ipl/mprogs/novae.icn b/ipl/mprogs/novae.icn deleted file mode 100644 index 71cd5d3..0000000 --- a/ipl/mprogs/novae.icn +++ /dev/null @@ -1,93 +0,0 @@ -############################################################################ -# -# File: novae.icn -# -# Subject: Program to show allocations as exploding stars -# -# Author: Ralph E. Griswold -# -# Date: June 25, 1996 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This program shows allocation on two stars with radiating lines -# -# The tool-specific options are: -# -# -h i Height of panel, default 300 -# -w i Width of one panel, default 300 -# -s i number of lines, default 360 -# -d draw dot at end of line instead of full line -# -############################################################################ -# -# Requires: Version 9 graphics -# -############################################################################ -# -# Links: em_setup, visprocs -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -$include "evdefs.icn" - -link em_setup -link visprocs - -$define Height 300 -$define Width 300 -$define Sectors 360 - -procedure main(args) - local clear, sdegrees, bdegrees - local degrees, arc, advance, fullcircle - local xorg, yorg, radius, radians, dots, sxorg, syorg, bxorg, byorg - - em_setup(args) - - fullcircle := 360 - sdegrees := bdegrees := 0 - radians := 0 - advance := fullcircle / Sectors # amount to advance - - sxorg := integer(Width / 2.0) - syorg := (Height / 2.0) - bxorg := sxorg + Width - byorg := syorg - radius := ((Height < Width) | Height) / 2.0 - - vis_setup("label=novae", "size=" || (2 * Width) || "," || Height, - "bg=black") - - Context := context_setup(AllocMask) - - while EvGet(AllocMask) do { - if &eventcode === E_String then { - xorg := sxorg - yorg := syorg - sdegrees +:= advance - sdegrees %:= fullcircle - radians := -dtor(sdegrees) - } - else { - xorg := bxorg - yorg := byorg - bdegrees +:= advance - bdegrees %:= fullcircle - radians := -dtor(bdegrees) - } - DrawLine(Context[&eventcode], xorg, yorg, &eventvalue * cos(radians) + - xorg, &eventvalue * sin(radians) + yorg) - } - - em_end() - -end diff --git a/ipl/mprogs/numsum.icn b/ipl/mprogs/numsum.icn deleted file mode 100644 index f08f15e..0000000 --- a/ipl/mprogs/numsum.icn +++ /dev/null @@ -1,103 +0,0 @@ -############################################################################ -# -# File: numsum.icn -# -# Subject: Program to tabulate numerical computation -# -# Author: Ralph E. Griswold -# -# Date: September 20, 1994 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This tool tabulates numerical-computation activity. It is called as -# -# numsum prog -# -# where prog is a program compiled under MT Icon whose events are to -# be tabulated. -# -# The options supported are: -# -# -o s write output to file s; default &output. -# -# -t record time spent in monitoring. -# -############################################################################ -# -# Requires: MT Icon and event monitoring. -# -############################################################################ -# -# Links: evinit, options, procname -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -link evinit -link options -link procname - -$include "evdefs.icn" - -procedure main(args) - local opts, itime, output, inttbl, reltbl, cmask, rmask, numlist, op - local pos, neg, plus, minus, mpy, div, pwr, mod, count - - opts := options(args, "o:t") - - output := open(\opts["o"], "w") | &output - - if \opts["t"] then itime := &time - - EvInit(args) | stop("*** cannot load program") # initialize interface - - inttbl := table(0) - reltbl := table(0) - - cmask := E_Fcall ++ E_Ocall - rmask := E_Fret ++ E_Oret ++ E_Ffail ++ E_Ofail - - pos := proc("+", 1) - neg := proc("-", 1) - plus := proc("+", 2) - minus := proc("-", 2) - mpy := proc("*", 2) - div := proc("/", 2) - mod := proc("%", 2) - pwr := proc("^", 2) - - while EvGet(cmask) do { - if (op := &eventvalue) === ( - plus | minus | mpy | div | neg | pwr | mod | - iand | ior | ixor | icom | ishift | pos - ) then { - EvGet(rmask) - if &eventcode === (E_Ofail | E_Ffail) then next - case type(&eventvalue) of { - "integer": inttbl[op] +:= 1 - "real": reltbl[op] +:= 1 - } - } - } - - write(output, "\nInteger computation:\n") - numlist := sort(inttbl, 4) - while count := pull(numlist) do - write(output, left(procname(pull(numlist)), 6), right(count, 9)) - - write(output, "\nReal computation:\n") - numlist := sort(reltbl, 4) - while count := pull(numlist) do - while write(output, left(procname(pull(numlist)), 6), right(count, 9)) - - write(output, "\nelapsed time: ", &time - \itime, "ms") - -end diff --git a/ipl/mprogs/opersum.icn b/ipl/mprogs/opersum.icn deleted file mode 100644 index 3d6ffce..0000000 --- a/ipl/mprogs/opersum.icn +++ /dev/null @@ -1,200 +0,0 @@ -############################################################################ -# -# File: opersum.icn -# -# Subject: Program to tabulate operation activity -# -# Author: Ralph E. Griswold -# -# Date: March 10, 1998 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This tool tabulates operation activity. It is called as -# -# opersum prog -# -# where prog is a program compiled under MT Icon whose events are to -# be tabulated. -# -# The options supported are: -# -# -m s sets the event mask named s. The supported masks are -# FncMask (the default), OperMask, ProcMask, ScanMask, -# and Oper+Mask, which includes both ScanMask and -# OperMask. -# -# -o s write output to file s; default &output. -# -# -t record time spent in monitoring. -# -############################################################################ -# -# Requires: MT Icon and event monitoring. -# -############################################################################ -# -# Links: evinit, evnames, options, procname -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -link evaltree -link evinit -link evnames -link options -link procname - -$include "evdefs.icn" - -global namemap, output, fncset, scan, fnames, mask -global calltbl, retntbl, susptbl, failtbl, resmtbl, remvtbl - -procedure main(args) - local opts, itime - - namemap := evnames() - - opts := options(args, "m:o:t") - - mask := FncMask - mask := case \opts["m"] of { - "ProcMask": ProcMask - "FncMask": FncMask - "OperMask": OperMask - "ScanMask": { - scan := 1 - ScanMask - } - "Oper+Mask": { - scan := 1 - OperMask ++ ScanMask - } - default: stop("*** invalid event mask name") - } - - if mask === FncMask then { # beware record constructors - fnames := set() # valid function names - every insert(fnames, function() || "()") - } - - output := open(\opts["o"], "w") | &output - - if \opts["t"] then itime := &time - - EvInit(args) | stop("*** cannot load program") # initialize interface - - calltbl := table(0) - retntbl := table(0) - susptbl := table(0) - failtbl := table(0) - resmtbl := table(0) - remvtbl := table(0) - - fncset := set() - - EvInit(args) | stop("*** cannot load program") # initialize interface - - evaltree(mask, note) - - write(output, - left("name", 14), - right("calls", 10), - right("returns", 10), - right("suspends", 10), - right("failures", 10), - right("resumps", 10), - right("removals", 10) - ) - write(output) - - every name := !sort(fncset) do - write(output, - left(name, 14), - right(calltbl[name], 10), - right(retntbl[name], 10), - right(susptbl[name], 10), - right(failtbl[name], 10), - right(resmtbl[name], 10), - right(remvtbl[name], 10) - ) - - write(output, - "\n", - left("total", 14), - right(tblsum(calltbl), 10), - right(tblsum(retntbl), 10), - right(tblsum(susptbl), 10), - right(tblsum(failtbl), 10), - right(tblsum(resmtbl), 10), - right(tblsum(remvtbl), 10) - ) - - write(output, "\nelapsed time: ", &time - \itime, "ms") - -end - -procedure note(new, old) - - case &eventcode of { - !CallCodes: { - name := ename(new.node) - if (mask === FncMask) & not(member(fnames, name)) then return - calltbl[name] +:= 1 - insert(fncset, name) - } - !ReturnCodes: { - name := ename(old.node) - if (mask === FncMask) & not(member(fnames, name)) then return - retntbl[name] +:= 1 - } - !SuspendCodes: { - name := ename(old.node) - if (mask === FncMask) & not(member(fnames, name)) then return - susptbl[name] +:= 1 - } - !FailCodes: { - name := ename(old.node) - if (mask === FncMask) & not(member(fnames, name)) then return - failtbl[name] +:= 1 - } - !ResumeCodes: { - name := ename(new.node) - if (mask === FncMask) & not(member(fnames, name)) then return - resmtbl[name] +:= 1 - } - !RemoveCodes: { - name := ename(old.node) - if (mask === FncMask) & not(member(fnames, name)) then return - remvtbl[name] +:= 1 - } - } - - return - -end - -procedure ename(x) - if /x then return "bogon" - else if \scan & not(proc(x)) then return "e1 ? e2" - else return procname(x, 1) # use the expanded form - -end - -procedure tblsum(tbl) - local count - - count := 0 - - every count +:= !tbl - - return count - -end diff --git a/ipl/mprogs/ostrip.icn b/ipl/mprogs/ostrip.icn deleted file mode 100644 index 44091a5..0000000 --- a/ipl/mprogs/ostrip.icn +++ /dev/null @@ -1,71 +0,0 @@ -############################################################################ -# -# File: ostrip.icn -# -# Subject: Program to show virtual-machine op-code strip -# -# Author: Ralph E. Griswold -# -# Date: March 26, 2002 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This program produces a listing of virtual machine codes and the events -# that occur between them. -# -# The following option is supported: -# -# -o s direct output to file s; default &output -# -############################################################################ -# -# Requires: MT Icon and event monitoring -# -############################################################################ -# -# Links: evinit, evsyms, opnames, options -# -############################################################################ - -link evinit -link evsyms -link opnames -link options - -$include "evdefs.icn" - -procedure main(args) - local codes, esmap, opmap, opcode, opts, output - - opts := options(args, "o:") - output := open(\opts["o"], "w") | &output - - EvInit(args) | stop("*** cannot load SP") - - opmap := opnames() - esmap := evsyms() - - opcode := cset(E_Opcode) - - while EvGet(opcode) do { # get to first "real" op-code - if opmap[integer(&eventvalue)] == "Invoke" then { - writes(output, "Invoke |") - break() - } - } - - while EvGet() do { - if &eventcode === E_Opcode then { - write(output) - writes(output, left(opmap[integer(&eventvalue)], 10), "|") - } - else writes(output, " ", esmap[&eventcode]) - } - - write(output) - -end diff --git a/ipl/mprogs/playev.icn b/ipl/mprogs/playev.icn deleted file mode 100644 index 7fdf595..0000000 --- a/ipl/mprogs/playev.icn +++ /dev/null @@ -1,59 +0,0 @@ -############################################################################ -# -# File: playev.icn -# -# Subject: Program to play back events -# -# Author: Ralph E. Griswold -# -# Date: August 16, 1994 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This program plays back events saved by recordev. Since recordev -# uses image() for recording, some information may be lost. -# -# This program is called as -# -# playev em <history -# -# where history is a file produced by recordev. -# -############################################################################ -# -# Requires: Version 9.0 MT Icon with event monitoring -# -############################################################################ -# -# Links: evinit, ivalue -# -############################################################################ - -link evinit -link ivalue - -procedure main(args) - local mask, prog - - prog := load(pop(args), args) | stop("*** cannot EM") - - variable("&eventsource", prog) := ¤t | stop("no eventsource?") - - mask := @prog # activate EM to get its mask - - while &eventcode := read() do { - &eventcode := ivalue(&eventcode) # can fail - &eventvalue := read() | break - if find(&eventcode, mask) then { - &eventvalue := ivalue(&eventvalue) # can fail - mask := event(, , prog) # pass event; get mask back - } - } - - cofail(prog) - -end diff --git a/ipl/mprogs/program.icn b/ipl/mprogs/program.icn deleted file mode 100644 index ad32344..0000000 --- a/ipl/mprogs/program.icn +++ /dev/null @@ -1,138 +0,0 @@ -############################################################################ -# -# File: program.icn -# -# Subject: Program to display portion of a program in a window -# -# Author: Ralph E. Griswold -# -# Date: February 28, 1997 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This program views the text of a program through a window. The image -# of the program is maintained in a pixmap. Positioning the desired -# portion of the program amounts to copying the appropriate portion -# of the pixmap to the window. -# -# The pixmap has half a window's white space at the top and at the -# bottom to that the beginning and ends of a program can be shown -# using the same logic as for interior portions of the program. -# -# The program is written as a visual monitor to run under the control -# of another program, such as Eve. -# -############################################################################ -# -# Requires: Version 9 graphics -# -############################################################################ -# -# Links: basename, em_setup, filedim -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -$include "evdefs.icn" - -link basename -link em_setup -link filedim - -global Visualization, textmap, twidth, wheight, oheight, hsize, ncols -global highlight - -procedure main(args) - local vrows, SourceFile, size, mrows, mcols - local input, line_no, cwidth, x, colmask, column - local xwidth, wwidth, maxcols, linemask, line, i - - colmask := 2 ^ 16 - linemask := colmask - 1 - - em_setup(args) - - vrows := 10 # ad hoc for now - ncols := 6 # ditto - maxcols := 85 # ditto - - hsize := 4 - - SourceFile := prog_name() - - size := filedim(SourceFile) - - mrows := vrows + size.rows # white space at top and bottom - mcols := size.cols - mcols >:= maxcols - mcols +:= ncols + 1 # space for line numbers and bar - -# Now create hidden canvases for the program and identifying line numbers. - - textmap := WOpen("canvas=hidden", "lines=" || mrows, - "columns=" || mcols) | stop("*** cannot hidden canvas for program") - - twidth := WAttrib(textmap, "width") - oheight := (WAttrib(textmap, "height") / mrows) / 2 + (hsize / 2) - -# Set positions in the pixmaps to leave space at the top and the bottom. - - GotoRC(textmap, vrows / 2, 1) - -# Put the text of the program into the canvas, while adding line -# numbers to the other canvas. - - input := open(SourceFile) | stop("*** cannot open ", SourceFile) - - line_no := 0 - - while write(textmap, right(line_no +:= 1, ncols - 1), " ", read(input)) - -# Draw a line in linemap to separate the line numbers from the -# program text when they get copied into the window. - - cwidth := TextWidth(textmap, repl("x", ncols + 1)) - x := cwidth - (cwidth / (2 * (ncols))) - 5 - - DrawLine(textmap, x, 0, x, WAttrib(textmap, "height")) - - vis_setup("label=" || basename(SourceFile), "lines=" || vrows, - "columns=80") - - highlight := Clone(Visualization, "fg=red") - - wwidth := WAttrib(Visualization, "width") - wheight := WAttrib(Visualization, "height") - - focus(1, 0) # start-up view - - while EvGet('', 1) do - if &eventcode === E_ALoc then { - line := iand(&eventvalue, linemask) - 1 # for positioning - column := &eventvalue / colmask - focus(line, column) - } - -end - -procedure focus(line, column) - local x, y - - y := (line - 1) * WAttrib("leading") # for positioning - CopyArea(textmap, Visualization, 0, y, twidth, wheight) - FillRectangle(highlight, 2, y := wheight / 2 - oheight, hsize, hsize) - if column > 0 then { - x := (column + ncols + 1) * WAttrib("fwidth") - FillRectangle(highlight, x, y + 10, 6, 1) - } - - return - -end diff --git a/ipl/mprogs/recordev.icn b/ipl/mprogs/recordev.icn deleted file mode 100644 index 4ad0f8f..0000000 --- a/ipl/mprogs/recordev.icn +++ /dev/null @@ -1,69 +0,0 @@ -############################################################################ -# -# File: recordev.icn -# -# Subject: Program to record events -# -# Author: Ralph E. Griswold -# -# Date: August 16, 1994 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This program records events in a file. Event information is stored -# by using image(), so some information may be lost. -# -# This program is called as -# -# recordev <options> tp args -# -# The options supported are: -# -# -o s write event history to the file named s; default standard -# output. -# -# -c s prefix the event history with a comment event whose value -# is s. -# -# Warning: If -o is not given and tp also writes to standard output, -# the event history file will be corrupted. -# -# If args contains options, use -- to prevent recordev from consuming them, -# as in -# -# recordev -o history -- tp args -# -############################################################################ -# -# Requires: Version 9.0 MT Icon with event monitoring -# -############################################################################ -# -# Links: evinit, options -# -############################################################################ - -link evinit -link options - -procedure main(args) - local file, output, opts - - opts := options(args, "c:o:") - if file := \opts["o"] then { - output := open(file, "w") | stop("*** cannot open ", image(file)) - } - else output := &output - - write(output, image("#"), "\n", image(\opts["c"])) - - EvInit(args) | stop("*** cannot load TP") - - while EvGet() do - write(output, image(&eventcode), "\n", image(&eventvalue)) - -end diff --git a/ipl/mprogs/roll.icn b/ipl/mprogs/roll.icn deleted file mode 100644 index 0f1ea32..0000000 --- a/ipl/mprogs/roll.icn +++ /dev/null @@ -1,103 +0,0 @@ -############################################################################ -# -# File: roll.icn -# -# Subject: Program to display the program counter on a stripchart -# -# Author: Gregg M. Townsend and Ralph E. Griswold -# -# Date: June 25, 1996 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# roll displays a chart recording a time-history of program execution -# by line number. -# -############################################################################ -# -# Requires: Version 9 graphics -# -############################################################################ -# -# Links: em_setup, filedim, strpchrt -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -$include "evdefs.icn" - -link em_setup -link filedim -link strpchrt - -$define Width 500 -$define MaxHeight 500 - -global ifile, Limit -global maxln - -procedure main(args) - local fname, sc, h, t, y, mask, ymul, maxln - local size, i, linemask - - linemask := 2 ^ 16 - 1 - - em_setup(args) - - size := filedim(prog_name()) - maxln := size.rows - - if maxln > MaxHeight then { - ymul := real(MaxHeight) / maxln - maxln := MaxHeight - } - else ymul := 1 - - Limit := 10 - - vis_setup("size=" || Width || "," || maxln, "label=roll") - - sc := stripchart(Visualization, 0, 0, Width, maxln) - - t := 0 - i := 0 - - mask := E_Loc ++ E_Tick - - repeat { - - i := (i + 1) % Limit - - if i = 0 then { - while *Pending(Visualization) > 0 do - case Event(Visualization) of { - &lpress | &mpress | &rpress: { - event(E_ALoc, integer(&y / ymul) + 1, &eventsource) - } - } - } - - - EvGet(mask) | break - if &eventcode === E_Loc then { - y := ymul * iand(&eventvalue, linemask) - DrawPoint(sc.win, sc.x, y) - } - else if &eventcode === E_Tick then sadvance(sc, &eventvalue) - } - - sadvance(sc) - - Fg(sc.win, "red") - DrawLine(sc.win, sc.x, 0, sc.x, maxln) - - em_end() - -end diff --git a/ipl/mprogs/scat.icn b/ipl/mprogs/scat.icn deleted file mode 100644 index 631be9c..0000000 --- a/ipl/mprogs/scat.icn +++ /dev/null @@ -1,143 +0,0 @@ -############################################################################ -# -# File: scat.icn -# -# Subject: Program to produce call/result scatterplot -# -# Author: Clinton Jeffery -# -# Date: November 11, 1997 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# Press the left mouse button atop any plotted point to see the list of -# procedures at that point. Execution (and point motion) is suspended -# until the mouse button is released. -# -############################################################################ -# -# Requires: Version 9 graphics -# -############################################################################ -# -# Links: eemutils, vinit -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -$include "evdefs.icn" - -link emutils -link evinit - -global at, # table of counts of procedures at a given point - call, # table of call counts - rslt # table of result counts - -record activation (p, parent, children) - -procedure main(av) - local mask, maxmax, maxmatch, current_proc, L, max, i, k, child, e - - EvInit(av) | stop("*** cannot load SP") - - kill_output() - - &window := open("scat","x","geometry=150x180") | stop("can't open window") - current_proc := activation(,activation(,,,,[]),[]) - call := table(0) - rslt := table(0) - at := table(0) - mask := ProcMask ++ E_MXevent - maxmax := 0 - maxmatch := 0 - - while EvGet(mask) do { - case &eventcode of { - E_Pcall: { - move(&eventvalue, 1, 0) - current_proc := activation(&eventvalue, current_proc, []) - put(current_proc.parent.children, current_proc) - } - E_Psusp: { - move(current_proc.p, 0, 1) - current_proc := current_proc.parent - } - E_Presum: { - current_proc := current_proc.children[-1] - } - E_Pret: { - move(current_proc.p, 0, 1) - pull(current_proc.parent.children) - current_proc := current_proc.parent - } - E_Pfail: { - pull(current_proc.parent.children) - current_proc := current_proc.parent - } - E_Prem: { - child := pull(current_proc.children) - current_proc.children |||:= child.children - } - E_MXevent: { - case &eventvalue of { - "q" | "\033": stop("terminated") - &lpress | &ldrag : { - repeat { - L := [] - every k := key(call) do { - if -3 < 2*log(call[k]+2,1.25)+2 - &x < 3 & - -3 < 2*log(rslt[k]+2,1.25)+2 - &y < 3 then { - put(L, procedure_name(k)) - } - } - if max := * (L[1]) then { - every max <:= *( !L ) - maxmax <:= max - } - maxmatch <:= *L - &col := WAttrib("columns") - maxmax - &row := WAttrib("lines") - maxmatch - 1 - EraseArea(&x,&y) - if *L > 0 then { - every i := 1 to *L do { - GotoRC(WAttrib("lines")-*L+i,WAttrib("columns")-max) - writes(&window,L[i]) - } - e := Event() - every i := 1 to *L do { - GotoRC(WAttrib("lines")-*L+i,WAttrib("columns")-max) - writes(&window,L[i]) - } - } - else e := Event() - - if e === &lrelease then break - } - } - } - } - } - } - -end - -procedure procedure_name(p) - return image(p) ? { ="procedure "; tab(0) } -end - -procedure move(who, iscall, isrslt) - if (at[integer(2*log(call[who]+2,1.25)) || "," || integer(2*log(rslt[who]+2,1.25))] -:= 1) = 0 then - EraseArea(2*log(call[who]+2,1.25) + 2, 2*log(rslt[who]+2,1.25) + 2, 2, 2) - call[who] +:= iscall - rslt[who] +:= isrslt - if (at[integer(2*log(call[who]+2,1.25)) || "," || integer(2*log(rslt[who]+2,1.25))] +:= 1) = 1 then - FillRectangle(2*log(call[who]+2,1.25) + 2, 2*log(rslt[who]+2,1.25) + 2, 2, 2) -end diff --git a/ipl/mprogs/scater.icn b/ipl/mprogs/scater.icn deleted file mode 100644 index aad7502..0000000 --- a/ipl/mprogs/scater.icn +++ /dev/null @@ -1,183 +0,0 @@ -############################################################################ -# -# File: scater.icn -# -# Subject: Program to display visualize string concatenation -# -# Author: Ralph E. Griswold -# -# Date: March 1, 1997 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This program displays successive numbers by lines of corresponding -# height. When the display area is full, it scrolls from right to -# left. -# -# In this version, input is piped in. -# -############################################################################ -# -# Requires: Version 9 graphics, MT Icon and instrumentation -# -############################################################################ -# -# Links: evinit, interact, vsetup -# -############################################################################ - -link evinit -link interact -link vsetup - -global vidgets -global root -global strip -global state -global gc_black -global reset -global scale - -global width -global height - -global window - -$include "evdefs.icn" - -procedure main(args) - - init(args) - - display() - -end - -procedure init(args) - - EvInit(args) | stop("*** cannot load SP.") - - /EventSource := &eventsource - - variable("write", EventSource) := -1 - variable("writes", EventSource) := -1 - - window := WOpen ! ui_atts() - - vidgets := ui() - - root := vidgets["root"] - - state := &null - scale := 1 - - width := vidgets["strip"].uw - height := vidgets["strip"].uh - - strip := Clone(window, "dx=" || vidgets["strip"].ux, "dy=" || - vidgets["strip"].uy) - Clip(strip, 0, 0, width, height) - gc_black := Clone(strip, "fg=black") - -end - -procedure display() - static cat, cmask, rmask - - initial { - cat := proc("||", 2) - cmask := cset(E_Ocall) - rmask := cset(E_Oret) - } - - repeat { - while (*Pending() > 0) | \state do - ProcessEvent(root, , shortcuts) - EvGet(cmask) | exit() - if &eventvalue === cat then { - EvGet(rmask) | exit() - &eventvalue := *&eventvalue - &eventvalue *:= scale - &eventvalue >:= height # Motif bug avoidance - CopyArea(strip, 1, 0, width - 1, height, 0, 0) - EraseArea(strip, width - 1, 0, width, height) - DrawLine(gc_black, width - 1, height - &eventvalue, width - 1, height) - } - } - -end - -procedure file_cb(vidget, value) - - case value[1] of { - "snapshot @S": return snapshot(strip, 0, 0, width, height) - "quit @Q": exit() - } - - fail - -end - -procedure configure_cb(vidget, value) - - case value[1] of { - "scale": { - repeat { - if TextDialog(, "scale", scale, 10) == "Okay" then { - scale := (0 < numeric(dialog_value[1])) | { - Notice("Invalid scale value.") - next - } - reset_cb() - return - } - else fail # user canceled - } - } - } - - fail - -end - -procedure reset_cb() - - EraseArea(strip) - - return - -end - -procedure shortcuts(e) - - if &meta then - case map(e) of { - "q": exit() - "s": return snapshot(strip, 0, 0, width, height) - } - else fail - -end - -#===<<vib:begin>>=== modify using vib; do not remove this marker line -procedure ui_atts() - return ["size=477,255", "bg=gray-white"] -end - -procedure ui(win, cbk) -return vsetup(win, cbk, - [":Sizer:::0,0,477,255:",], - ["configure:Menu:pull::36,0,71,21:Configure",configure_cb, - ["scale"]], - ["file:Menu:pull::0,1,36,21:File",file_cb, - ["snapshot @S","quit @Q"]], - ["line1:Line:::0,22,477,22:",], - ["reset:Button:regular::11,76,42,20:reset",reset_cb], - ["strip:Rect:grooved::63,37,400,200:",], - ) -end -#===<<vib:end>>=== end of section maintained by vib diff --git a/ipl/mprogs/strsum.icn b/ipl/mprogs/strsum.icn deleted file mode 100644 index 6160b13..0000000 --- a/ipl/mprogs/strsum.icn +++ /dev/null @@ -1,100 +0,0 @@ -############################################################################ -# -# File: strsum.icn -# -# Subject: Program to tabulate string computation -# -# Author: Ralph E. Griswold -# -# Date: August 14, 1994 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This tool tabulates string-computation activity. It is called as -# -# strsum prog -# -# where prog is a program compiled under MT Icon whose events are to -# be tabulated. -# -# The options supported are: -# -# -o s write output to file s; default &output. -# -# -t record time spent in monitoring. -# -############################################################################ -# -# Requires: MT Icon and event monitoring. -# -############################################################################ -# -# Links: evinit, options, procname -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -link evinit -link options -link procname - -$include "evdefs.icn" - -procedure main(args) - local opts, itime, output, cnttbl, amttbl, cmask, rmask, numlist, op, cat - local subs - - opts := options(args, "o:t") - - output := open(\opts["o"], "w") | &output - - if \opts["t"] then itime := &time - - EvInit(args) | stop("*** cannot load program") # initialize interface - - cnttbl := table(0) - amttbl := table(0) - - cat := proc("||", 2) - subs := proc("[]", 2) - - cmask := E_Fcall ++ E_Ocall ++ E_Ssasgn - rmask := E_Fret ++ E_Oret - - while EvGet(cmask) do { - case &eventcode of { - E_Fcall | E_Ocall: { - if (op := &eventvalue) === ( - cat | right | left | center | entab | detab | repl | - reverse | map - ) then { - EvGet(rmask) - cnttbl[op] +:= 1 - amttbl[op] +:= *&eventvalue - } - } - E_Ssasgn: { - cnttbl[subs] +:= 1 - amttbl[subs] +:= 1 - } - } - } - - write(output, "\nString operation count:\n") - numlist := sort(cnttbl, 3) - while write(output, left(procname(get(numlist)), 6), right(get(numlist), 8)) - - write(output, "\nString allocation:\n") - numlist := sort(amttbl, 3) - while write(output, left(procname(get(numlist)), 6), right(get(numlist), 8)) - - write(output, "\nelapsed time: ", &time - \itime, "ms") - -end diff --git a/ipl/mprogs/strucget.icn b/ipl/mprogs/strucget.icn deleted file mode 100644 index f06ab44..0000000 --- a/ipl/mprogs/strucget.icn +++ /dev/null @@ -1,68 +0,0 @@ -############################################################################ -# -# File: strucget.icn -# -# Subject: Program to collect SP structures -# -# Author: Ralph E. Griswold -# -# Date: March 26, 2002 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This program collects the structures in an SP and when the SP -# terminates, it saves them as an xencoded file. Records are not -# collected because they cannot be decoded in the absence of the -# appropriate record declaration. -# -# By keeping pointers to the structures in an SP, it assures that -# all structures produced by that program are intact at the time -# the SP terminates. Be aware, however, that some structures may -# have been "emptied" by the time the SP terminates, for example, -# by get(L). -# -# Saving the SP structure prevents them from being collected, which may -# affect SP performance or even behavior. -# -# The xencoded file is named <sp>.xcode there <sp> is the name of the -# SP as given on the command line. -# -############################################################################ -# -# Requires: MT Icon and instrumentation -# -############################################################################ -# -# Links: evinit, xcodes -# -############################################################################ - -link evinit -link xcodes - -$include "evdefs.icn" - -procedure main(args) - local mask, structs, name - - name := args[1] | stop("*** no SP") - - EvInit(args) | stop("*** cannot open SP") - - variable("write", &eventsource) := -1 # turn off SP output - variable("writes", &eventsource) := -1 - - structs := set() - - mask := cset(E_Lcreate || E_Rcreate || E_Screate || E_Tcreate) - - while EvGet(mask) do - insert(structs, &eventvalue) # add new structure - - xencoden(sort(structs), name || ".xcode") # save SP structures - -end diff --git a/ipl/mprogs/vc.icn b/ipl/mprogs/vc.icn deleted file mode 100644 index 6e1e5e2..0000000 --- a/ipl/mprogs/vc.icn +++ /dev/null @@ -1,616 +0,0 @@ -############################################################################ -# -# File: vc.icn -# -# Subject: Program to coordinate visualization programs -# -# Author: Ralph E. Griswold -# -# Date: March 1, 1997 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This program loads and runs multiple MPs. It is based on the original -# visualization coordinator, Eve, written by Clint Jeffery. -# -# This is a work in progress. At the moment, it works in demonstration -# mode with only hard-coded SPs and MPs available. -# -# The following interface features are provided: -# -# File menu -# -# snapshot @S take snapshot of selected visualization -# quit @Q exit from vc -# -# Pause toggle (@P) to stop and start visualization -# -# Speed control slider for SP events -# -# Display of clock ticks in SP -# -############################################################################ -# -# The following features remain to be implemented: -# -# disabling and enabling MPs -# adding and removing MPs -# specification of SPs and MPs not in hard-coded list -# specification of input data for SPs -# attempt to position MP windows in a useful way -# provide for changing SPs -# provide for continued visualization when SP terminates -# -# Also, there are numerous small problems that need to be fixed, as -# well as better documentation. -# -############################################################################ -# -# Requires: Version 9 MT Icon, event monitoring, and graphics -# -############################################################################ -# -# Links: basename, evutils, interact, lists, vsetup -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -link basename -link evutils -link interact -link lists -link vsetup - -$include "evdefs.icn" - -$define EventIter 10 # number of SP events per check on interface - -$define BlkSize 500000 # region sizes for SP and MPs -$define StrSize 500000 -$define MstkSize 20000 - -$define On 1 # initial selection states for MPs -$define Off &null - -# vc's knowledge about MPs is stored in a list of records of type "mp_rec". - -record mp_rec(name, prog, mask, enabled) - -global mps # list of EMs -global mpath # path to MPs -global spath # path to SPs and data -global pause # pause vidget -global unioncset # union of MPs' csets -global root # root vidget -global EventCodeTable # table of MPs to call for each event -global delayval # amount of delay per event -global candidates # list of potential MPs to run -global ticksum # number of clock ticks elapsed in SP -global vc_handlers # procedures for each event vc handles itself -global vc_queue # queue used for MP-MP communication -global vidgets # table of vidgets -global state # paused/running toggle -global mps_names # MP names -global mps_selected # MPs selected -global program # SP - -global SourceProgram # source-code file for SP -global Coordination # indicate MPs are running under a coordinator - -procedure main() - - init() # initialize interface, SP, and MPs - - run() # process events - -end - -procedure able_mps() - local mp_names, mp_enabled, rec, i - - mp_names := [] - mp_enabled := [] - - every rec := !mps do { - put(mp_names, rec.name) - put(mp_enabled, rec.enabled) - } - - if ToggleDialog("MP state", mp_names, mp_enabled) == - "Cancel" then fail - - every i := 1 to *mps do - mps[i].enabled := dialog_value[i] - - union_mask() - - return - -end - -procedure add_mps() - local i - - if ToggleDialog( "Select monitoring programs:", mps_names, mps_selected) == - "Cancel" then fail - - mps_selected := candidates := dialog_value - - mps := [] - - every i := 1 to *candidates do { - if /candidates[i] then next # skip unselected MPs - else put(mps, mp(mpath || mps_names[i])) - } - - every i := 1 to *mps do - mps[i].mask := @mps[i].prog - - union_mask() - - return - -end - -# broadcast() - send event to interested MPs -# -procedure broadcast(x, except) - - /vc_queue := [] - - put(vc_queue, x, except) - - flush_queue() - - return - -end - -# Write the current elapsed SP clock ticks. -# -procedure drawtime(val) - static odo, odo_x, odo_y - - initial { - odo := vidgets["odometer"] - odo_x := vidgets["odometer"].ax - odo_y := vidgets["odometer"].ay + vidgets["odometer"].ah - 6 - } - - GotoXY(odo_x, odo_y) - WWrites(right(val, 6)) - -end - -# Handle file menu. -# -procedure file_cb(vidget, value) - - case value[1] of { - "quit @Q": exit() - "snapshot @S": snap_view() - } - - return - -end - -# Flush events produced during MP-MP communcation. This code is similar to -# vc's main loop. -# -procedure flush_queue() - local c, mask, x, except, monitor - - while *vc_queue > 0 do { - x := pop(vc_queue) - except := pop(vc_queue) | - ExitNotice("Malformed broadcast queue.") - every monitor := (except ~=== !mps) do - if mask := event( , , monitor.prog) then { - if mask ~=== monitor.mask then { - while type(mask) ~== "cset" do { - # - # An MP (probably) has raised a flag. - # Pass it on to all the others except the mp itself. - # - put(vc_queue, mask) - put(vc_queue, monitor) - if not (mask := event( , , monitor.prog)) then - unschedule(monitor) # MP terminated - break next - } - if monitor.mask ~===:= mask then - union_mask() - } - } - else { - unschedule(monitor) # MP terminated - break - } - } - -end - -# Initialize the vc, load SP, load MPs. -# -procedure init() - local i, attribs, info - - Coordination := 1 # post vc's presence - - mpath := "/home/ralph/ibin/" - spath := "/home/ralph/SVP/SPs/" - - attribs := ui_atts() # vc's window attributes - push(attribs, "posx=10", "posy=10") # add initial positioning - - (WOpen ! attribs) | stop("*** can't open window for vc") - - vidgets := ui() # table of vidgets - - root := vidgets["root"] # root vidget - - delayval := 0 # start at fastest speed - VSetState(vidgets["speed"], delayval) - - pause := vidgets["pause"] - VSetState(pause, 1) # start paused to allow setup - - ticksum := 0 - - load_prg() | ExitNotice("Monitoring cancelled in specifying SP.") - - vc_handlers := table() # procedures for events vc handles - - vc_handlers[E_Tick] := vc_tick - vc_handlers[E_Error] := vc_error - - mps_names := [ - "program", - "roll", - "algae", - "napoleon", - "allocviews", - "tinylist", - "scater", - "locus" - ] - mps_selected := [ - On, # program - On, # roll - Off, # algae - Off, # napoleon - Off, # allocviews - Off, # tinylist - Off, # scater - Off # locus - ] - - add_mps() | ExitNotice("Monitoring cancelled in specifying MPs.") - - info := WOpen("lines=" || *mps + 5, "columns=32", "bg=white-gray", - "label=monitoring") - - WWrite(info, " SP: ", basename(program)) - WWrite(info) - WWrite(info, " MPs:") - every WWrite(info, " ", basename((!mps).name)) - - Raise() # bring control window to the front (may not make active) - - return - -end - -# Load SP. - -procedure load_prg() - static input, sps - - initial { - sps := [ - "chess", # chess playing - "concord", # concordance - "macho", # recursive descent parsing - "sortnews", # news sorting - "pool", # population growth - "singles", # bridge tournamen scheduling -# "beards", # parser constructor -# "yhcheng", # line editor - "rsg" # random sentence generation - ] - } - - repeat { - SelectDialog( "Select source program:", sps, sps[1]) == "Okay" | fail - - program := spath || dialog_value - SourceProgram := program || ".icn" - - # Note: Currently, the input data for the SP must be in the same - # directory as the SP, have the same base name as the SP, and - # have the suffix ".dat". - - &eventsource := load( - program, - , - open(spath || dialog_value || ".dat"), - open("/dev/null", "w"), - open("/dev/null", "w"), - BlkSize, - StrSize, - MstkSize - ) | { - Notice("Can't load " || dialog_value || ".") - next - } - - return - - } - -end - -# mp() - create and initialize a mp_rec. -# -procedure mp(name) - local rec - - rec := mp_rec(name) - rec.prog := load( - rec.name, - , - &input, - &output, - &errout, - BlkSize, - StrSize, - MstkSize - ) | ExitNotice("Can't load " || image(rec.name) || ".") - - variable("&eventsource", rec.prog) := ¤t | - ExitNotice("Internal inconsistency; no event source.") - - every variable("Monitored" | "EventSource", rec.prog) := &eventsource - - /rec.mask := '' - /rec.enabled := 1 - - return rec - -end - -# Handle pause toggle. - -procedure pause_cb(vidget, value) - - state := value - - return - -end - -# vc's main loop -# -procedure run() - local monitor, mask - - repeat { - delay(delayval) - - # Process interface events before going on to SP events. - - while (*Pending() > 0) | \state do - ProcessEvent(root, , shortcuts) - - # Process several SP events before going back to check for - # interface events. - - every 1 to EventIter do { - EvGet(unioncset) | Exit() # exit on termination of SP - - # Call vc's own handler for this event, if there is one. - - (\vc_handlers[&eventcode])() - - # Forward the event to those MPs that want it. - - every monitor := !EventCodeTable[&eventcode] do { - if mask := event( , , monitor.prog) then { - if mask ~=== monitor.mask then { - while type(mask) ~== "cset" do { - - # The MP (probably) has raised a signal; pass it on, then - # return to the mp to get his next event request. - - broadcast(mask, monitor) - if not (mask := event( , , monitor.prog)) then { - unschedule(monitor) # MP terminated - break next - } - } - if monitor.mask ~===:= mask then union_mask() - } - } - else unschedule(monitor) # MP terminated - } - } - } - -end - -# Exit when SP is done. - -procedure Exit() - - ExitNotice("Source program terminated normally.") - -end - -# Handle keyboard shortcuts. - -procedure shortcuts(e) - - if &meta then - case map(e) of { # fold case - "s": snap_view() - "q": exit() - "p": VSetState(pause, if \state then &null else 1) - } - - return - -end - -# Take snapshot of MP's visualization window. - -procedure snap_view() - local mp_names, rec, win - - mp_names := [] - - every rec := !mps do - put(mp_names, basename(rec.name)) - - if SelectDialog("Select MP visualization:", mp_names) == "Cancel" then fail - - dialog_value := mpath || dialog_value - - every rec := !mps do - if rec.name == dialog_value then { - win := \variable("Visualization", rec.prog) | - return FailNotice("No image available from " || rec.name) - snapshot( - win, - 0, - 0, - \WAttrib(win, "clipw" | "width"), - \WAttrib(win, "cliph" | "height") - ) | return FailNotice("Cannot produce image file.") - return - } - - return FailNotice("MP not found.") - -end - -# Control speed of event stream. - -procedure speed_cb(vidget, value) - - delayval := sqrt(value) - - return - -end - -# Determine the set of events required by the union of all MPs, including -# vc's and user input needs. -# -procedure union_mask() - local monitor, c - static tickset - - initial tickset := E_Tick ++ E_Error - - # EventCodeTable is keyed by events. For each event, the corresponding - # value is a list of MPs that need that event. - - EventCodeTable := table() - EventCodeTable[E_Tick] := [] - EventCodeTable[E_Error] := [] - - unioncset := tickset - - # Go through the list of MPs, and for each one that is currently - # enabled, add it to the list for each of its event codes. - - every monitor := !mps do { - if \monitor.enabled then { - unioncset ++:= monitor.mask - every c := !monitor.mask do { - /EventCodeTable[c] := [] - put(EventCodeTable[c], monitor) - } - } - } - - return - -end - -# Remove MP from list of MPs. -# -procedure unschedule(MP) - local newmps, monitor - - mps := lremvals(mps, MP) # remove MP - - union_mask() # recompute the union mask - - return - -end - -# Handle run-time error in SP. -# -procedure vc_error() - - # If error conversion is on in the SP, ignore the error. - # Otherwise, display the error information and then terminate - # monitoring. - - if keyword("error", &eventsource) = 0 then - ExitNotice( - "run-time error " || image(&eventvalue), - "", - "file " || keyword("file", &eventsource) || - ", line " || keyword("line", &eventsource), - "", - keyword("errortext", &eventsource), - "", - "offending value: " || image(keyword("errorvalue", &eventsource)) - ) - - else return - -end - -# Handle clock tick events in the SP. -# -procedure vc_tick() - - drawtime(ticksum +:= &eventvalue) - - return - -end - -#===<<vib:begin>>=== modify using vib; do not remove this marker line -procedure ui_atts() - return ["size=253,220", "bg=gray-white", "label=vc"] -end - -procedure ui(win, cbk) -return vsetup(win, cbk, - [":Sizer:::0,0,253,220:visualization coordinator",], - ["elapsed:Label:::10,156,91,13:elapsed time:",], - ["fast:Label:::209,103,28,13:fast",], - ["file:Menu:pull::1,2,36,21:File",file_cb, - ["snapshot @S","quit @Q"]], - ["label1:Label:::151,156,77,13:clock ticks",], - ["line1:Line:::0,25,252,25:",], - ["pause:Button:regular:1:10,54,50,20:pause",pause_cb], - ["slow:Label:::10,103,28,13:slow",], - ["speed:Slider:h:1:48,103,150,15:100,0,0",speed_cb], - ["odometer:Rect:invisible::103,153,41,20:",], - ) -end -#===<<vib:end>>=== end of section maintained by vib diff --git a/ipl/mprogs/vmsum.icn b/ipl/mprogs/vmsum.icn deleted file mode 100644 index 2124325..0000000 --- a/ipl/mprogs/vmsum.icn +++ /dev/null @@ -1,62 +0,0 @@ -############################################################################ -# -# File: vmsum.icn -# -# Subject: Program to tabulate virtual-machine operations -# -# Author: Ralph E. Griswold -# -# Date: November 22, 1997 -# -############################################################################ -# -# This file is in the public domain. -# -############################################################################ -# -# This tool tabulates event codes. -# -############################################################################ -# -# Requires: Version 9 graphics and MT Icon -# -############################################################################ -# -# Links: evinit, numbers, opnames -# -############################################################################ -# -# Includes: evdefs.icn -# -############################################################################ - -$include "evdefs.icn" - -link evinit -link numbers -link opnames - -procedure main(args) - local name, summary, total, i - - EvInit(get(args) | &null) # initialize interface - - name := opnames() - - summary := table(0) - total := 0 - - while EvGet(E_Opcode) do { - summary[&eventvalue] +:= 1 - total +:= 1 - } - - summary := sort(summary,4) - total /:= 100.0 - - write(left("code",10), right("count",8), right("percent",10)) - write() - while write(left(name[get(summary)],10), right(i := get(summary),8), - " ", fix(i, total, 5, 2)) - -end |