eval.c
Go to the documentation of this file.
1 /*****************************************************************/
2 /* eval.c
3 / interpreted evaluation of lisp forms
4 /* 1986-Jun-6
5 /* Copyright Toshihiro Matsui, ETL Umezono Sakuramura
6 /* 0298-54-5459
7 *****************************************************************/
8 static char *rcsid="@(#)$Id$";
9 
10 #include "eus.h"
11 #define FALSE 0
12 #define TRUE 1
13 
14 extern pointer ALLOWOTHERKEYS,K_ALLOWOTHERKEYS;
15 extern pointer OPTIONAL,REST,KEY,AUX,MACRO,LAMBDA,LAMCLOSURE;
16 extern char *maxmemory;
17 
18 #ifdef EVAL_DEBUG
19 int evaldebug;
20 #endif
21 
22 pointer *getobjv(sym,varvec,obj)
23 register pointer sym;
24 pointer varvec,obj;
25 { register pointer *vv=varvec->c.vec.v;
26  register int i=0,n;
27  n=intval(varvec->c.vec.size);
28  while (i<n)
29  if (vv[i]==sym) return(&(obj->c.obj.iv[i]));
30  else i++;
31  return(NULL);}
32 
33 pointer getval(ctx,sym)
34 register context *ctx;
35 register pointer sym;
36 { register struct bindframe *bf=ctx->bindfp;
37  register pointer var,val;
38  pointer *vaddr;
39  int vt;
40  if (sym->c.sym.vtype>=V_SPECIAL) {
41  vt=intval(sym->c.sym.vtype);
42  val=ctx->specials->c.vec.v[vt]; /*sym->c.sym.speval;*/
43  if (val==UNBOUND) {
44  val=sym->c.sym.speval;
45  if (val==UNBOUND) error(E_UNBOUND,sym);
46  else return(val); }
47  else return(val);}
48  if (sym->c.sym.vtype==V_CONSTANT) return(sym->c.sym.speval);
49  GC_POINT;
50  while (bf!=NULL) {
51  var=bf->sym;
52  val=bf->val;
53  if (sym==var) { /*found in bind-frame*/
54  if (val==UNBOUND) goto getspecial;
55  return(val);}
56  else if (var->cix==vectorcp.cix) {
57  vaddr=getobjv(sym,var,val);
58  if (vaddr) return(*vaddr);}
59  if (bf==bf->lexblink) break;
60  bf=bf->lexblink;}
61  /*get special value from the symbol cell*/
62  /*if (sym->c.sym.vtype==V_GLOBAL) goto getspecial;*/
63 getspecial:
64  val=sym->c.sym.speval;
65  if (val==UNBOUND) error(E_UNBOUND,sym);
66  else return(val);}
67 
68 pointer setval(ctx,sym,val)
69 register context *ctx;
70 register pointer sym,val;
71 { register struct bindframe *bf=ctx->bindfp;
72  register pointer var;
73  pointer *vaddr;
74  int vt;
75  if (sym->c.sym.vtype>=V_SPECIAL) {
76  vt=intval(sym->c.sym.vtype);
77  pointer_update(ctx->specials->c.vec.v[vt],val);
78  return(val);}
79  while (bf!=NULL) {
80  var=bf->sym;
81  if (sym==var) {
82  if (bf->val==UNBOUND) goto setspecial;
83  pointer_update(bf->val,val); return(val);}
84  else if (var->cix==vectorcp.cix) {
85  vaddr=getobjv(sym,var,bf->val);
86  if (vaddr) {pointer_update(*vaddr,val); return(val);}}
87  bf=bf->lexblink; GC_POINT;}
88  /* no local var found. try global binding */
89  if (sym->c.sym.vtype==V_CONSTANT) error(E_SETCONST,sym);
90  if (sym->c.sym.vtype==V_GLOBAL) goto setspecial;
91  setspecial:
92  pointer_update(sym->c.sym.speval,val); /* global val*/
93  return(val);
94  }
95 
96 
97 pointer getfunc(ctx,f)
98 register context *ctx;
99 register pointer f; /*must be a symbol*/
100 { register struct fletframe *ffp=ctx->fletfp;
101  while (ffp!=NULL) {
102  if (ffp->name==f) { return(ffp->fclosure);}
103  else ffp=ffp->lexlink;}
104  if (f->c.sym.spefunc==UNBOUND) error(E_UNDEF,f);
105  else { /*global function definition is taken, context changes*/
106  return(f->c.sym.spefunc);}}
107 
108 /* called from compiled code*/
109 pointer get_sym_func(s)
110 pointer s;
111 { register pointer f;
112  if ((f=s->c.sym.spefunc)==UNBOUND) error(E_UNDEF,s);
113  else return(f);}
114 
115 
116 void setfunc(sym,func)
117 register pointer sym,func;
118 { pointer_update(sym->c.sym.spefunc,func);}
119 
120 pointer *ovafptr(o,v)
121 register pointer o,v;
122 { register pointer c,*vaddr;
123  if (!ispointer(o)) error(E_NOOBJ,o,v);
124  c=classof(o);
125  vaddr=getobjv(v,c->c.cls.vars,o);
126  if (vaddr) return(vaddr);
127  else error(E_NOOBJVAR,o,v);}
128 
129 /***** special variable binding *****/
130 
131 void bindspecial(ctx,sym,newval)
132 register context *ctx;
133 pointer sym,newval;
134 { register struct specialbindframe *sbf=(struct specialbindframe *)(ctx->vsp);
135  int vt;
136  GC_POINT;
137  vt=intval(sym->c.sym.vtype);
138  ctx->vsp += (sizeof(struct specialbindframe)/sizeof(pointer));
139  sbf->sblink=ctx->sbindfp;
140  sbf->sym=sym;
141 
142  if (sym->c.sym.vtype==V_GLOBAL){
143  sbf->oldval=speval(sym); speval(sym)=newval;}
144  else { sbf->oldval=spevalof(sym,vt); spevalof(sym,vt)=newval;}
145 
146  ctx->sbindfp=sbf;
147  ctx->special_bind_count++;}
148 
149 /* called by compiled code */
150 void unbindx(ctx,count)
151 register context *ctx;
152 register int count;
153 { register pointer s;
154  register struct specialbindframe *sbfp=ctx->sbindfp;
155  if (ctx->special_bind_count<count) error(E_USER,(pointer)"inconsistent special binding");
156  ctx->special_bind_count -= count;
157  while (count-- >0) {
158  s=sbfp->sym;
159  /***/
160  if (s->c.sym.vtype==V_GLOBAL) {pointer_update(speval(s),sbfp->oldval);}
161  else pointer_update(Spevalof(s),sbfp->oldval);
162  sbfp=sbfp->sblink;}
163  ctx->sbindfp=sbfp;}
164 
165 void unbindspecial(ctx,limit)
166 register context *ctx;
167 register struct specialbindframe *limit;
168 { register pointer s;
169  register struct specialbindframe *sbfp=ctx->sbindfp;
170  if (sbfp) {
171  while (limit<=sbfp) { /* < is harmful to unwind in eus.c */
172  s=sbfp->sym;
173  /***/
174  if (s->c.sym.vtype==V_GLOBAL) {pointer_update(speval(s),sbfp->oldval);}
175  else pointer_update(Spevalof(s),sbfp->oldval);
176  sbfp=sbfp->sblink;
177  ctx->special_bind_count--;}
178  ctx->sbindfp=sbfp;}}
179 
180 struct bindframe *fastbind(ctx,var,val,lex)
181 register context *ctx;
182 register pointer var,val;
183 struct bindframe *lex;
184 { register struct bindframe *bf;
185  bf=(struct bindframe *)(ctx->vsp);
186  ctx->vsp += sizeof(struct bindframe)/sizeof(eusinteger_t);
187  bf->lexblink=lex;
188  bf->dynblink=ctx->bindfp;
189  bf->sym=var;
190  bf->val=val;
191  ctx->bindfp=bf; /*update bindfp*/
192  return(bf); }
193 
194 struct bindframe *vbind(ctx,var,val,lex,declscope)
195 register context *ctx;
196 register pointer var,val;
197 struct bindframe *lex,*declscope;
198 { register struct bindframe *p;
199  if (!issymbol(var)) error(E_NOSYMBOL);
200  if (var->c.sym.vtype==V_CONSTANT) error(E_NOVARIABLE,var);
201  p=ctx->bindfp;
202  while (p>declscope) {
203  if (p->sym==var)
204  if (p->val==UNBOUND) { bindspecial(ctx,var,val); return(ctx->bindfp);}
205  else error(E_MULTIDECL);
206  if (p==p->lexblink) break;
207  p=p->lexblink;}
208  /*not found in declare scope*/
209  if (var->c.sym.vtype>= /* V_SPECIAL */ V_GLOBAL ) {
210  /* For defun-c-callable in eusforeign.l to create a foreign-pod,
211  global value of SYMBOL must be replaced with FOREIGN-POD
212  by let binding. Since SYMBOL is V_GLOBAL, special binding
213  (global binding) must be made for V_GLOBAL. Proclaiming
214  symbol as SPECIAL is no use, since INTERN does not refer
215  thread local binding. */
216  bindspecial(ctx,var,val);
217  return(ctx->bindfp);}
218  return(fastbind(ctx,var,val,lex));}
219 
220 struct bindframe *declare(ctx,decllist,env)
221 register context *ctx;
222 pointer decllist;
223 struct bindframe *env;
224 { register pointer decl,var;
225 
226  while (iscons(decllist)) {
227  decl=ccar(decllist); decllist=ccdr(decllist);
228  if (!iscons(decl)) error(E_DECLARE);
229  if (ccar(decl)==QSPECIAL) { /*special binding*/
230  decl=ccdr(decl);
231  while (iscons(decl)) {
232  var=ccar(decl);
233  if (var->c.sym.vtype < V_SPECIAL) env=vbind(ctx,var,UNBOUND,env,ctx->bindfp);
234  decl=ccdr(decl); } } }
235  return(env);}
236 
237 int parsekeyparams(keyvec,actuals,noarg,results,allowotherkeys)
238  /*for compiled codes*/
239 register pointer keyvec, *actuals, *results;
240 int noarg,allowotherkeys;
241 { register int i=0,n=0,suppliedbits=0,keysize, bitpos;
242  register pointer akeyvar, *keys;
243 
244  if (noarg<=0) return(suppliedbits);
245  if (noarg & 1) error(E_KEYPARAM);
246  keysize=vecsize(keyvec);
247  for (i=0; i<keysize; i++) {
248 #ifdef SAFETY
249  take_care(results[i]);
250 #endif
251  results[i]=NIL;
252  }
253  while (n<noarg) {
254  akeyvar=actuals[n++];
255  if (!issymbol(akeyvar)) error(E_KEYPARAM);
256  if (akeyvar->c.sym.homepkg!=keywordpkg) error(E_KEYPARAM);
257  i=0; /*search for keyword*/
258  keys=keyvec->c.vec.v;
259  if (akeyvar==K_ALLOWOTHERKEYS) allowotherkeys=(actuals[n]!=NIL);
260  while (i<keysize && keys[i]!=akeyvar) i++;
261  if (i<keysize) { /*keyword found*/
262  bitpos = 1<<i;
263  if ((suppliedbits & bitpos) ==0) { /*already supplied-->ignore*/
264  pointer_update(results[i],actuals[n]);
265  suppliedbits |= bitpos;} }
266  else if (!allowotherkeys) error(E_NOKEYPARAM,akeyvar);
267  n++;}
268  return(suppliedbits);}
269 
270 struct bindframe *bindkeyparams(ctx,formal,argp,noarg,env,bf)
271 register context *ctx;
272 pointer formal;
273 pointer *argp;
274 int noarg;
275 struct bindframe *env,*bf;
276 { pointer fvar,initform;
277  register pointer fkeyvar,akeyvar;
278  pointer keys[KEYWORDPARAMETERLIMIT],
279  vars[KEYWORDPARAMETERLIMIT],
280  inits[KEYWORDPARAMETERLIMIT];
281  register int nokeys=0,i,n,allowotherkeys=0;
282 
283  /*parse lambda list and make keyword tables*/
284  while (iscons(formal)) {
285  fkeyvar=ccar(formal); formal=ccdr(formal);
286  if (iscons(fkeyvar)) {
287  fvar=ccar(fkeyvar);
288  initform=ccdr(fkeyvar);
289  if (iscons(initform)) initform=ccar(initform); else initform=NIL;
290  if (iscons(fvar)) {
291  fkeyvar=ccar(fvar); fvar=ccdr(fvar);
292  if (!iscons(fvar)) error(E_KEYPARAM);
293  fvar=ccar(fvar);
294  if (!issymbol(fkeyvar)) error(E_NOSYMBOL);
295  if (fkeyvar->c.sym.homepkg!=keywordpkg) error(E_KEYPARAM);}
296  else {
297  if (!issymbol(fvar)) error(E_NOSYMBOL);
298  fkeyvar=fvar->c.sym.pname;
299  fkeyvar=intern(ctx,(char *)fkeyvar->c.str.chars,
300  vecsize(fkeyvar),keywordpkg);}}
301  else if (fkeyvar==ALLOWOTHERKEYS) {
302  allowotherkeys=1;
303  if (islist(formal)) {
304  fkeyvar=ccar(formal); formal=ccdr(formal);
305  if (fkeyvar==AUX) break;
306  else error(E_USER,(pointer)"something after &allow-other-keys"); }
307  break;}
308  else if (fkeyvar==AUX) break;
309  else {
310  initform=NIL;
311  fvar=fkeyvar;
312  if (!issymbol(fvar)) error(E_NOSYMBOL);
313  fkeyvar=fvar->c.sym.pname;
314  fkeyvar=intern(ctx,(char *)fkeyvar->c.str.chars,
315  vecsize(fkeyvar),keywordpkg);}
316 
317  keys[nokeys]=fkeyvar;
318  vars[nokeys]=fvar;
319  inits[nokeys]=initform;
320  nokeys++;
321  if (nokeys>=KEYWORDPARAMETERLIMIT) {
322  error(E_USER, "Too many keyword parameters >%d",KEYWORDPARAMETERLIMIT);
323  }
324  }
325  n=0;
326  while (n<noarg) {
327  akeyvar=argp[n++];
328  if (!issymbol(akeyvar)) error(E_KEYPARAM);
329  if (akeyvar->c.sym.homepkg!=keywordpkg) error(E_KEYPARAM);
330  if (akeyvar==K_ALLOWOTHERKEYS) allowotherkeys=(argp[n]!=NIL);
331  i=0; /*search for keyword*/
332  while (i<nokeys && keys[i]!=akeyvar) i++;
333  if (n>=noarg) error(E_KEYPARAM); /*not paired*/
334  if (i<nokeys) {
335  if (inits[i]!=UNBOUND) {
336  env=vbind(ctx,vars[i],argp[n],env,bf);
337  inits[i]=UNBOUND;} }
338  else if (!allowotherkeys) error(E_NOKEYPARAM,akeyvar);
339  n++; }
340  i=0;
341  while (i<nokeys) {
342  if (inits[i]!=UNBOUND) env=vbind(ctx,vars[i],eval(ctx,inits[i]),env,bf);
343  i++;}
344  return(env);}
345 
346 pointer funlambda(ctx,fn,formal,body,argp,env,noarg)
347 register context *ctx;
348 pointer fn,formal,body,*argp;
349 struct bindframe *env;
350 int noarg;
351 { pointer ftype,fvar,result,decl,aval,initform,fkeyvar,akeyvar;
352  pointer *vspsave= ctx->vsp;
353  struct specialbindframe *sbfps=ctx->sbindfp;
354  struct bindframe *bf=ctx->bindfp;
355  struct blockframe *myblock;
356  int n=0,keyno=0,i;
357  jmp_buf funjmp;
358 
359  ctx->bindfp=env; /*****?????*****/
360 
361  /*declaration*/
362  while (iscons(body)) {
363  decl=ccar(body);
364  if (!iscons(decl) || (ccar(decl)!=QDECLARE)) break;
365  env=declare(ctx,ccdr(decl),env);
366  body=ccdr(body); GC_POINT;}
367 
368  /* make a new bind frame */
369  while (iscons(formal)) {
370  fvar=ccar(formal); formal=ccdr(formal);
371  if (fvar==OPTIONAL) goto bindopt;
372  if (fvar==REST) goto bindrest;
373  if (fvar==KEY) { keyno=n; goto bindkey;}
374  if (fvar==AUX) goto bindaux;
375  if (n>=noarg) error(E_MISMATCHARG);
376  env=vbind(ctx,fvar,argp[n],env,bf);
377  n++;}
378  if (n!=noarg) error(E_MISMATCHARG);
379  goto evbody;
380 bindopt:
381  while (iscons(formal)) {
382  fvar=ccar(formal); formal=ccdr(formal); /*take one formal*/
383  if (fvar==REST) goto bindrest;
384  if (fvar==KEY) { keyno=n; goto bindkey;}
385  if (fvar==AUX) goto bindaux;
386  if (n<noarg) { /*an actual arg is supplied*/
387  aval=argp[n];
388  if (iscons(fvar)) fvar=ccar(fvar);}
389  else if (iscons(fvar)) {
390  initform=ccdr(fvar);
391  fvar=ccar(fvar);
392  if (iscons(initform)) {GC_POINT;aval=eval(ctx,ccar(initform));}
393  else aval=NIL;}
394  else aval=NIL;
395  env=vbind(ctx,fvar,aval,env,bf);
396  n++;}
397  if (n<noarg) error(E_MISMATCHARG);
398  goto evbody;
399 bindrest:
400  keyno=n;
401  fvar=carof(formal,E_PARAMETER);
402  formal=ccdr(formal);
403  /*list up all rest arguments*/
404  result=NIL;
405  i=noarg;
406  while (n<i) result=cons(ctx,argp[--i],result);
407  env=vbind(ctx,fvar,result,env,bf);
408  n++;
409  if (!iscons(formal)) goto evbody;
410  fvar=ccar(formal); formal=ccdr(formal);
411  if (fvar==KEY) goto bindkey;
412  else if (fvar==AUX) goto bindaux;
413  else error(E_PARAMETER);
414 bindkey:
415  env=bindkeyparams(ctx,formal,&argp[keyno],noarg-keyno,env,bf);
416  while (iscons(formal)) {
417  fvar=ccar(formal); formal=ccdr(formal);
418  if (fvar==AUX) goto bindaux;}
419  goto evbody;
420 bindaux:
421  while (iscons(formal)) {
422  fvar=ccar(formal); formal=ccdr(formal);
423  if (iscons(fvar)) {
424  initform=ccdr(fvar);
425  fvar=ccar(fvar);
426  if (iscons(initform)) {GC_POINT;aval=eval(ctx,ccar(initform));}
427  else aval=NIL;}
428  else aval=NIL;
429  env=vbind(ctx,fvar,aval,env,bf); }
430 evbody:
431  GC_POINT;
432  /*create block around lambda*/
433  myblock=(struct blockframe *)makeblock(ctx,BLOCKFRAME,fn,&funjmp,NULL);
434  /*evaluate body*/
435  if ((result=(pointer)eussetjmp(funjmp))==0) {GC_POINT;result=progn(ctx,body);}
436  else if (result==(pointer)1) result=makeint(0);
437  /*end of body evaluation: clean up stack frames*/
438  ctx->blkfp=myblock->dynklink;
439  ctx->bindfp=bf;
440  ctx->vsp=vspsave;
441 
442 #ifdef __RETURN_BARRIER
443  check_return_barrier(ctx);
444  /* check return barrier */
445 #endif
446 /* unbindspecial(ctx,(struct specialbindframe *)ctx->vsp); */
447  unbindspecial(ctx,sbfps+1);
448  return(result);}
449 
450 #if IRIX6
451 
452 #include <alloca.h>
453 
454 extern long i_call_foreign(eusinteger_t (*)(),int,numunion *);
455 extern double f_call_foreign(eusinteger_t (*)(),int,numunion *);
456 
457 pointer call_foreign(func,code,n,args)
458 eusinteger_t (*func)();
459 pointer code;
460 int n;
461 pointer args[];
462 { pointer paramtypes=code->c.fcode.paramtypes;
463  pointer resulttype=code->c.fcode.resulttype;
464  pointer p,lisparg;
465  numunion nu,*cargv;
466  eusinteger_t i=0;
467  double f;
468 
469  cargv=(numunion *)alloca(n*sizeof(numunion));
470  while (iscons(paramtypes)) {
471  p=ccar(paramtypes); paramtypes=ccdr(paramtypes);
472  lisparg=args[i];
473  if (p==K_INTEGER)
474  cargv[i++].ival=isint(lisparg)?intval(lisparg):bigintval(lisparg);
475  else if (p==K_FLOAT) cargv[i++].fval=ckfltval(lisparg);
476  else if (p==K_STRING)
477  if (elmtypeof(lisparg)==ELM_FOREIGN)
478  cargv[i++].ival=lisparg->c.ivec.iv[0];
479  else cargv[i++].ival=(eusinteger_t)(lisparg->c.str.chars);
480  else error(E_USER,(pointer)"unknown type specifier");}
481  /* &rest arguments? */
482  while (i<n) { /* i is the counter for the actual arguments*/
483  lisparg=args[i];
484  if (isint(lisparg)) cargv[i++].ival=intval(lisparg);
485  else if (isflt(lisparg)) cargv[i++].fval=ckfltval(lisparg);
486  else if (isvector(lisparg)) {
487  if (elmtypeof(lisparg)==ELM_FOREIGN)
488  cargv[i++].ival=lisparg->c.ivec.iv[0];
489  else cargv[i++].ival=(eusinteger_t)(lisparg->c.str.chars);}
490  else cargv[i++].ival=(eusinteger_t)(lisparg->c.obj.iv);}
491 
492  if (resulttype==K_FLOAT) return(makeflt(f_call_foreign(func,n,cargv)));
493  else {
494  i=i_call_foreign(func,n,cargv);
495  if (resulttype==K_INTEGER) return(mkbigint(i));
496  else if (resulttype==K_STRING) {
497  p=makepointer(i-2*sizeof(pointer));
498  if (isvector(p)) return(p);
499  else error(E_USER,(pointer)"illegal foreign string"); }
500  else if (iscons(resulttype)) {
501  /* (:string [10]) (:foreign-string [20]) */
502  if (ccar(resulttype)==K_STRING) {
503  resulttype=ccdr(resulttype);
504  if (resulttype!=NIL) j=ckintval(ccar(resulttype));
505  else j=strlen((char *)i);
506  return(makestring((char *)i, j)); }
507  else if (ccar(resulttype)==K_FOREIGN_STRING) {
508  resulttype=ccdr(resulttype);
509  if (resulttype!=NIL) j=ckintval(ccar(resulttype));
510  else j=strlen((char *)i);
511  return(make_foreign_string(i, j)); }
512  error(E_USER,(pointer)"unknown result type"); }
513  else error(E_USER,(pointer)"result type?");
514  }}
515 
516 #else /* IRIX6 */
517 
518 #if IRIX
519 
520 #include <alloca.h>
521 
522 extern int i_call_foreign(eusinteger_t (*)(),int,int *);
523 extern double f_call_foreign(eusinteger_t (*)(),int,int *);
524 
525 pointer call_foreign(func,code,n,args)
526 eusinteger_t (*func)();
527 pointer code;
528 int n;
529 pointer args[];
530 { pointer paramtypes=code->c.fcode.paramtypes;
531  pointer resulttype=code->c.fcode.resulttype;
532  pointer p,lisparg;
533  numunion nu,*cargs;
534  eusinteger_t i=0;
535  unsigned int *offset,*isfloat,m=0;
536  int *cargv;
537  union {
538  double d;
539  struct {
540  int i1,i2;} i;
541  } numbox;
542  double f;
543 
544  cargs=(numunion *)alloca(n*sizeof(numunion));
545  offset=(unsigned int *)alloca(n*sizeof(unsigned int));
546  isfloat=(unsigned int *)alloca(n*sizeof(unsigned int));
547  while (iscons(paramtypes)) {
548  p=ccar(paramtypes); paramtypes=ccdr(paramtypes);
549  lisparg=args[i];
550  if (isfloat[i]=(p==K_FLOAT)) {
551  cargs[i].fval=ckfltval(lisparg);
552  offset[i]=(m+1)&~1; m=offset[i++]+2;}
553  else if (p==K_INTEGER) {
554  cargs[i++].ival=isint(lisparg)?intval(lisparg):bigintval(lisparg);
555  offset[i++]=m++;}
556  else if (p==K_STRING) {
557  if (elmtypeof(lisparg)==ELM_FOREIGN)
558  cargs[i].ival=lisparg->c.ivec.iv[0];
559  else cargs[i].ival=(eusinteger_t)(lisparg->c.str.chars);
560  offset[i++]=m++;}
561  else error(E_USER,(pointer)"unknown type specifier");}
562  /* &rest arguments? */
563  while (i<n) { /* i is the counter for the actual arguments*/
564  lisparg=args[i];
565  if (isfloat[i]=isflt(lisparg)) {
566  cargs[i].fval=ckfltval(lisparg);
567  offset[i]=(m+1)&~1; m=offset[i++]+2;}
568  else if (isint(lisparg)) {
569  cargs[i].ival=intval(lisparg);
570  offset[i++]=m++;}
571  else if (isvector(lisparg)) {
572  if (elmtypeof(lisparg)==ELM_FOREIGN)
573  cargs[i].ival=lisparg->c.ivec.iv[0];
574  else cargs[i].ival=(eusinteger_t)(lisparg->c.str.chars);
575  offset[i++]=m++;}
576  else {
577  cargs[i++].ival=(eusinteger_t)(lisparg->c.obj.iv);
578  offset[i++]=m++;}}
579  cargv=(int *)alloca(m*sizeof(int));
580  for (i=0; i<n; ++i) {
581  if (isfloat[i]) {
582  numbox.d=(double)cargs[i].fval;
583  cargv[offset[i]]=numbox.i.i1; cargv[offset[i]+1]=numbox.i.i2;}
584  else cargv[offset[i]]=cargs[i].ival;}
585 
586  if (resulttype==K_FLOAT) return(makeflt(f_call_foreign(func,m,cargv)));
587  else {
588  i=i_call_foreign(func,m,cargv);
589  if (resulttype==K_INTEGER) return(mkbigint(i));
590  else if (resulttype==K_STRING) {
591  p=makepointer(i-2*sizeof(pointer));
592  if (isvector(p)) return(p);
593  else error(E_USER,(pointer)"illegal foreign string"); }
594  else if (iscons(resulttype)) {
595  /* (:string [10]) (:foreign-string [20]) */
596  if (ccar(resulttype)=K_STRING) {
597  resulttype=ccdr(resulttype);
598  if (resulttype!=NIL) j=ckintval(ccar(resulttype));
599  else j=strlen((char *)i);
600  return(makestring((char *)i, j)); }
601  else if (ccar(resulttype)=K_FOREIGN_STRING) {
602  resulttype=ccdr(resulttype);
603  if (resulttype!=NIL) j=ckintval(ccar(resulttype));
604  else j=strlen((char *)i);
605  return(make_foreign_string(i, j)); }
606  error(E_USER,(pointer)"unknown result type"); }
607  else error(E_USER,(pointer)"result type?");
608  }}
609 
610 #else /* IRIX */
611 
612 /* not IRIS */
613 #if (defined(x86_64) || defined(aarch64))
614 extern long exec_function_i(void (*)(), long *, long *, long, long *);
615 extern long exec_function_f(void (*)(), long *, long *, long, long *);
616 
617 #if x86_64
618 // func %rdi
619 // iargv %rsi
620 // fargv %rdx
621 // vargc %rcx
622 // vargv %r8
623 __asm__ (".align 8\n"
624 #if Darwin
625  "_exec_function_i:\n\t"
626 #else
627  "exec_function_i:\n\t"
628 #endif
629  "push %rbx\n\t"
630  "sub $0x120, %rsp\n\t"
631  "mov %rdx, %rax\n\t"
632  "movsd 0x00(%rax), %xmm0\n\t"
633  "movsd 0x08(%rax), %xmm1\n\t"
634  "movsd 0x10(%rax), %xmm2\n\t"
635  "movsd 0x18(%rax), %xmm3\n\t"
636  "movsd 0x20(%rax), %xmm4\n\t"
637  "movsd 0x28(%rax), %xmm5\n\t"
638  "movsd 0x30(%rax), %xmm6\n\t"
639  "movsd 0x38(%rax), %xmm7\n\t"
640  "mov %rsp, %rax\n\t"
641  "mov $0, %r10\n\t"
642  "cmpl %ecx, %r10d\n\t"
643  "jge .LENDLP\n"
644  ".LNEXTLP:\n\t"
645  "mov (%r8), %rbx\n\t"
646  "mov %rbx, (%rax)\n\t"
647  "add $8, %rax\n\t"
648  "add $8, %r8\n\t"
649  "add $1, %r10d\n\t"
650  "cmpl %r10d, %ecx\n\t"
651  "jg .LNEXTLP\n"
652  ".LENDLP:\n\t"
653  "mov %rdi, %rbx\n\t"
654  "mov %rsi, %rax\n\t"
655  "mov 0x00(%rax), %rdi\n\t"
656  "mov 0x08(%rax), %rsi\n\t"
657  "mov 0x10(%rax), %rdx\n\t"
658  "mov 0x18(%rax), %rcx\n\t"
659  "mov 0x20(%rax), %r8\n\t"
660  "mov 0x28(%rax), %r9\n\t"
661  "mov $0x00, %eax\n\t"
662  "call *%rbx\n\t"
663  "add $0x120, %rsp\n\t"
664  "pop %rbx\n\t"
665  "retq"
666  );
667 __asm__ (".align 8\n"
668 #if Darwin
669  "_exec_function_f:\n\t"
670 #else
671  "exec_function_f:\n\t"
672 #endif
673  "push %rbx\n\t"
674  "sub $0x120, %rsp\n\t"
675  "mov %rdx, %rax\n\t"
676  "movsd 0x00(%rax), %xmm0\n\t"
677  "movsd 0x08(%rax), %xmm1\n\t"
678  "movsd 0x10(%rax), %xmm2\n\t"
679  "movsd 0x18(%rax), %xmm3\n\t"
680  "movsd 0x20(%rax), %xmm4\n\t"
681  "movsd 0x28(%rax), %xmm5\n\t"
682  "movsd 0x30(%rax), %xmm6\n\t"
683  "movsd 0x38(%rax), %xmm7\n\t"
684  "mov %rsp, %rax\n\t"
685  "mov $0, %r10\n\t"
686  "cmpl %ecx, %r10d\n\t"
687  "jge .LENDLPF\n"
688  ".LNEXTLPF:\n\t"
689  "mov (%r8), %rbx\n\t"
690  "mov %rbx, (%rax)\n\t"
691  "add $8, %rax\n\t"
692  "add $8, %r8\n\t"
693  "add $1, %r10d\n\t"
694  "cmpl %r10d, %ecx\n\t"
695  "jg .LNEXTLPF\n"
696  ".LENDLPF:\n\t"
697  "mov %rdi, %rbx\n\t"
698  "mov %rsi, %rax\n\t"
699  "mov 0x00(%rax), %rdi\n\t"
700  "mov 0x08(%rax), %rsi\n\t"
701  "mov 0x10(%rax), %rdx\n\t"
702  "mov 0x18(%rax), %rcx\n\t"
703  "mov 0x20(%rax), %r8\n\t"
704  "mov 0x28(%rax), %r9\n\t"
705  "mov $0x00, %eax\n\t"
706  "call *%rbx\n\t"
707  "movsd %xmm0, (%rsp)\n\t"
708  "mov (%rsp), %rax\n\t"
709  "add $0x120, %rsp\n\t"
710  "pop %rbx\n\t"
711  "retq"
712  );
713 #endif
714 
715 #if aarch64
716 __asm__ (".align 8\n"
717  "exec_function_i:\n\t"
718  "sub sp, sp, #192\n\t" // 128(8x16) + 64
719  "stp x29, x30, [sp, 128]\n\t"
720  "add x29, sp, 128\n\t"
721  "str x0, [x29, 56]\n\t" // fc
722  "str x1, [x29, 48]\n\t" // iargv
723  "str x2, [x29, 40]\n\t" // fargv
724  "str x3, [x29, 32]\n\t" // vargc
725  "str x4, [x29, 24]\n\t" // vargv
726  // vargv -> stack
727  "mov x1, 0\n\t"
728  "ldr x2, [x29, 24]\n\t"
729  "b .FUNCII_LPCK\n\t"
730  ".FUNCII_LP:\n\t"
731  "lsl x0, x1, 3\n\t"
732  "add x3, x2, x0\n\t" // vargv[i]
733  "add x4, sp, x0\n\t" // stack[i]
734  "ldr x0, [x3]\n\t"
735  "str x0, [x4]\n\t" // push stack
736  "add x1, x1, 1\n\t"
737  ".FUNCII_LPCK:\n\t"
738  "ldr x5, [x29, 32]\n\t"
739  "cmp x1, x5\n\t"
740  "blt .FUNCII_LP\n\t"
741  // fargv -> register
742  "ldr x0, [x29, 40]\n\t" // fargv
743  "ldr d0, [x0]\n\t"
744  "add x0, x0, 8\n\t"
745  "ldr d1, [x0]\n\t"
746  "add x0, x0, 8\n\t"
747  "ldr d2, [x0]\n\t"
748  "add x0, x0, 8\n\t"
749  "ldr d3, [x0]\n\t"
750  "add x0, x0, 8\n\t"
751  "ldr d4, [x0]\n\t"
752  "add x0, x0, 8\n\t"
753  "ldr d5, [x0]\n\t"
754  "add x0, x0, 8\n\t"
755  "ldr d6, [x0]\n\t"
756  "add x0, x0, 8\n\t"
757  "ldr d7, [x0]\n\t"
758  // iargv -> register
759  "ldr x0, [x29, 48]\n\t" // iargv
760  "ldr x9, [x0]\n\t"
761  "add x0, x0, 8\n\t"
762  "ldr x1, [x0]\n\t"
763  "add x0, x0, 8\n\t"
764  "ldr x2, [x0]\n\t"
765  "add x0, x0, 8\n\t"
766  "ldr x3, [x0]\n\t"
767  "add x0, x0, 8\n\t"
768  "ldr x4, [x0]\n\t"
769  "add x0, x0, 8\n\t"
770  "ldr x5, [x0]\n\t"
771  "add x0, x0, 8\n\t"
772  "ldr x6, [x0]\n\t"
773  "add x0, x0, 8\n\t"
774  "ldr x7, [x0]\n\t"
775  // function call
776  "ldr x8, [x29, 56]\n\t"
777  "mov x0, x9\n\t"
778  "blr x8\n\t"
779  "add sp, x29, 0\n\t"
780  "ldp x29, x30, [sp], 64\n\t"
781  "ret"
782  );
783 
784 __asm__ (".align 8\n"
785  "exec_function_f:\n\t"
786  "sub sp, sp, #192\n\t" // 128(8x16) + 64
787  "stp x29, x30, [sp, 128]\n\t"
788  "add x29, sp, 128\n\t"
789  "str x0, [x29, 56]\n\t" // fc
790  "str x1, [x29, 48]\n\t" // iargv
791  "str x2, [x29, 40]\n\t" // fargv
792  "str x3, [x29, 32]\n\t" // vargc
793  "str x4, [x29, 24]\n\t" // vargv
794  // vargv -> stack
795  "mov x1, 0\n\t"
796  "ldr x2, [x29, 24]\n\t"
797  "b .FUNCFF_LPCK\n\t"
798  ".FUNCFF_LP:\n\t"
799  "lsl x0, x1, 3\n\t"
800  "add x3, x2, x0\n\t" // vargv[i]
801  "add x4, sp, x0\n\t" // stack[i]
802  "ldr x0, [x3]\n\t"
803  "str x0, [x4]\n\t" // push stack
804  "add x1, x1, 1\n\t"
805  ".FUNCFF_LPCK:\n\t"
806  "ldr x5, [x29, 32]\n\t"
807  "cmp x1, x5\n\t"
808  "blt .FUNCFF_LP\n\t"
809  // fargv -> register
810  "ldr x0, [x29, 40]\n\t" // fargv
811  "ldr d0, [x0]\n\t"
812  "add x0, x0, 8\n\t"
813  "ldr d1, [x0]\n\t"
814  "add x0, x0, 8\n\t"
815  "ldr d2, [x0]\n\t"
816  "add x0, x0, 8\n\t"
817  "ldr d3, [x0]\n\t"
818  "add x0, x0, 8\n\t"
819  "ldr d4, [x0]\n\t"
820  "add x0, x0, 8\n\t"
821  "ldr d5, [x0]\n\t"
822  "add x0, x0, 8\n\t"
823  "ldr d6, [x0]\n\t"
824  "add x0, x0, 8\n\t"
825  "ldr d7, [x0]\n\t"
826  // iargv -> register
827  "ldr x0, [x29, 48]\n\t" // iargv
828  "ldr x9, [x0]\n\t"
829  "add x0, x0, 8\n\t"
830  "ldr x1, [x0]\n\t"
831  "add x0, x0, 8\n\t"
832  "ldr x2, [x0]\n\t"
833  "add x0, x0, 8\n\t"
834  "ldr x3, [x0]\n\t"
835  "add x0, x0, 8\n\t"
836  "ldr x4, [x0]\n\t"
837  "add x0, x0, 8\n\t"
838  "ldr x5, [x0]\n\t"
839  "add x0, x0, 8\n\t"
840  "ldr x6, [x0]\n\t"
841  "add x0, x0, 8\n\t"
842  "ldr x7, [x0]\n\t"
843  // function call
844  "ldr x8, [x29, 56]\n\t"
845  "mov x0, x9\n\t"
846  "blr x8\n\t"
847  "str d0, [x29, 56]\n\t"
848  "ldr x0, [x29, 56]\n\t"
849  "add sp, x29, 0\n\t"
850  "ldp x29, x30, [sp], 64\n\t"
851  "ret"
852  );
853 #endif
854 
855 #if x86_64
856 #define NUM_INT_ARGUMENTS 6
857 #define NUM_FLT_ARGUMENTS 8
858 #define NUM_EXTRA_ARGUMENTS 16
859 #elif aarch64
860 #define NUM_INT_ARGUMENTS 8
861 #define NUM_FLT_ARGUMENTS 8
862 #define NUM_EXTRA_ARGUMENTS 16
863 #endif
864 
865 pointer call_foreign(ifunc,code,n,args)
866 eusinteger_t (*ifunc)(); /* ???? */
867 pointer code;
868 int n;
869 pointer args[];
870 {
871  pointer paramtypes=code->c.fcode.paramtypes;
872  pointer resulttype=code->c.fcode.resulttype;
873  pointer p,lisparg;
874  eusinteger_t iargv[NUM_INT_ARGUMENTS];
875  eusinteger_t fargv[NUM_FLT_ARGUMENTS];
876  eusinteger_t vargv[NUM_EXTRA_ARGUMENTS];
877  int icntr = 0, fcntr = 0, vcntr = 0;
878 
879  numunion nu;
880  eusinteger_t j=0; /*lisp argument counter*//* ???? */
881  eusinteger_t c=0;
882  union {
883  double d;
884  float f;
885  long l;
886  struct {
887  int i1,i2;} i;
888  } numbox;
889  double f;
890 
891  if (code->c.fcode.entry2 != NIL) {
892  ifunc = (eusinteger_t (*)())((((eusinteger_t)ifunc)&0xffffffff00000000)
893  | (intval(code->c.fcode.entry2)&0x00000000ffffffff));
894  /* R.Hanai 090726 */
895  }
896 
897  while (iscons(paramtypes)) {
898  p=ccar(paramtypes); paramtypes=ccdr(paramtypes);
899  lisparg=args[j++];
900  if (p==K_INTEGER) {
901  c = isint(lisparg)?intval(lisparg):bigintval(lisparg);
902  if(icntr < NUM_INT_ARGUMENTS) iargv[icntr++] = c; else vargv[vcntr++] = c;
903  } else if (p==K_STRING) {
904  if (elmtypeof(lisparg)==ELM_FOREIGN) c=lisparg->c.ivec.iv[0];
905  else c=(eusinteger_t)(lisparg->c.str.chars);
906  if(icntr < NUM_INT_ARGUMENTS) iargv[icntr++] = c; else vargv[vcntr++] = c;
907  } else if (p==K_FLOAT32) {
908  numbox.f=(float)ckfltval(lisparg);
909  c=((eusinteger_t)numbox.i.i1) & 0x00000000FFFFFFFF;
910  if(fcntr < NUM_FLT_ARGUMENTS) fargv[fcntr++] = c; else vargv[vcntr++] = c;
911  } else if (p==K_DOUBLE || p==K_FLOAT) {
912  numbox.d=ckfltval(lisparg);
913  c=numbox.l;
914  if(fcntr < NUM_FLT_ARGUMENTS) fargv[fcntr++] = c; else vargv[vcntr++] = c;
915  } else error(E_USER,(pointer)"unknown type specifier");
916  if (vcntr >= NUM_EXTRA_ARGUMENTS) {
917  error(E_USER,(pointer)"too many number of arguments");
918  }
919  }
920  /* &rest arguments? */
921  while (j<n) { /* j is the counter for the actual arguments*/
922  lisparg=args[j++];
923  if (isint(lisparg)) {
924  c=intval(lisparg);
925  if(icntr < NUM_INT_ARGUMENTS) iargv[icntr++] = c; else vargv[vcntr++] = c;
926  } else if (isflt(lisparg)) {
927  numbox.d=ckfltval(lisparg); /* i advances independently */
928  c=numbox.l;
929  if(fcntr < NUM_FLT_ARGUMENTS) fargv[fcntr++] = c; else vargv[vcntr++] = c;
930  } else if (isvector(lisparg)) {
931  if (elmtypeof(lisparg)==ELM_FOREIGN) c=lisparg->c.ivec.iv[0];
932  else c=(eusinteger_t)(lisparg->c.str.chars);
933  if(icntr < NUM_INT_ARGUMENTS) iargv[icntr++] = c; else vargv[vcntr++] = c;
934  } else if (isbignum(lisparg)){
935  if (bigsize(lisparg)==1){
936  eusinteger_t *xv = bigvec(lisparg);
937  c=(eusinteger_t)xv[0];
938  if(icntr < NUM_INT_ARGUMENTS) iargv[icntr++] = c; else vargv[vcntr++] = c;
939  }else{
940  fprintf(stderr, "bignum size!=1\n");
941  }
942  } else {
943  c=(eusinteger_t)(lisparg->c.obj.iv);
944  if(icntr < NUM_INT_ARGUMENTS) iargv[icntr++] = c; else vargv[vcntr++] = c;
945  }
946  if (vcntr >= NUM_EXTRA_ARGUMENTS) {
947  error(E_USER,(pointer)"too many number of arguments");
948  }
949  }
950 
951  if (resulttype==K_FLOAT) {
952  numbox.l = exec_function_f((void (*)())ifunc, iargv, fargv, vcntr, vargv);
953  f = numbox.d;
954  return(makeflt(f));
955  } else if (resulttype==K_FLOAT32) {
956  numbox.l = exec_function_f((void (*)())ifunc, iargv, fargv, vcntr, vargv);
957  f = (double)numbox.f;
958  return(makeflt(f));
959  } else {
960  c = exec_function_i((void (*)())ifunc, iargv, fargv, vcntr, vargv);
961  if (resulttype==K_INTEGER) {
962  return(mkbigint(c));
963  } else if (resulttype==K_STRING) {
964  p=makepointer(c-2*sizeof(pointer));
965  if (isvector(p)) return(p);
966  else error(E_USER,(pointer)"illegal foreign string");
967  } else if (iscons(resulttype)) {
968  /* (:string [10]) (:foreign-string [20]) */
969  if (ccar(resulttype)==K_STRING) { /* R.Hanai 09/07/25 */
970  resulttype=ccdr(resulttype);
971  if (resulttype!=NIL) j=ckintval(ccar(resulttype));
972  else j=strlen((char *)c);
973  return(makestring((char *)c, j));
974  } else if (ccar(resulttype)==K_FOREIGN_STRING) { /* R.Hanai 09/07/25 */
975  resulttype=ccdr(resulttype);
976  if (resulttype!=NIL) j=ckintval(ccar(resulttype));
977  else j=strlen((char *)c);
978  return(make_foreign_string(c, j)); }
979  error(E_USER,(pointer)"unknown result type");
980  } else error(E_USER,(pointer)"result type?");
981  }
982 }
983 #else /* not x86_64 */
984 pointer call_foreign(ifunc,code,n,args)
985 eusinteger_t (*ifunc)(); /* ???? */
986 pointer code;
987 int n;
988 pointer args[];
989 { double (*ffunc)();
990  pointer paramtypes=code->c.fcode.paramtypes;
991  pointer resulttype=code->c.fcode.resulttype;
992  pointer p,lisparg;
993  eusinteger_t cargv[100];
994  numunion nu;
995  eusinteger_t i=0; /*C argument counter*//* ???? */
996  eusinteger_t j=0; /*lisp argument counter*//* ???? */
997  union {
998  double d;
999  float f;
1000  struct {
1001  int i1,i2;} i;
1002  } numbox;
1003  double f;
1004 
1005  if (code->c.fcode.entry2 != NIL) {
1006 #if (WORD_SIZE == 64)
1007  ifunc = (((eusinteger_t)ifunc)&0xffffffff00000000) | (intval(code->c.fcode.entry2)&0x00000000ffffffff);
1008 #else
1009  ifunc = (eusinteger_t (*)())((((int)ifunc)&0xffff0000) | (intval(code->c.fcode.entry2)&0x0000ffff)); /* kanehiro's patch 2000.12.13 */
1010 #endif
1011  }
1012  ffunc=(double (*)())ifunc;
1013  while (iscons(paramtypes)) {
1014  p=ccar(paramtypes); paramtypes=ccdr(paramtypes);
1015  lisparg=args[j++];
1016  if (p==K_INTEGER)
1017  cargv[i++]=isint(lisparg)?intval(lisparg):bigintval(lisparg);
1018  else if (p==K_STRING) {
1019  if (elmtypeof(lisparg)==ELM_FOREIGN) cargv[i++]=lisparg->c.ivec.iv[0];
1020  else cargv[i++]=(eusinteger_t)(lisparg->c.str.chars);}
1021  else if (p==K_FLOAT32) {
1022  numbox.f=ckfltval(lisparg);
1023  cargv[i++]=(int)numbox.i.i1;}
1024  else if (p==K_DOUBLE || p==K_FLOAT) {
1025  numbox.d=ckfltval(lisparg);
1026  cargv[i++]=numbox.i.i1; cargv[i++]=numbox.i.i2;}
1027  else error(E_USER,(pointer)"unknown type specifier");}
1028  /* &rest arguments? */
1029  while (j<n) { /* j is the counter for the actual arguments*/
1030  lisparg=args[j++];
1031  if (isint(lisparg)) cargv[i++]=intval(lisparg);
1032  else if (isflt(lisparg)) {
1033  numbox.d=ckfltval(lisparg); /* i advances independently */
1034  numbox.f=ckfltval(lisparg);
1035  cargv[i++]=numbox.i.i1; cargv[i++]=numbox.i.i2;}
1036  else if (isvector(lisparg)) {
1037  if (elmtypeof(lisparg)==ELM_FOREIGN)
1038  cargv[i++]=lisparg->c.ivec.iv[0];
1039  else cargv[i++]=(eusinteger_t)(lisparg->c.str.chars);}
1040 #if 1 /* begin kanehiro's patch 2000.12.13 */
1041  else if (isbignum(lisparg)){
1042  if (bigsize(lisparg)==1){
1043  eusinteger_t *xv = bigvec(lisparg);
1044  cargv[i++]=(eusinteger_t)xv[0];
1045  }else{
1046  fprintf(stderr, "bignum size!=1\n");
1047  }
1048  }
1049 #endif /* end of kanehiro's patch 2000.12.13 */
1050  else cargv[i++]=(eusinteger_t)(lisparg->c.obj.iv);}
1051 
1052  if (resulttype==K_FLOAT) {
1053  if (i<=8)
1054  f=(*ffunc)(cargv[0],cargv[1],cargv[2],cargv[3],
1055  cargv[4],cargv[5],cargv[6],cargv[7]);
1056  else if (i<=32)
1057  f=(*ffunc)(cargv[0],cargv[1],cargv[2],cargv[3],
1058  cargv[4],cargv[5],cargv[6],cargv[7],
1059  cargv[8],cargv[9],cargv[10],cargv[11],
1060  cargv[12],cargv[13],cargv[14],cargv[15],
1061  cargv[16],cargv[17],cargv[18],cargv[19],
1062  cargv[20],cargv[21],cargv[22],cargv[23],
1063  cargv[24],cargv[25],cargv[26],cargv[27],
1064  cargv[28],cargv[29],cargv[30],cargv[31]);
1065 #if (sun3 || sun4 || mips || alpha)
1066  else if (i>32)
1067  f=(*ffunc)(cargv[0],cargv[1],cargv[2],cargv[3],
1068  cargv[4],cargv[5],cargv[6],cargv[7],
1069  cargv[8],cargv[9],cargv[10],cargv[11],
1070  cargv[12],cargv[13],cargv[14],cargv[15],
1071  cargv[16],cargv[17],cargv[18],cargv[19],
1072  cargv[20],cargv[21],cargv[22],cargv[23],
1073  cargv[24],cargv[25],cargv[26],cargv[27],
1074  cargv[28],cargv[29],cargv[30],cargv[31],
1075  cargv[32],cargv[33],cargv[34],cargv[35],
1076  cargv[36],cargv[37],cargv[38],cargv[39],
1077  cargv[40],cargv[41],cargv[42],cargv[43],
1078  cargv[44],cargv[45],cargv[46],cargv[47],
1079  cargv[48],cargv[49],cargv[50],cargv[51],
1080  cargv[52],cargv[53],cargv[54],cargv[55],
1081  cargv[56],cargv[57],cargv[58],cargv[59],
1082  cargv[60],cargv[61],cargv[62],cargv[63],
1083  cargv[64],cargv[65],cargv[66],cargv[67],
1084  cargv[68],cargv[69],cargv[70],cargv[71],
1085  cargv[72],cargv[73],cargv[74],cargv[75],
1086  cargv[76],cargv[77],cargv[78],cargv[79]);
1087 #endif
1088  return(makeflt(f));}
1089  else {
1090  if (i<8)
1091  i=(*ifunc)(cargv[0],cargv[1],cargv[2],cargv[3],
1092  cargv[4],cargv[5],cargv[6],cargv[7]);
1093  else if (i<=32)
1094  i=(*ifunc)(cargv[0],cargv[1],cargv[2],cargv[3],
1095  cargv[4],cargv[5],cargv[6],cargv[7],
1096  cargv[8],cargv[9],cargv[10],cargv[11],
1097  cargv[12],cargv[13],cargv[14],cargv[15],
1098  cargv[16],cargv[17],cargv[18],cargv[19],
1099  cargv[20],cargv[21],cargv[22],cargv[23],
1100  cargv[24],cargv[25],cargv[26],cargv[27],
1101  cargv[28],cargv[29],cargv[30],cargv[31]);
1102 #if (sun3 || sun4 || mips || alpha)
1103  else if (i>32)
1104  i=(*ifunc)(cargv[0],cargv[1],cargv[2],cargv[3],
1105  cargv[4],cargv[5],cargv[6],cargv[7],
1106  cargv[8],cargv[9],cargv[10],cargv[11],
1107  cargv[12],cargv[13],cargv[14],cargv[15],
1108  cargv[16],cargv[17],cargv[18],cargv[19],
1109  cargv[20],cargv[21],cargv[22],cargv[23],
1110  cargv[24],cargv[25],cargv[26],cargv[27],
1111  cargv[28],cargv[29],cargv[30],cargv[31],
1112  cargv[32],cargv[33],cargv[34],cargv[35],
1113  cargv[36],cargv[37],cargv[38],cargv[39],
1114  cargv[40],cargv[41],cargv[42],cargv[43],
1115  cargv[44],cargv[45],cargv[46],cargv[47],
1116  cargv[48],cargv[49],cargv[50],cargv[51],
1117  cargv[52],cargv[53],cargv[54],cargv[55],
1118  cargv[56],cargv[57],cargv[58],cargv[59],
1119  cargv[60],cargv[61],cargv[62],cargv[63],
1120  cargv[64],cargv[65],cargv[66],cargv[67],
1121  cargv[68],cargv[69],cargv[70],cargv[71],
1122  cargv[72],cargv[73],cargv[74],cargv[75],
1123  cargv[76],cargv[77],cargv[78],cargv[79]);
1124 #endif
1125  if (resulttype==K_INTEGER) return(mkbigint(i));
1126  else if (resulttype==K_STRING) {
1127  p=makepointer(i-2*sizeof(pointer));
1128  if (isvector(p)) return(p);
1129  else error(E_USER,(pointer)"illegal foreign string"); }
1130  else if (iscons(resulttype)) {
1131  /* (:string [10]) (:foreign-string [20]) */
1132  if (ccar(resulttype)=K_STRING) {
1133  resulttype=ccdr(resulttype);
1134  if (resulttype!=NIL) j=ckintval(ccar(resulttype));
1135  else j=strlen((char *)i);
1136  return(makestring((char *)i, j)); }
1137  else if (ccar(resulttype)=K_FOREIGN_STRING) {
1138  resulttype=ccdr(resulttype);
1139  if (resulttype!=NIL) j=ckintval(ccar(resulttype));
1140  else j=strlen((char *)i);
1141  return(make_foreign_string(i, j)); }
1142  error(E_USER,(pointer)"unknown result type"); }
1143  else error(E_USER,(pointer)"result type?");
1144  }}
1145 #endif /* x86_64 */
1146 #endif /* IRIX */
1147 #endif /* IRIX6 */
1148 
1149 pointer funcode(ctx,func,args,noarg)
1150 register context *ctx;
1151 register pointer func,args;
1152 register int noarg;
1153 { register pointer (*subr)();
1154  register pointer *argp=ctx->vsp;
1155  register int n=0;
1156  register eusinteger_t addr;
1157  pointer tmp;
1158  addr=(eusinteger_t)(func->c.code.entry);
1159 #if (WORD_SIZE == 64)
1160  addr &= ~3L; /*0xfffffffffffffffc; ???? */
1161 #else
1162  addr &= ~3; /*0xfffffffc; ???? */
1163 #endif
1164 #if ARM
1165  if (func->c.code.entry2 != NIL) {
1166 #if (WORD_SIZE == 64)
1167  addr = addr | (intval(func->c.code.entry2)&0x00000000ffffffff);
1168 #else
1169  addr = addr | (intval(func->c.code.entry2)&0x0000ffff);
1170 #endif
1171  }
1172 #endif
1173  subr=(pointer (*)())(addr);
1174 #ifdef FUNCODE_DEBUG
1175  printf( "funcode:func = " ); hoge_print( func );
1176  printf( "funcode:args = " ); hoge_print( args );
1177 #endif
1178  GC_POINT;
1179  switch((eusinteger_t)(func->c.code.subrtype)) { /*func,macro or special form*//* ???? */
1180  case (eusinteger_t)SUBR_FUNCTION:/* ???? */
1181  if (noarg<0) {
1182  while (piscons(args)) {
1183  vpush(eval(ctx,ccar(args))); args=ccdr(args); n++; GC_POINT;}
1184  if (pisfcode(func)) /*foreign function?*/
1185  return(call_foreign((eusinteger_t (*)())subr,func,n,argp));
1186  else return((*subr)(ctx,n,argp));}
1187  else if (pisfcode(func))
1188  return(call_foreign((eusinteger_t (*)())subr,func,noarg,(pointer *)args));
1189  else return((*subr)(ctx,noarg,args,0));
1190  break;
1191  case (eusinteger_t)SUBR_MACRO:/* ???? */
1192  if (noarg>=0) error(E_ILLFUNC);
1193  while (iscons(args)) { vpush(ccar(args)); args=ccdr(args); n++;}
1194  GC_POINT;
1195  tmp = (*subr)(ctx,n,argp);
1196  GC_POINT;
1197  return(eval(ctx,tmp));
1198  case (eusinteger_t)SUBR_SPECIAL: /* ???? */
1199  if (noarg>=0) error(E_ILLFUNC);
1200  else return((*subr)(ctx,args));
1201 /* case (int)SUBR_ENTRY:
1202  func=(*subr)(func);
1203  return(makeint(func)); */
1204  default: error(E_ILLFUNC); break;}
1205  }
1206 
1207 pointer clofunc;
1208 pointer ufuncall(ctx,form,fn,args,env,noarg)
1209 register context *ctx;
1210 pointer form,fn;
1211 register pointer args; /*or 'pointer *' */
1212 struct bindframe *env;
1213 int noarg;
1214 { pointer func,formal,aval,ftype,result,*argp,hook;
1215  register struct callframe *vf=(struct callframe *)(ctx->vsp);
1216  struct specialbindframe *sbfps=ctx->sbindfp;
1217  register int n=0,i;
1218  register pointer (*subr)();
1219  struct fletframe *oldfletfp=ctx->fletfp, *fenv;
1220  GC_POINT;
1221  /* evalhook */
1222  if (Spevalof(QEVALHOOK)!=NIL && ehbypass==0) {
1223  hook=Spevalof(QEVALHOOK);
1224  bindspecial(ctx,QEVALHOOK,NIL);
1225  if (noarg<0) vpush(cons(ctx,fn,args));
1226  else {
1227  argp=(pointer *)args;
1228  aval=NIL;
1229  i=noarg;
1230  while (--i>=0) aval=cons(ctx,argp[i],aval);
1231  vpush(cons(ctx,fn,aval));}
1232  vpush(env);
1233  GC_POINT;
1234  result=ufuncall(ctx,form,hook,(pointer)(ctx->vsp-2),env,2); /*apply evalhook function*/
1235  ctx->vsp=(pointer *)vf;
1236  unbindspecial(ctx,sbfps+1);
1237 #ifdef __RETURN_BARRIER
1238  check_return_barrier(ctx);
1239  /* check return barrier */
1240 #endif
1241  return(result);}
1242  else ehbypass=0;
1243 
1244  if (issymbol(fn)) {
1245  func=getfunc(ctx,fn);
1246  }
1247  else {
1248  if (islist(fn)) env=ctx->bindfp;
1249  func=fn;}
1250  if (!ispointer(func)) error(E_ILLFUNC);
1251 
1252  /*make a new stack frame*/
1253  stackck; /*stack overflow?*/
1254  breakck; /*signal exists?*/
1255  vf->vlink=ctx->callfp;
1256  vf->form=form;
1257  ctx->callfp=vf;
1258  ctx->vsp+=sizeof(struct callframe)/(sizeof(pointer));
1259  argp=ctx->vsp;
1260 
1261  if (pisclosure(func)) {
1262  clofunc=func;
1263  fn=func;
1264  if (fn->c.code.subrtype!=SUBR_FUNCTION) error(E_ILLFUNC);
1265 #if (WORD_SIZE == 64)
1266  subr=(pointer (*)())((eusinteger_t)(fn->c.code.entry) & ~3L /*0xfffffffc ????*/);
1267 #else
1268  subr=(pointer (*)())((eusinteger_t)(fn->c.code.entry) & ~3 /*0xfffffffc ????*/);
1269 #endif
1270 #if ARM
1271  register eusinteger_t addr;
1272  addr = (eusinteger_t)(fn->c.code.entry);
1273 #if (WORD_SIZE == 64)
1274  addr &= ~3L; /*0xfffffffc; ???? */
1275 #else
1276  addr &= ~3; /*0xfffffffc; ???? */
1277 #endif
1278  if (fn->c.code.entry2 != NIL) {
1279 #if (WORD_SIZE == 64)
1280  addr = addr | (intval(fn->c.code.entry2)&0x00000000ffffffff);
1281 #else
1282  addr = addr | (intval(fn->c.code.entry2)&0x0000ffff);
1283 #endif
1284  }
1285  subr=(pointer (*)())(addr);
1286 #endif
1287 #if !Solaris2 && !SunOS4_1 && !Linux && !IRIX && !IRIX6 && !alpha && !Cygwin
1288  if ((char *)subr>maxmemory) {
1289  prinx(ctx,clofunc, STDOUT);
1290  error(E_USER,(pointer)"garbage closure, fatal bug!"); }
1291 #endif
1292  if (noarg<0) {
1293  while (iscons(args)) {
1294  vpush(eval(ctx,ccar(args))); args=ccdr(args); n++; GC_POINT;}
1295  result=(*subr)(ctx,n,argp,func);} /*call func with env*/
1296  else result=(*subr)(ctx,noarg,args,func);
1297  /*recover call frame and stack pointer*/
1298  ctx->vsp=(pointer *)vf;
1299  ctx->callfp= vf->vlink;
1300  ctx->fletfp=oldfletfp;
1301 #ifdef __RETURN_BARRIER
1302  check_return_barrier(ctx);
1303  /* check return barrier */
1304 #endif
1305  return(result);}
1306 
1307  else if (piscode(func)) { /*call subr*/
1308  GC_POINT;
1309  result=funcode(ctx,func,args,noarg);
1310  ctx->vsp=(pointer *)vf;
1311  ctx->callfp= vf->vlink;
1312  ctx->fletfp=oldfletfp;
1313 #ifdef __RETURN_BARRIER
1314  check_return_barrier(ctx);
1315 #endif
1316  return(result);}
1317  else if (piscons(func)) {
1318  ftype=ccar(func);
1319  func=ccdr(func);
1320  if (!issymbol(ftype)) error(E_LAMBDA);
1321  if (ftype->c.sym.homepkg==keywordpkg) fn=ftype; /*blockname=selector*/
1322  else if (ftype==LAMCLOSURE) {
1323  fn=ccar(func); func=ccdr(func);
1324  env=(struct bindframe *)intval(ccar(func));
1325  if (env < (struct bindframe *)ctx->stack ||
1326  (struct bindframe *)ctx->stacklimit < env) env=0;
1327  func=ccdr(func);
1328  /* ctx->fletfp=(struct fletframe *)intval(ccar(func)); */
1329  fenv=(struct fletframe *)intval(ccar(func));
1330  func=ccdr(func);}
1331  else if (ftype!=LAMBDA && ftype!=MACRO) error(E_LAMBDA);
1332  else env=NULL /*0 ????*/;
1333  formal=carof(func,E_LAMBDA);
1334  func=ccdr(func);
1335  if (noarg<0) { /*spread args on stack*/
1336  noarg=0;
1337  while (iscons(args)) {
1338  aval=ccar(args);
1339  args=ccdr(args);
1340  if (ftype!=MACRO) {GC_POINT;aval=eval(ctx,aval);}
1341  vpush(aval); noarg++;}}
1342  else {
1343  argp=(pointer *)args;
1344  if (ftype==MACRO) error(E_ILLFUNC);}
1345  GC_POINT;
1346  if (ftype==LAMCLOSURE) { ctx->fletfp=fenv; }
1347  result=funlambda(ctx,fn,formal,func,argp,env,noarg);
1348  ctx->vsp=(pointer *)vf;
1349  ctx->callfp=vf->vlink;
1350  GC_POINT;
1351  if (ftype==MACRO) result=eval(ctx,result);
1352  ctx->fletfp=oldfletfp;
1353 #ifdef __RETURN_BARRIER
1354  check_return_barrier(ctx);
1355  /* check return barrier */
1356 #endif
1357  return(result);}
1358  else error(E_ILLFUNC);
1359  }
1360 
1361 pointer eval(ctx,form)
1362 register context *ctx;
1363 register pointer form;
1364 { register pointer c;
1365  register pointer p;
1366 #if defined(DEBUG_COUNT) || defined(EVAL_DEBUG)
1367  static int count=0;
1368  int save_count;
1369 
1370  count++;
1371  save_count = count;
1372 #endif
1373 #ifdef EVAL_DEBUG
1374  if( evaldebug ) {
1375  printf( "%d:", count );
1376  hoge_print(form);
1377  }
1378 #endif
1379  GC_POINT;
1380  if (isnum(form)) p = form;
1381  else if (pissymbol(form)) p = getval(ctx,form);
1382  else if (!piscons(form)) p = form;
1383  else {
1384  c=ccdr(form);
1385  if (c!=NIL && issymbol(c)) p = (*ovafptr(eval(ctx,ccar(form)),c));
1386  else {
1387  p = ufuncall(ctx,form,ccar(form),c,NULL,-1);
1388 #ifdef SAFETY
1389  take_care(p);
1390 #endif
1391  }
1392  }
1393 
1394 #ifdef EVAL_DEBUG
1395  if( evaldebug ) {
1396  printf( "%d:--- ", save_count );
1397  hoge_print(p);
1398  }
1399 #endif
1400  return(p);
1401  }
1402 
1403 pointer eval2(ctx,form,env)
1404 register context *ctx;
1405 register pointer form;
1406 pointer env;
1407 { register pointer c;
1408  GC_POINT;
1409  if (isnum(form)) return(form);
1410  else if (pissymbol(form)) return(getval(ctx,form));
1411  else if (!piscons(form)) return(form);
1412  else {
1413  c=ccdr(form);
1414  if (c!=NIL && issymbol(c)) return(*ovafptr(eval(ctx,ccar(form)),c));
1415  else return(ufuncall(ctx,form,ccar(form),(pointer)c,(struct bindframe *)env,-1));}
1416  }
1417 
1418 pointer progn(ctx,forms)
1419 register context *ctx;
1420 register pointer forms;
1421 { register pointer result=NIL;
1422  while (iscons(forms)) {
1423  GC_POINT;
1424  result=eval(ctx,ccar(forms)); forms=ccdr(forms);}
1425  return(result);}
1426 
1427 
1428 /* csend(ctx,object,selector,argc,arg1,arg2,....) */
1429 #ifdef USE_STDARG
1430 
1431 pointer csend(context *ctx, ...)
1432 {
1433  va_list ap;
1434 
1435  pointer rec,sel;
1436  int cnt;
1437  pointer res,*spsave;
1438  int i=0;
1439 
1440  va_start(ap, ctx);
1441 
1442  rec = va_arg(ap,pointer);
1443  sel = va_arg(ap,pointer);
1444  cnt = va_arg(ap,int);
1445  spsave=ctx->vsp;
1446  vpush(rec); vpush(sel);
1447  while (i++ < cnt) vpush(va_arg(ap,pointer));
1448  GC_POINT;
1449  res=(pointer)SEND(ctx,cnt+2, spsave);
1450  ctx->vsp=spsave;
1451  return(res);}
1452 
1453 #else
1454 pointer csend(va_alist)
1455 va_dcl
1456 { va_list ap;
1457  pointer rec,sel;
1458  int cnt;
1459  pointer res,*spsave;
1460  int i=0;
1461  register context *ctx;
1462 
1463  va_start(ap);
1464  ctx = va_arg(ap,context *);
1465  rec = va_arg(ap,pointer);
1466  sel = va_arg(ap,pointer);
1467  cnt = va_arg(ap,int);
1468  spsave=ctx->vsp;
1469  vpush(rec); vpush(sel);
1470  while (i++ < cnt) vpush(va_arg(ap,pointer));
1471  GC_POINT;
1472  res=(pointer)SEND(ctx,cnt+2, spsave);
1473  ctx->vsp=spsave;
1474 #ifdef SAFETY
1475  take_care(res);
1476 #endif
1477  return(res);}
1478 #endif
1479 
intvector::iv
eusinteger_t iv[1]
Definition: eus.h:303
prinx
pointer prinx(context *, pointer, pointer)
Definition: printer.c:611
d
d
ovafptr
pointer * ovafptr(pointer o, pointer v)
Definition: eval.c:120
symbol::speval
pointer speval
Definition: eus.h:201
fcode::resulttype
pointer resulttype
Definition: eus.h:245
f
f
E_NOOBJ
Definition: eus.h:971
intern
pointer intern(context *, char *, int, pointer)
Definition: intern.c:105
vectorcp
cixpair vectorcp
Definition: eus.c:88
cell::cellunion::vec
struct vector vec
Definition: eus.h:412
rcsid
static char * rcsid
Definition: eval.c:8
cell::cellunion::cls
struct _class cls
Definition: eus.h:416
makeblock
struct blockframe * makeblock(context *, pointer, pointer, jmp_buf *, struct blockframe *)
Definition: makes.c:766
makeint
#define makeint(v)
Definition: sfttest.c:2
pointer
struct cell * pointer
Definition: eus.h:163
setfunc
void setfunc(pointer sym, pointer func)
Definition: eval.c:116
context
Definition: eus.h:522
STDOUT
pointer STDOUT
Definition: eus.c:119
cons
pointer cons(context *, pointer, pointer)
Definition: makes.c:97
getval
pointer getval(context *ctx, pointer sym)
Definition: eval.c:33
cell::cellunion::str
struct string str
Definition: eus.h:400
_class::vars
pointer vars
Definition: eus.h:326
numunion::fval
eusfloat_t fval
Definition: eus.h:428
code::entry2
pointer entry2
Definition: eus.h:234
string::chars
byte chars[1]
Definition: eus.h:210
getobjv
pointer * getobjv(pointer sym, pointer varvec, pointer obj)
Definition: eval.c:22
context::vsp
pointer * vsp
Definition: eus.h:523
OPTIONAL
pointer OPTIONAL
Definition: eus.c:170
bindframe::val
pointer val
Definition: eus.h:480
maxmemory
char * maxmemory
Definition: memory.c:50
vbind
struct bindframe * vbind(context *ctx, pointer var, pointer val, struct bindframe *lex, struct bindframe *declscope)
Definition: eval.c:194
n
GLfloat n[6][3]
Definition: cube.c:15
body
static GLfloat body[][2]
Definition: dinoshade.c:75
K_ALLOWOTHERKEYS
pointer K_ALLOWOTHERKEYS
Definition: eus.c:169
cell::cellunion::fcode
struct fcode fcode
Definition: eus.h:407
cell::cellunion::code
struct code code
Definition: eus.h:406
intval
#define intval(p)
Definition: sfttest.c:1
declare
struct bindframe * declare(context *ctx, pointer decllist, struct bindframe *env)
Definition: eval.c:220
MACRO
pointer MACRO
Definition: eus.c:170
fargv
static float * fargv
Definition: transargv.c:57
call_foreign
pointer call_foreign(eusinteger_t(*ifunc)(), pointer code, int n, args)
Definition: eval.c:984
iargv
static int * iargv
Definition: transargv.c:58
E_LAMBDA
Definition: eus.h:946
fletframe::name
pointer name
Definition: eus.h:508
E_USER
Definition: eus.h:1002
K_STRING
pointer K_STRING
Definition: eus.c:131
REST
pointer REST
Definition: eus.c:170
code::entry
pointer entry
Definition: eus.h:232
blockframe::dynklink
struct blockframe * dynklink
Definition: eus.h:489
E_ILLFUNC
Definition: eus.h:939
LAMBDA
pointer LAMBDA
Definition: eus.c:170
cell::cellunion::sym
struct symbol sym
Definition: eus.h:399
ckfltval
float ckfltval()
K_FLOAT32
pointer K_FLOAT32
Definition: eus.c:133
ALLOWOTHERKEYS
pointer ALLOWOTHERKEYS
Definition: eus.c:169
specialbindframe::oldval
pointer oldval
Definition: eus.h:485
QDECLARE
pointer QDECLARE
Definition: eus.c:112
clofunc
pointer clofunc
Definition: eval.c:1207
cell::cellunion::ivec
struct intvector ivec
Definition: eus.h:414
parsekeyparams
int parsekeyparams(pointer keyvec, pointer *actuals, int noarg, pointer *results, int allowotherkeys)
Definition: eval.c:237
cell::c
union cell::cellunion c
object::iv
pointer iv[2]
Definition: eus.h:319
callframe
Definition: eus.h:472
bindframe
Definition: eus.h:477
bindspecial
void bindspecial(context *ctx, pointer sym, pointer newval)
Definition: eval.c:131
numunion
Definition: eus.h:426
bindframe::sym
pointer sym
Definition: eus.h:479
l
long l
Definition: structsize.c:3
symbol::homepkg
pointer homepkg
Definition: eus.h:201
bindkeyparams
struct bindframe * bindkeyparams(context *ctx, pointer formal, pointer *argp, int noarg, struct bindframe *env, struct bindframe *bf)
Definition: eval.c:270
eval2
pointer eval2(context *ctx, pointer form, pointer env)
Definition: eval.c:1403
E_DECLARE
Definition: eus.h:982
callframe::vlink
struct callframe * vlink
Definition: eus.h:473
cell
Definition: eus.h:379
setval
pointer setval(context *ctx, pointer sym, pointer val)
Definition: eval.c:68
K_FOREIGN_STRING
pointer K_FOREIGN_STRING
Definition: eus.c:133
unbindx
void unbindx(context *ctx, int count)
Definition: eval.c:150
callframe::form
pointer form
Definition: eus.h:474
QEVALHOOK
pointer QEVALHOOK
Definition: eus.c:121
QSPECIAL
pointer QSPECIAL
Definition: eus.c:112
bindframe::lexblink
struct bindframe * lexblink
Definition: eus.h:478
fletframe::fclosure
pointer fclosure
Definition: eus.h:509
s
short s
Definition: structsize.c:2
vector::size
pointer size
Definition: eus.h:298
progn
pointer progn(context *ctx, pointer forms)
Definition: eval.c:1418
specialbindframe::sym
pointer sym
Definition: eus.h:484
code::subrtype
pointer subrtype
Definition: eus.h:231
funlambda
pointer funlambda(context *ctx, pointer fn, pointer formal, pointer body, pointer *argp, struct bindframe *env, int noarg)
Definition: eval.c:346
AUX
pointer AUX
Definition: eus.c:170
cell::cix
short cix
Definition: eus.h:396
symbol::vtype
pointer vtype
Definition: eus.h:201
K_DOUBLE
pointer K_DOUBLE
Definition: eus.c:133
bindframe::dynblink
struct bindframe * dynblink
Definition: eus.h:478
fletframe::lexlink
struct fletframe * lexlink
Definition: eus.h:511
error
pointer error(enum errorcode ec,...) pointer error(va_alist) va_dcl
Definition: eus.c:297
KEY
pointer KEY
Definition: eus.c:170
eusinteger_t
long eusinteger_t
Definition: eus.h:19
code
Definition: eus.h:228
GC_POINT
#define GC_POINT
Definition: eus.h:170
unbindspecial
void unbindspecial(context *ctx, struct specialbindframe *limit)
Definition: eval.c:165
SEND
pointer SEND(context *, int, pointer *)
count
int count
Definition: thrtest.c:11
makestring
pointer makestring(char *, int)
Definition: makes.c:147
fcode::paramtypes
pointer paramtypes
Definition: eus.h:244
specialbindframe::sblink
struct specialbindframe * sblink
Definition: eus.h:483
E_UNDEF
Definition: eus.h:937
fastbind
struct bindframe * fastbind(context *ctx, pointer var, pointer val, struct bindframe *lex)
Definition: eval.c:180
NULL
#define NULL
Definition: transargv.c:8
ehbypass
int ehbypass
Definition: eus.c:160
cell::cellunion::obj
struct object obj
Definition: eus.h:415
symbol::pname
pointer pname
Definition: eus.h:201
K_FLOAT
pointer K_FLOAT
Definition: eus.c:133
csend
pointer csend(va_alist)
Definition: eval.c:1454
make_foreign_string
pointer make_foreign_string(eusinteger_t, int)
Definition: makes.c:157
funcode
pointer funcode(context *ctx, pointer func, pointer args, int noarg)
Definition: eval.c:1149
v
GLfloat v[8][3]
Definition: cube.c:21
LAMCLOSURE
pointer LAMCLOSURE
Definition: eus.c:170
K_INTEGER
pointer K_INTEGER
Definition: eus.c:132
symbol::spefunc
pointer spefunc
Definition: eus.h:201
E_UNBOUND
Definition: eus.h:936
cixpair::cix
short cix
Definition: eus.h:451
NIL
pointer NIL
Definition: eus.c:110
fletframe
Definition: eus.h:507
eval
pointer eval(context *ctx, pointer form)
Definition: eval.c:1361
fcode::entry2
pointer entry2
Definition: eus.h:243
vector::v
pointer v[1]
Definition: eus.h:299
ufuncall
pointer ufuncall(context *ctx, pointer form, pointer fn, pointer args, struct bindframe *env, int noarg)
Definition: eval.c:1208
getfunc
pointer getfunc(context *ctx, pointer f)
Definition: eval.c:97
keywordpkg
pointer keywordpkg
Definition: eus.c:109
get_sym_func
pointer get_sym_func(pointer s)
Definition: eval.c:109
makeflt
pointer makeflt()
numunion::ival
eusinteger_t ival
Definition: eus.h:429

euslisp
Author(s): Toshihiro Matsui
autogenerated on Fri Feb 21 2020 03:20:54