int picolCallProc(picolInterp *i, int argc, char **argv)
{
if(i->level>MAXRECURSION)
return picolErr(i,"too many nested evaluations (infinite loop?)");
picolCmd *c = picolGetCmd(i,argv[0]);
if(!c)
return PICOL_ERR;
void *pd = c->privdata;
if(!pd)
return PICOL_ERR;
char **x=pd;
char *alist=x[0], *body=x[1];
char buf[MAXSTR];
picolCallFrame *cf = mycalloc(1,sizeof(*cf));
int a = 0, done = 0, errcode = PICOL_ERR;
#ifndef __arm__
if(!cf) {printf("could not allocate callframe\n"); exit(1);}
#else
extern void print1(char *str);
if(!cf) {dbg_send_str3("could not allocate callframe", 1); return PICOL_ERR;}
#endif
cf->parent = i->callframe;
i->callframe = cf;
i->level++;
char *p = mystrdup(alist);
while(1) {
char *start = p;
while(*p != ' ' && *p != '\0') p++;
if (*p != '\0' && p == start) { p++; continue; }
if (p == start) break;
if (*p == '\0') done=1; else *p = '\0';
if(EQ(start,"args") && done) {
dbg_send_hex2("eq", p - alist);
picolSetVar(i,start,picolList1(buf,argc-a-1,argv+a+1));
a = argc-1;
break;
}
if (++a > argc-1)
break;
picolSetVar(i,start,argv[a]);
p++;
if (done) break;
}
if (a == argc-1)
errcode = picolEval(i,body);
else
errcode = picolErr1(i,"wrong # args for '%s'",argv[0]);
if (errcode == PICOL_RETURN)
errcode = PICOL_OK;
i->callframe = cf->parent;
myfree(cf);
i->level--;
return errcode;
}
int picolCommandSet(struct picolInterp *i, int argc, char **argv, void *pd) {
if (argc != 3)
return picolArityErr(i, argv[0]);
picolSetVar(i, argv[1], argv[2]);
picolSetResult(i, argv[2]);
return PICOL_OK;
}
int picolCommandCallProc(struct picolInterp *i, int argc, char **argv, void *pd) {
char **x=pd, *alist=x[0], *body=x[1], *p=strdup(alist), *tofree;
struct picolCallFrame *cf = malloc(sizeof(*cf));
int arity = 0, done = 0, errcode = PICOL_OK;
char errbuf[1024];
cf->vars = NULL;
cf->parent = i->callframe;
i->callframe = cf;
tofree = p;
while(1) {
char *start = p;
while(*p != ' ' && *p != '\0') p++;
if (*p != '\0' && p == start) {
p++; continue;
}
if (p == start) break;
if (*p == '\0') done=1; else *p = '\0';
if (++arity > argc-1) goto arityerr;
picolSetVar(i,start,argv[arity]);
p++;
if (done) break;
}
free(tofree);
if (arity != argc-1) goto arityerr;
errcode = picolEval(i,body);
if (errcode == PICOL_RETURN) errcode = PICOL_OK;
picolDropCallFrame(i); /* remove the called proc callframe */
return errcode;
arityerr:
snprintf(errbuf,1024,"Proc '%s' called with wrong arg num",argv[0]);
picolSetResult(i,errbuf);
picolDropCallFrame(i); /* remove the called proc callframe */
return PICOL_ERR;
}
