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     ! 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.