31 |
} |
} |
32 |
|
|
33 |
object |
object |
34 |
ImakeClosure(addr,argd,n,va_alist) |
ImakeClosure(object (*addr)(),int argd,int n,...) |
|
object (*addr)(); |
|
|
int argd; |
|
|
int n; |
|
|
va_dcl |
|
35 |
{ object x = fSmakefun(Cnil,addr,argd); |
{ object x = fSmakefun(Cnil,addr,argd); |
36 |
va_list ap; |
va_list ap; |
37 |
va_start(ap); |
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; |
60 |
} |
} |
61 |
} |
} |
62 |
|
|
63 |
DEFUN("INITFUN",object,fSinitfun,SI,3,ARG_LIMIT,NONE,OO,OO,OO,OO, |
DEFUN_NEW("INITFUN",object,fSinitfun,SI,3,ARG_LIMIT,NONE,OO,OO,OO,OO, |
64 |
|
(object sym,object addr_ind,object argd,...), |
65 |
"Store a compiled function on SYMBOL whose body is in the VV array at \ |
"Store a compiled function on SYMBOL whose body is in the VV array at \ |
66 |
INDEX, and whose argd descriptor is ARGD. If more arguments IND1, IND2,.. \ |
INDEX, and whose argd descriptor is ARGD. If more arguments IND1, IND2,.. \ |
67 |
are supplied these are indices in the VV array for the environment of this \ |
are supplied these are indices in the VV array for the environment of this \ |
68 |
closure.") |
closure.") |
|
(sym,addr_ind,argd,va_alist) |
|
|
object sym,addr_ind,argd; va_dcl |
|
69 |
{ int nargs = F_NARGS(VFUN_NARGS) -3; |
{ int nargs = F_NARGS(VFUN_NARGS) -3; |
70 |
va_list ap; |
va_list ap; |
71 |
object fun = fSmakefun(IisSymbol(sym),PADDR(addr_ind),Mfix(argd)); |
object fun = fSmakefun(IisSymbol(sym),PADDR(addr_ind),Mfix(argd)); |
72 |
if (nargs > 0) |
if (nargs > 0) |
73 |
{ va_start(ap); |
{ va_start(ap,argd); |
74 |
IsetClosure(fun,nargs,ap); |
IsetClosure(fun,nargs,ap); |
75 |
while (--nargs >= 0) |
while (--nargs >= 0) |
76 |
/* the things put in by IsetClosure were only the indices |
/* the things put in by IsetClosure were only the indices |
82 |
return sym; |
return sym; |
83 |
} |
} |
84 |
|
|
85 |
DEFUN("INITMACRO",object,fSinitmacro,SI,3,ARG_LIMIT,NONE,OO,OO,OO,OO, |
DEFUN_NEW("INITMACRO",object,fSinitmacro,SI,4,ARG_LIMIT,NONE,OO,OO,OO,OO,(object first,...), |
86 |
"Like INITFUN, but makes then sets the 'macro' flag on this symbol") |
"Like INITFUN, but makes then sets the 'macro' flag on this symbol") |
|
(va_alist) |
|
|
va_dcl |
|
87 |
{va_list ap; |
{va_list ap; |
88 |
object res; |
object res; |
89 |
va_start(ap); |
va_start(ap,first); |
90 |
res = Iapply_ap(fSinitfun,ap); |
res = Iapply_ap_new((object (*)())fSinitfun,first,ap); |
91 |
va_end(ap); |
va_end(ap); |
92 |
res->s.s_mflag = 1; |
res->s.s_mflag = 1; |
93 |
return res; |
return res; |
94 |
} |
} |
95 |
|
|
96 |
DEFUN("SET-KEY-STRUCT",object,fSset_key_struct,SI,1,1,NONE,OO,OO,OO,OO, |
DEFUN_NEW("SET-KEY-STRUCT",object,fSset_key_struct,SI,1,1,NONE,OO,OO,OO,OO,(object key_struct_ind), |
97 |
"Called inside the loader. The keystruct is set up in the file with \ |
"Called inside the loader. The keystruct is set up in the file with \ |
98 |
indexes rather than the actual entries. We change these indices to \ |
indexes rather than the actual entries. We change these indices to \ |
99 |
the objects") |
the objects") |
|
(key_struct_ind) |
|
|
object key_struct_ind; |
|
|
|
|
100 |
{ set_key_struct(PADDR(key_struct_ind),sSPmemory->s.s_dbind); |
{ set_key_struct(PADDR(key_struct_ind),sSPmemory->s.s_dbind); |
101 |
return Cnil; |
return Cnil; |
102 |
} |
} |
116 |
|
|
117 |
|
|
118 |
object |
object |
119 |
MakeClosure(n,argd,data,fn,va_alist) |
MakeClosure(int n,int argd,object data,object (*fn)(),...) |
|
int n; |
|
|
int argd; |
|
|
object data; |
|
|
object (*fn)(); |
|
|
va_dcl |
|
120 |
{ object x; |
{ object x; |
121 |
va_list ap; |
va_list ap; |
122 |
x = alloc_object(t_closure); |
x = alloc_object(t_closure); |
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); |
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);} |
136 |
return x; |
return x; |
137 |
} |
} |
138 |
|
|
139 |
DEFUN("INVOKE",object,fSinvoke,SI,1,ARG_LIMIT,NONE,OO,OO,OO,OO, |
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") |
|
(x) |
|
|
object x; |
|
141 |
{ int (*fn)(); |
{ int (*fn)(); |
142 |
fn = (void *) PADDR(x); |
fn = (void *) PADDR(x); |
143 |
(*fn)(); |
(*fn)(); |