home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / BIPL.ZIP / PROCS.ZIP / IFTRACE.ICN < prev    next >
Encoding:
Text File  |  1992-09-28  |  3.6 KB  |  178 lines
  1. ############################################################################
  2. #
  3. #    File:     iftrace.icn
  4. #
  5. #    Subject:  Procedures to trace Icon function calls
  6. #
  7. #    Author:   Stephen B. Wampler
  8. #
  9. #    Date:     July 12, 1991
  10. #
  11. ###########################################################################
  12. #
  13. #    These procedures provide tracing for Icon functions by using procedure
  14. #  wrappers to call the functions.
  15. #
  16. #     trace_options(args) sets options for tracing given in the list args,
  17. #  typically provided via the command line as an argument to main().
  18. #  The values can be
  19. #
  20. #    -trace    turn on tracing (sets &trace to -1)
  21. #    -Fs    enable tracing for the function named s.
  22. #
  23. #     set_trace(vf) sets tracing for vf (used by trace_options).
  24. #
  25. ############################################################################
  26. #
  27. #    Note: The functions that can be traced and their procedure wrappers should
  28. #  be organized and coordinated to assure consistency and to allow for
  29. #  extended function repertoire.
  30. #
  31. ############################################################################
  32. #
  33. #  Links:  ifncs
  34. #
  35. ############################################################################
  36.  
  37. link ifncs
  38.  
  39. procedure trace_options(args)
  40.    local nextarg, arg
  41.  
  42.     #
  43.     # Check arguments for tracing parameters
  44.     #
  45.     #    trace built-in functions, e.g.:
  46.     #
  47.     #        -Ftab
  48.     # 
  49.     #    will trace tab()
  50.     #
  51.  
  52.    every arg := !args do {
  53.       if map(arg) == "-trace" then
  54.          &trace := -1
  55.       else if match("-F",arg) then {    # trace a built-in function
  56.          set_trace(arg[3:0])
  57.          }
  58.       }
  59.  
  60.    return
  61. end
  62.  
  63. procedure set_trace(vf)
  64.    local traceset, vp
  65.  
  66.     #
  67.     # trace the built-in function 'vf', if possible
  68.     #
  69.  
  70.    if not find("Version 8",&version) then {
  71.       write(&errout,"You are running ",&version,", which doesn't support")
  72.       write(&errout,"   this package.  You need version 8.")
  73.       stop()
  74.       }
  75.   
  76.     #  Here's the standard Version 8.x set.  It's easy to add others.
  77.  
  78.    traceset := set([
  79.       "acos",
  80.       "any",
  81.       "args",
  82.       "asin",
  83.       "atan",
  84.       "bal",
  85.       "center",
  86.       "char",
  87.       "chdir",
  88.       "close",
  89.       "collect",
  90.       "copy",
  91.       "cos",
  92.       "cset",
  93.       "delay",
  94.       "delete",
  95.       "detab",
  96.       "display",
  97.       "dtor",
  98.       "entab",
  99.       "errorclear",
  100.       "exit",
  101.       "exp",
  102.       "find",
  103.       "flush",
  104.       "get",
  105.       "getenv",
  106.       "iand",
  107.       "icom",
  108.       "image",
  109.       "insert",
  110.       "integer",
  111.       "ior",
  112.       "ishift",
  113.       "ixor",
  114.       "key",
  115.       "left",
  116.       "list",
  117.       "log",
  118.       "many",
  119.       "map",
  120.       "match",
  121.       "member",
  122.       "mmout",
  123.       "mmpause",
  124.       "mmshow",
  125.       "move",
  126.       "name",
  127.       "numeric",
  128.       "open",
  129.       "ord",
  130.       "pop",
  131.       "pos",
  132.       "proc",
  133.       "pull",
  134.       "push",
  135.       "put",
  136.       "read",
  137.       "reads",
  138.       "real",
  139.       "remove",
  140.       "rename",
  141.       "repl",
  142.       "reverse",
  143.       "right",
  144.       "rtod",
  145.       "runerr",
  146.       "seek",
  147.       "seq",
  148.       "set",
  149.       "sin",
  150.       "sort",
  151.       "sqrt",
  152.       "stop",
  153.       "string",
  154.       "system",
  155.       "tab",
  156.       "table",
  157.       "tan",
  158.       "trim",
  159.       "type",
  160.       "upto",
  161.       "variable",
  162.       "where",
  163.       "write",
  164.       "writes"
  165.       ])
  166.     
  167.    if member(traceset,vf) then {
  168.       &trace := -1        # have to also trace all procedures!
  169.       vp := vf
  170.       vp[1] := map(vp[1],&lcase,&ucase)
  171.       variable(vp) :=: variable(vf)
  172.       return
  173.       }
  174.    else
  175.       fail
  176.  
  177. end
  178.