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