/* * Initialize a function for definition. * Newflag is TRUE if we should allocate a new function structure, * instead of the usual overwriting of the template function structure. * The new structure is returned in the global curfunc variable. * * given: * name name of function * newflag TRUE if need new structure */ void beginfunc(char *name, BOOL newflag) { register FUNC *fp; /* current function */ newindex = adduserfunc(name); maxopcodes = OPCODEALLOCSIZE; fp = functemplate; if (newflag) { fp = (FUNC *) malloc(funcsize(maxopcodes)); if (fp == NULL) { math_error("Cannot allocate temporary function"); /*NOTREACHED*/ } } fp->f_next = NULL; fp->f_localcount = 0; fp->f_opcodecount = 0; fp->f_savedvalue.v_type = V_NULL; fp->f_savedvalue.v_subtype = V_NOSUBTYPE; newname = namestr(&funcnames, newindex); fp->f_name = newname; curfunc = fp; initlocals(); initlabels(); oldop = OP_NOP; oldoldop = OP_NOP; debugline = 0; errorcount = 0; }
/* * Call the appropriate user-defined routine to handle an object action. * Returns the value that the routine returned. */ VALUE objcall(int action, VALUE *v1, VALUE *v2, VALUE *v3) { FUNC *fp; /* function to call */ STATIC OBJECTACTIONS *oap; /* object to call for */ struct objectinfo *oip; /* information about action */ long index; /* index of function (negative if undefined) */ VALUE val; /* return value */ VALUE tmp; /* temp value */ char name[SYMBOLSIZE+1+1]; /* full name of user routine to call */ size_t namestr_len; /* length of the namestr() return string */ char *namestr_ret; /* namestr() return string */ size_t opi_name_len; /* length of the oip name */ /* initialize VALUEs */ val.v_subtype = V_NOSUBTYPE; tmp.v_subtype = V_NOSUBTYPE; if ((unsigned)action > OBJ_MAXFUNC) { math_error("Illegal action for object call"); /*NOTREACHED*/ } oip = &objectinfo[action]; if (v1->v_type == V_OBJ) { oap = v1->v_obj->o_actions; } else if (v2->v_type == V_OBJ) { oap = v2->v_obj->o_actions; } else { math_error("Object routine called with non-object"); /*NOTREACHED*/ } index = oap->oa_indices[action]; if (index < 0) { namestr_ret = namestr(&objectnames, oap->oa_index); if (namestr_ret == NULL) { math_error("namestr returned NULL!!!"); /*NOTREACHED*/ } namestr_len = strlen(namestr_ret); opi_name_len = strlen(oip->name); if (namestr_len > (size_t)SYMBOLSIZE-1-opi_name_len) { math_error("namestr returned a strong too long!!!"); /*NOTREACHED*/ } name[0] = '\0'; strncpy(name, namestr_ret, namestr_len+1); strcat(name, "_"); strncat(name, oip->name, opi_name_len+1); index = adduserfunc(name); oap->oa_indices[action] = index; } fp = NULL; if (index >= 0) fp = findfunc(index); if (fp == NULL) { switch (oip->error) { case ERR_PRINT: objprint(v1->v_obj); val.v_type = V_NULL; break; case ERR_CMP: val.v_type = V_INT; if (v1->v_type != v2->v_type) { val.v_int = 1; return val; } val.v_int = objcmp(v1->v_obj, v2->v_obj); break; case ERR_TEST: val.v_type = V_INT; val.v_int = objtest(v1->v_obj); break; case ERR_POW: if (v2->v_type != V_NUM) { math_error("Non-real power"); /*NOTREACHED*/ } val = objpowi(v1, v2->v_num); break; case ERR_ONE: val.v_type = V_NUM; val.v_num = qlink(&_qone_); break; case ERR_INC: tmp.v_type = V_NUM; tmp.v_num = &_qone_; val = objcall(OBJ_ADD, v1, &tmp, NULL_VALUE); break; case ERR_DEC: tmp.v_type = V_NUM; tmp.v_num = &_qone_; val = objcall(OBJ_SUB, v1, &tmp, NULL_VALUE); break; case ERR_SQUARE: val = objcall(OBJ_MUL, v1, v1, NULL_VALUE); break; case ERR_VALUE: copyvalue(v1, &val); break; case ERR_ASSIGN: copyvalue(v2, &tmp); tmp.v_subtype |= v1->v_subtype; freevalue(v1); *v1 = tmp; val.v_type = V_NULL; break; default: math_error("Function \"%s\" is undefined", namefunc(index)); /*NOTREACHED*/ } return val; } switch (oip->args) { case 0: break; case 1: ++stack; stack->v_addr = v1; stack->v_type = V_ADDR; break; case 2: ++stack; stack->v_addr = v1; stack->v_type = V_ADDR; ++stack; stack->v_addr = v2; stack->v_type = V_ADDR; break; case 3: ++stack; stack->v_addr = v1; stack->v_type = V_ADDR; ++stack; stack->v_addr = v2; stack->v_type = V_ADDR; ++stack; stack->v_addr = v3; stack->v_type = V_ADDR; break; default: math_error("Bad number of args to calculate"); /*NOTREACHED*/ } calculate(fp, oip->args); switch (oip->retval) { case A_VALUE: return *stack--; case A_UNDEF: freevalue(stack--); val.v_type = V_NULL; break; case A_INT: if ((stack->v_type != V_NUM) || qisfrac(stack->v_num)) { math_error("Integer return value required"); /*NOTREACHED*/ } index = qtoi(stack->v_num); qfree(stack->v_num); stack--; val.v_type = V_INT; val.v_int = index; break; default: math_error("Bad object return"); /*NOTREACHED*/ } return val; }