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 / lmisc.r < prev    next >
Text File  |  2000-07-29  |  4KB  |  177 lines
  1. /*
  2.  * file: lmisc.r
  3.  *   Contents: [O]create, activate
  4.  */
  5.  
  6. /*
  7.  * create - return an entry block for a co-expression.
  8.  */
  9. #if COMPILER
  10. struct b_coexpr *create(fnc, cproc, ntemps, wrk_size)
  11. continuation fnc;
  12. struct b_proc *cproc;
  13. int ntemps;
  14. int wrk_size;
  15. #else                    /* COMPILER */
  16.  
  17. int Ocreate(entryp, cargp)
  18. word *entryp;
  19. register dptr cargp;
  20. #endif                    /* COMPILER */
  21.    {
  22.  
  23. #ifdef Coexpr
  24.    tended struct b_coexpr *sblkp;
  25.    register struct b_refresh *rblkp;
  26.    register dptr dp, ndp;
  27.    int na, nl, i;
  28.  
  29. #if !COMPILER
  30.    struct b_proc *cproc;
  31.  
  32.    /* cproc is the Icon procedure that create occurs in */
  33.    cproc = (struct b_proc *)BlkLoc(glbl_argp[0]);
  34. #endif                    /* COMPILER */
  35.  
  36.    /*
  37.     * Calculate number of arguments and number of local variables.
  38.     */
  39. #if COMPILER
  40.    na = abs((int)cproc->nparam);
  41. #else                    /* COMPILER */
  42.    na = pfp->pf_nargs + 1;  /* includes Arg0 */
  43. #endif                    /* COMPILER */
  44.    nl = (int)cproc->ndynam;
  45.  
  46.    /*
  47.     * Get a new co-expression stack and initialize.
  48.     */
  49.  
  50. #ifdef MultiThread
  51.    Protect(sblkp = alccoexp(0, 0), err_msg(0, NULL));
  52. #else                    /* MultiThread */
  53.    Protect(sblkp = alccoexp(), err_msg(0, NULL));
  54. #endif                    /* MultiThread */
  55.  
  56.  
  57.    if (!sblkp)
  58. #if COMPILER
  59.       return NULL;
  60. #else                    /* COMPILER */
  61.       Fail;
  62. #endif                    /* COMPILER */
  63.  
  64.    /*
  65.     * Get a refresh block for the new co-expression.
  66.     */
  67. #if COMPILER
  68.    Protect(rblkp = alcrefresh(na, nl, ntemps, wrk_size), err_msg(0,NULL));
  69. #else                    /* COMPILER */
  70.    Protect(rblkp = alcrefresh(entryp, na, nl),err_msg(0,NULL));
  71. #endif                    /* COMPILER */
  72.    if (!rblkp)
  73. #if COMPILER
  74.       return NULL;
  75. #else                    /* COMPILER */
  76.       Fail;
  77. #endif                    /* COMPILER */
  78.  
  79.    sblkp->freshblk.dword = D_Refresh;
  80.    BlkLoc(sblkp->freshblk) = (union block *) rblkp;
  81.  
  82. #if !COMPILER
  83.    /*
  84.     * Copy current procedure frame marker into refresh block.
  85.     */
  86.    rblkp->pfmkr = *pfp;
  87.    rblkp->pfmkr.pf_pfp = 0;
  88. #endif                    /* COMPILER */
  89.  
  90.    /*
  91.     * Copy arguments into refresh block.
  92.     */
  93.    ndp = rblkp->elems;
  94.    dp = glbl_argp;
  95.    for (i = 1; i <= na; i++)
  96.       *ndp++ = *dp++;
  97.  
  98.    /*
  99.     * Copy locals into the refresh block.
  100.     */
  101. #if COMPILER
  102.    dp = pfp->tend.d;
  103. #else                    /* COMPILER */
  104.    dp = &(pfp->pf_locals)[0];
  105. #endif                    /* COMPILER */
  106.    for (i = 1; i <= nl; i++)
  107.       *ndp++ = *dp++;
  108.  
  109.    /*
  110.     * Use the refresh block to finish initializing the co-expression stack.
  111.     */
  112.    co_init(sblkp);
  113.  
  114. #if COMPILER
  115.    sblkp->fnc = fnc;
  116.    if (line_info) {
  117.       if (debug_info)
  118.          PFDebug(sblkp->pf)->proc = cproc;
  119.       PFDebug(sblkp->pf)->old_fname = "";
  120.       PFDebug(sblkp->pf)->old_line = 0;
  121.       }
  122.  
  123.    return sblkp;
  124. #else                    /* COMPILER */
  125.    /*
  126.     * Return the new co-expression.
  127.     */
  128.    Arg0.dword = D_Coexpr;
  129.    BlkLoc(Arg0) = (union block *) sblkp;
  130.    Return;
  131. #endif                    /* COMPILER */
  132. #else                    /* Coexpr */
  133.    err_msg(401, NULL);
  134. #if COMPILER
  135.    return NULL;
  136. #else                    /* COMPILER */
  137.    Fail;
  138. #endif                    /* COMPILER */
  139. #endif                    /* Coexpr */
  140.  
  141.    }
  142.  
  143. /*
  144.  * activate - activate a co-expression.
  145.  */
  146. int activate(val, ncp, result)
  147. dptr val;
  148. struct b_coexpr *ncp;
  149. dptr result;
  150.    {
  151. #ifdef Coexpr
  152.  
  153.    int first;
  154.  
  155.    /*
  156.     * Set activator in new co-expression.
  157.     */
  158.    if (ncp->es_actstk == NULL) {
  159.       Protect(ncp->es_actstk = alcactiv(),RunErr(0,NULL));
  160.       first = 0;
  161.       }
  162.    else
  163.       first = 1;
  164.  
  165.    if (pushact(ncp, (struct b_coexpr *)BlkLoc(k_current)) == Error)
  166.       RunErr(0,NULL);
  167.  
  168.    if (co_chng(ncp, val, result, A_Coact, first) == A_Cofail)
  169.       return A_Resume;
  170.    else
  171.       return A_Continue;
  172.  
  173. #else                    /* Coexpr */
  174.    RunErr(401,NULL);
  175. #endif                    /* Coexpr */
  176.    }
  177.