20 |
} |
} |
21 |
|
|
22 |
|
|
23 |
object |
static object |
24 |
fSmakefun(object sym, object (*addr) (/* ??? */), unsigned int argd) |
fSmakefun(object sym, object (*addr) (/* ??? */), unsigned int argd) |
25 |
{object ans = MakeAfun(addr,argd, |
{object ans = MakeAfun(addr,argd, |
26 |
(sSPmemory && sSPmemory->s.s_dbind && |
(sSPmemory && sSPmemory->s.s_dbind && |
30 |
return ans; |
return ans; |
31 |
} |
} |
32 |
|
|
33 |
object |
/* static object */ |
34 |
ImakeClosure(object (*addr)(),int argd,int n,...) |
/* ImakeClosure(object (*addr)(),int argd,int n,...) */ |
35 |
{ object x = fSmakefun(Cnil,addr,argd); |
/* { object x = fSmakefun(Cnil,addr,argd); */ |
36 |
va_list ap; |
/* va_list ap; */ |
37 |
va_start(ap,n); |
/* va_start(ap,n); */ |
38 |
IsetClosure(x,n,ap); |
/* IsetClosure(x,n,ap); */ |
39 |
va_end(ap); |
/* va_end(ap); */ |
40 |
return x; |
/* return x; */ |
41 |
} |
/* } */ |
42 |
|
|
43 |
void |
static void |
44 |
IsetClosure(object x, int n, va_list ap) |
IsetClosure(object x, int n, va_list ap) |
45 |
{ /* this will change so that we can allocate 'hunks' which will be little |
{ /* this will change so that we can allocate 'hunks' which will be little |
46 |
blocks the size of an array header say with only one header word. This |
blocks the size of an array header say with only one header word. This |
115 |
} |
} |
116 |
|
|
117 |
|
|
118 |
object |
/* static object */ |
119 |
MakeClosure(int n,int argd,object data,object (*fn)(),...) |
/* MakeClosure(int n,int argd,object data,object (*fn)(),...) */ |
120 |
{ object x; |
/* { object x; */ |
121 |
va_list ap; |
/* va_list ap; */ |
122 |
x = alloc_object(t_closure); |
/* x = alloc_object(t_closure); */ |
123 |
x->cl.cl_name = Cnil; |
/* x->cl.cl_name = Cnil; */ |
124 |
x->cl.cl_self = fn; |
/* x->cl.cl_self = fn; */ |
125 |
x->cl.cl_data = data; |
/* x->cl.cl_data = data; */ |
126 |
x->cl.cl_argd = argd; |
/* x->cl.cl_argd = argd; */ |
127 |
x->cl.cl_env = 0; |
/* x->cl.cl_env = 0; */ |
128 |
x->cl.cl_env = (object *)alloc_contblock(n*sizeof(object)); |
/* x->cl.cl_env = (object *)alloc_contblock(n*sizeof(object)); */ |
129 |
x->cl.cl_envdim=n; |
/* x->cl.cl_envdim=n; */ |
130 |
va_start(ap,fn); |
/* va_start(ap,fn); */ |
131 |
{ object *p = x->cl.cl_env; |
/* { object *p = x->cl.cl_env; */ |
132 |
while (--n>= 0) |
/* while (--n>= 0) */ |
133 |
{ *p++ = va_arg(ap,object);} |
/* { *p++ = va_arg(ap,object);} */ |
134 |
va_end(ap); |
/* va_end(ap); */ |
135 |
} |
/* } */ |
136 |
return x; |
/* return x; */ |
137 |
} |
/* } */ |
138 |
|
|
139 |
DEFUN_NEW("INVOKE",object,fSinvoke,SI,1,ARG_LIMIT,NONE,OO,OO,OO,OO,(object x), |
DEFUN_NEW("INVOKE",object,fSinvoke,SI,1,ARG_LIMIT,NONE,OO,OO,OO,OO,(object x), |
140 |
"Invoke a C function whose body is at INDEX in the VV array") |
"Invoke a C function whose body is at INDEX in the VV array") |