home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v92.tgz / v92.tar / v92 / src / runtime / fmonitr.r < prev    next >
Text File  |  1996-03-22  |  9KB  |  336 lines
  1. /*
  2.  *  fmonitr.r -- event, EvGet
  3.  *
  4.  *   This file contains event monitoring code, used only if EventMon
  5.  *   (event monitoring) is defined.  Event monitoring is normally is
  6.  *   not enabled.
  7.  *
  8.  *   When EventMon is undefined, most of the "MMxxxx" and "EVxxxx"
  9.  *   entry points are defined as null macros in monitor.h.  See
  10.  *   monitor.h for important definitions.
  11.  */
  12.  
  13. #ifdef EventMon
  14.  
  15. /*
  16.  * Prototypes.
  17.  */
  18.  
  19. novalue mmrefresh        Params((noargs));
  20.  
  21. #define evforget()
  22.  
  23.  
  24. static char typech[MaxType+1];    /* output character for each type */
  25. static char *monname = NULL;    /* output file name */
  26.  
  27. int noMTevents;            /* don't produce events in EVAsgn */
  28.  
  29. union {             /* clock ticker -- keep in sync w/ interp.r */
  30.    unsigned short s[16];    /* four counters */
  31.    unsigned long l[8];        /* two longs are easier to check */
  32. } ticker;
  33. unsigned long oldtick;        /* previous sum of the two longs */
  34.  
  35. #if UNIX
  36. /*
  37.  * Global state used by EVTick()
  38.  */
  39. word oldsum = 0;
  40. #endif                    /* UNIX */
  41.  
  42. #ifdef MultiThread
  43.  
  44. static char scopechars[] = "+:-^";
  45.  
  46. /*
  47.  * Special event function for E_Assign; allocates out of monitor's heap.
  48.  */
  49. novalue EVAsgn(dx)
  50. dptr dx;
  51. {
  52.    int i;
  53.    dptr procname;
  54.    struct progstate *parent = curpstate->parent;
  55.    struct region *rp = curpstate->stringregion;
  56.  
  57. #if COMPILER
  58.    procname = &(PFDebug(*pfp)->proc->pname);
  59. #else                    /* COMPILER */
  60.    procname = &((&BlkLoc(*argp)->proc)->pname);
  61. #endif                    /* COMPILER */
  62.    /*
  63.     * call get_name, allocating out of the monitor if necessary.
  64.     */
  65.    curpstate->stringregion = parent->stringregion;
  66.    parent->stringregion = rp;
  67.    noMTevents++;
  68.    i = get_name(dx,&(parent->eventval));
  69.  
  70.    if (i == GlobalName) {
  71.       if (reserve(Strings, StrLen(parent->eventval) + 1) == NULL)
  72.      syserr("event monitoring out-of-memory error");
  73.       StrLoc(parent->eventval) =
  74.      alcstr(StrLoc(parent->eventval), StrLen(parent->eventval));
  75.       alcstr("+",1);
  76.       StrLen(parent->eventval)++;
  77.       }
  78.    else if (i == StaticName || i == LocalName || i == ParamName) {
  79.       if (!reserve(Strings, StrLen(parent->eventval) + StrLen(*procname) + 1))
  80.      syserr("event monitoring out-of-memory error");
  81.       StrLoc(parent->eventval) =
  82.      alcstr(StrLoc(parent->eventval), StrLen(parent->eventval));
  83.       alcstr(scopechars+i,1);
  84.       alcstr(StrLoc(*procname), StrLen(*procname));
  85.       StrLen(parent->eventval) += StrLen(*procname) + 1;
  86.       }
  87.    else if (i == Error) {
  88.       noMTevents--;
  89.       return; /* should be more violent than this */
  90.       }
  91.  
  92.    parent->stringregion = curpstate->stringregion;
  93.    curpstate->stringregion = rp;
  94.    noMTevents--;
  95.    actparent(E_Assign);
  96. }
  97.  
  98.  
  99. /*
  100.  * event(x, y, C) -- generate an event at the program level.
  101.  */
  102.  
  103. "event(x, y, C) - create event with event code x and event value y."
  104.  
  105. function{0,1} event(x,y,ce)
  106.    body {
  107.       struct progstate *dest;
  108.  
  109.       if (is:null(x)) {
  110.      x = curpstate->eventcode;
  111.      if (is:null(y)) y = curpstate->eventval;
  112.      }
  113.       if (is:null(ce) && is:coexpr(curpstate->parentdesc))
  114.      ce = curpstate->parentdesc;
  115.       else if (!is:coexpr(ce)) runerr(118,ce);
  116.       dest = BlkLoc(ce)->coexpr.program;
  117.       dest->eventcode = x;
  118.       dest->eventval = y;
  119.       if (mt_activate(&(dest->eventcode),&result,
  120.              (struct b_coexpr *)BlkLoc(ce)) == A_Cofail) {
  121.          fail;
  122.          }
  123.        return result;
  124.       }
  125. end
  126.  
  127. /*
  128.  * EvGet(c) - user function for reading event streams.
  129.  */
  130.  
  131. "EvGet(c,flag) - read through the next event token having a code matched "
  132. " by cset c."
  133.  
  134. /*
  135.  *  EvGet returns the code of the matched token.  These keywords are also set:
  136.  *    &eventcode     token code
  137.  *    &eventvalue    token value
  138.  */
  139. function{0,1} EvGet(cs,flag)
  140.    if !def:cset(cs,fullcs) then
  141.       runerr(104,cs)
  142.  
  143.    body {
  144.       register int c;
  145.       tended struct descrip dummy;
  146.       struct progstate *p;
  147.  
  148.       /*
  149.        * Be sure an eventsource is available
  150.        */
  151.       if (!is:coexpr(curpstate->eventsource))
  152.          runerr(118,curpstate->eventsource);
  153.  
  154.       /*
  155.        * If our event source is a child of ours, assign its event mask.
  156.        */
  157.       p = BlkLoc(curpstate->eventsource)->coexpr.program;
  158.       if (p->parent == curpstate)
  159.      p->eventmask = cs;
  160.  
  161. #ifdef Graphics
  162.       if (Testb((word)ToAscii(E_MXevent), cs) &&
  163.       is:file(kywd_xwin[XKey_Window])) {
  164.      wbp _w_ = (wbp)BlkLoc(kywd_xwin[XKey_Window])->file.fd;
  165.      pollctr = pollevent();
  166.      if (pollctr == -1)
  167.         fatalerr(141, NULL);
  168.      if (BlkLoc(_w_->window->listp)->list.size > 0) {
  169.         c = wgetevent(_w_, &curpstate->eventval);
  170.         if (c == 0) {
  171.            StrLen(curpstate->eventcode) = 1;
  172.            StrLoc(curpstate->eventcode) =
  173.           (char *)&allchars[FromAscii(E_MXevent) & 0xFF];
  174.            return curpstate->eventcode;
  175.            }
  176.         else if (c == -1)
  177.            runerr(141);
  178.         else
  179.            runerr(143);
  180.         }
  181.      }
  182. #endif                    /* Graphics */
  183.  
  184.       /*
  185.        * Loop until we read an event allowed.
  186.        */
  187.       while (1) {
  188.          /*
  189.           * Activate the event source to produce the next event.
  190.           */
  191.      dummy = cs;
  192.      if (mt_activate(&dummy, &curpstate->eventcode,
  193.              (struct b_coexpr *)BlkLoc(curpstate->eventsource)) == A_Cofail) fail;
  194.  
  195.      deref(&curpstate->eventcode, &curpstate->eventcode);
  196.  
  197.      if (!is:string(curpstate->eventcode) ||
  198.          StrLen(curpstate->eventcode) != 1) {
  199.         /*
  200.          * this event is out-of-band data; return or reject it
  201.          * depending on whether flag is null.
  202.          */
  203.         if (!is:null(flag))
  204.            return curpstate->eventcode;
  205.         else continue;
  206.         }
  207.      return curpstate->eventcode;
  208.      }
  209.       }
  210. end
  211.  
  212. #endif                    /* MultiThread */
  213.  
  214. /*
  215.  *  EVInit() - initialization.
  216.  */
  217.  
  218. novalue EVInit()
  219.    {
  220.    int i;
  221.  
  222.    /*
  223.     * Initialize the typech array, which is used if either file-based
  224.     * or MT-based event monitoring is enabled.
  225.     */
  226.  
  227.    for (i = 0; i <= MaxType; i++)
  228.       typech[i] = '?';    /* initialize with error character */
  229.  
  230. #ifdef LargeInts
  231.    typech[T_Lrgint]  = E_Lrgint;    /* long integer */
  232. #endif                    /* LargeInts */
  233.  
  234.    typech[T_Real]    = E_Real;        /* real number */
  235.    typech[T_Cset]    = E_Cset;        /* cset */
  236.    typech[T_File]    = E_File;        /* file block */
  237.    typech[T_Record]  = E_Record;    /* record block */
  238.    typech[T_Tvsubs]  = E_Tvsubs;    /* substring trapped variable */
  239.    typech[T_External]= E_External;    /* external block */
  240.    typech[T_List]    = E_List;        /* list header block */
  241.    typech[T_Lelem]   = E_Lelem;        /* list element block */
  242.    typech[T_Table]   = E_Table;        /* table header block */
  243.    typech[T_Telem]   = E_Telem;        /* table element block */
  244.    typech[T_Tvtbl]   = E_Tvtbl;        /* table elem trapped variable*/
  245.    typech[T_Set]     = E_Set;        /* set header block */
  246.    typech[T_Selem]   = E_Selem;        /* set element block */
  247.    typech[T_Slots]   = E_Slots;        /* set/table hash slots */
  248.    typech[T_Coexpr]  = E_Coexpr;    /* co-expression block (static) */
  249.    typech[T_Refresh] = E_Refresh;    /* co-expression refresh block */
  250.  
  251.  
  252.    /*
  253.     * codes used elsewhere but not shown here:
  254.     *    in the static region: E_Alien = alien (malloc block)
  255.     *    in the static region: E_Free = free
  256.     *    in the string region: E_String = string
  257.     */
  258.  
  259. #if UNIX
  260.    /*
  261.     * Call profil(2) to enable program counter profiling.  We use the smallest
  262.     *  allowable scale factor in order to minimize the number of counters;
  263.     *  we assume that the text of iconx does not exceed 256K and so we use
  264.     *  four bins.  One of these four bins will be incremented every system
  265.     *  clock tick (typically 4 to 20 ms).
  266.     *
  267.     *  Take your local profil(2) man page with a grain of salt.  All the systems
  268.     *  we tested really maintain 16-bit counters despite what the man pages say.
  269.     *  Some also say that a scale factor of two maps everything to one counter;
  270.     *  that is believed to be a no-longer-correct statement dating from the days
  271.     *  when the maximum program size was 64K.
  272.     *
  273.     *  The reference to EVInit below just obtains an arbitrary address within
  274.     *  the text segment.
  275.     */
  276.    profil(ticker.s, sizeof(ticker.s), (int) EVInit & ~0x3FFFF, 2);
  277. #endif                    /* UNIX */
  278.    }
  279.  
  280. /*
  281.  * MMAlc(len, type) - note an allocation at the end of the block region.
  282.  *
  283.  *  If len is negative, it's a deallocation, and the type doesn't matter.
  284.  */
  285.  
  286. novalue MMAlc(len, type)
  287. word len;
  288. int type;
  289.    {
  290.    if (len < 0)
  291.       EVVal(-len, E_BlkDeAlc);
  292.    else
  293.       EVVal(len, typech[type]);
  294.    }
  295.  
  296. /*
  297.  * MMStr(len) - note a string allocation at the end of the string region.
  298.  *
  299.  *  If len is negative, it's a deallocation.
  300.  */
  301.  
  302. novalue MMStr(slen)
  303. word slen;
  304.    {
  305.    if (slen > 0)
  306.       EVVal(slen, E_String);
  307.    else if (slen < 0)
  308.       EVVal(-slen, E_StrDeAlc);
  309.    }
  310.  
  311. /*
  312.  * mmrefresh() - redraw screen, initially or after garbage collection.
  313.  */
  314.  
  315. novalue mmrefresh()
  316.    {
  317.    char *p;
  318.    word n;
  319.  
  320.    /*
  321.     * If the monitor is asking for E_EndCollect events, then it
  322.     * can handle these memory allocation "redraw" events.
  323.     */
  324.   if (!is:null(curpstate->eventmask) &&
  325.        Testb((word)ToAscii(E_EndCollect), curpstate->eventmask)) {
  326.       for (p = blkbase; p < blkfree; p += n)
  327.      MMAlc(n = BlkSize(p), (int)BlkType(p));/* block region */
  328.       MMStr(DiffPtrs(strfree, strbase));    /* string region */
  329.       }
  330.    }
  331.  
  332.  
  333. #else                    /* EventMon */
  334. static char x;            /* avoid empty module */
  335. #endif                    /* EventMon */
  336.