Imported Upstream version 9.5.0upstream/9.5.0upstream

1 files changed, 1 insertions, 163 deletions

diff --git a/src/runtime/invoke.r b/src/runtime/invoke.r
index 87b9fd1..ab781af 100644
--- a/src/runtime/invoke.r
+++ b/src/runtime/invoke.r
@@ -1,148 +1,7 @@
 /*
- * invoke.r - contains invoke, apply
+ * invoke.r -- Perform setup for invocation.
  */
 
-#if COMPILER
-
-/*
- * invoke - perform general invocation on a value.
- */
-int invoke(nargs, args, rslt, succ_cont)
-int nargs;
-dptr args;
-dptr rslt;
-continuation succ_cont;
-   {
-   tended struct descrip callee;
-   struct b_proc *proc;
-   C_integer n;
-
-   /*
-    * remove the operation being called from the argument list.
-    */
-   deref(&args[0], &callee);
-   ++args;
-   nargs -= 1;
-
-   if (is:proc(callee))
-      return (*((struct b_proc *)BlkLoc(callee))->ccode)(nargs, args, rslt,
-         succ_cont);
-   else if (cnv:C_integer(callee, n)) {
-      if (n <= 0)
-         n += nargs + 1;
-      if (n <= 0 || n > nargs)
-         return A_Resume;
-      *rslt = args[n - 1];
-      return A_Continue;
-      }
-   else if (cnv:string(callee, callee)) {
-      proc = strprc(&callee, (C_integer)nargs);
-      if (proc == NULL)
-         RunErr(106, &callee);
-      return (*(proc)->ccode)(nargs, args, rslt, succ_cont);
-      }
-   else
-      RunErr(106, &callee);
-   }
-
-
-/*
- * apply - implement binary bang. Construct an argument list for
- *   invoke() from the callee and the list it is applied to.
- */
-int apply(callee, strct, rslt, succ_cont)
-dptr callee;
-dptr strct;
-dptr rslt;
-continuation succ_cont;
-   {
-   tended struct descrip dstrct;
-   struct tend_desc *tnd_args;  /* place to tend arguments to invoke() */
-   union block *ep;
-   int nargs;
-   word i, j;
-   word indx;
-   int signal;
-
-   deref(strct, &dstrct);
-
-   switch (Type(dstrct)) {
-
-      case T_List: {
-         /*
-          * Copy the arguments from the list into an tended array of descriptors.
-          */
-         nargs = BlkLoc(dstrct)->list.size + 1;
-         tnd_args = malloc(sizeof(struct tend_desc)
-            + (nargs - 1) * sizeof(struct descrip));
-         if (tnd_args == NULL)
-            RunErr(305, NULL);
-
-         tnd_args->d[0] = *callee;
-         indx = 1;
-         for (ep = BlkLoc(dstrct)->list.listhead;
-#ifdef ListFix
-	      BlkType(ep) == T_Lelem;
-#else					/* ListFix */
-	      ep != NULL;
-#endif					/* ListFix */
-	      ep = ep->lelem.listnext) {
-            for (i = 0; i < ep->lelem.nused; i++) {
-               j = ep->lelem.first + i;
-               if (j >= ep->lelem.nslots)
-                  j -= ep->lelem.nslots;
-               tnd_args->d[indx++] = ep->lelem.lslots[j];
-               }
-            }
-         tnd_args->num = nargs;
-         tnd_args->previous = tend;
-         tend = tnd_args;
-
-         signal = invoke(indx, tnd_args->d, rslt, succ_cont);
-
-         tend = tnd_args->previous;
-         free(tnd_args);
-         return signal;
-         }
-      case T_Record: {
-         /*
-          * Copy the arguments from the record into an tended array
-          * of descriptors.
-          */
-         nargs = BlkLoc(dstrct)->record.recdesc->proc.nfields;
-         tnd_args = malloc(sizeof(struct tend_desc)
-            + (nargs - 1) * sizeof(struct descrip));
-         if (tnd_args == NULL)
-            RunErr(305, NULL);
-
-         tnd_args->d[0] = *callee;
-         indx = 1;
-         ep = BlkLoc(dstrct);
-         for (i = 0; i < nargs; i++)
-            tnd_args->d[indx++] = ep->record.fields[i];
-         tnd_args->num = nargs;
-         tnd_args->previous = tend;
-         tend = tnd_args;
-
-         signal = invoke(indx, tnd_args->d, rslt, succ_cont);
-
-         tend = tnd_args->previous;
-         free(tnd_args);
-         return signal;
-         }
-      default: {
-         RunErr(126, &dstrct);
-         }
-      }
-   }
-
-#else					/* COMPILER */
-
-#ifdef EventMon
-#include "../h/opdefs.h"
-#endif					/* EventMon */
-
-
 /*
  * invoke -- Perform setup for invocation.
  */
@@ -294,15 +153,12 @@ int nargs, *n;
       *cargp = newargp;
       sp = newsp;
 
-      EVVal((word)Op_Invoke,E_Ecall);
-
       if ((nparam < 0) || (proc->ndynam == -2))
          return I_Vararg;
       else
          return I_Builtin;
       }
 
-#ifndef MultiThread
    /*
     * Make a stab at catching interpreter stack overflow.  This does
     * nothing for invocation in a co-expression other than &main.
@@ -310,7 +166,6 @@ int nargs, *n;
    if (BlkLoc(k_current) == BlkLoc(k_main) &&
       ((char *)sp + PerilDelta) > (char *)stackend)
          fatalerr(301, NULL);
-#endif					/* MultiThread */
 
    /*
     * Build the procedure frame.
@@ -326,10 +181,6 @@ int nargs, *n;
    newpfp->pf_gfp = gfp;
    newpfp->pf_efp = efp;
 
-#ifdef MultiThread
-   newpfp->pf_prog = curpstate;
-#endif					/* MultiThread */
-
    glbl_argp = newargp;
    pfp = newpfp;
    newsp += Vwsizeof(*pfp);
@@ -347,15 +198,6 @@ int nargs, *n;
     */
    ipc.opnd = (word *)proc->entryp.icode;
 
-#ifdef MultiThread
-   /*
-    * Enter the program state of the procedure being invoked.
-    */
-   if (!InRange(code, ipc.opnd, ecode)) {
-      syserr("interprogram procedure calls temporarily prohibited\n");
-      }
-#endif					/* MultiThread */
-
    efp = 0;
    gfp = 0;
 
@@ -369,9 +211,5 @@ int nargs, *n;
    sp = newsp;
    k_level++;
 
-   EVValD(newargp, E_Pcall);
-
    return I_Continue;
 }
-
-#endif					/* COMPILER */