summaryrefslogtreecommitdiff
path: root/src/runtime/invoke.r
diff options
context:
space:
mode:
Diffstat (limited to 'src/runtime/invoke.r')
-rw-r--r--src/runtime/invoke.r164
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 */