101 |
return Cnil; |
return Cnil; |
102 |
} |
} |
103 |
|
|
104 |
|
#define collect(top_,next_,val_) ({object _x=MMcons(val_,Cnil);\ |
105 |
|
if (top_==Cnil) top_=next_=_x; \ |
106 |
|
else next_=next_->c.c_cdr=_x;}) |
107 |
|
|
108 |
|
|
109 |
|
static void |
110 |
|
put_fn_procls(object sym,int argd,int oneval) { |
111 |
|
|
112 |
|
unsigned int atypes=F_TYPES(argd) >> F_TYPE_WIDTH; |
113 |
|
unsigned int minargs=F_MIN_ARGS(argd); |
114 |
|
unsigned int maxargs=F_MAX_ARGS(argd); |
115 |
|
unsigned int rettype=F_RESULT_TYPE(argd); |
116 |
|
unsigned int i; |
117 |
|
object ta=Cnil,na=Cnil; |
118 |
|
|
119 |
|
for (i=0;i<minargs;i++,atypes >>=F_TYPE_WIDTH) |
120 |
|
switch(maxargs!=minargs ? F_object : atypes & MASK_RANGE(0,F_TYPE_WIDTH)) { |
121 |
|
case F_object: |
122 |
|
collect(ta,na,Ct); |
123 |
|
break; |
124 |
|
case F_int: |
125 |
|
collect(ta,na,sLfixnum); |
126 |
|
break; |
127 |
|
case F_shortfloat: |
128 |
|
collect(ta,na,sLshort_float); |
129 |
|
break; |
130 |
|
case F_double_ptr: |
131 |
|
collect(ta,na,sLlong_float); |
132 |
|
break; |
133 |
|
default: |
134 |
|
FEerror("Bad sfn declaration",0); |
135 |
|
break; |
136 |
|
} |
137 |
|
if (maxargs!=minargs) |
138 |
|
collect(ta,na,sLA); |
139 |
|
putprop(sym,ta,sSproclaimed_arg_types); |
140 |
|
ta=na=Cnil; |
141 |
|
if (oneval) |
142 |
|
switch(rettype) { |
143 |
|
case F_object: |
144 |
|
ta=Ct; |
145 |
|
break; |
146 |
|
case F_int: |
147 |
|
ta=sLfixnum; |
148 |
|
break; |
149 |
|
case F_shortfloat: |
150 |
|
ta=sLshort_float; |
151 |
|
break; |
152 |
|
case F_double_ptr: |
153 |
|
ta=sLlong_float; |
154 |
|
break; |
155 |
|
default: |
156 |
|
FEerror("Bad sfn declaration",0); |
157 |
|
break; |
158 |
|
} |
159 |
|
else |
160 |
|
ta=MMcons(sLA,Cnil); |
161 |
|
putprop(sym,ta,sSproclaimed_return_type); |
162 |
|
if (oneval) |
163 |
|
putprop(sym,Ct,sSproclaimed_function); |
164 |
|
|
165 |
|
} |
166 |
|
|
167 |
|
|
168 |
void |
void |
169 |
SI_makefun(char *strg, object (*fn) (/* ??? */), unsigned int argd) |
SI_makefun(char *strg, object (*fn) (/* ??? */), unsigned int argd) |
170 |
{ object sym = make_si_ordinary(strg); |
{ object sym = make_si_ordinary(strg); |
171 |
fSfset(sym, fSmakefun(sym,fn,argd)); |
fSfset(sym, fSmakefun(sym,fn,argd)); |
172 |
|
put_fn_procls(sym,argd,1); |
173 |
} |
} |
174 |
|
|
175 |
void |
void |
176 |
LISP_makefun(char *strg, object (*fn) (/* ??? */), unsigned int argd) |
LISP_makefun(char *strg, object (*fn) (/* ??? */), unsigned int argd) |
177 |
{ object sym = make_ordinary(strg); |
{ object sym = make_ordinary(strg); |
178 |
fSfset(sym, fSmakefun(sym,fn,argd)); |
fSfset(sym, fSmakefun(sym,fn,argd)); |
179 |
|
put_fn_procls(sym,argd,1); |
180 |
|
} |
181 |
|
|
182 |
|
void |
183 |
|
SI_makefunm(char *strg, object (*fn) (/* ??? */), unsigned int argd) |
184 |
|
{ object sym = make_si_ordinary(strg); |
185 |
|
fSfset(sym, fSmakefun(sym,fn,argd)); |
186 |
|
put_fn_procls(sym,argd,0); |
187 |
|
} |
188 |
|
|
189 |
|
void |
190 |
|
LISP_makefunm(char *strg, object (*fn) (/* ??? */), unsigned int argd) |
191 |
|
{ object sym = make_ordinary(strg); |
192 |
|
fSfset(sym, fSmakefun(sym,fn,argd)); |
193 |
|
put_fn_procls(sym,argd,0); |
194 |
} |
} |
195 |
|
|
196 |
|
|