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