57 |
} bill; |
} bill; |
58 |
|
|
59 |
|
|
60 |
static object coerce_df(x) |
/* static object coerce_df(object x) */ |
61 |
object x; |
/* {if (type_of(x)==t_longfloat) return x; */ |
62 |
{if (type_of(x)==t_longfloat) return x; |
/* if (type_of(x)==t_shortfloat) return make_longfloat(Msf(x)); */ |
63 |
if (type_of(x)==t_shortfloat) return make_longfloat(Msf(x)); |
/* FEerror("Not of float type ~a" ,1,x); */ |
64 |
FEerror("Not of float type ~a" ,1,x); |
/* return Cnil; */ |
65 |
return Cnil; |
/* } */ |
|
} |
|
66 |
|
|
67 |
|
|
68 |
|
|
69 |
object |
object |
70 |
Icall_proc(fun_name,link_desk,link_loc,ap) |
Icall_proc(object fun_name, int link_desk, object (**link_loc) (/* ??? */), va_list ap) |
|
object fun_name; |
|
|
int link_desk; |
|
|
object (**link_loc)(); |
|
|
va_list ap; |
|
71 |
{ object fun,res; |
{ object fun,res; |
72 |
object (*fn)(); |
object (*fn)(); |
73 |
int nargs; |
int nargs; |
93 |
&& F_MAX_ARGS(fargd) >= F_MIN_ARGS(link_desk) |
&& F_MAX_ARGS(fargd) >= F_MIN_ARGS(link_desk) |
94 |
&& F_TYPES(fargd) == F_TYPES(link_desk)) |
&& F_TYPES(fargd) == F_TYPES(link_desk)) |
95 |
{ /* do the link */ |
{ /* do the link */ |
96 |
(void) vpush_extend((long) link_loc,sLAlink_arrayA->s.s_dbind); |
(void) vpush_extend(link_loc,sLAlink_arrayA->s.s_dbind); |
97 |
(void) vpush_extend((long) *link_loc,sLAlink_arrayA->s.s_dbind); |
(void) vpush_extend(*link_loc,sLAlink_arrayA->s.s_dbind); |
98 |
*link_loc = fn;} |
*link_loc = fn;} |
99 |
/* make this call */ |
/* make this call */ |
100 |
|
|
|
call_nopush: |
|
101 |
/* figure out the true number of args passed */ |
/* figure out the true number of args passed */ |
102 |
nargs = (F_ARG_FLAGS_P(link_desk,F_requires_nargs) ? |
nargs = (F_ARG_FLAGS_P(link_desk,F_requires_nargs) ? |
103 |
F_NARGS(VFUN_NARGS) : F_NARGS(link_desk)); |
F_NARGS(VFUN_NARGS) : F_NARGS(link_desk)); |
166 |
*/ |
*/ |
167 |
|
|
168 |
float |
float |
169 |
Icall_proc_float(fun_name,link_desk,link_loc,ap) |
Icall_proc_float(object fun_name, int link_desk, object (**link_loc) (/* ??? */), va_list ap) |
|
object fun_name; |
|
|
int link_desk; |
|
|
object (**link_loc)(); |
|
|
va_list ap; |
|
170 |
{ object val; |
{ object val; |
171 |
val = Icall_proc(fun_name,link_desk,link_loc,ap); |
val = Icall_proc(fun_name,link_desk,link_loc,ap); |
172 |
{ union { void *p; |
{ union { void *p; |
176 |
} |
} |
177 |
|
|
178 |
object |
object |
179 |
IapplyVector(fun,nargs,base) |
IapplyVector(object fun, int nargs, object *base) |
180 |
object fun,*base; |
|
181 |
int nargs; |
|
182 |
/* Call FUN a lisp objectect on NARGS which are loaded into an array |
/* Call FUN a lisp objectect on NARGS which are loaded into an array |
183 |
starting at BASE. This pushes on the CallHist, and puts the args onto |
starting at BASE. This pushes on the CallHist, and puts the args onto |
184 |
the arg stack, so that debuggers may examine them. It sets |
the arg stack, so that debuggers may examine them. It sets |
255 |
} |
} |
256 |
|
|
257 |
*/ |
*/ |
258 |
Iinvoke_c_function_from_value_stack(f,fargd) |
void |
259 |
object (*f)(); |
Iinvoke_c_function_from_value_stack(object (*f)(), int fargd) |
260 |
int fargd; |
{ |
|
{ int restype = F_RESULT_TYPE(fargd); |
|
261 |
int atypes = F_TYPES(fargd)>> F_TYPE_WIDTH; |
int atypes = F_TYPES(fargd)>> F_TYPE_WIDTH; |
262 |
object *base = vs_base; |
object *base = vs_base; |
263 |
int i; |
int i; |
306 |
|
|
307 |
#define TYPE_STRING(i) (i == F_object ? "object" : i == F_int ? "int" : i == F_double_ptr ? "double ptr" : "unknown") |
#define TYPE_STRING(i) (i == F_object ? "object" : i == F_int ? "int" : i == F_double_ptr ? "double ptr" : "unknown") |
308 |
|
|
309 |
print_fargd(fargd) |
int |
310 |
int fargd; |
print_fargd(int fargd) |
311 |
{ int m,i,ftyp; |
{ int i; |
312 |
int nargs = 7; |
int nargs = 7; |
313 |
unsigned int ftypes = (F_TYPES(fargd) >> F_TYPE_WIDTH); |
unsigned int ftypes = (F_TYPES(fargd) >> F_TYPE_WIDTH); |
314 |
int fret_type = F_TYPES(fargd) & MASK_RANGE(0,F_TYPE_WIDTH); |
|
315 |
printf("minargs=%d,maxargs=%d, arg_types=(",F_MIN_ARGS(fargd), |
printf("minargs=%d,maxargs=%d, arg_types=(",F_MIN_ARGS(fargd), |
316 |
F_MAX_ARGS(fargd)); |
F_MAX_ARGS(fargd)); |
317 |
for (i = 0; i < F_MAX_ARGS(fargd) ; i++, ftypes >>= F_TYPE_WIDTH) |
for (i = 0; i < F_MAX_ARGS(fargd) ; i++, ftypes >>= F_TYPE_WIDTH) |