Return to invoke.c CVS log

Up to [Research Unix] / researchv10dc / cmd / icon / src / iconx

Annotation of researchv10dc/cmd/icon/src/iconx/invoke.c, revision 1.1.1.1

1.1       root        1: #include "../h/rt.h"
                      2: 
                      3: #define PerilDelta 100
                      4: extern word *stackend;         /* End of main interpreter stack */
                      5: /*
                      6:  * invoke -- Perform setup for invocation.  
                      7:  */
                      8: invoke(nargs,cargp,n)
                      9: struct descrip **cargp;
                     10: int nargs, *n;
                     11: {
                     12:    register struct pf_marker *newpfp;
                     13:    register struct descrip *newargp;
                     14:    register word *newsp = sp;
                     15:    register word i;
                     16:    struct b_proc *proc;
                     17:    int nparam;
                     18:    long longint;
                     19:    char strbuf[MaxCvtLen];
                     20: 
                     21:    /*
                     22:     * Point newargp at Arg0 and dereference it.
                     23:     */
                     24:    newargp = (struct descrip *)(sp - 1) - nargs;
                     25:    DeRef(newargp[0]);
                     26:    
                     27:    /*
                     28:     * See what course the invocation is to take.
                     29:     */
                     30:    if (newargp->dword != D_Proc) {
                     31:       /*
                     32:        * Arg0 is not a procedure.
                     33:        */
                     34:       if (cvint(&newargp[0], &longint) == T_Integer) {
                     35:          /*
                     36:          * Arg0 is an integer, select result.
                     37:          */
                     38:          i = cvpos(longint, (word)nargs);
                     39:          if (i > nargs)
                     40:             return I_Goal_Fail;
                     41:          newargp[0] = newargp[i];
                     42:          sp = (word *)newargp + 1;
                     43:          return I_Continue;
                     44:          }
                     45:       else {
                     46:          /*
                     47:          * See if Arg0 can be converted to a string that names a procedure
                     48:          *  or operator.  If not, generate run-time error 106.
                     49:          */
                     50:          if (cvstr(&newargp[0],strbuf) == NULL || strprc(&newargp[0],(word)nargs) == 0)
                     51:             runerr(106, newargp);
                     52:         }
                     53:       }
                     54:    
                     55:    /*
                     56:     * newargp[0] is now a descriptor suitable for invocation.  Dereference
                     57:     *  the supplied arguments.
                     58:     */
                     59:    for (i = 1; i <= nargs; i++)
                     60:       DeRef(newargp[i]);
                     61:       
                     62:    /*
                     63:     * Adjust the argument list to conform to what the routine being invoked
                     64:     *  expects (proc->nparam).  If nparam is -1, the number of arguments
                     65:     *  is variable and no adjustment is required.  If too many arguments
                     66:     *  were supplied, adjusting the stack pointer is all that is necessary.
                     67:     *  If too few arguments were supplied, null descriptors are pushed
                     68:     *  for each missing argument.
                     69:     */
                     70:    proc = (struct b_proc *)BlkLoc(newargp[0]);
                     71:    nparam = proc->nparam;
                     72:    if (nparam != -1) {
                     73:       if (nargs > nparam)
                     74:          newsp -= (nargs - nparam) * 2;
                     75:       else if (nargs < nparam) {
                     76:          i = nparam - nargs;
                     77:          while (i--) {
                     78:             *++newsp = D_Null;
                     79:             *++newsp = 0;
                     80:             }
                     81:          }
                     82:       nargs = nparam;
                     83:       }
                     84: 
                     85:    if (proc->ndynam < 0) {
                     86:       /*
                     87:        * A built-in procedure is being invoked, so nothing else here
                     88:        *  needs to be done.
                     89:        */
                     90:       *n = nargs;
                     91:       *cargp = newargp;
                     92:       sp = newsp;
                     93:       if ((nparam == -1) || (proc->ndynam == -2))
                     94:          return I_Vararg;
                     95:       else
                     96:          return I_Builtin;
                     97:       }
                     98: 
                     99:    /*
                    100:     * Make a stab at catching interpreter stack overflow.  This does
                    101:     * nothing for invocation in a co-expression other than &main.
                    102:     */
                    103:    if (BlkLoc(current) == BlkLoc(k_main) && (sp + PerilDelta) > stackend)
                    104:       runerr(301, NULL);
                    105:    /*
                    106:     * Build the procedure frame.
                    107:     */
                    108:    newpfp = (struct pf_marker *)(newsp + 1);
                    109:    newpfp->pf_nargs = nargs;
                    110:    newpfp->pf_argp = argp;
                    111:    newpfp->pf_pfp = pfp;
                    112:    newpfp->pf_ilevel = ilevel;
                    113: 
                    114:    newpfp->pf_ipc = ipc;
                    115:    newpfp->pf_gfp = gfp;
                    116:    newpfp->pf_efp = efp;
                    117: 
                    118:    argp = newargp;
                    119:    pfp = newpfp;
                    120:    newsp += Vwsizeof(*pfp);
                    121:    
                    122:    /*
                    123:     * Point ipc at the icode entry point of the procedure being invoked.
                    124:     */
                    125:    ipc = (word *)proc->entryp.icode;
                    126:    efp = 0;
                    127:    gfp = 0;
                    128: 
                    129:    newpfp->pf_line = line;
                    130: 
                    131:    /*
                    132:     * If tracing is on, use ctrace to generate a message.
                    133:     */   
                    134:    if (k_trace != 0)
                    135:       ctrace(proc, nargs, &newargp[1]);
                    136: 
                    137:    /*
                    138:     * Push a null descriptor on the stack for each dynamic local.
                    139:     */
                    140:    for (i = proc->ndynam; i > 0; i--) {
                    141:       *++newsp = D_Null;
                    142:       *++newsp = 0;
                    143:       }
                    144: 
                    145:    sp = newsp;
                    146:    k_level++;
                    147:    return I_Continue;
                    148: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.