90 |
DEF_ORDINARY("%MEMORY",sSPmemory,SI,""); |
DEF_ORDINARY("%MEMORY",sSPmemory,SI,""); |
91 |
DEF_ORDINARY("%INIT",sSPinit,SI,""); |
DEF_ORDINARY("%INIT",sSPinit,SI,""); |
92 |
|
|
93 |
void Lidentity(); |
void Lidentity(void); |
94 |
init_cmpaux() |
void |
95 |
|
init_cmpaux(void) |
96 |
{ |
{ |
97 |
|
|
98 |
|
|
103 |
|
|
104 |
|
|
105 |
int |
int |
106 |
ifloor(x, y) |
ifloor(int x, int y) |
|
int x, y; |
|
107 |
{ |
{ |
108 |
if (y == 0) |
if (y == 0) { |
109 |
FEerror("Zero divizor", 0); |
FEerror("Zero divizor", 0); |
110 |
else if (y > 0) |
return 0; |
111 |
if (x >= 0) |
} |
112 |
return(x/y); |
if (y > 0) { |
113 |
else |
if (x >= 0) |
114 |
return(-((-x+y-1))/y); |
return(x/y); |
115 |
else |
else |
116 |
if (x >= 0) |
return(-((-x+y-1))/y); |
117 |
return(-((x-y-1)/(-y))); |
} |
118 |
else |
if (x >= 0) |
119 |
return((-x)/(-y)); |
return(-((x-y-1)/(-y))); |
120 |
|
else |
121 |
|
return((-x)/(-y)); |
122 |
} |
} |
123 |
|
|
124 |
int |
int |
125 |
imod(x, y) |
imod(int x, int y) |
|
int x, y; |
|
126 |
{ |
{ |
127 |
return(x - ifloor(x, y)*y); |
return(x - ifloor(x, y)*y); |
128 |
} |
} |
129 |
|
|
130 |
set_VV_data(VV,n,data,start,size) |
void |
131 |
object VV[],data; |
set_VV_data(object *VV, int n, object data, char *start, int size) |
|
int size,n; |
|
|
char *start; |
|
132 |
{set_VV(VV,n,data); |
{set_VV(VV,n,data); |
133 |
data->cfd.cfd_start=start; |
data->cfd.cfd_start=start; |
134 |
data->cfd.cfd_size = size; |
data->cfd.cfd_size = size; |
135 |
} |
} |
136 |
|
|
137 |
set_VV(VV, n, data) |
void |
138 |
object VV[]; |
set_VV(object *VV, int n, object data) |
|
int n; |
|
|
object data; |
|
139 |
{ |
{ |
140 |
object *p, *q; |
object *p, *q; |
141 |
|
|
151 |
*/ |
*/ |
152 |
|
|
153 |
char |
char |
154 |
object_to_char(x) |
object_to_char(object x) |
|
object x; |
|
155 |
{ |
{ |
156 |
int c; |
int c=0; |
157 |
|
|
158 |
switch (type_of(x)) { |
switch (type_of(x)) { |
159 |
case t_fixnum: |
case t_fixnum: |
177 |
} |
} |
178 |
|
|
179 |
int |
int |
180 |
object_to_int(x) |
object_to_int(object x) |
|
object x; |
|
181 |
{ |
{ |
182 |
int i; |
int i=0; |
183 |
|
|
184 |
switch (type_of(x)) { |
switch (type_of(x)) { |
185 |
case t_character: |
case t_character: |
202 |
} |
} |
203 |
|
|
204 |
float |
float |
205 |
object_to_float(x) |
object_to_float(object x) |
|
object x; |
|
206 |
{ |
{ |
207 |
float f; |
float f=0.0; |
208 |
|
|
209 |
switch (type_of(x)) { |
switch (type_of(x)) { |
210 |
case t_character: |
case t_character: |
225 |
} |
} |
226 |
|
|
227 |
double |
double |
228 |
object_to_double(x) |
object_to_double(object x) |
|
object x; |
|
229 |
{ |
{ |
230 |
double d; |
double d=0.0; |
231 |
|
|
232 |
switch (type_of(x)) { |
switch (type_of(x)) { |
233 |
case t_character: |
case t_character: |
252 |
have a null character in the fillpointer position. */ |
have a null character in the fillpointer position. */ |
253 |
|
|
254 |
char * |
char * |
255 |
object_to_string(x) |
object_to_string(object x) |
|
object x; |
|
256 |
{ unsigned int leng; |
{ unsigned int leng; |
257 |
if (type_of(x)!=t_string) FEwrong_type_argument(sLstring,x); |
if (type_of(x)!=t_string) FEwrong_type_argument(sLstring,x); |
258 |
leng= x->st.st_fillp; |
leng= x->st.st_fillp; |
273 |
}} |
}} |
274 |
|
|
275 |
|
|
276 |
typedef int (*FUNC)(); |
/* typedef int (*FUNC)(); */ |
277 |
|
|
278 |
/* perform the actual invocation of the init function durint a fasload |
/* perform the actual invocation of the init function durint a fasload |
279 |
init_address is the offset from the place in memory where the code is loaded |
init_address is the offset from the place in memory where the code is loaded |
282 |
where f1 f2 are forms to be evaled. |
where f1 f2 are forms to be evaled. |
283 |
*/ |
*/ |
284 |
|
|
285 |
call_init(init_address,memory,fasl_vec,fptr) |
void |
286 |
int init_address; |
call_init(int init_address, object memory, object fasl_vec, FUNC fptr) |
|
object memory,fasl_vec; |
|
|
FUNC fptr; |
|
|
|
|
287 |
{object form; |
{object form; |
288 |
FUNC at; |
FUNC at; |
289 |
|
|
324 |
|
|
325 |
*/ |
*/ |
326 |
|
|
327 |
do_init(statVV) |
void |
328 |
object *statVV; |
do_init(object *statVV) |
|
|
|
|
|
|
329 |
{object fasl_vec=sSPinit->s.s_dbind; |
{object fasl_vec=sSPinit->s.s_dbind; |
330 |
object data = sSPmemory->s.s_dbind; |
object data = sSPmemory->s.s_dbind; |
331 |
{object *p,*q,x,y; |
{object *p,*q,y; |
332 |
int n=fasl_vec->v.v_fillp -1; |
int n=fasl_vec->v.v_fillp -1; |
333 |
int i; |
int i; |
334 |
object form; |
object form; |
399 |
#endif |
#endif |
400 |
|
|
401 |
void |
void |
402 |
init_or_load1(fn,file) |
init_or_load1(int (*fn) (/* ??? */), char *file) |
|
int (*fn)(); |
|
|
char *file; |
|
403 |
{int n=strlen(file); |
{int n=strlen(file); |
404 |
if (file[n-1]=='o') |
if (file[n-1]=='o') |
405 |
{ object memory; |
{ object memory; |