1 |
#include "include.h" |
#include "include.h" |
2 |
#include "funlink.h" |
#include "funlink.h" |
3 |
|
|
4 |
#define PADDR(i) ((char *)(sSPinit->s.s_dbind->fixa.fixa_self[Mfix(i)])) |
#define PADDR(i) ((void *)(sSPinit->s.s_dbind->fixa.fixa_self[Mfix(i)])) |
5 |
/* eg: |
/* eg: |
6 |
MakeAfun(addr,F_ARGD(min,max,flags,ARGTYPES(a,b,c,d)),0); |
MakeAfun(addr,F_ARGD(min,max,flags,ARGTYPES(a,b,c,d)),0); |
7 |
MakeAfun(addr,F_ARGD(2,3,NONE,ARGTYPES(OO,OO,OO,OO)),0); |
MakeAfun(addr,F_ARGD(2,3,NONE,ARGTYPES(OO,OO,OO,OO)),0); |
8 |
*/ |
*/ |
9 |
object MakeAfun(addr,argd,data) |
object MakeAfun(object (*addr)(object,object), unsigned int argd, object data) |
|
object data; |
|
|
int (*addr) (); |
|
|
unsigned int argd; |
|
10 |
{int type = (F_ARG_FLAGS_P(argd,F_requires_fun_passed) ? t_closure : t_afun); |
{int type = (F_ARG_FLAGS_P(argd,F_requires_fun_passed) ? t_closure : t_afun); |
11 |
object x = alloc_object(type); |
object x = alloc_object(type); |
12 |
x->sfn.sfn_name = Cnil; |
x->sfn.sfn_name = Cnil; |
21 |
|
|
22 |
|
|
23 |
object |
object |
24 |
fSmakefun(sym,addr,argd) |
fSmakefun(object sym, object (*addr) (/* ??? */), unsigned int argd) |
|
object sym, (*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 && |
27 |
type_of(sSPmemory->s.s_dbind)==t_cfdata) ? |
type_of(sSPmemory->s.s_dbind)==t_cfdata) ? |
31 |
} |
} |
32 |
|
|
33 |
object |
object |
34 |
ImakeClosure(addr,argd,n,va_alist) |
ImakeClosure(object (*addr) (/* ??? */), int argd, int n, __builtin_va_alist_t __builtin_va_alist) |
|
object (*addr)(); |
|
|
int n,argd; |
|
|
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); |
39 |
va_end(ap); |
va_end(ap); |
40 |
return x; |
return x; |
41 |
} |
} |
42 |
|
|
43 |
IsetClosure(x,n,ap) |
void |
44 |
object x; |
IsetClosure(object x, int n, va_list ap) |
|
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 |
47 |
will be more economical. Because of gc, we can't allocate relblock, it |
will be more economical. Because of gc, we can't allocate relblock, it |
88 |
(va_alist) |
(va_alist) |
89 |
va_dcl |
va_dcl |
90 |
{va_list ap; |
{va_list ap; |
91 |
object res,name; |
object res; |
92 |
va_start(ap); |
va_start(ap); |
93 |
res = Iapply_ap(fSinitfun,ap); |
res = Iapply_ap(fSinitfun,ap); |
94 |
va_end(ap); |
va_end(ap); |
109 |
|
|
110 |
|
|
111 |
void |
void |
112 |
SI_makefun(strg,fn,argd) |
SI_makefun(char *strg, object (*fn) (/* ??? */), unsigned int argd) |
|
char *strg; |
|
|
unsigned int argd; |
|
|
object (*fn)(); |
|
113 |
{ object sym = make_si_ordinary(strg); |
{ object sym = make_si_ordinary(strg); |
114 |
fSfset(sym, fSmakefun(sym,fn,argd)); |
fSfset(sym, fSmakefun(sym,fn,argd)); |
115 |
} |
} |
116 |
|
|
117 |
void |
void |
118 |
LISP_makefun(strg,fn,argd) |
LISP_makefun(char *strg, object (*fn) (/* ??? */), unsigned int argd) |
|
char *strg; |
|
|
unsigned int argd; |
|
|
object (*fn)(); |
|
119 |
{ object sym = make_ordinary(strg); |
{ object sym = make_ordinary(strg); |
120 |
fSfset(sym, fSmakefun(sym,fn,argd)); |
fSfset(sym, fSmakefun(sym,fn,argd)); |
121 |
} |
} |
122 |
|
|
123 |
|
|
124 |
object |
object |
125 |
MakeClosure(n,argd,data,fn,va_alist) |
MakeClosure(int n, int argd, object data, object (*fn)(), __builtin_va_alist_t __builtin_va_alist) |
|
int n; |
|
|
int (*fn)(); |
|
|
object data; |
|
|
va_dcl |
|
126 |
{ object x; |
{ object x; |
127 |
va_list ap; |
va_list ap; |
128 |
x = alloc_object(t_closure); |
x = alloc_object(t_closure); |