46 |
|
|
47 |
|
|
48 |
|
|
49 |
object c_apply_n(); |
/* object c_apply_n(long int (*fn)(), int n, object *x); */ |
50 |
|
|
51 |
object sSAbreak_pointsA; |
object sSAbreak_pointsA; |
52 |
object sSAbreak_stepA; |
object sSAbreak_stepA; |
54 |
|
|
55 |
#define SET_TO_APPLY(res,f,n,x) \ |
#define SET_TO_APPLY(res,f,n,x) \ |
56 |
switch(n) {\ |
switch(n) {\ |
57 |
case 0: res=(object)((long (*)())(f))(); break;\ |
case 0: res=(*f)(); break;\ |
58 |
case 1: res=(object)((long (*)())(f))(x[0]); break; \ |
case 1: res=(*f)(x[0]); break; \ |
59 |
case 2: res=(object)((long (*)())(f))(x[0],x[1]);break; \ |
case 2: res=(*f)(x[0],x[1]);break; \ |
60 |
case 3: res=(object)((long (*)())(f))(x[0],x[1],x[2]);break; \ |
case 3: res=(*f)(x[0],x[1],x[2]);break; \ |
61 |
case 4: res=(object)((long (*)())(f))(x[0],x[1],x[2],x[3]);break; \ |
case 4: res=(*f)(x[0],x[1],x[2],x[3]);break; \ |
62 |
case 5: res=(object)((long (*)())(f))(x[0],x[1],x[2],x[3],x[4]);break; \ |
case 5: res=(*f)(x[0],x[1],x[2],x[3],x[4]);break; \ |
63 |
case 6: res=(object)((long (*)())(f))(x[0],x[1],x[2],x[3],x[4],x[5]); break;\ |
case 6: res=(*f)(x[0],x[1],x[2],x[3],x[4],x[5]); break;\ |
64 |
case 7: res=(object)((long (*)())(f))(x[0],x[1],x[2],x[3],x[4],x[5], x[6]); break;\ |
case 7: res=(*f)(x[0],x[1],x[2],x[3],x[4],x[5], x[6]); break;\ |
65 |
case 8: res=(object)((long (*)())(f))(x[0],x[1],x[2],x[3],x[4],x[5], x[6],x[7]); break;\ |
case 8: res=(*f)(x[0],x[1],x[2],x[3],x[4],x[5], x[6],x[7]); break;\ |
66 |
case 9: res=(object)((long (*)())(f))(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8]);break;\ |
case 9: res=(*f)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8]);break;\ |
67 |
case 10: res=(object)((long (*)())(f))(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9]);break;\ |
case 10: res=(*f)(x[0],x[1],x[2],x[3],x[4],x[5],x[6],x[7],x[8],x[9]);break;\ |
68 |
default: res=c_apply_n(f,n,x); break;} |
default: res=c_apply_n(*f,n,x); break;} |
69 |
|
|
70 |
/* |
/* |
71 |
#undef SET_TO_APPLY |
#undef SET_TO_APPLY |
74 |
|
|
75 |
/* for t_sfun,t_gfun with args on vs stack */ |
/* for t_sfun,t_gfun with args on vs stack */ |
76 |
|
|
77 |
quick_call_sfun(fun) |
void |
78 |
object fun; |
quick_call_sfun(object fun) |
79 |
{ DEBUG_AVMA |
{ DEBUG_AVMA |
80 |
int i,n; |
int i,n; |
81 |
enum ftype restype; |
enum ftype restype; |
109 |
return;} |
return;} |
110 |
|
|
111 |
/* only for sfun not gfun !! Does not check number of args */ |
/* only for sfun not gfun !! Does not check number of args */ |
112 |
call_sfun_no_check(fun) |
void |
113 |
object fun; |
call_sfun_no_check(object fun) |
114 |
{ DEBUG_AVMA |
{ DEBUG_AVMA |
115 |
int n; |
int n; |
116 |
object *base=vs_base; |
object *base=vs_base; |
120 |
CHECK_AVMA; |
CHECK_AVMA; |
121 |
return; |
return; |
122 |
} |
} |
123 |
call_vfun(fun) |
void |
124 |
object fun; |
call_vfun(object fun) |
125 |
{ DEBUG_AVMA |
{ DEBUG_AVMA |
126 |
int n; |
int n; |
127 |
object *base=vs_base; |
object *base=vs_base; |
138 |
} |
} |
139 |
|
|
140 |
|
|
141 |
|
void |
142 |
funcall(fun) |
funcall(object fun) |
|
object fun; |
|
143 |
{ |
{ |
144 |
object temporary; |
object temporary; |
145 |
object endp_temp; |
object endp_temp; |
325 |
CHECK_AVMA; |
CHECK_AVMA; |
326 |
}} |
}} |
327 |
|
|
328 |
|
void |
329 |
funcall_no_event(fun) |
funcall_no_event(object fun) |
|
object fun; |
|
330 |
{ |
{ |
331 |
object endp_temp; |
object endp_temp; |
332 |
DEBUG_AVMA |
DEBUG_AVMA |
369 |
} |
} |
370 |
} |
} |
371 |
|
|
372 |
lispcall(funp, narg) |
void |
373 |
object *funp; |
lispcall(object *funp, int narg) |
|
int narg; |
|
374 |
{ |
{ |
375 |
object endp_temp; DEBUG_AVMA |
object endp_temp; DEBUG_AVMA |
376 |
object fun = *funp; |
object fun = *funp; |
411 |
CHECK_AVMA; |
CHECK_AVMA; |
412 |
} |
} |
413 |
|
|
414 |
lispcall_no_event(funp, narg) |
void |
415 |
object *funp; |
lispcall_no_event(object *funp, int narg) |
|
int narg; |
|
416 |
{ object endp_temp; DEBUG_AVMA |
{ object endp_temp; DEBUG_AVMA |
417 |
object fun = *funp; |
object fun = *funp; |
418 |
|
|
453 |
CHECK_AVMA; |
CHECK_AVMA; |
454 |
} |
} |
455 |
|
|
456 |
symlispcall(sym, base, narg) |
void |
457 |
object sym, *base; |
symlispcall(object sym, object *base, int narg) |
|
int narg; |
|
458 |
{ |
{ |
459 |
object endp_temp; |
object endp_temp; |
460 |
DEBUG_AVMA |
DEBUG_AVMA |
495 |
CHECK_AVMA; |
CHECK_AVMA; |
496 |
} |
} |
497 |
|
|
498 |
symlispcall_no_event(sym, base, narg) |
void |
499 |
object sym, *base; |
symlispcall_no_event(object sym, object *base, int narg) |
|
int narg; |
|
500 |
{ |
{ |
501 |
object endp_temp; |
object endp_temp; |
502 |
DEBUG_AVMA |
DEBUG_AVMA |
539 |
} |
} |
540 |
|
|
541 |
object |
object |
542 |
simple_lispcall(funp, narg) |
simple_lispcall(object *funp, int narg) |
|
object *funp; |
|
|
int narg; |
|
543 |
{ |
{ |
544 |
object endp_temp; |
object endp_temp; |
545 |
DEBUG_AVMA |
DEBUG_AVMA |
585 |
} |
} |
586 |
|
|
587 |
object |
object |
588 |
simple_lispcall_no_event(funp, narg) |
simple_lispcall_no_event(object *funp, int narg) |
|
object *funp; |
|
|
int narg; |
|
589 |
{ |
{ |
590 |
object endp_temp; |
object endp_temp; |
591 |
DEBUG_AVMA |
DEBUG_AVMA |
631 |
} |
} |
632 |
|
|
633 |
object |
object |
634 |
simple_symlispcall(sym, base, narg) |
simple_symlispcall(object sym, object *base, int narg) |
|
object sym, *base; |
|
|
int narg; |
|
635 |
{ |
{ |
636 |
object endp_temp; |
object endp_temp; |
637 |
DEBUG_AVMA |
DEBUG_AVMA |
677 |
} |
} |
678 |
|
|
679 |
object |
object |
680 |
simple_symlispcall_no_event(sym, base, narg) |
simple_symlispcall_no_event(object sym, object *base, int narg) |
|
object sym, *base; |
|
|
int narg; |
|
681 |
{ |
{ |
682 |
object endp_temp; |
object endp_temp; |
683 |
DEBUG_AVMA |
DEBUG_AVMA |
721 |
return(vs_base[0]); |
return(vs_base[0]); |
722 |
} |
} |
723 |
|
|
724 |
super_funcall(fun) |
void |
725 |
object fun; |
super_funcall(object fun) |
726 |
{ |
{ |
727 |
if (type_of(fun) == t_symbol) { |
if (type_of(fun) == t_symbol) { |
728 |
if (fun->s.s_sfdef != NOT_SPECIAL || fun->s.s_mflag) |
if (fun->s.s_sfdef != NOT_SPECIAL || fun->s.s_mflag) |
734 |
funcall(fun); |
funcall(fun); |
735 |
} |
} |
736 |
|
|
737 |
super_funcall_no_event(fun) |
void |
738 |
object fun; |
super_funcall_no_event(object fun) |
739 |
{ |
{ |
740 |
#ifdef DEBUGGING_AVMA |
#ifdef DEBUGGING_AVMA |
741 |
funcall_no_event(fun); return; |
funcall_no_event(fun); return; |
794 |
|
|
795 |
if (type_of(form) != t_symbol) RETURN1(form); |
if (type_of(form) != t_symbol) RETURN1(form); |
796 |
|
|
|
SYMBOL: |
|
797 |
switch (form->s.s_stype) { |
switch (form->s.s_stype) { |
798 |
case stp_constant: |
case stp_constant: |
799 |
RETURN1((form->s.s_dbind)); |
RETURN1((form->s.s_dbind)); |
861 |
goto EVAL_ARGS; |
goto EVAL_ARGS; |
862 |
} |
} |
863 |
|
|
|
GFDEF: |
|
864 |
if ((x = fun->s.s_gfdef) == OBJNULL) |
if ((x = fun->s.s_gfdef) == OBJNULL) |
865 |
FEundefined_function(fun); |
FEundefined_function(fun); |
866 |
|
|
916 |
#else |
#else |
917 |
|
|
918 |
object |
object |
919 |
Ieval(form) |
Ieval(object form) |
|
object form; |
|
920 |
{ eval(form); |
{ eval(form); |
921 |
return Ivs_values(); |
return Ivs_values(); |
922 |
} |
} |
923 |
#endif |
#endif |
924 |
|
|
925 |
|
void |
926 |
eval(form) |
eval(object form) |
|
object form; |
|
927 |
{ |
{ |
928 |
object temporary; |
object temporary; |
929 |
object endp_temp; |
object endp_temp; |
931 |
object fun, x; |
object fun, x; |
932 |
object *top; |
object *top; |
933 |
object *base; |
object *base; |
|
object orig_form; |
|
934 |
|
|
935 |
cs_check(form); |
cs_check(form); |
936 |
|
|
969 |
return; |
return; |
970 |
} |
} |
971 |
|
|
|
SYMBOL: |
|
972 |
switch (form->s.s_stype) { |
switch (form->s.s_stype) { |
973 |
case stp_constant: |
case stp_constant: |
974 |
vs_base = vs_top; |
vs_base = vs_top; |
1044 |
goto EVAL_ARGS; |
goto EVAL_ARGS; |
1045 |
} |
} |
1046 |
|
|
|
GFDEF: |
|
1047 |
if ((x = fun->s.s_gfdef) == OBJNULL) |
if ((x = fun->s.s_gfdef) == OBJNULL) |
1048 |
FEundefined_function(fun); |
FEundefined_function(fun); |
1049 |
|
|
1099 |
FEinvalid_function(fun); |
FEinvalid_function(fun); |
1100 |
} |
} |
1101 |
|
|
1102 |
call_applyhook(fun) |
void |
1103 |
object fun; |
call_applyhook(object fun) |
1104 |
{ |
{ |
1105 |
object ah; |
object ah; |
1106 |
object *v; |
object *v; |
1143 |
object fun; |
object fun; |
1144 |
va_dcl |
va_dcl |
1145 |
{ int m,n=VFUN_NARGS; |
{ int m,n=VFUN_NARGS; |
|
object *new; |
|
1146 |
object list; |
object list; |
1147 |
object buf[MAX_ARGS]; |
object buf[MAX_ARGS]; |
1148 |
object *base=buf; |
object *base=buf; |
1177 |
return Ivs_values(); |
return Ivs_values(); |
1178 |
} |
} |
1179 |
|
|
1180 |
Levalhook() |
void |
1181 |
|
Levalhook(void) |
1182 |
{ |
{ |
1183 |
object env; |
object env; |
1184 |
bds_ptr old_bds_top = bds_top; |
bds_ptr old_bds_top = bds_top; |
1208 |
bds_unwind(old_bds_top); |
bds_unwind(old_bds_top); |
1209 |
} |
} |
1210 |
|
|
1211 |
Lapplyhook() |
void |
1212 |
|
Lapplyhook(void) |
1213 |
{ |
{ |
1214 |
object endp_temp; |
object endp_temp; |
1215 |
|
|
1269 |
} |
} |
1270 |
|
|
1271 |
object |
object |
1272 |
ieval(x) |
ieval(object x) |
|
object x; |
|
1273 |
{ |
{ |
1274 |
object *old_vs_base; |
object *old_vs_base; |
1275 |
object *old_vs_top; |
object *old_vs_top; |
1284 |
} |
} |
1285 |
|
|
1286 |
object |
object |
1287 |
ifuncall1(fun, arg1) |
ifuncall1(object fun, object arg1) |
|
object fun, arg1; |
|
1288 |
{ |
{ |
1289 |
object *old_vs_base; |
object *old_vs_base; |
1290 |
object *old_vs_top; |
object *old_vs_top; |
1302 |
} |
} |
1303 |
|
|
1304 |
object |
object |
1305 |
ifuncall2(fun, arg1, arg2) |
ifuncall2(object fun, object arg1, object arg2) |
|
object fun, arg1, arg2; |
|
1306 |
{ |
{ |
1307 |
object *old_vs_base; |
object *old_vs_base; |
1308 |
object *old_vs_top; |
object *old_vs_top; |
1321 |
} |
} |
1322 |
|
|
1323 |
object |
object |
1324 |
ifuncall3(fun, arg1, arg2, arg3) |
ifuncall3(object fun, object arg1, object arg2, object arg3) |
|
object fun, arg1, arg2, arg3; |
|
1325 |
{ |
{ |
1326 |
object *old_vs_base; |
object *old_vs_base; |
1327 |
object *old_vs_top; |
object *old_vs_top; |
1340 |
return(x); |
return(x); |
1341 |
} |
} |
1342 |
|
|
1343 |
funcall_with_catcher(fname, fun) |
void |
1344 |
object fname, fun; |
funcall_with_catcher(object fname, object fun) |
1345 |
{ |
{ |
1346 |
int n = vs_top - vs_base; |
int n = vs_top - vs_base; |
1347 |
if (n > 64) n = 64; |
if (n > 64) n = 64; |
1356 |
#include <varargs.h> |
#include <varargs.h> |
1357 |
|
|
1358 |
object |
object |
1359 |
fcalln_cclosure(ap) |
fcalln_cclosure(va_list ap) |
|
va_list ap; |
|
1360 |
{ |
{ |
1361 |
object endp_temp; |
object endp_temp; |
1362 |
int i=fcall.argd; |
int i=fcall.argd; |
1402 |
}} |
}} |
1403 |
|
|
1404 |
object |
object |
1405 |
fcalln_general(ap) |
fcalln_general(va_list ap) { |
1406 |
va_list ap; |
int i=fcall.argd; |
1407 |
{int i=fcall.argd; |
|
1408 |
object fun=fcall.fun; |
{ |
1409 |
{int n= SFUN_NARGS(i); |
int n= SFUN_NARGS(i); |
1410 |
/* object *old_vs_base=vs_base; */ |
/* object *old_vs_base=vs_base; */ |
1411 |
object *old_vs_top=vs_top; |
object *old_vs_top=vs_top; |
1412 |
object x; |
object x; |
1413 |
enum ftype typ,restype=SFUN_RETURN_TYPE(i); |
enum ftype typ,restype=SFUN_RETURN_TYPE(i); |
1414 |
vs_top = vs_base = old_vs_top; |
vs_top = vs_base = old_vs_top; |
1415 |
SFUN_START_ARG_TYPES(i); |
SFUN_START_ARG_TYPES(i); |
1416 |
if (i==0) |
if (i==0) |
1417 |
while (n-- > 0) |
while (n-- > 0) { |
1418 |
{ typ= SFUN_NEXT_TYPE(i); |
typ= SFUN_NEXT_TYPE(i); |
1419 |
x = |
x = |
1420 |
(typ==f_object ? va_arg(ap,object): |
(typ==f_object ? va_arg(ap,object): |
1421 |
typ==f_fixnum ? make_fixnum(va_arg(ap,fixnum)): |
typ==f_fixnum ? make_fixnum(va_arg(ap,fixnum)): |
1422 |
(object) (FEerror("bad type",0),Cnil)); |
(object) (FEerror("bad type",0),Cnil)); |
1423 |
*(vs_top++) = x;} |
*(vs_top++) = x; |
1424 |
else |
} |
1425 |
{object *base=vs_top; |
else { |
1426 |
while (n-- > 0) |
object *base=vs_top; |
1427 |
{ *(base++) = va_arg(ap,object);} |
while (n-- > 0) |
1428 |
vs_top=base;} |
*(base++) = va_arg(ap,object); |
1429 |
funcall(fcall.fun); |
vs_top=base; |
1430 |
x= vs_base[0]; |
} |
1431 |
vs_top=old_vs_top; |
funcall(fcall.fun); |
1432 |
/* vs_base=old_vs_base; */ |
x= vs_base[0]; |
1433 |
return (restype== f_object ? x : |
vs_top=old_vs_top; |
1434 |
restype== f_fixnum ? (object) (fix(x)): |
/* vs_base=old_vs_base; */ |
1435 |
(object) (FEerror("bad type",0),Cnil)); |
return (restype== f_object ? x : |
1436 |
}} |
restype== f_fixnum ? (object) (fix(x)): |
1437 |
|
(object) (FEerror("bad type",0),Cnil)); |
1438 |
|
} |
1439 |
|
} |
1440 |
|
|
1441 |
object |
object |
1442 |
fcalln_vfun(vl) |
fcalln_vfun(va_list vl) |
|
va_list vl; |
|
1443 |
{object *new,res; |
{object *new,res; |
1444 |
DEBUG_AVMA |
DEBUG_AVMA |
1445 |
{COERCE_VA_LIST(new,vl,fcall.argd); |
{COERCE_VA_LIST(new,vl,fcall.argd); |
1450 |
} |
} |
1451 |
|
|
1452 |
object |
object |
1453 |
fcalln(va_alist) |
fcalln(__builtin_va_alist_t __builtin_va_alist) |
|
va_dcl |
|
1454 |
{ va_list ap; |
{ va_list ap; |
1455 |
object fun=fcall.fun; |
object fun=fcall.fun; |
1456 |
DEBUG_AVMA |
DEBUG_AVMA |
1489 |
} |
} |
1490 |
|
|
1491 |
/* call a cfun eg funcall_cfun(Lmake_hash_table,2,sKtest,sLeq) */ |
/* call a cfun eg funcall_cfun(Lmake_hash_table,2,sKtest,sLeq) */ |
1492 |
typedef void (*funcvoid)(); |
/* typedef void (*funcvoid)(); */ |
1493 |
|
|
1494 |
object |
object |
1495 |
funcall_cfun(fn,n,va_alist) |
funcall_cfun(funcvoid fn, int n, __builtin_va_alist_t __builtin_va_alist) |
|
int n; |
|
|
funcvoid fn; |
|
|
va_dcl |
|
1496 |
{object *old_top = vs_top; |
{object *old_top = vs_top; |
1497 |
object *old_base= vs_base; |
object *old_base= vs_base; |
1498 |
object result; |
object result; |
1514 |
DEFVAR("*BREAK-POINTS*",sSAbreak_pointsA,SI,Cnil,""); |
DEFVAR("*BREAK-POINTS*",sSAbreak_pointsA,SI,Cnil,""); |
1515 |
DEFVAR("*BREAK-STEP*",sSAbreak_stepA,SI,Cnil,""); |
DEFVAR("*BREAK-STEP*",sSAbreak_stepA,SI,Cnil,""); |
1516 |
|
|
1517 |
|
void |
1518 |
init_eval() |
init_eval(void) |
1519 |
{ |
{ |
1520 |
|
|
1521 |
|
|