summaryrefslogtreecommitdiff
path: root/ipl/mprocs
diff options
context:
space:
mode:
Diffstat (limited to 'ipl/mprocs')
-rw-r--r--ipl/mprocs/colormap.icn232
-rw-r--r--ipl/mprocs/colortyp.icn44
-rw-r--r--ipl/mprocs/em_setup.icn101
-rw-r--r--ipl/mprocs/emutils.icn508
-rw-r--r--ipl/mprocs/evaltree.icn106
-rw-r--r--ipl/mprocs/evinit.icn89
-rw-r--r--ipl/mprocs/evnames.icn174
-rw-r--r--ipl/mprocs/evsyms.icn160
-rw-r--r--ipl/mprocs/evtmap.icn181
-rw-r--r--ipl/mprocs/evutils.icn94
-rw-r--r--ipl/mprocs/hexlib.icn146
-rw-r--r--ipl/mprocs/loadfile.icn64
-rw-r--r--ipl/mprocs/opname.icn129
-rw-r--r--ipl/mprocs/typebind.icn56
-rw-r--r--ipl/mprocs/typesyms.icn71
-rw-r--r--ipl/mprocs/viewpack.icn329
16 files changed, 0 insertions, 2484 deletions
diff --git a/ipl/mprocs/colormap.icn b/ipl/mprocs/colormap.icn
deleted file mode 100644
index 2bfcd70..0000000
--- a/ipl/mprocs/colormap.icn
+++ /dev/null
@@ -1,232 +0,0 @@
-############################################################################
-#
-# File: colormap.icn
-#
-# Subject: Procedures to map type event to color
-#
-# Author: Ralph E. Griswold
-#
-# Date: July 1, 1997
-#
-############################################################################
-#
-# This file is in the public domain.
-#
-############################################################################
-#
-# colormap(palette) returns a table that maps event-monitoring codes
-# for allocation events into RGB specifications for Icon. The
-# argument is the name of a palette, as given in the MemMon
-# system. The default for palette is "standard".
-#
-############################################################################
-#
-# Includes: evdefs.icn
-#
-############################################################################
-
-$include "evdefs.icn"
-
-procedure colormap(palette)
- static maps
- local x
-
- initial {
- maps := table()
-
-# Color map for doc.clr
-
- x := table()
-
- x[E_Coexpr] := "18724,18724,18724"
- x[E_String] := "65535,65535,65535"
- x[E_Tvsubs] := "65535,65535,65535"
- x[E_File] := "56172,56172,56172"
- x[E_Refresh] := "18724,18724,18724"
- x[E_Lrgint] := "65535,65535,65535"
- x[E_Real] := "65535,65535,65535"
- x[E_Record] := "28086,28086,28086"
- x[E_Set] := "28086,28086,28086"
- x[E_Selem] := "46810,46810,46810"
- x[E_List] := "18724,18724,18724"
- x[E_Lelem] := "37448,37448,37448"
- x[E_Table] := "18724,18724,18724"
- x[E_Telem] := "56172,56172,56172"
- x[E_Tvtbl] := "37448,37448,37448"
- x[E_Slots] := "28086,28086,28086"
- x[E_Cset] := "46810,46810,46810"
-
- maps["doc"] := x
-
-# Color map for lw.clr
-
- x := table()
-
- x[E_Coexpr] := "28086,28086,28086"
- x[E_String] := "65535,65535,65535"
- x[E_Tvsubs] := "65535,65535,56172"
- x[E_File] := "09362,00000,00000"
- x[E_Refresh] := "09362,00000,00000"
- x[E_Lrgint] := "65535,65535,65535"
- x[E_Real] := "65535,65535,65535"
- x[E_Record] := "65535,65535,65535"
- x[E_Set] := "09362,18724,18724"
- x[E_Selem] := "09362,18724,18724"
- x[E_List] := "37448,37448,37448"
- x[E_Lelem] := "37448,37448,37448"
- x[E_Table] := "65535,65535,56172"
- x[E_Telem] := "65535,65535,56172"
- x[E_Tvtbl] := "65535,65535,56172"
- x[E_Slots] := "18724,18724,18724"
- x[E_Cset] := "09362,09362,09362"
-
- maps["lw"] := x
-
-# Color map for pastel.clr
-
- x := table()
-
- x[E_Coexpr] := "65535,46810,28086" # peach
- x[E_String] := "56172,28086,09362" # reddish brown
- x[E_Tvsubs] := "56172,28086,09362" # reddish brown
- x[E_File] := "00000,00000,28086" # dark blue
- x[E_Refresh] := "37448,00000,00000" # dark red
- x[E_Lrgint] := "65535,65535,00000" # yellow
- x[E_Real] := "65535,28086,28086" # salmon
- x[E_Record] := "65535,46810,28086" # peach
- x[E_Set] := "56172,46810,65535" # light purple
- x[E_Selem] := "56172,28086,65535" # medium purple
- x[E_List] := "18724,37448,56172" # medium blue
- x[E_Lelem] := "18724,56172,65535" # pastel blue
- x[E_Table] := "46810,65535,37448" # light yellow-green
- x[E_Telem] := "18724,56172,18724" # light green
- x[E_Tvtbl] := "09362,37448,09362" # dark green
- x[E_Slots] := "37448,65535,65535" # light blue
- x[E_Cset] := "65535,65535,46810" # ivory
-
- maps["pastel"] := x
-
-# Color map for qms.clr
-
- x := table()
-
- x[E_Coexpr] := "37448,18724,00000" # brown
- x[E_String] := "65535,65535,46810" # ivory
- x[E_Tvsubs] := "65535,65535,46810" # ivory
- x[E_File] := "56172,65535,00000" # light green
- x[E_Refresh] := "37448,18724,00000" # brown
- x[E_Lrgint] := "65535,46810,28086" # peach
- x[E_Real] := "65535,65535,00000" # yellow
- x[E_Record] := "56172,00000,65535" # magenta
- x[E_Set] := "37448,00000,00000" # medium red
- x[E_Selem] := "65535,00000,00000" # red
- x[E_List] := "00000,46810,46810" # medium cyan
- x[E_Lelem] := "00000,65535,65535" # cyan
- x[E_Table] := "00000,37448,00000" # dark green
- x[E_Telem] := "00000,65535,00000" # green
- x[E_Tvtbl] := "28086,65535,00000" # light green
- x[E_Slots] := "37448,00000,56172" # purple
- x[E_Cset] := "65535,56172,00000" # yellow orange
-
- maps["qms"] := x
-
-# Color map for qmscomb.clr
-
- x := table()
-
- x[E_Coexpr] := "37448,18724,00000" # brown
- x[E_String] := "65535,65535,46810" # ivory
- x[E_Tvsubs] := "65535,65535,46810" # ivory
- x[E_File] := "56172,65535,00000" # light green
- x[E_Refresh] := "37448,18724,00000" # brown
- x[E_Lrgint] := "65535,46810,28086" # peach
- x[E_Real] := "65535,65535,00000" # yellow
- x[E_Record] := "56172,00000,65535" # magenta
- x[E_Set] := "65535,00000,00000" # red
- x[E_Selem] := "65535,00000,00000" # red
- x[E_List] := "00000,65535,65535" # cyan
- x[E_Lelem] := "00000,65535,65535" # cyan
- x[E_Table] := "00000,65535,00000" # green
- x[E_Telem] := "00000,65535,00000" # green
- x[E_Tvtbl] := "00000,65535,00000" # green
- x[E_Slots] := "37448,00000,56172" # purple
- x[E_Cset] := "65535,56172,00000" # yellow orange
-
- maps["qmscomb"] := x
-
-# Color map for rt.clr
-
- x := table()
-
- x[E_Coexpr] := "37448,28086,18724" # light brown
- x[E_String] := "65535,65535,46810" # ivory
- x[E_Tvsubs] := "65535,28086,56172" # pink
- x[E_File] := "37448,00000,56172" # purple
- x[E_Refresh] := "00000,00000,37448" # navy blue
- x[E_Lrgint] := "65535,46810,28086" # peach
- x[E_Real] := "65535,65535,00000" # yellow
- x[E_Record] := "65535,37448,00000" # orange
- x[E_Set] := "37448,00000,00000" # dark red
- x[E_Selem] := "56172,00000,00000" # red
- x[E_List] := "18724,46810,65535" # pastel blue
- x[E_Lelem] := "09362,28086,46810" # medium blue
- x[E_Table] := "00000,28086,00000" # dark green
- x[E_Telem] := "00000,46810,00000" # medium green
- x[E_Tvtbl] := "28086,65535,28086" # light green
- x[E_Slots] := "37448,28086,18724" # light brown
- x[E_Cset] := "46810,28086,00000" # reddish brown
-
- maps["rt"] := x
-
-# Color map for sun.clr
-
- x := table()
-
- x[E_Coexpr] := "37448,28086,18724" # light brown
- x[E_String] := "65535,65535,46810" # ivory
- x[E_Tvsubs] := "65535,28086,56172" # pink
- x[E_File] := "37448,00000,56172" # purple
- x[E_Refresh] := "00000,00000,37448" # navy blue
- x[E_Lrgint] := "65535,46810,28086" # peach
- x[E_Real] := "65535,65535,00000" # yellow
- x[E_Record] := "65535,37448,00000" # orange
- x[E_Set] := "46810,00000,00000" # dark red
- x[E_Selem] := "56172,00000,00000" # red
- x[E_List] := "18724,46810,65535" # pastel blue
- x[E_Lelem] := "09362,28086,46810" # medium blue
- x[E_Table] := "00000,28086,00000" # dark green
- x[E_Telem] := "00000,37448,00000" # medium green
- x[E_Tvtbl] := "00000,65535,00000" # light green
- x[E_Slots] := "37448,28086,18724" # light brown
- x[E_Cset] := "46810,28086,00000" # reddish brown
-
- maps["sun"] := x
-
-# Color map for standard colors
-
- x := table()
-
- x[E_Coexpr] := "deep gray"
- x[E_String] := "pale yellow"
- x[E_Tvsubs] := "yellow"
- x[E_File] := "pale gray"
- x[E_Refresh] := "deep gray"
- x[E_Lrgint] := "pale brown"
- x[E_Real] := "pale purple"
- x[E_Record] := "magenta"
- x[E_Set] := "dark red"
- x[E_Selem] := "red"
- x[E_List] := "dark blue green"
- x[E_Lelem] := "blue green"
- x[E_Table] := "dark green"
- x[E_Telem] := "green"
- x[E_Tvtbl] := "light green"
- x[E_Slots] := "purple"
- x[E_Cset] := "orange"
-
- maps["standard"] := x
- }
-
- return \maps[\palette | "standard"]
-
-end
diff --git a/ipl/mprocs/colortyp.icn b/ipl/mprocs/colortyp.icn
deleted file mode 100644
index 2592e0f..0000000
--- a/ipl/mprocs/colortyp.icn
+++ /dev/null
@@ -1,44 +0,0 @@
-############################################################################
-#
-# File: colortyp.icn
-#
-# Subject: Procedure to produce table of colors for Icon types
-#
-# Author: Ralph E. Griswold
-#
-# Date: July 1, 1997
-#
-############################################################################
-#
-# This file is in the public domain.
-#
-############################################################################
-#
-# Links: typecode
-#
-############################################################################
-
-# Color table for Icon type codes
-
-procedure colortyp()
- local x
-
- x := table()
-
- x["C"] := "deep gray"
- x["s"] := "pale yellow"
- x["r"] := "pale purple"
- x["R"] := "magenta"
- x["S"] := "dark red"
- x["L"] := "dark blue green"
- x["T"] := "dark green"
- x["c"] := "orange"
- x["f"] := "pink"
- x["i"] := "white"
- x["n"] := "gray"
- x["p"] := "red viole"
- x["w"] := "deep blue"
-
- return x
-
-end
diff --git a/ipl/mprocs/em_setup.icn b/ipl/mprocs/em_setup.icn
deleted file mode 100644
index c915fd8..0000000
--- a/ipl/mprocs/em_setup.icn
+++ /dev/null
@@ -1,101 +0,0 @@
-############################################################################
-#
-# File: em_setup.icn
-#
-# Subject: Procedures to set up execution monitors
-#
-# Author: Ralph E. Griswold
-#
-# Date: March 3, 1997
-#
-############################################################################
-#
-# This file is in the public domain.
-#
-############################################################################
-#
-# These procedures provide support for the routine parts of building
-# Icon execution monitors, including what's necessary for them to
-# run stand-alone as well as under the control of monitor coordinators
-# like eve and vc.
-#
-# vis_setup(args[]) opens a window with attributes given
-# by args[]
-#
-# em_setup(sp) loads sp as the program to be monitored
-#
-# context_setup(mask) returns table of graphics context for
-# mask
-#
-# prog_name() returns the name of the source program
-# for the SP set up by em_setup()
-#
-# em_end() hold visualization window open if (a)
-# there is one and (b) monitoring is
-# stand alone
-#
-############################################################################
-#
-# Requires: Version 9 MT Icon, instrumentation, and graphics
-#
-############################################################################
-#
-# Links: evinit, interact, typebind, graphics
-#
-############################################################################
-#
-# Includes: evdefs.icn
-#
-############################################################################
-
-link evinit
-link interact
-link typebind
-link graphics
-
-$include "evdefs.icn"
-
-global Coordination # if nonnull, vc is in charge
-global Visualization # visualization window
-global EventSource # vc's event source
-
-procedure vis_setup(args[]) #: set up visualization window
-
- Visualization := (WOpen ! args) |
- stop("*** cannot open window for visualization")
-
- return Visualization
-
-end
-
-procedure em_setup(sp) #: set up program to be monitored
- local trash
-
- trash := open("/dev/null", "w") |
- stop("*** cannot open /dev/null")
-
- EvInit(sp, , trash, trash) | stop("*** cannot load SP")
-
- return
-
-end
-
-procedure context_setup(mask) #: table of graphics contexts for mask
-
- return typebind(Visualization, mask)
-
-end
-
-procedure prog_name() #: name of monitored source program
-
- return variable("&progname", EventSource) || ".icn"
-
-end
-
-procedure em_end() #: hold event monitoring for event at end
- local back
-
- back := WOpen("canvas=hidden", "bg=light gray")
- if /Coordination then ExitNotice(back, "Normal termination of SP")
-
-end
diff --git a/ipl/mprocs/emutils.icn b/ipl/mprocs/emutils.icn
deleted file mode 100644
index 322815f..0000000
--- a/ipl/mprocs/emutils.icn
+++ /dev/null
@@ -1,508 +0,0 @@
-############################################################################
-#
-# File: emutils.icn
-#
-# Subject: Procedures to support MT-Icon monitors
-#
-# Author: Ralph E. Griswold
-#
-# Date: April 16, 1997
-#
-############################################################################
-#
-# This file is in the public domain.
-#
-############################################################################
-#
-# evname(s) maps the event code to a standard descriptive phrases and vice
-# versa.
-#
-############################################################################
-#
-# Links: convert, tables
-#
-############################################################################
-#
-# Includes: evdefs.icn
-#
-############################################################################
-
-link convert
-link tables
-
-$include "evdefs.icn"
-
-procedure evname(s)
- local result
- static namemap
-
- initial {
- namemap := table()
-
- namemap[E_Aconv] := "conversion attempt"
- namemap[E_Argp] := "argument pointer"
- namemap[E_Alien] := "alien allocation"
- namemap[E_Assign] := "assignment"
-# namemap[E_Base] := "base address of storage region"
- namemap[E_BlkDeAlc] := "block deallocation"
- namemap[E_Bsusp] := "suspension from operation"
- namemap[E_Coact] := "co-expression activation"
- namemap[E_Cocreate] := "co-expression creation"
- namemap[E_Coexpr] := "co-expression allocation"
- namemap[E_Cofail] := "co-expression failure"
- namemap[E_Collect] := "garbage collection"
-# namemap[E_Comment] := "comment"
- namemap[E_Coret] := "co-expression return"
- namemap[E_Cset] := "cset allocation"
- namemap[E_Deref] := "variable dereference"
- namemap[E_Ecall] := "call of operation"
- namemap[E_Efail] := "failure from expression"
- namemap[E_Efp] := "expression frame pointer"
- namemap[E_EndCollect] := "end of garbage collection"
- namemap[E_Erem] := "removal of a suspended generator"
- namemap[E_Eresum] := "resumption of expression"
-# namemap[E_Eret] := "return from expression"
- namemap[E_Error] := "run-time error"
- namemap[E_Esusp] := "suspension from alternation"
- namemap[E_Exit] := "program exit"
- namemap[E_External] := "external allocation"
- namemap[E_Fcall] := "function call"
- namemap[E_Fclose] := "file close"
- namemap[E_Fconv] := "conversion failure"
- namemap[E_Ffail] := "function failure"
- namemap[E_File] := "file allocation"
- namemap[E_Floc] := "file location"
- namemap[E_Fmode] := "file open mode"
- namemap[E_Fopen] := "file open"
- namemap[E_Fread] := "file read"
- namemap[E_Freads] := "file reads"
- namemap[E_Free] := "free region"
- namemap[E_Frem] := "function suspension removal"
- namemap[E_Fresum] := "function resumption"
- namemap[E_Fret] := "function return"
- namemap[E_Fseek] := "file seek"
- namemap[E_Fstring] := "string read or written"
- namemap[E_Fsusp] := "function suspension"
- namemap[E_Fwhere] := "file location"
- namemap[E_Fwrite] := "function write"
- namemap["\223"] := "function writes"
- namemap[E_Gfp] := "generator frame pointer"
-# namemap[E_Highlight] := "allocation highlight"
- namemap[E_Ilevel] := "interpreter call level"
- namemap[E_Intcall] := "interpreter call"
- namemap[E_Integer] := "integer value pseudo-event"
- namemap[E_Intret] := "interpreter return"
- namemap[E_Ipc] := "interpreter program counter"
- namemap[E_Kywdint] := "integer keyword value pseudo-event"
- namemap[E_Kywdpos] := "position value pseudo-event"
- namemap[E_Kywdsubj] := "subject value pseudo-event"
- namemap[E_Lbang] := "list generation"
- namemap[E_Lcreate] := "list creation"
- namemap[E_Lelem] := "list element allocation"
- namemap[E_Lget] := "list get"
- namemap[E_Line] := "line change"
- namemap[E_List] := "list allocation"
- namemap[E_Loc] := "location change"
- namemap[E_Lpop] := "list pop"
- namemap[E_Lpull] := "list pull"
- namemap[E_Lpush] := "list push"
- namemap[E_Lput] := "list put"
- namemap[E_Lrand] := "list random reference"
-# namemap[E_Lref] := "list reference"
- namemap[E_Lrgint] := "large integer allocation"
- namemap[E_Lsub] := "list subscript"
- namemap[E_Lsusp] := "suspension from limitation"
- namemap[E_MXevent] := "monitor input event"
- namemap[E_Nconv] := "conversion not needed"
- namemap[E_NewRegion] := "new storage region"
- namemap[E_Null] := "null value value pseudo-event"
- namemap[E_Ocall] := "operator call"
- namemap[E_Ofail] := "operator failure"
-# namemap[E_Offset] := "address offset"
-# namemap[E_Op] := "interpreter operation"
- namemap[E_Opcode] := "virtual-machine instruction"
- namemap[E_Orem] := "operator suspension removal"
- namemap[E_Oresum] := "operator resumption"
- namemap[E_Oret] := "operator return"
- namemap[E_Osusp] := "operator suspension"
-# namemap[E_Pause] := "memory monitoring comment"
- namemap[E_Pcall] := "procedure call"
- namemap[E_Pfail] := "procedure failure"
- namemap[E_Pfp] := "procedure frame pointer"
-# namemap[E_Pid] := "symbol name"
- namemap[E_Prem] := "suspended procedure removal"
- namemap[E_Presum] := "procedure resumption"
- namemap[E_Pret] := "procedure return"
- namemap[E_Proc] := "procedure value pseudo-event"
- namemap[E_Psusp] := "procedure suspension"
- namemap[E_Rbang] := "record generation"
- namemap[E_Rcreate] := "record creation"
- namemap[E_Real] := "real allocation"
- namemap[E_Record] := "record allocation"
- namemap[E_Refresh] := "refresh allocation"
-# namemap[E_Region] := "region"
- namemap[E_Rrand] := "record random reference"
-# namemap[E_Rref] := "record reference"
- namemap[E_Rsub] := "record subscript"
- namemap[E_Sbang] := "set generation"
- namemap[E_Sconv] := "conversion success"
- namemap[E_Screate] := "set creation"
- namemap[E_Sdelete] := "set deletion"
- namemap[E_Selem] := "set element allocation"
- namemap[E_Set] := "set allocation"
- namemap[E_Sfail] := "scanning failure"
- namemap[E_Sinsert] := "set insertion"
-# namemap[E_Size] := "region size"
- namemap[E_Slots] := "hash header allocation"
- namemap[E_Smember] := "set membership"
- namemap[E_Snew] := "scanning environment creation"
- namemap[E_Spos] := "scanning position"
- namemap[E_Srand] := "set random reference"
- namemap[E_Srem] := "scanning environment removal"
- namemap[E_Sresum] := "scanning resumption"
- namemap[E_Ssasgn] := "substring assignment"
- namemap[E_Ssusp] := "scanning suspension"
- namemap[E_Stack] := "stack depth"
- namemap[E_StrDeAlc] := "string deallocation"
- namemap[E_String] := "string allocation"
- namemap[E_Sval] := "set value"
-# namemap[E_Sym] := "symbol table entry"
- namemap[E_Table] := "table allocation"
- namemap[E_Tbang] := "table generation"
- namemap[E_Tconv] := "conversion target"
- namemap[E_Tcreate] := "table creation"
- namemap[E_Tdelete] := "table deletion"
- namemap[E_Telem] := "table element allocation"
- namemap[E_TenureBlock] := "tenure a block region"
- namemap[E_TenureString] := "tenure a string region"
- namemap[E_Tick] := "clock tick"
- namemap[E_Tinsert] := "table insertion"
- namemap[E_Tkey] := "table key generation"
- namemap[E_Tmember] := "table membership"
- namemap[E_Trand] := "table random reference"
-# namemap[E_Tref] := "table reference"
- namemap[E_Tsub] := "table subscript"
-# namemap[E_Tval] := "table value"
- namemap[E_Tvsubs] := "substring trapped variable allocation"
- namemap[E_Tvtbl] := "table-element trapped variable allocation"
-# namemap[E_Used] := "space used"
- namemap[E_Value] := "value assigned"
- namemap[E_Fterm] := "write terminator"
-
-# namemap := twt(namemap)
- }
-
- result := namemap[s]
- /result := "E_\\" || exbase10(find(s, &cset) - 1, 8)
-
- return result
-
-end
-
-############################################################################
-#
-# evsym() maps event codes to the symbolic names for the codes and vice
-# versa.
-#
-############################################################################
-
-procedure evsym(s)
- local result
- static symmap
-
- initial {
- symmap := table()
-
- symmap[E_Aconv] := "E_Aconv"
- symmap[E_Argp] := "E_Argp"
- symmap[E_Alien] := "E_Alien"
- symmap[E_Assign] := "E_Assign"
- symmap[E_BlkDeAlc] := "E_BlkDeAlc"
- symmap[E_Bsusp] := "E_Bsusp"
- symmap[E_Coact] := "E_Coact"
- symmap[E_Cocreate] := "E_Cocreate"
- symmap[E_Coexpr] := "E_Coexpr"
- symmap[E_Cofail] := "E_Cofail"
- symmap[E_Cofree] := "E_Cofree"
- symmap[E_Collect] := "E_Collect"
- symmap[E_Coret] := "E_Coret"
- symmap[E_Cset] := "E_Cset"
- symmap[E_Deref] := "E_Deref"
- symmap[E_Ecall] := "E_Ecall"
- symmap[E_Efail] := "E_Efail"
- symmap[E_Efp] := "E_Efp"
- symmap[E_Eresum] := "E_Eresum"
- symmap[E_Error] := "E_Error"
- symmap[E_Esusp] := "E_Esusp"
- symmap[E_Erem] := "E_Erem"
- symmap[E_Exit] := "E_Exit"
- symmap[E_External] := "E_External"
- symmap[E_Fcall] := "E_Fcall"
- symmap[E_Fclose] := "E_Fclose"
- symmap[E_Fconv] := "E_Fconv"
- symmap[E_Ffail] := "E_Ffail"
- symmap[E_File] := "E_File"
- symmap[E_Floc] := "E_Loc"
- symmap[E_Fmode] := "E_Fmode"
- symmap[E_Fopen] := "E_Fopen"
- symmap[E_Fread] := "E_Fread"
- symmap[E_Freads] := "E_Freads"
- symmap[E_Free] := "E_Free"
- symmap[E_Frem] := "E_Frem"
- symmap[E_Fresum] := "E_Fresum"
- symmap[E_Fret] := "E_Fret"
- symmap[E_Fseek] := "E_Fseek"
- symmap[E_Fstring] := "E_Fstring"
- symmap[E_Fsusp] := "E_Fsusp"
- symmap[E_Fwhere] := "E_Fwhere"
- symmap[E_Fwrite] := "E_Fwrite"
- symmap[E_Fterm] := "E_Fterm"
- symmap[E_Gfp] := "E_Gfp"
- symmap[E_Ilevel] := "E_Ilevel"
- symmap[E_Intcall] := "E_Intcall"
- symmap[E_Integer] := "E_Integer"
- symmap[E_Intret] := "E_Intret"
- symmap[E_Ipc] := "E_Ipc"
- symmap[E_Kywdint] := "E_Kywdint"
- symmap[E_Kywdpos] := "E_Kywdpos"
- symmap[E_Kywdsubj] := "E_Kywdsubj"
- symmap[E_Lbang] := "E_Lbang"
- symmap[E_Lcreate] := "E_Lcreate"
- symmap[E_Lelem] := "E_Lelem"
- symmap[E_Line] := "E_Line"
- symmap[E_List] := "E_List"
- symmap[E_Loc] := "E_Loc"
- symmap[E_Lpop] := "E_Lpop"
- symmap[E_Lpull] := "E_Lpull"
- symmap[E_Lpush] := "E_Lpush"
- symmap[E_Lput] := "E_Lput"
- symmap[E_Lrand] := "E_Lrand"
- symmap[E_Lref] := "E_Lref"
- symmap[E_Lrgint] := "E_Lrgint"
- symmap[E_Lsub] := "E_Lsub"
- symmap[E_Lsusp] := "E_Lsusp"
- symmap[E_Nconv] := "E_Nconv"
- symmap[E_NewRegion]:= "E_NewRegion"
- symmap[E_Null] := "E_Null"
- symmap[E_Ocall] := "E_Ocall"
- symmap[E_Ofail] := "E_Ofail"
- symmap[E_Op] := "E_Op"
- symmap[E_Opcode] := "E_Opcode"
- symmap[E_Oresum] := "E_Oresum"
- symmap[E_Oret] := "E_Oret"
- symmap[E_Osusp] := "E_Osusp"
- symmap[E_Orem] := "E_Orem"
- symmap[E_Pcall] := "E_Pcall"
- symmap[E_Pfail] := "E_Pfail"
- symmap[E_Pfp] := "E_Pfp"
- symmap[E_Presum] := "E_Presum"
- symmap[E_Pret] := "E_Pret"
- symmap[E_Proc] := "E_Proc"
- symmap[E_Psusp] := "E_Psusp"
- symmap[E_Prem] := "E_Prem"
- symmap[E_Rbang] := "E_Rbang"
- symmap[E_Rcreate] := "E_Rcreate"
- symmap[E_Real] := "E_Real"
- symmap[E_Record] := "E_Record"
- symmap[E_Refresh] := "E_Refresh"
- symmap[E_Rrand] := "E_Rrand"
- symmap[E_Rref] := "E_Rref"
- symmap[E_Rsub] := "E_Rsub"
- symmap[E_Sbang] := "E_Sbang"
- symmap[E_Sconv] := "E_Sconv"
- symmap[E_Screate] := "E_Screate"
- symmap[E_Sdelete] := "E_Sdelete"
- symmap[E_Selem] := "E_Selem"
- symmap[E_Set] := "E_Set"
- symmap[E_Sfail] := "E_Sfail"
- symmap[E_Sinsert] := "E_Sinsert"
- symmap[E_Slots] := "E_Slots"
- symmap[E_Smember] := "E_Smember"
- symmap[E_Snew] := "E_Snew"
- symmap[E_Spos] := "E_Spos"
- symmap[E_Srand] := "E_Srand"
- symmap[E_Sresum] := "E_Sresum"
- symmap[E_Ssasgn] := "E_Ssasgn"
- symmap[E_Ssusp] := "E_Ssusp"
- symmap[E_Stack] := "E_Stack"
- symmap[E_StrDeAlc] := "E_StrDeAlc"
- symmap[E_String] := "E_String"
- symmap[E_Sval] := "E_Sval"
- symmap[E_Srem] := "E_Srem"
- symmap[E_Table] := "E_Table"
- symmap[E_Tbang] := "E_Tbang"
- symmap[E_Tconv] := "E_Tconv"
- symmap[E_Tcreate] := "E_Tcreate"
- symmap[E_Tdelete] := "E_Tdelete"
- symmap[E_Telem] := "E_Telem"
- symmap[E_Tick] := "E_Tick"
- symmap[E_Tinsert] := "E_Tinsert"
- symmap[E_Tkey] := "E_Tkey"
- symmap[E_Tmember] := "E_Tmember"
- symmap[E_Trand] := "E_Trand"
- symmap[E_Tref] := "E_Tref"
- symmap[E_Tsub] := "E_Tsub"
- symmap[E_Tval] := "E_Tval"
- symmap[E_Tvsubs] := "E_Tvsubs"
- symmap[E_Tvtbl] := "E_Tvtbl"
- symmap[E_Value] := "E_Value"
-
- twt(symmap)
- }
-
- result := symmap[s]
- /result := "E_\\" || exbase10(find(s, &cset), 8)
-
- return result
-
-end
-
-procedure allocode(s)
- static allocmap
-
- initial {
- allocmap := table("unknown code")
-
- allocmap[E_Coexpr] := "co-expression"
- allocmap[E_Cset] := "cset"
- allocmap[E_File] := "file"
- allocmap[E_List] := "list"
- allocmap[E_Real] := "real"
- allocmap[E_Record] := "record"
- allocmap[E_Set] := "set"
- allocmap[E_String] := "string"
- allocmap[E_Table] := "table"
-
- twt(allocmap)
- }
-
- return allocmap[s]
-
-end
-
-# Turn off output in SP.
-
-procedure kill_output()
-
- variable("write", EventSource) := -1
- variable("writes", EventSource) := -1
-
- return
-
-end
-
-############################################################################
-#
-# opname() maps a virtual-machine instruction number to a symbolic name.
-#
-############################################################################
-
-procedure opname(i) #: map virtual-machine code to name
- static opmap
-
- initial {
- opmap := table("")
-
- opmap[1] := "Asgn"
- opmap[2] := "Bang"
- opmap[3] := "Cat"
- opmap[4] := "Compl"
- opmap[5] := "Diff"
- opmap[6] := "Div"
- opmap[7] := "Eqv"
- opmap[8] := "Inter"
- opmap[9] := "Lconcat"
- opmap[10] := "Lexeq"
- opmap[11] := "Lexge"
- opmap[12] := "Lexgt"
- opmap[13] := "Lexle"
- opmap[14] := "Lexlt"
- opmap[15] := "Lexne"
- opmap[16] := "Minus"
- opmap[17] := "Mod"
- opmap[18] := "Mult"
- opmap[19] := "Neg"
- opmap[20] := "Neqv"
- opmap[21] := "Nonnull"
- opmap[22] := "Null"
- opmap[23] := "Number"
- opmap[24] := "Numeq"
- opmap[25] := "Numge"
- opmap[26] := "Numgt"
- opmap[27] := "Numle"
- opmap[28] := "Numlt"
- opmap[29] := "Numne"
- opmap[30] := "Plus"
- opmap[31] := "Power"
- opmap[32] := "Random"
- opmap[33] := "Rasgn"
- opmap[34] := "Refresh"
- opmap[35] := "Rswap"
- opmap[36] := "Sect"
- opmap[37] := "Size"
- opmap[38] := "Subsc"
- opmap[39] := "Swap"
- opmap[40] := "Tabmat"
- opmap[41] := "Toby"
- opmap[42] := "Unions"
- opmap[43] := "Value"
- opmap[44] := "Bscan"
- opmap[45] := "Ccase"
- opmap[46] := "Chfail"
- opmap[47] := "Coact"
- opmap[48] := "Cofail"
- opmap[49] := "Coret"
- opmap[50] := "Create"
- opmap[51] := "Cset"
- opmap[52] := "Dup"
- opmap[53] := "Efail"
- opmap[54] := "Eret"
- opmap[55] := "Escan"
- opmap[56] := "Esusp"
- opmap[57] := "Field"
- opmap[58] := "Goto"
- opmap[59] := "Init"
- opmap[60] := "Int"
- opmap[61] := "Invoke"
- opmap[62] := "Keywd"
- opmap[63] := "Limit"
- opmap[64] := "Line"
- opmap[65] := "Llist"
- opmap[66] := "Lsusp"
- opmap[67] := "Mark"
- opmap[68] := "Pfail"
- opmap[69] := "Pnull"
- opmap[70] := "Pop"
- opmap[71] := "Pret"
- opmap[72] := "Psusp"
- opmap[73] := "Push1"
- opmap[74] := "Pushn1"
- opmap[75] := "Real"
- opmap[76] := "Sdup"
- opmap[77] := "Str"
- opmap[78] := "Unmark"
- opmap[80] := "Var"
- opmap[81] := "Arg"
- opmap[82] := "Static"
- opmap[83] := "Local"
- opmap[84] := "Global"
- opmap[85] := "Mark0"
- opmap[86] := "Quit"
- opmap[87] := "FQuit"
- opmap[88] := "Tally"
- opmap[89] := "Apply"
- opmap[90] := "Acset"
- opmap[91] := "Areal"
- opmap[92] := "Astr"
- opmap[93] := "Aglobal"
- opmap[94] := "Astatic"
- opmap[95] := "Agoto"
- opmap[96] := "Amark"
- opmap[98] := "Noop"
- opmap[100] := "SymEvents"
- opmap[108] := "Colm"
- }
-
- return opmap[i]
-
-end
diff --git a/ipl/mprocs/evaltree.icn b/ipl/mprocs/evaltree.icn
deleted file mode 100644
index c007dca..0000000
--- a/ipl/mprocs/evaltree.icn
+++ /dev/null
@@ -1,106 +0,0 @@
-############################################################################
-#
-# File: evaltree.icn
-#
-# Subject: Procedures to maintain activation tree
-#
-# Author: Clinton Jeffery
-#
-# Date: June 19, 1994
-#
-###########################################################################
-#
-# This file is in the public domain.
-#
-############################################################################
-#
-# Usage: evaltree(cset, procedure, record constructor)
-#
-# The record type must have fields node, parent, children
-#
-# See "A Framework for Monitoring Program Execution", Clinton L. Jeffery,
-# TR 93-21, Department of Computer Science, The University of Arizona,
-# July 30, 1993.
-#
-############################################################################
-#
-# Requires: MT Icon and event monitoring
-#
-############################################################################
-
-$include "evdefs.icn"
-
-record __evaltree_node(node,parent,children)
-
-global CallCodes,
- SuspendCodes,
- ResumeCodes,
- ReturnCodes,
- FailCodes,
- RemoveCodes
-
-procedure evaltree(mask, callback, activation_record)
- local c, current, p, child
-
-
- /activation_record := __evaltree_node
- CallCodes := string(mask ** cset(E_Pcall || E_Fcall || E_Ocall || E_Snew))
- SuspendCodes := string(mask ** cset(E_Psusp || E_Fsusp ||
- E_Osusp || E_Ssusp))
- ResumeCodes := string(mask ** cset(E_Presum || E_Fresum || E_Oresum ||
- E_Sresum))
- ReturnCodes := string(mask ** cset(E_Pret || E_Fret || E_Oret))
- FailCodes := string(mask ** cset(E_Pfail || E_Ffail || E_Ofail || E_Sfail))
- RemoveCodes := string(mask ** cset(E_Prem || E_Frem || E_Orem || E_Srem))
-
- current := activation_record()
- current.parent := activation_record()
- current.children := []
- current.parent.children := []
-
- while EvGet(mask) do {
- case &eventcode of {
- !CallCodes: {
- c := activation_record()
- c.node := &eventvalue
- c.parent := current
- c.children := []
- put(current.children, c)
- current := c
- callback(current, current.parent)
- }
- !ReturnCodes | !FailCodes: {
- p := pull(current.parent.children)
- current := current.parent
- callback(current, p)
- }
- !SuspendCodes: {
- current := current.parent
- callback(current, current.children[-1])
- }
- !ResumeCodes: {
- current := current.children[-1]
- callback(current, current.parent)
- }
- !RemoveCodes: {
- if child := pull(current.children) then {
- while put(current.children, pop(child.children))
- callback(current, child)
- }
- else {
- if current === current.parent.children[-1] then {
- p := pull(current.parent.children)
- current := current.parent
- callback(current, p)
- next
- }
- else stop("evaltree: unknown removal")
- }
- }
- default: {
- callback(current, current)
- }
- }
- }
-end
-
diff --git a/ipl/mprocs/evinit.icn b/ipl/mprocs/evinit.icn
deleted file mode 100644
index 09a2ee6..0000000
--- a/ipl/mprocs/evinit.icn
+++ /dev/null
@@ -1,89 +0,0 @@
-############################################################################
-#
-# File: evinit.icn
-#
-# Subject: Procedures for event monitoring
-#
-# Author: Ralph E. Griswold
-#
-# Date: November 5, 1995
-#
-############################################################################
-#
-# This file is in the public domain.
-#
-############################################################################
-#
-# This file provides initialization for event monitors.
-#
-# This file is intended for use with event monitors running under
-# MT Icon.
-#
-############################################################################
-
-$include "evdefs.icn"
-
-procedure EvInit(f,input,output,error)
- if not MTEvInit(f,input,output,error) then fail
- return
-end
-
-procedure EvTerm(win)
- if &eventsource === (Monitored | EventSource) then {
- if type(win) == "window" then
- Event(win)
- }
-end
-#
-# MultiThread EventMon support, from file mtsupport.icn
-#
-
-global Monitored, EventSource, MTEventMask
-
-#
-# If EvInit is called with a string or a list, run as a standalone MT-based
-# event monitor -- load the icode file and overload certain EvMon symbols.
-#
-# This operation is skipped if &eventsource has already been initialized,
-# presumably by some event broker such as Eve.
-#
-procedure MTEvInit(f,input,output,error)
-
- if \&eventsource then return
-
- if type(f) == "string" then {
- &eventsource := EventSource := Monitored := load(f,,input,output,error) | fail
- EvGet :=: MTEvGet
- }
- else if type(f) == "list" then {
- &eventsource := EventSource := Monitored := load(f[1],f[2:0],input,output,error) | fail
- EvGet :=: MTEvGet
- }
- return &eventsource
-end
-
-procedure MTEvGet(c,flag)
- static lastcset
- initial {
- lastcset := ''
- }
-
- if c ~=== lastcset then {
- lastcset := c
- eventmask(\(Monitored | EventSource) ,\c | &cset,&main)
- }
- return MTEvGet(c,flag)
-end
-
-#
-# Eve-specific extensions to the general model
-#
-procedure EvQuit()
- EvSignal("quit")
-end
-
-procedure EvSignal(x)
- if type(x) == "cset" then
- write(&errout, "EvSignal(", image(x), ") is ambiguous.")
- return x @ &eventsource
-end
diff --git a/ipl/mprocs/evnames.icn b/ipl/mprocs/evnames.icn
deleted file mode 100644
index 046b4a3..0000000
--- a/ipl/mprocs/evnames.icn
+++ /dev/null
@@ -1,174 +0,0 @@
-############################################################################
-#
-# File: evnames.icn
-#
-# Subject: Procedures to map between event codes and names
-#
-# Author: Ralph E. Griswold
-#
-# Date: December 26, 1995
-#
-############################################################################
-#
-# This file is in the public domain.
-#
-############################################################################
-#
-# evnames(x) creates a two-way table. Indexed by an event code, it
-# produces a descriptive phrase for the code. Indexed by the descriptive
-# phrase it produces the event code. It returns the value for key x.
-#
-############################################################################
-#
-# Links: tables
-#
-############################################################################
-#
-# Includes: evdefs.icn
-#
-############################################################################
-
-link tables
-
-$include "evdefs.icn"
-
-procedure evnames(e)
- static namemap
-
- initial {
- namemap := table("unknown event")
-
- namemap[E_Aconv] := "conversion attempt"
- namemap[E_Alien] := "alien allocation"
- namemap[E_Assign] := "assignment"
- namemap[E_Base] := "base address of storage region"
- namemap[E_BlkDeAlc] := "block deallocation"
- namemap[E_Bsusp] := "suspension from operation"
- namemap[E_Coact] := "co-expression activation"
- namemap[E_Coexpr] := "co-expression allocation"
- namemap[E_Cofail] := "co-expression failure"
- namemap[E_Collect] := "garbage collection"
- namemap[E_Comment] := "comment"
- namemap[E_Coret] := "co-expression return"
- namemap[E_Cset] := "cset allocation"
- namemap[E_Ecall] := "call of operation"
- namemap[E_Efail] := "failure from expression"
- namemap[E_EndCollect] := "end of garbage collection"
- namemap[E_Erem] := "removal of a suspended generator"
- namemap[E_Eresum] := "resumption of expression"
- namemap[E_Eret] := "return from expression"
- namemap[E_Error] := "run-time error"
- namemap[E_Esusp] := "suspension from alternation"
- namemap[E_Exit] := "program exit"
- namemap[E_External] := "external allocation"
- namemap[E_Fcall] := "function call"
- namemap[E_Fconv] := "conversion failure"
- namemap[E_Ffail] := "function failure"
- namemap[E_File] := "file allocation"
- namemap[E_Free] := "free region"
- namemap[E_Frem] := "function suspension removal"
- namemap[E_Fresum] := "function resumption"
- namemap[E_Fret] := "function return"
- namemap[E_Fsusp] := "function suspension"
- namemap[E_Highlight] := "allocation highlight"
- namemap[E_Intcall] := "interpreter call"
- namemap[E_Integer] := "integer value pseudo-event"
- namemap[E_Intret] := "interpreter return"
- namemap[E_Kywdint] := "integer keyword value pseudo-event"
- namemap[E_Kywdpos] := "position value pseudo-event"
- namemap[E_Kywdsubj] := "subject value pseudo-event"
- namemap[E_Lbang] := "list generation"
- namemap[E_Lcreate] := "list creation"
- namemap[E_Lelem] := "list element allocation"
- namemap[E_Lget] := "list get"
- namemap[E_Line] := "line change"
- namemap[E_List] := "list allocation"
- namemap[E_Loc] := "location change"
- namemap[E_Lpop] := "list pop"
- namemap[E_Lpull] := "list pull"
- namemap[E_Lpush] := "list push"
- namemap[E_Lput] := "list put"
- namemap[E_Lrand] := "list random reference"
- namemap[E_Lref] := "list reference"
- namemap[E_Lrgint] := "large integer allocation"
- namemap[E_Lsub] := "list subscript"
- namemap[E_Lsusp] := "suspension from limitation"
- namemap[E_MXevent] := "monitor input event"
- namemap[E_Nconv] := "conversion not needed"
- namemap[E_Null] := "null value value pseudo-event"
- namemap[E_Ocall] := "operator call"
- namemap[E_Ofail] := "operator failure"
- namemap[E_Offset] := "address offset"
- namemap[E_Opcode] := "virtual-machine instruction"
- namemap[E_Orem] := "operator suspension removal"
- namemap[E_Oresum] := "operator resumption"
- namemap[E_Oret] := "operator return"
- namemap[E_Osusp] := "operator suspension"
- namemap[E_Pause] := "memory monitoring comment"
- namemap[E_Pcall] := "procedure call"
- namemap[E_Pfail] := "procedure failure"
- namemap[E_Pid] := "symbol name"
- namemap[E_Prem] := "suspended procedure removal"
- namemap[E_Presum] := "procedure resumption"
- namemap[E_Pret] := "procedure return"
- namemap[E_Proc] := "procedure value pseudo-event"
- namemap[E_Psusp] := "procedure suspension"
- namemap[E_Rbang] := "record generation"
- namemap[E_Rcreate] := "record creation"
- namemap[E_Real] := "real allocation"
- namemap[E_Record] := "record allocation"
- namemap[E_Refresh] := "refresh allocation"
- namemap[E_Region] := "region"
- namemap[E_Rrand] := "record random reference"
- namemap[E_Rref] := "record reference"
- namemap[E_Rsub] := "record subscript"
- namemap[E_Sbang] := "set generation"
- namemap[E_Sconv] := "conversion success"
- namemap[E_Screate] := "set creation"
- namemap[E_Sdelete] := "set deletion"
- namemap[E_Selem] := "set element allocation"
- namemap[E_Set] := "set allocation"
- namemap[E_Sfail] := "scanning failure"
- namemap[E_Sinsert] := "set insertion"
- namemap[E_Size] := "region size"
- namemap[E_Slots] := "hash header allocation"
- namemap[E_Smember] := "set membership"
- namemap[E_Snew] := "scanning environment creation"
- namemap[E_Spos] := "scanning position"
- namemap[E_Srand] := "set random reference"
- namemap[E_Srem] := "scanning environment removal"
- namemap[E_Sresum] := "scanning resumption"
- namemap[E_Ssasgn] := "substring assignment"
- namemap[E_Ssusp] := "scanning suspension"
- namemap[E_Stack] := "stack depth"
- namemap[E_StrDeAlc] := "string deallocation"
- namemap[E_String] := "string allocation"
- namemap[E_Sval] := "set value"
- namemap[E_Sym] := "symbol table entry"
- namemap[E_Table] := "table allocation"
- namemap[E_Tbang] := "table generation"
- namemap[E_Tconv] := "conversion target"
- namemap[E_Tcreate] := "table creation"
- namemap[E_Tdelete] := "table deletion"
- namemap[E_Telem] := "table element allocation"
- namemap[E_TenureBlock] := "tenure a block region"
- namemap[E_TenureString] := "tenure a string region"
- namemap[E_Tick] := "clock tick"
- namemap[E_Tinsert] := "table insertion"
- namemap[E_Tkey] := "table key generation"
- namemap[E_Tmember] := "table membership"
- namemap[E_Trand] := "table random reference"
- namemap[E_Tref] := "table reference"
- namemap[E_Tsub] := "table subscript"
- namemap[E_Tval] := "table value"
- namemap[E_Tvsubs] := "substring trapped variable allocation"
- namemap[E_Tvtbl] := "table-element trapped variable allocation"
- namemap[E_Used] := "space used"
- namemap[E_Value] := "value assigned"
-
- twt(namemap)
- }
-
- return namemap[e]
-
-end
diff --git a/ipl/mprocs/evsyms.icn b/ipl/mprocs/evsyms.icn
deleted file mode 100644
index 8ccc705..0000000
--- a/ipl/mprocs/evsyms.icn
+++ /dev/null
@@ -1,160 +0,0 @@
-############################################################################
-#
-# File: evsyms.icn
-#
-# Subject: Procedures to produce table of event codes and symbols
-#
-# Author: Ralph E. Griswold
-#
-# Date: October 3, 1996
-#
-############################################################################
-#
-# This file is in the public domain.
-#
-############################################################################
-#
-# evsyms() returns returns a two-way table. Indexed by an event code, it
-# produces the symbol (global identifier name) for the code. Indexed by the
-# symbol of the code, it produces the event code.
-#
-# This procedure is intended for use in event monitors under MT Icon.
-#
-############################################################################
-#
-# Links: tables
-#
-############################################################################
-#
-# Includes: "evdefs.icn"
-#
-############################################################################
-
-link tables
-
-$include "evdefs.icn"
-
-procedure evsyms()
- static symmap
-
- initial {
- symmap := table("E_????")
-
- symmap[E_Aconv] := "E_Aconv"
- symmap[E_Alien] := "E_Alien"
- symmap[E_Assign] := "E_Assign"
- symmap[E_BlkDeAlc] := "E_BlkDeAlc"
- symmap[E_Bsusp] := "E_Bsusp"
- symmap[E_Coact] := "E_Coact"
- symmap[E_Coexpr] := "E_Coexpr"
- symmap[E_Cofail] := "E_Cofail"
- symmap[E_Collect] := "E_Collect"
- symmap[E_Coret] := "E_Coret"
- symmap[E_Cset] := "E_Cset"
- symmap[E_Ecall] := "E_Ecall"
- symmap[E_Efail] := "E_Efail"
- symmap[E_Eresum] := "E_Eresum"
- symmap[E_Error] := "E_Error"
- symmap[E_Esusp] := "E_Esusp"
- symmap[E_Erem] := "E_Erem"
- symmap[E_Exit] := "E_Exit"
- symmap[E_External] := "E_External"
- symmap[E_Fcall] := "E_Fcall"
- symmap[E_Fconv] := "E_Fconv"
- symmap[E_Ffail] := "E_Ffail"
- symmap[E_File] := "E_File"
- symmap[E_Free] := "E_Free"
- symmap[E_Fresum] := "E_Fresum"
- symmap[E_Fret] := "E_Fret"
- symmap[E_Fsusp] := "E_Fsusp"
- symmap[E_Frem] := "E_Frem"
- symmap[E_Intcall] := "E_Intcall"
- symmap[E_Integer] := "E_Integer"
- symmap[E_Intret] := "E_Intret"
- symmap[E_Kywdint] := "E_Kywdint"
- symmap[E_Kywdpos] := "E_Kywdpos"
- symmap[E_Kywdsubj] := "E_Kywdsubj"
- symmap[E_Lbang] := "E_Lbang"
- symmap[E_Lcreate] := "E_Lcreate"
- symmap[E_Lelem] := "E_Lelem"
- symmap[E_Line] := "E_Line"
- symmap[E_List] := "E_List"
- symmap[E_Loc] := "E_Loc"
- symmap[E_Lpop] := "E_Lpop"
- symmap[E_Lpull] := "E_Lpull"
- symmap[E_Lpush] := "E_Lpush"
- symmap[E_Lput] := "E_Lput"
- symmap[E_Lrand] := "E_Lrand"
- symmap[E_Lref] := "E_Lref"
- symmap[E_Lrgint] := "E_Lrgint"
- symmap[E_Lsub] := "E_Lsub"
- symmap[E_Lsusp] := "E_Lsusp"
- symmap[E_Nconv] := "E_Nconv"
- symmap[E_Null] := "E_Null"
- symmap[E_Ocall] := "E_Ocall"
- symmap[E_Ofail] := "E_Ofail"
- symmap[E_Opcode] := "E_Opcode"
- symmap[E_Oresum] := "E_Oresum"
- symmap[E_Oret] := "E_Oret"
- symmap[E_Osusp] := "E_Osusp"
- symmap[E_Orem] := "E_Orem"
- symmap[E_Pcall] := "E_Pcall"
- symmap[E_Pfail] := "E_Pfail"
- symmap[E_Presum] := "E_Presum"
- symmap[E_Pret] := "E_Pret"
- symmap[E_Proc] := "E_Proc"
- symmap[E_Psusp] := "E_Psusp"
- symmap[E_Prem] := "E_Prem"
- symmap[E_Rbang] := "E_Rbang"
- symmap[E_Rcreate] := "E_Rcreate"
- symmap[E_Real] := "E_Real"
- symmap[E_Record] := "E_Record"
- symmap[E_Refresh] := "E_Refresh"
- symmap[E_Rrand] := "E_Rrand"
- symmap[E_Rref] := "E_Rref"
- symmap[E_Rsub] := "E_Rsub"
- symmap[E_Sbang] := "E_Sbang"
- symmap[E_Sconv] := "E_Sconv"
- symmap[E_Screate] := "E_Screate"
- symmap[E_Sdelete] := "E_Sdelete"
- symmap[E_Selem] := "E_Selem"
- symmap[E_Set] := "E_Set"
- symmap[E_Sfail] := "E_Sfail"
- symmap[E_Sinsert] := "E_Sinsert"
- symmap[E_Slots] := "E_Slots"
- symmap[E_Smember] := "E_Smember"
- symmap[E_Snew] := "E_Snew"
- symmap[E_Spos] := "E_Spos"
- symmap[E_Srand] := "E_Srand"
- symmap[E_Sresum] := "E_Sresum"
- symmap[E_Ssasgn] := "E_Ssasgn"
- symmap[E_Ssusp] := "E_Ssusp"
- symmap[E_Stack] := "E_Stack"
- symmap[E_StrDeAlc] := "E_StrDeAlc"
- symmap[E_String] := "E_String"
- symmap[E_Sval] := "E_Sval"
- symmap[E_Srem] := "E_Srem"
- symmap[E_Table] := "E_Table"
- symmap[E_Tbang] := "E_Tbang"
- symmap[E_Tconv] := "E_Tconv"
- symmap[E_Tcreate] := "E_Tcreate"
- symmap[E_Tdelete] := "E_Tdelete"
- symmap[E_Telem] := "E_Telem"
- symmap[E_Tick] := "E_Tick"
- symmap[E_Tinsert] := "E_Tinsert"
- symmap[E_Tkey] := "E_Tkey"
- symmap[E_Tmember] := "E_Tmember"
- symmap[E_Trand] := "E_Trand"
- symmap[E_Tref] := "E_Tref"
- symmap[E_Tsub] := "E_Tsub"
- symmap[E_Tval] := "E_Tval"
- symmap[E_Tvsubs] := "E_Tvsubs"
- symmap[E_Tvtbl] := "E_Tvtbl"
- symmap[E_Value] := "E_Value"
-
- symmap := twt(symmap)
- }
-
- return symmap
-
-end
diff --git a/ipl/mprocs/evtmap.icn b/ipl/mprocs/evtmap.icn
deleted file mode 100644
index 255adae..0000000
--- a/ipl/mprocs/evtmap.icn
+++ /dev/null
@@ -1,181 +0,0 @@
-############################################################################
-#
-# File: evtmap.icn
-#
-# Subject: Procedure to map event code names to values
-#
-# Author: Ralph E. Griswold
-#
-# Date: July 15, 1995
-#
-############################################################################
-#
-# This file is in the public domain.
-#
-############################################################################
-#
-# evtmap(s) returns the event-code value for the event string name s. It
-# fails is s is not the name of an event value.
-#
-############################################################################
-#
-# Includes: evdefs.icn, etdefs.icn
-#
-############################################################################
-
-$include "evdefs.icn"
-$include "etdefs.icn"
-
-procedure evtmap(s) #: map event code name to event value
- static maptbl
-
- initial {
- maptbl:= table()
-
- maptbl["E_Aconv"] := "I"
- maptbl["E_Alien"] := "z"
- maptbl["E_Assign"] := "\347"
- maptbl["E_Base"] := "<"
- maptbl["E_BlkDeAlc"] := "-"
- maptbl["E_Bsusp"] := "b"
- maptbl["E_Coact"] := "A"
- maptbl["E_Coexpr"] := "x"
- maptbl["E_Cofail"] := "D"
- maptbl["E_Collect"] := "G"
- maptbl["E_Comment"] := "#"
- maptbl["E_Coret"] := "B"
- maptbl["E_Cset"] := "e"
- maptbl["E_Ecall"] := "c"
- maptbl["E_Efail"] := "f"
- maptbl["E_EndCollect"] := "\360"
- maptbl["E_Erem"] := "v"
- maptbl["E_Eresum"] := "u"
- maptbl["E_Eret"] := "r"
- maptbl["E_Error"] := "E"
- maptbl["E_Esusp"] := "a"
- maptbl["E_Exit"] := "X"
- maptbl["E_External"] := "j"
- maptbl["E_Fcall"] := ":"
- maptbl["E_Fconv"] := "J"
- maptbl["E_Ffail"] := "M"
- maptbl["E_File"] := "g"
- maptbl["E_Free"] := "Z"
- maptbl["E_Frem"] := "["
- maptbl["E_Fresum"] := "Y"
- maptbl["E_Fret"] := "P"
- maptbl["E_Fsusp"] := "W"
- maptbl["E_Highlight"] := "H"
- maptbl["E_Intcall"] := "\351"
- maptbl["E_Integer"] := "@"
- maptbl["E_Intret"] := "\352"
- maptbl["E_Kywdint"] := "^"
- maptbl["E_Kywdpos"] := "&"
- maptbl["E_Kywdsubj"] := "*"
- maptbl["E_Lbang"] := "\301"
- maptbl["E_Lcreate"] := "\302"
- maptbl["E_Lelem"] := "m"
- maptbl["E_List"] := "k"
- maptbl["E_Loc"] := "|"
- maptbl["E_Lpop"] := "\303"
- maptbl["E_Lpull"] := "\304"
- maptbl["E_Lpush"] := "\305"
- maptbl["E_Lput"] := "\306"
- maptbl["E_Lrand"] := "\307"
- maptbl["E_Lref"] := "\310"
- maptbl["E_Lrgint"] := "L"
- maptbl["E_Lsub"] := "\311"
- maptbl["E_Lsusp"] := "l"
- maptbl["E_MXevent"] := "\370"
- maptbl["E_Nconv"] := "N"
- maptbl["E_Null"] := "$"
- maptbl["E_Ocall"] := "\\"
- maptbl["E_Ofail"] := "]"
- maptbl["E_Offset"] := "+"
- maptbl["E_Opcode"] := "O"
- maptbl["E_Orem"] := "\177"
- maptbl["E_Oresum"] := "}"
- maptbl["E_Oret"] := "`"
- maptbl["E_Osusp"] := "{"
- maptbl["E_Pause"] := ";"
- maptbl["E_Pcall"] := "C"
- maptbl["E_Pfail"] := "F"
- maptbl["E_Pid"] := "."
- maptbl["E_Prem"] := "V"
- maptbl["E_Presum"] := "U"
- maptbl["E_Pret"] := "R"
- maptbl["E_Proc"] := "%"
- maptbl["E_Psusp"] := "S"
- maptbl["E_Rbang"] := "\312"
- maptbl["E_Rcreate"] := "\313"
- maptbl["E_Real"] := "d"
- maptbl["E_Record"] := "h"
- maptbl["E_Refresh"] := "y"
- maptbl["E_Region"] := "?"
- maptbl["E_Rrand"] := "\314"
- maptbl["E_Rref"] := "\315"
- maptbl["E_Rsub"] := "\316"
- maptbl["E_Ssasgn"] := "\354"
- maptbl["E_Sbang"] := "\317"
- maptbl["E_Sconv"] := "Q"
- maptbl["E_Screate"] := "\320"
- maptbl["E_Sdelete"] := "\321"
- maptbl["E_Selem"] := "t"
- maptbl["E_Set"] := "q"
- maptbl["E_Sfail"] := "\341"
- maptbl["E_Sinsert"] := "\322"
- maptbl["E_Size"] := ">"
- maptbl["E_Slots"] := "w"
- maptbl["E_Smember"] := "\323"
- maptbl["E_Snew"] := "\340"
- maptbl["E_Spos"] := "\346"
- maptbl["E_Srand"] := "\336"
- maptbl["E_Srem"] := "\344"
- maptbl["E_Sresum"] := "\343"
- maptbl["E_Ssusp"] := "\342"
- maptbl["E_Stack"] := "\353"
- maptbl["E_StrDeAlc"] := "~"
- maptbl["E_String"] := "s"
- maptbl["E_Sval"] := "\324"
- maptbl["E_Sym"] := "T"
- maptbl["E_Table"] := "n"
- maptbl["E_Tbang"] := "\325"
- maptbl["E_Tconv"] := "K"
- maptbl["E_Tcreate"] := "\326"
- maptbl["E_Tdelete"] := "\327"
- maptbl["E_Telem"] := "o"
- maptbl["E_TenureBlock"] := "\362"
- maptbl["E_TenureString"] := "\361"
- maptbl["E_Tick"] := "."
- maptbl["E_Tinsert"] := "\330"
- maptbl["E_Tkey"] := "\331"
- maptbl["E_Tmember"] := "\332"
- maptbl["E_Trand"] := "\337"
- maptbl["E_Tref"] := "\333"
- maptbl["E_Tsub"] := "\334"
- maptbl["E_Tval"] := "\335"
- maptbl["E_Tvsubs"] := "i"
- maptbl["E_Tvtbl"] := "p"
- maptbl["E_Used"] := "="
- maptbl["E_Value"] := "\350"
-
- maptbl["T_01"] := "A"
- maptbl["T_02"] := "B"
- maptbl["T_03"] := "C"
- maptbl["T_04"] := "D"
- maptbl["T_05"] := "E"
- maptbl["T_06"] := "F"
- maptbl["T_07"] := "G"
- maptbl["T_08"] := "H"
- maptbl["T_09"] := "I"
- maptbl["T_10"] := "J"
- maptbl["T_11"] := "K"
- maptbl["T_12"] := "L"
- maptbl["T_13"] := "M"
- maptbl["T_14"] := "N"
-
-$define T_Mask1 cset("ABCDEFGHIJKLM")
- }
-
- return \maptbl[s]
-
-end
diff --git a/ipl/mprocs/evutils.icn b/ipl/mprocs/evutils.icn
deleted file mode 100644
index c1c847e..0000000
--- a/ipl/mprocs/evutils.icn
+++ /dev/null
@@ -1,94 +0,0 @@
-############################################################################
-#
-# File: evutils.icn
-#
-# Subject: Procedures to support event monitoring
-#
-# Author: Clinton L. Jeffery
-#
-# Date: November 23, 1997
-#
-############################################################################
-#
-# This file is in the public domain.
-#
-############################################################################
-#
-# This may not be the latest version of this file, despite the date.
-#
-############################################################################
-#
-# Requires: Version 9 graphics
-#
-############################################################################
-
-#
-# location() - encodes a two-dimensional location in an integer
-#
-procedure location(x, y)
- return ishift(x, 16) + y
-end
-
-#
-# vertical() - returns the y/line/row component of a location
-#
-procedure vertical(Loc)
- return iand(Loc, 65535) # 16 least-significant bits
-end
-
-#
-# horizontal - returns the x/column component of a location
-#
-procedure horizontal(Loc)
- return ishift(Loc, -16) # 16 most-significant bits
-end
-
-#
-# prog_len() return the number of lines in TP
-# Don't call until EvInit() has been called.
-#
-procedure prog_len()
- local basename, fname, f, count
- #
- # Extract TP's &file keyword
- #
- basename := fname := keyword("file", EventSource)
- if (not (f := open(fname))) & lpath := getenv("LPATH") || " " then {
- #
- # Search LPATH for the file if it wasn't in the current directory.
- #
- lpath ? {
- while dir := tab(find(" ")) do {
- if fname := dir || "/" || basename & (f := open(fname)) then break
- }
- if /f then fail
- }
- }
- count := 0
- every !f do count +:= 1
- close(f)
- return count
-end
-
-#
-# procedure_name() - return the name of a procedure
-#
-procedure procedure_name(p)
- return image(p)[10:0] # strip off "procedure " prefix of image
-end
-
-#
-# XHeight(w) - return window height in pixels
-#
-procedure XHeight(w)
- /w := &window
- return WAttrib(w, "height")
-end
-
-#
-# XWidth(w) - return window width in pixels
-#
-procedure XWidth(w)
- /w := &window
- return WAttrib(w, "width")
-end
diff --git a/ipl/mprocs/hexlib.icn b/ipl/mprocs/hexlib.icn
deleted file mode 100644
index 4b7d5b9..0000000
--- a/ipl/mprocs/hexlib.icn
+++ /dev/null
@@ -1,146 +0,0 @@
-############################################################################
-#
-# File: hexlib.icn
-#
-# Subject: Procedures for hexagons
-#
-# Author: Clinton Jeffery
-#
-# Date: August 12, 1994
-#
-#########################################################################
-#
-# This file is in the public domain.
-#
-############################################################################
-#
-# This file is used by algae but is not finished or supported.
-#
-############################################################################
-#
-# Requires: Version 9 graphics
-#
-############################################################################
-
-global scale,scale2,scale4,scale5,numrows,numcols,drawsegs,drawlefts,drawrights
-global drawesegs, q, qq, wHexOutline
-
-procedure starthex(w)
- /scale := 10
- /numrows := 10
- /numcols := 10
- scale2 := 2*scale
- scale4 := 4*scale
- scale5 := 5*scale
- if (numcols % 2) = 0 then numcols +:= 1
- every col := 0 to numcols-1 by 2 do oddcol(w,col*scale4)
- every col := 1 to numcols-1 by 2 do evencol(w,col*scale4)
-# DrawSegment ! drawsegs
-end
-
-procedure oddcol(w,x)
- initial {
- i := numrows+1
- i6 := i * 6
- drawlefts := list(i6+1)
- drawrights := list(i6+1)
- drawsegs := list(i*8+1)
- drawlefts[1] := drawrights[1] := drawsegs[1] := w
- q := qq := 2
- every i := 0 to numrows do hex(x,i*scale4)
- DrawLine ! drawlefts
- DrawLine ! drawrights
- DrawSegment ! drawsegs
- return
- }
- q := 2
- qq := 2
- every i := 0 to numrows do rehex(x,i*scale4)
- DrawLine ! drawlefts
- DrawLine ! drawrights
- DrawSegment ! drawsegs
-end
-
-procedure evencol(w,x)
- initial {
- drawesegs := list(numrows*8+1)
- drawesegs[1] := w
- q := 2
- every i := 0 to numrows-1 do parthex(x,i*scale4+scale2)
- DrawSegment ! drawesegs
- return
- }
- q := 2
- every i := 0 to numrows-1 do reparthex(x,i*scale4+scale2)
- DrawSegment ! drawesegs
-end
-
-procedure parthex(x,y)
- y4 := y + scale4
- drawesegs[q+1] := y4
- drawesegs[q+3] := y4
- drawesegs[q+5] := y
- drawesegs[q+7] := y
- reparthex(x,y)
-end
-procedure reparthex(x,y)
- x1 := x + scale
- x4 := x + scale4
- drawesegs[q ] := x1
- drawesegs[q+2] := x4
- drawesegs[q+4] := x1
- drawesegs[q+6] := x4
- q +:= 8
-end
-procedure hex(x,y)
- y2 := y + scale2
- y4 := y + scale4
- drawlefts[qq+1] := y
- drawlefts[qq+3] := y2
- drawlefts[qq+5] := y4
- drawrights[qq+1] := y
- drawrights[qq+3] := y2
- drawrights[qq+5] := y4
- drawsegs[q+1] := y4
- drawsegs[q+3] := y4
- drawsegs[q+5] := y
- drawsegs[q+7] := y
- rehex(x,y)
-end
-procedure rehex(x,y)
- x1 := x + scale
- x4 := x + scale4
- drawlefts[qq] := x1
- drawlefts[qq+2] := x
- drawlefts[qq+4] := x1
- drawrights[qq] := x4
- drawrights[qq+2] := x+scale5
- drawrights[qq+4] := x4
- drawsegs[q] := x1
- drawsegs[q+2] := x4
- drawsegs[q+4] := x1
- drawsegs[q+6] := x4
- q +:= 8
- qq +:= 6
-end
-
-procedure hex_spot(w, row, col)
- x := (col-1)*scale4
- y := (row-1)*scale4
- if col % 2 = 0 then y +:= scale2
- x1 := x + scale
- x4 := x + scale4
- x5 := x + scale5
- y2 := y + scale2
- y4 := y + scale4
- FillPolygon(w, x1, y, x, y2, x1, y4, x4, y4, x5, y2, x4, y)
- DrawLine(wHexOutline, x1, y, x, y2, x1, y4, x4, y4, x5, y2, x4, y, x1, y)
-end
-
-procedure hex_mouse(y,x)
- if x % scale4 = 0 then fail
- col := x / scale4 + 1
- if col % 2 = 0 then row := (y - scale2) / scale4 + 1
- else row := y / scale4 + 1
- return ishift(col, 16) + row
-end
diff --git a/ipl/mprocs/loadfile.icn b/ipl/mprocs/loadfile.icn
deleted file mode 100644
index 28cd0b2..0000000
--- a/ipl/mprocs/loadfile.icn
+++ /dev/null
@@ -1,64 +0,0 @@
-############################################################################
-#
-# File: loadfile.icn
-#
-# Subject: Procedure to produce and load program on the fly
-#
-# Author: Ralph E. Griswold
-#
-# Date: November 21, 1996
-#
-############################################################################
-#
-# This file is in the public domain.
-#
-############################################################################
-#
-# loadfile(exp, link, ...) produces and loads a program that generates
-# the results of exp. The trailing arguments name link
-# files needed for the expression. loadfile() returns a procedure
-# that generates the results.
-#
-############################################################################
-#
-# Requires: MT-Icon, system(), pipes, /tmp
-#
-############################################################################
-#
-# Links: io
-#
-############################################################################
-
-link io
-
-procedure loadfile(exp, links[]) #: produce and load program
- local output, prog
- static name
-
- output := tempfile("load", ".icn", "/tmp")
-
- image(output) ? {
- ="file("
- name := tab(find(".icn"))
- }
-
- write(output, "invocable all")
- every write(output, "link ", image(!links))
- write(output, "procedure main(args)")
- write(output, " suspend ", exp)
- write(output, "end")
-
- close(output)
-
- if system("mticont -o " || name || " -s " || name ||
- " >/dev/null 2>/dev/null") ~= 0 then fail
-
- remove(name || ".icn") # remove source code file
-
- # Load the program
-
- prog := load(name) | stop("*** load failure in loadfile")
-
- return variable("main", prog)
-
-end
diff --git a/ipl/mprocs/opname.icn b/ipl/mprocs/opname.icn
deleted file mode 100644
index 9c87667..0000000
--- a/ipl/mprocs/opname.icn
+++ /dev/null
@@ -1,129 +0,0 @@
-############################################################################
-#
-# File: opname.icn
-#
-# Subject: Procedure to map VM opcodes to their names
-#
-# Author: Ralph E. Griswold
-#
-# Date: August 8, 1997
-#
-############################################################################
-#
-# This file is in the public domain.
-#
-############################################################################
-#
-# opnames() maps the virtual-machine instruction numbers to symbolic names.
-#
-############################################################################
-
-procedure opname(i) #: map virtual-machine code to name
- static opmap
-
- initial {
- opmap := table("")
-
- opmap[1] := "Asgn"
- opmap[2] := "Bang"
- opmap[3] := "Cat"
- opmap[4] := "Compl"
- opmap[5] := "Diff"
- opmap[6] := "Div"
- opmap[7] := "Eqv"
- opmap[8] := "Inter"
- opmap[9] := "Lconcat"
- opmap[10] := "Lexeq"
- opmap[11] := "Lexge"
- opmap[12] := "Lexgt"
- opmap[13] := "Lexle"
- opmap[14] := "Lexlt"
- opmap[15] := "Lexne"
- opmap[16] := "Minus"
- opmap[17] := "Mod"
- opmap[18] := "Mult"
- opmap[19] := "Neg"
- opmap[20] := "Neqv"
- opmap[21] := "Nonnull"
- opmap[22] := "Null"
- opmap[23] := "Number"
- opmap[24] := "Numeq"
- opmap[25] := "Numge"
- opmap[26] := "Numgt"
- opmap[27] := "Numle"
- opmap[28] := "Numlt"
- opmap[29] := "Numne"
- opmap[30] := "Plus"
- opmap[31] := "Power"
- opmap[32] := "Random"
- opmap[33] := "Rasgn"
- opmap[34] := "Refresh"
- opmap[35] := "Rswap"
- opmap[36] := "Sect"
- opmap[37] := "Size"
- opmap[38] := "Subsc"
- opmap[39] := "Swap"
- opmap[40] := "Tabmat"
- opmap[41] := "Toby"
- opmap[42] := "Unions"
- opmap[43] := "Value"
- opmap[44] := "Bscan"
- opmap[45] := "Ccase"
- opmap[46] := "Chfail"
- opmap[47] := "Coact"
- opmap[48] := "Cofail"
- opmap[49] := "Coret"
- opmap[50] := "Create"
- opmap[51] := "Cset"
- opmap[52] := "Dup"
- opmap[53] := "Efail"
- opmap[54] := "Eret"
- opmap[55] := "Escan"
- opmap[56] := "Esusp"
- opmap[57] := "Field"
- opmap[58] := "Goto"
- opmap[59] := "Init"
- opmap[60] := "Int"
- opmap[61] := "Invoke"
- opmap[62] := "Keywd"
- opmap[63] := "Limit"
- opmap[64] := "Line"
- opmap[65] := "Llist"
- opmap[66] := "Lsusp"
- opmap[67] := "Mark"
- opmap[68] := "Pfail"
- opmap[69] := "Pnull"
- opmap[70] := "Pop"
- opmap[71] := "Pret"
- opmap[72] := "Psusp"
- opmap[73] := "Push1"
- opmap[74] := "Pushn1"
- opmap[75] := "Real"
- opmap[76] := "Sdup"
- opmap[77] := "Str"
- opmap[78] := "Unmark"
- opmap[80] := "Var"
- opmap[81] := "Arg"
- opmap[82] := "Static"
- opmap[83] := "Local"
- opmap[84] := "Global"
- opmap[85] := "Mark0"
- opmap[86] := "Quit"
- opmap[87] := "FQuit"
- opmap[88] := "Tally"
- opmap[89] := "Apply"
- opmap[90] := "Acset"
- opmap[91] := "Areal"
- opmap[92] := "Astr"
- opmap[93] := "Aglobal"
- opmap[94] := "Astatic"
- opmap[95] := "Agoto"
- opmap[96] := "Amark"
- opmap[98] := "Noop"
- opmap[100] := "SymEvents"
- opmap[108] := "Colm"
- }
-
- return opmap[i]
-
-end
diff --git a/ipl/mprocs/typebind.icn b/ipl/mprocs/typebind.icn
deleted file mode 100644
index 84bf9ec..0000000
--- a/ipl/mprocs/typebind.icn
+++ /dev/null
@@ -1,56 +0,0 @@
-############################################################################
-#
-# File: typebind.icn
-#
-# Subject: Procedures to produce table of graphic contexts for type
-#
-# Author: Ralph E. Griswold and Clinton L. Jeffery
-#
-# Date: March 4, 1997
-#
-############################################################################
-#
-# This file is in the public domain.
-#
-############################################################################
-#
-# typebind(window, codes, opts) returns a table of graphic contexts bound to
-# window with foreground colors keyed by type in the string of event codes.
-#
-# Codes for which there is no corresponding color are ignored.
-#
-# Note: Event monitoring global identifiers must be linked by the program
-# that uses this procedure.
-#
-############################################################################
-#
-# Links: colormap
-#
-############################################################################
-#
-# Requires: Version 9 graphics
-#
-############################################################################
-
-link colormap
-
-procedure typebind(window, codes, opts)
- local code, context
- static contexts, color
-
- initial {
- contexts := table()
- if /opts then color := colormap("standard")
- else color := colormap(opts["p"])
- }
-
- if /contexts[window] := table() then {
- context := contexts[window]
- every code := !codes do
- context[code] := Clone(window, , "fg=" || \color[code])
- }
- contexts[window]["bg"] := Clone(window, "fg=" || WAttrib(window,"bg"))
- return contexts[window]
-
-end
-
diff --git a/ipl/mprocs/typesyms.icn b/ipl/mprocs/typesyms.icn
deleted file mode 100644
index 04dee72..0000000
--- a/ipl/mprocs/typesyms.icn
+++ /dev/null
@@ -1,71 +0,0 @@
-############################################################################
-#
-# File: typesyms.icn
-#
-# Subject: Procedure to map type codes to event codes
-#
-# Author: Ralph E. Griswold
-#
-# Date: June 8, 1994
-#
-############################################################################
-#
-# This file is in the public domain.
-#
-############################################################################
-#
-# typesyms() returns a table that maps type codes to event codes. The
-# table can be subscripted either by one-character strings in the style
-# of typecode() or by the integer values given by T_type globals.
-#
-# This procedure is intended for use with event monitors running under
-# MT Icon.
-#
-############################################################################
-#
-# See also: typecode.icn
-#
-############################################################################
-#
-# Includes: evdefs.icn
-#
-############################################################################
-
-$include "evdefs.icn"
-
-procedure typesyms()
- static typetable
-
- initial {
- typetable := table()
-
- typetable["L"] := E_List
- typetable["S"] := E_Set
- typetable["T"] := E_Table
- typetable["R"] := E_Record
- typetable["s"] := E_String
- typetable["c"] := E_Cset
- typetable["i"] := E_Integer
- typetable["r"] := E_Real
- typetable["f"] := E_File
- typetable["n"] := E_Null
- typetable["p"] := E_Proc
- typetable["C"] := E_Coexpr
-
- typetable[T_List] := E_List
- typetable[T_Set] := E_Set
- typetable[T_Table] := E_Table
- typetable[T_Record] := E_Record
- typetable[T_String] := E_String
- typetable[T_Cset] := E_Cset
- typetable[T_Integer] := E_Integer
- typetable[T_Real] := E_Real
- typetable[T_File] := E_File
- typetable[T_Null] := E_Null
- typetable[T_Proc] := E_Proc
- typetable[T_Coexpr] := E_Coexpr
- }
-
- return typetable
-
-end
diff --git a/ipl/mprocs/viewpack.icn b/ipl/mprocs/viewpack.icn
deleted file mode 100644
index 1797fd1..0000000
--- a/ipl/mprocs/viewpack.icn
+++ /dev/null
@@ -1,329 +0,0 @@
-############################################################################
-#
-# File: viewpack.icn
-#
-# Subject: Procedures to visualize color streams
-#
-# Author: Ralph E. Griswold
-#
-# Date: May 2, 2001
-#
-############################################################################
-#
-# This file is in the public domain.
-#
-############################################################################
-#
-# These procedures provide various ways of visualizing a stream of colors.
-#
-############################################################################
-#
-# Requires: Version 9 graphics
-#
-############################################################################
-
-$define Hold 300
-
-# blinking light
-
-procedure beacon(win, color, value) #: 1C visualization as blinking light
-
- Fg(win, color)
- FillCircle(win, width / 2, height / 2, width / 2)
- WDelay(win, Hold)
-
-end
-
-# random curves
-
-procedure curves(win, color, value) #: 1C visualization as random curves
- local x0, y0
-
- Fg(win, color)
- DrawCurve ! [
- win,
- x0 := ?width, y0 := ?height,
- ?width, ?height,
- ?width, ?height,
- ?width, ?height,
- ?width, ?height,
- ?width, ?height,
- ?width, ?height,
- .x0, .y0
- ]
-
- WDelay(win, Hold)
-
- return
-
-end
-
-# "haystack"
-
-procedure haystack(win, color, value) #: 2CS visualization as "haystack"
- static angle, xcenter, ycenter, xorg, yorg, fullcircle
-
- initial {
- fullcircle := 2 * &pi
- ycenter := height / 2
- xcenter := width / 2
- }
-
- Fg(win, color)
- angle := ?0 * fullcircle # angle for locating starting point
- xorg := xcenter + ?xcenter * cos(angle)
- yorg := ycenter + ?ycenter * sin(angle)
- angle := ?0 * fullcircle # angle for locating end point
- DrawLine(win, xorg, yorg, value * cos(angle) +
- xorg, value * sin(angle) + yorg)
-
- return
-
-end
-
-# "nova"
-
-$define Scale 1.5
-$define Rays 360
-
-procedure nova(win, color, value) #: 1C visualization as exploding star
- local clear, xorg, yorg, radius, arc, oldlength, length
- static fullcircle, radians, advance, erase
-
- initial {
- fullcircle := 2 * &pi
- radians := 0
- advance := fullcircle / Rays # amount to advance
- erase := list(Rays)
- }
-
- Fg(win, color)
- xorg := width / 2
- yorg := height / 2
- radius := ((height < width) | height) / 2.0
-
- length := value * Scale
- put(erase, length)
- oldlength := get(erase)
-
-# The following are to erase old ray at that angle
-
-# DrawLine(Background, xorg, yorg, \oldlength * cos(radians) + xorg,
-# oldlength * sin(radians) + yorg)
-
- DrawLine(win, xorg, yorg, length * cos(radians) +
- xorg, length * sin(radians) + yorg)
-
- radians +:= advance
- radians %:= fullcircle
-
- return
-
-end
-
-# "pinwheel"
-
-$define Sectors 240
-
-procedure pinwheel(win, color, value) #: 1C visualization as radar sweep
- static clear, xorg, yorg, radius, offset
- static arc, advance, blank, max, xratio, yratio
- static fullcircle, background
-
- initial {
- fullcircle := 2 * &pi
- max := real((width < height) | width)
- xratio := width / max
- yratio := height / max
- offset := 0
- advance := fullcircle / Sectors
- blank := 2 * advance
- xorg := width / 2
- yorg := height / 2
- radius := max / 2
-
- # This belongs elsewhere
-
- background := Clone(win, "bg=" || default_color)
-
- }
-
- Fg(win, color)
- FillArc(background, 0, 0, width, height, offset + advance, blank)
- FillArc(win, 0, 0, width, height, offset, advance)
- DrawLine(background, xorg, yorg, xratio * radius * cos(offset) +
- xorg, yratio * radius * sin(offset) + yorg)
-
- offset +:= advance
- offset %:= fullcircle
-
- return
-
-end
-
-# random polygons
-
-procedure polygons(win, color, value) #: 1C visualization as random polygons
- local x0, y0
-
- Fg(win, color)
- FillPolygon ! [
- win,
- x0 := ?width, y0 := ?height,
- ?width, ?height,
- ?width, ?height,
- ?width, ?height,
- ?width, ?height,
- ?width, ?height,
- ?width, ?height,
- .x0, .y0
- ]
-
- WDelay(win, Hold)
-
- return
-
-end
-
-# random dots
-
-procedure splatter(win, color, value) #: 2CS visualization as random dots
- local radius, xplace, yplace
-
- Fg(win, color)
- radius := sqrt(value)
- xplace := ?width - 1 - (radius / 2)
- yplace := ?height - 1 - (radius / 2)
- FillCircle(win, xplace, yplace, radius)
-
- return
-
-end
-
-# scrolling strip
-
-procedure strip(win, color, value) #: 2CS visualization as scrolling lines
- local count
-
- Fg(win, color) | "black"
- if /value | (value = 0) then return
- count := log(value, 10) + 1
- every 1 to count do {
- CopyArea(win, 1, 0, width - 1, height, 0, 0)
- EraseArea(win, width - 1, 0, width - 1, height)
- FillRectangle(win, width - 1, 0, 1, height)
- }
-
- return
-
-end
-
-procedure symdraw(W, mid, x, y, r)
-
- FillCircle(W, mid + x, mid + y, r)
- FillCircle(W, mid + x, mid - y, r)
- FillCircle(W, mid - x, mid + y, r)
- FillCircle(W, mid - x, mid - y, r)
-
- FillCircle(W, mid + y, mid + x, r)
- FillCircle(W, mid + y, mid - x, r)
- FillCircle(W, mid - y, mid + x, r)
- FillCircle(W, mid - y, mid - x, r)
-
- return
-
-end
-
-# symmetric random dots
-
-procedure symsplat(win, color, value) #: 2CS visualization as symmetric random dots
- local radius
- static xplace, yplace, oscale
-
- Fg(win, color)
- radius := sqrt(value)
- xplace := ?width - 1
- yplace := ?height - 1
- symdraw(win, width / 2, xplace, yplace, radius)
-
- return
-
-end
-
-# evolving vortex
-
-procedure vortex(win, color, value) #: 1C visualization as an aspirating vortex
- local count
- static x1, x2, y1, y2
-
- initial {
- x1 := y1 := 0
- x2 := width
- y2 := height
- }
-
- Fg(win, color)
- if value = 0 then return
- count := log(value, 10) + 1
- every 1 to count do {
- if (x2 | y2) < 0 then {
- x1 := y1 := 0
- x2 := width
- y2 := height
- }
- DrawRectangle(win, x1, y1, x2 - x1, y2 - y1)
- x1 +:= 1
- x2 -:= 1
- y1 +:= 1
- y2 -:= 1
- }
-
- return
-
-end
-
-# random walk
-#
-# This procedure is suspect -- it seems to wander off the display area.
-
-$define Delta 30
-
-procedure web(win, color, value) #: 2CS visualization as a random walk
- static xorg, yorg, x, y, angle, degrees, radians, resid
-
- initial {
- resid := 0
- xorg := ?(width - 1) # starting point
- yorg := ?(height - 1)
- }
-
- Fg(win, color)
- if resid <= 1 then {
- angle := ?0 * 2 * &pi # initial direction for new walk
- resid := value
- }
-
- x := xorg + resid * cos(angle)
- y := yorg + resid * sin(angle)
-
- if x > width then {
- x := width
- }
- if y > height then {
- y := height
- }
- if x < 0 then {
- x := 0
- }
- if y < 0 then {
- y := 0
- }
- DrawLine(win, xorg, yorg, x, y)
- resid -:= sqrt((x - xorg) ^ 2 + (y - yorg) ^ 2)
- xorg := x # move to new point
- yorg := y
- angle := -angle # reflect
-
- return
-
-end
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-15 09:50:08 +0000