setup.c

Bug Summary

File:	setup.c
Location:	line 422, column 3
Description:	Value stored to 'tbl' is never read

Annotated Source Code

1	/* File: "setup.c" */
2
3	/* Copyright (c) 1994-2013 by Marc Feeley, All Rights Reserved. */
4
5	/*
6	* This module contains the routines that setup the Scheme program for
7	* execution.
8	*/
9
10	#define ___INCLUDED_FROM_SETUP
11	#define ___VERSION407000 407000
12	#include "gambit.h"
13
14	#include "os_base.h"
15	#include "os_dyn.h"
16	#include "setup.h"
17	#include "mem.h"
18	#include "c_intf.h"
19
20
21	/---------------------------------------------------------------------------/
22
23	/*
24	* Global state structure.
25	*/
26
27	___EXP_DATA(___global_state_struct,___gstate)___global_state_struct ___gstate;
28
29
30	/*
31	* Global variables needed by this module.
32	*/
33
34	___NEED_GLO(___G__23__23_kernel_2d_handlers)extern ___glo_struct ___G__23__23_kernel_2d_handlers; /* from "_kernel.scm" */
35	___NEED_GLO(___G__23__23_dynamic_2d_env_2d_bind)extern ___glo_struct ___G__23__23_dynamic_2d_env_2d_bind;
36
37
38	/*
39	* Parameters passed to ___setup.
40	*/
41
42	___HIDDENstatic ___UCS_2unsigned short reset_argv0[] = { 0 };
43	___HIDDENstatic ___UCS_2STRINGunsigned short* reset_argv[] = { reset_argv0, 0 };
44
45	___setup_params_struct ___setup_params =
46	{ 0, reset_argv, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
47
48
49	/*
50	* Initial length of symbol table and keyword table.
51	*/
52
53	#define INIT_SYMKEY_TBL_LENGTH128 128
54
55
56	/---------------------------------------------------------------------------/
57
58	/*
59	* Interrupt handling.
60	*/
61
62	/*
63	* '___raise_interrupt (code)' is called when an interrupt has
64	* occured. At some later point in time, the Gambit kernel will cause
65	* the Scheme procedure ##interrupt-handler to be called with a single
66	* integer argument indicating which interrupt has been received.
67	* Interrupt codes are defined in "gambit.h". Currently, the
68	* following codes are defined:
69	*
70	* ___INTR_USER user has interrupted the program (e.g. ctrl-C)
71	* ___INTR_HEARTBEAT heartbeat time interval has elapsed
72	* ___INTR_GC a garbage collection has finished
73	*/
74
75	___EXP_FUNC(void,___raise_interrupt)void ___raise_interrupt
76	___P((int code),(int code)
77	(code)(int code)
78	int code;)(int code)
79	{
80	___processor_state ___ps = ___PSTATE(&(&___gstate)->pstate);
81
82	/*
83	* Note: ___raise_interrupt may be called before the processor state
84	* is initialized. As a consequence, the interrupt(s) received
85	* before the initialization of the processor state will be ignored.
86	*/
87
88	#ifdef CALL_GC_FREQUENTLY
89	if (code != ___INTR_USER0)
90	return;
91	#endif
92
93	if (___INTERRUPT_REQ(___ps->intr_flag[code] = ___FIX(1)<<code,(((___ps->intr_flag[code] = (((long)(1))<<2)<< code) & ___ps->intr_enabled & ~___ps->intr_mask ) != (((long)(0))<<2))
94	___ps->intr_mask)(((___ps->intr_flag[code] = (((long)(1))<<2)<< code) & ___ps->intr_enabled & ~___ps->intr_mask ) != (((long)(0))<<2)))
95	___STACK_TRIP_ON()___ps->stack_trip = ___ps->stack_start;
96	}
97
98
99	___EXP_FUNC(void,___begin_interrupt_service)void ___begin_interrupt_service ___PVOID(void)
100	{
101	___processor_state ___ps = ___PSTATE(&(&___gstate)->pstate);
102
103	___STACK_TRIP_OFF()___ps->stack_trip = ___ps->stack_limit;
104	}
105
106
107	___EXP_FUNC(___BOOL,___check_interrupt)int ___check_interrupt
108	___P((int code),(int code)
109	(code)(int code)
110	int code;)(int code)
111	{
112	___processor_state ___ps = ___PSTATE(&(&___gstate)->pstate);
113
114	if ((___ps->intr_flag[code] & ~___ps->intr_mask) != ___FIX(0)(((long)(0))<<2))
115	{
116	___ps->intr_flag[code] = ___FIX(0)(((long)(0))<<2);
117	return 1;
118	}
119
120	return 0;
121	}
122
123
124	___EXP_FUNC(void,___end_interrupt_service)void ___end_interrupt_service
125	___P((int code),(int code)
126	(code)(int code)
127	int code;)(int code)
128	{
129	___processor_state ___ps = ___PSTATE(&(&___gstate)->pstate);
130
131	if (___ps->intr_enabled != ___FIX(0)(((long)(0))<<2))
132	{
133	#ifdef CALL_HANDLER_AT_EVERY_POLL
134	___STACK_TRIP_ON()___ps->stack_trip = ___ps->stack_start;
135	#else
136	while (code < ___NB_INTRS4)
137	{
138	if ((___ps->intr_flag[code] & ~___ps->intr_mask) != ___FIX(0)(((long)(0))<<2))
139	{
140	___STACK_TRIP_ON()___ps->stack_trip = ___ps->stack_start;
141	break;
142	}
143	code++;
144	}
145	#endif
146	}
147	}
148
149
150	___EXP_FUNC(void,___disable_interrupts)void ___disable_interrupts ___PVOID(void)
151	{
152	___processor_state ___ps = ___PSTATE(&(&___gstate)->pstate);
153
154	___ps->intr_enabled = ___FIX(0)(((long)(0))<<2);
155
156	___begin_interrupt_service ();
157	___end_interrupt_service (0);
158	}
159
160
161	___EXP_FUNC(void,___enable_interrupts)void ___enable_interrupts ___PVOID(void)
162	{
163	___processor_state ___ps = ___PSTATE(&(&___gstate)->pstate);
164
165	___ps->intr_enabled = ___FIX((1<<___NB_INTRS)-1)(((long)((1<<4)-1))<<2);
166
167	___begin_interrupt_service ();
168	___end_interrupt_service (0);
169	}
170
171
172	/---------------------------------------------------------------------------/
173
174	/*
175	* Routines to setup symbol table, keyword table and global variable
176	* table.
177	*/
178
179	/*
180	* The hashing functions 'hash_UTF_8_string (str)' and
181	* 'hash_scheme_string (str)' must compute the same value as the
182	* function 'targ-hash' in the file "gsc/_t-c-3.scm".
183	* A fixnum error code is returned when there is an error.
184	*/
185
186	#define HASH_STEP(h,c)((((h)>>8) + (c)) * 331804471) & ((((long)(1))<< (32-2 -1))-1) ((((h)>>8) + (c)) * 331804471) & ___MAX_FIX32((((long)(1))<<(32-2 -1))-1)
187
188	___HIDDENstatic ___SCMOBJlong hash_UTF_8_string
189	___P((___UTF_8STRING str),(char* str)
190	(str)(char* str)
191	___UTF_8STRING str;)(char* str)
192	{
193	___UM32unsigned int h = 0;
194	___UTF_8STRINGchar* p = str;
195	___UCS_4unsigned int c;
196
197	for (;;)
198	{
199	___UTF_8STRINGchar* start = p;
200	c = ___UTF_8_get (&p);
201	if (p == start \|\| c > ___MAX_CHR0x10ffff)
202	return ___FIX(___CTOS_UTF_8STRING_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+(109<<7))))<<2);
203	if (c == 0)
204	break;
205	h = HASH_STEP(h,c)((((h)>>8) + (c)) * 331804471) & ((((long)(1))<< (32-2 -1))-1);
206	}
207
208	return ___FIX(h)(((long)(h))<<2);
209	}
210
211
212	___HIDDENstatic ___SCMOBJlong hash_scheme_string
213	___P((___SCMOBJ str),(long str)
214	(str)(long str)
215	___SCMOBJ str;)(long str)
216	{
217	___SIZE_Tunsigned long i, n = ___INT(___STRINGLENGTH(str))(((((long)(((((unsigned long)((((long)((str)-(1))))))>> (3 +5))>>2)))<<2))>>2);
218	___UM32unsigned int h = 0;
219
220	for (i=0; i<n; i++)
221	h = HASH_STEP(h,___INT(___STRINGREF(str,___FIX(i))))((((h)>>8) + (((((((long)(((unsigned int)((((unsigned int )((((long)((str)-(1)))+1)))+(((((long)(i))<<2))>> 2))))))<<2)+2))>>2))) 331804471) & ((((long )(1))<<(32-2 -1))-1);
222
223	return ___FIX(h)(((long)(h))<<2);
224	}
225
226
227	___HIDDENstatic ___SCMOBJlong symkey_table
228	___P((unsigned int subtype),(unsigned int subtype)
229	(subtype)(unsigned int subtype)
230	unsigned int subtype;)(unsigned int subtype)
231	{
232	switch (subtype)
233	{
234	case ___sKEYWORD9:
235	return ___GSTATE(&___gstate)->keyword_table;
236	default: /* assume ___sSYMBOL */
237	return ___GSTATE(&___gstate)->symbol_table;
238	}
239	}
240
241
242	___HIDDENstatic void symkey_table_set
243	___P((unsigned int subtype,(unsigned int subtype, long new_table)
244	___SCMOBJ new_table),(unsigned int subtype, long new_table)
245	(subtype,(unsigned int subtype, long new_table)
246	new_table)(unsigned int subtype, long new_table)
247	unsigned int subtype;(unsigned int subtype, long new_table)
248	___SCMOBJ new_table;)(unsigned int subtype, long new_table)
249	{
250	switch (subtype)
251	{
252	case ___sKEYWORD9:
253	___GSTATE(&___gstate)->keyword_table = new_table;
254	break;
255	default: /* assume ___sSYMBOL */
256	___GSTATE(&___gstate)->symbol_table = new_table;
257	break;
258	}
259	}
260
261
262	___HIDDENstatic ___SCMOBJlong symkey_table_alloc
263	___P((unsigned int subtype,(unsigned int subtype, long length)
264	___SIZE_TS length),(unsigned int subtype, long length)
265	(subtype,(unsigned int subtype, long length)
266	length)(unsigned int subtype, long length)
267	unsigned int subtype;(unsigned int subtype, long length)
268	___SIZE_TS length;)(unsigned int subtype, long length)
269	{
270	___SCMOBJlong tbl = ___make_vector (length+1, ___NUL((((long)(-3))<<2)+2), ___STILL5);
271
272	if (!___FIXNUMP(tbl)(((tbl)&((1<<2)-1))==(0)))
273	___FIELD(tbl,0)(((((long)((tbl)-(1)))+1)+0)) = ___FIX(0)(((long)(0))<<2);
274
275	return tbl;
276	}
277
278
279	___HIDDENstatic void symkey_add
280	___P((___SCMOBJ symkey),(long symkey)
281	(symkey)(long symkey)
282	___SCMOBJ symkey;)(long symkey)
283	{
284	unsigned int subtype = ___INT(___SUBTYPE(symkey))((((((long)((symkey)&-(1<<2)))&(((1<<5) -1)<<3))>>(3 -2)))>>2);
285	___SCMOBJlong tbl = symkey_table (subtype);
286	int i = ___INT(___FIELD(symkey,___SYMKEY_HASH))(((((((long)((symkey)-(1)))+1)+1)))>>2)
287	% (___INT(___VECTORLENGTH(tbl))(((((long)((((unsigned long)((((long)((tbl)-(1))))))>> ((3 +5)+3))))<<2))>>2) - 1)
288	+ 1;
289
290	___FIELD(symkey,___SYMKEY_NEXT)(((((long)((symkey)-(1)))+1)+2)) = ___FIELD(tbl,i)(((((long)((tbl)-(1)))+1)+i));
291	___FIELD(tbl,i)(((((long)((tbl)-(1)))+1)+i)) = symkey;
292
293	___FIELD(tbl,0)(((((long)((tbl)-(1)))+1)+0)) = ___FIXADD(___FIELD(tbl,0),___FIX(1))((long)(((((((long)((tbl)-(1)))+1)+0)))+((((long)(1))<< 2))));
294
295	if (___INT(___FIELD(tbl,0))(((((((long)((tbl)-(1)))+1)+0)))>>2) > ___INT(___VECTORLENGTH(tbl))(((((long)((((unsigned long)((((long)((tbl)-(1))))))>> ((3 +5)+3))))<<2))>>2) * 4)
296	{
297	int new_len = (___INT(___VECTORLENGTH(tbl))(((((long)((((unsigned long)((((long)((tbl)-(1))))))>> ((3 +5)+3))))<<2))>>2)-1) * 2;
298	___SCMOBJlong newtbl = symkey_table_alloc (subtype, new_len);
299
300	if (!___FIXNUMP(newtbl)(((newtbl)&((1<<2)-1))==(0)))
301	{
302	for (i=___INT(___VECTORLENGTH(tbl))(((((long)((((unsigned long)((((long)((tbl)-(1))))))>> ((3 +5)+3))))<<2))>>2)-1; i>0; i--)
303	{
304	___SCMOBJlong probe = ___FIELD(tbl,i)(((((long)((tbl)-(1)))+1)+i));
305
306	while (probe != ___NUL((((long)(-3))<<2)+2))
307	{
308	___SCMOBJlong symkey = probe;
309	int j = ___INT(___FIELD(symkey,___SYMKEY_HASH))(((((((long)((symkey)-(1)))+1)+1)))>>2)%new_len + 1;
310
311	probe = ___FIELD(symkey,___SYMKEY_NEXT)(((((long)((symkey)-(1)))+1)+2));
312	___FIELD(symkey,___SYMKEY_NEXT)(((((long)((symkey)-(1)))+1)+2)) = ___FIELD(newtbl,j)(((((long)((newtbl)-(1)))+1)+j));
313	___FIELD(newtbl,j)(((((long)((newtbl)-(1)))+1)+j)) = symkey;
314	}
315	}
316
317	___FIELD(newtbl,0)(((((long)((newtbl)-(1)))+1)+0)) = ___FIELD(tbl,0)(((((long)((tbl)-(1)))+1)+0));
318
319	symkey_table_set (subtype, newtbl);
320	}
321	}
322	}
323
324
325	___HIDDENstatic ___SCMOBJlong find_symkey_from_UTF_8_string
326	___P((char str,(char str, unsigned int subtype)
327	unsigned int subtype),(char *str, unsigned int subtype)
328	(str,(char *str, unsigned int subtype)
329	subtype)(char *str, unsigned int subtype)
330	char str;(char str, unsigned int subtype)
331	unsigned int subtype;)(char *str, unsigned int subtype)
332	{
333	___SCMOBJlong tbl;
334	___SCMOBJlong probe;
335	___SCMOBJlong h = hash_UTF_8_string (str);
336
337	if (h < ___FIX(0)(((long)(0))<<2))
338	return h;
339
340	tbl = symkey_table (subtype);
341	probe = ___FIELD(tbl, ___INT(h) % (___INT(___VECTORLENGTH(tbl))-1) + 1)(((((long)((tbl)-(1)))+1)+((h)>>2) % ((((((long)((((unsigned long)((((long)((tbl)-(1))))))>>((3 +5)+3))))<< 2))>>2)-1) + 1));
342
343	while (probe != ___NUL((((long)(-3))<<2)+2))
344	{
345	___SCMOBJlong name = ___FIELD(probe,___SYMKEY_NAME)(((((long)((probe)-(1)))+1)+0));
346	___SIZE_Tunsigned long i;
347	___SIZE_Tunsigned long n = ___INT(___STRINGLENGTH(name))(((((long)(((((unsigned long)((((long)((name)-(1))))))>> (3 +5))>>2)))<<2))>>2);
348	___UTF_8STRINGchar* p = str;
349	for (i=0; i<n; i++)
350	if (___UTF_8_get (&p) !=
351	___CAST(___UCS_4,___INT(___STRINGREF(name,___FIX(i))))((unsigned int)(((((((long)(((unsigned int)((((unsigned int )((((long*)((name)-(1)))+1)))+(((((long)(i))<<2))>> 2))))))<<2)+2))>>2))))
352	goto next;
353	if (___UTF_8_get (&p) == 0)
354	return probe;
355	next:
356	probe = ___FIELD(probe,___SYMKEY_NEXT)(((((long)((probe)-(1)))+1)+2));
357	}
358
359	return ___FAL((((long)(-1))<<2)+2);
360	}
361
362
363	___SCMOBJlong ___find_symkey_from_scheme_string
364	___P((___SCMOBJ str,(long str, unsigned int subtype)
365	unsigned int subtype),(long str, unsigned int subtype)
366	(str,(long str, unsigned int subtype)
367	subtype)(long str, unsigned int subtype)
368	___SCMOBJ str;(long str, unsigned int subtype)
369	unsigned int subtype;)(long str, unsigned int subtype)
370	{
371	___SCMOBJlong tbl;
372	___SCMOBJlong probe;
373	___SCMOBJlong h = hash_scheme_string (str);
374
375	tbl = symkey_table (subtype);
376	probe = ___FIELD(tbl, ___INT(h) % (___INT(___VECTORLENGTH(tbl))-1) + 1)(((((long)((tbl)-(1)))+1)+((h)>>2) % ((((((long)((((unsigned long)((((long)((tbl)-(1))))))>>((3 +5)+3))))<< 2))>>2)-1) + 1));
377
378	while (probe != ___NUL((((long)(-3))<<2)+2))
379	{
380	___SCMOBJlong name = ___FIELD(probe,___SYMKEY_NAME)(((((long)((probe)-(1)))+1)+0));
381	___SIZE_TSlong i = 0;
382	___SIZE_TSlong n = ___INT(___STRINGLENGTH(name))(((((long)(((((unsigned long)((((long)((name)-(1))))))>> (3 +5))>>2)))<<2))>>2);
383	if (___INT(___STRINGLENGTH(str))(((((long)(((((unsigned long)((((long)((str)-(1))))))>> (3 +5))>>2)))<<2))>>2) == n)
384	{
385	for (i=0; i<n; i++)
386	if (___STRINGREF(str,___FIX(i))((((long)(((unsigned int)((((unsigned int)((((long)((str)- (1)))+1)))+(((((long)(i))<<2))>>2))))))<<2) +2) != ___STRINGREF(name,___FIX(i))((((long)(((unsigned int)((((unsigned int)((((long)((name) -(1)))+1)))+(((((long)(i))<<2))>>2))))))<<2 )+2))
387	goto next;
388	return probe;
389	}
390	next:
391	probe = ___FIELD(probe,___SYMKEY_NEXT)(((((long)((probe)-(1)))+1)+2));
392	}
393
394	return ___FAL((((long)(-1))<<2)+2);
395	}
396
397
398	___SCMOBJlong ___new_symkey
399	___P((___SCMOBJ name, /* name must be a permanent object */(long name, unsigned int subtype)
400	unsigned int subtype),(long name, unsigned int subtype)
401	(name,(long name, unsigned int subtype)
402	subtype)(long name, unsigned int subtype)
403	___SCMOBJ name;(long name, unsigned int subtype)
404	unsigned int subtype;)(long name, unsigned int subtype)
405	{
406	___SCMOBJlong obj;
407	___SCMOBJlong tbl;
408
409	switch (subtype)
410	{
411	case ___sKEYWORD9:
412	obj = ___alloc_scmobj (___sKEYWORD9, ___KEYWORD_SIZE3<<___LWS3, ___PERM6);
413	break;
414	default: /* assume ___sSYMBOL */
415	obj = ___alloc_scmobj (___sSYMBOL8, ___SYMBOL_SIZE4<<___LWS3, ___PERM6);
416	break;
417	}
418
419	if (___FIXNUMP(obj)(((obj)&((1<<2)-1))==(0)))
420	return obj;
421
422	tbl = symkey_table (subtype);
	Value stored to 'tbl' is never read
423
424	/* object layout is same for ___sSYMBOL and ___sKEYWORD */
425
426	___FIELD(obj,___SYMKEY_NAME)(((((long)((obj)-(1)))+1)+0)) = name;
427	___FIELD(obj,___SYMKEY_HASH)(((((long)((obj)-(1)))+1)+1)) = hash_scheme_string (name);
428
429	if (subtype == ___sSYMBOL8)
430	___FIELD(obj,___SYMBOL_GLOBAL)(((((long)((obj)-(1)))+1)+3)) = 0;
431
432	symkey_add (obj);
433
434	return obj;
435	}
436
437
438	___HIDDENstatic ___SCMOBJlong make_symkey
439	___P((___UTF_8STRING str,(char* str, unsigned int subtype)
440	unsigned int subtype),(char* str, unsigned int subtype)
441	(str,(char* str, unsigned int subtype)
442	subtype)(char* str, unsigned int subtype)
443	___UTF_8STRING str;(char* str, unsigned int subtype)
444	unsigned int subtype;)(char* str, unsigned int subtype)
445	{
446	___SCMOBJlong obj = find_symkey_from_UTF_8_string (str, subtype);
447
448	if (___FIXNUMP(obj)(((obj)&((1<<2)-1))==(0)))
449	return obj;
450
451	if (obj == ___FAL((((long)(-1))<<2)+2))
452	{
453	___SCMOBJlong name;
454	___SCMOBJlong err;
455
456	if ((err = ___NONNULLUTF_8STRING_to_SCMOBJ
457	(str,
458	&name,
459	-1)) /* allocate as permanent object */
460	!= ___FIX(___NO_ERR)(((long)(0))<<2))
461	return err;
462
463	obj = ___new_symkey (name, subtype);
464	}
465
466	return obj;
467	}
468
469
470	___HIDDENstatic ___SCMOBJlong make_global
471	___P((___UTF_8STRING str,(char* str, int supply, ___glo_struct **glo)
472	int supply,(char* str, int supply, ___glo_struct **glo)
473	___glo_struct *glo),(char str, int supply, ___glo_struct **glo)
474	(str,(char* str, int supply, ___glo_struct **glo)
475	supply,(char* str, int supply, ___glo_struct **glo)
476	glo)(char* str, int supply, ___glo_struct **glo)
477	___UTF_8STRING str;(char* str, int supply, ___glo_struct **glo)
478	int supply;(char* str, int supply, ___glo_struct **glo)
479	___glo_struct *glo;)(char str, int supply, ___glo_struct **glo)
480	{
481	___processor_state ___ps = ___PSTATE(&(&___gstate)->pstate);
482	___SCMOBJlong sym;
483	___SCMOBJlong g;
484	___glo_struct *p;
485
486	sym = make_symkey (str, ___sSYMBOL8);
487
488	if (___FIXNUMP(sym)(((sym)&((1<<2)-1))==(0)))
489	return sym;
490
491	g = ___FIELD(sym,___SYMBOL_GLOBAL)(((((long)((sym)-(1)))+1)+3));
492
493	if (g == ___FIX(0)(((long)(0))<<2))
494	{
495	___SCMOBJlong e;
496
497	if ((e = ___alloc_global_var (&p)) != ___FIX(___NO_ERR)(((long)(0))<<2))
498	return e;
499
500	#ifdef ___MULTIPLE_GLO
501	p->val = ___gstate.nb_glo_vars;
502	#endif
503
504	#ifdef ___MULTIPLE_PRM
505	p->prm = ___gstate.nb_glo_vars;
506	#endif
507
508	___gstate.nb_glo_vars++;
509	___GLOCELL(p->val)p->val = supply?___UNB2((((long)(-8))<<2)+2):___UNB1((((long)(-7))<<2)+2);
510	___PRMCELL(p->prm)p->prm = ___FAL((((long)(-1))<<2)+2);
511
512	p->next = 0;
513	if (___ps->glo_list_head == 0)
514	___ps->glo_list_head = ___CAST(___SCMOBJ,p)((long)(p));
515	else
516	___CAST(___glo_struct,___ps->glo_list_tail)((___glo_struct)(___ps->glo_list_tail))->next =
517	___CAST(___SCMOBJ,p)((long)(p));
518	___ps->glo_list_tail = ___CAST(___SCMOBJ,p)((long)(p));
519
520	___FIELD(sym,___SYMBOL_GLOBAL)(((((long)((sym)-(1)))+1)+3)) = ___CAST(___SCMOBJ,p)((long)(p));
521	}
522	else
523	{
524	p = ___CAST(___glo_struct,g)((___glo_struct)(g));
525	if (supply && ___GLOCELL(p->val)p->val == ___UNB1((((long)(-7))<<2)+2))
526	___GLOCELL(p->val)p->val = ___UNB2((((long)(-8))<<2)+2);
527	}
528
529	*glo = p;
530
531	return ___FIX(___NO_ERR)(((long)(0))<<2);
532	}
533
534
535	void ___for_each_symkey
536	___P((unsigned int subtype,(unsigned int subtype, void (visit) (long symkey, void data ), void *data)
537	void (visit) (___SCMOBJ symkey, void data),(unsigned int subtype, void (visit) (long symkey, void data ), void *data)
538	void data),(unsigned int subtype, void (visit) (long symkey, void data ), void data)
539	(subtype,(unsigned int subtype, void (visit) (long symkey, void data ), void *data)
540	visit,(unsigned int subtype, void (visit) (long symkey, void data ), void *data)
541	data)(unsigned int subtype, void (visit) (long symkey, void data ), void *data)
542	unsigned int subtype;(unsigned int subtype, void (visit) (long symkey, void data ), void *data)
543	void (visit) ();(unsigned int subtype, void (visit) (long symkey, void data ), void data)
544	void data;)(unsigned int subtype, void (visit) (long symkey, void data ), void data)
545	{
546	___SCMOBJlong tbl = symkey_table (subtype);
547	int i;
548
549	for (i=___INT(___VECTORLENGTH(tbl))(((((long)((((unsigned long)((((long)((tbl)-(1))))))>> ((3 +5)+3))))<<2))>>2)-1; i>0; i--)
550	{
551	___SCMOBJlong probe = ___FIELD(tbl, i)(((((long)((tbl)-(1)))+1)+i));
552
553	while (probe != ___NUL((((long)(-3))<<2)+2))
554	{
555	visit (probe, data);
556	probe = ___FIELD(probe,___SYMKEY_NEXT)(((((long)((probe)-(1)))+1)+2));
557	}
558	}
559	}
560
561
562	/---------------------------------------------------------------------------/
563
564	/*
565	* Alignment of objects.
566	*/
567
568	___HIDDENstatic ___SCMOBJlong *align
569	___P((___SCMOBJ from,(long from, long words, int need_64bit_alignment)
570	___SIZE_TS words,(long *from, long words, int need_64bit_alignment)
571	int need_64bit_alignment),(long *from, long words, int need_64bit_alignment)
572	(from,(long *from, long words, int need_64bit_alignment)
573	words,(long *from, long words, int need_64bit_alignment)
574	need_64bit_alignment)(long *from, long words, int need_64bit_alignment)
575	___SCMOBJ from;(long from, long words, int need_64bit_alignment)
576	___SIZE_TS words;(long *from, long words, int need_64bit_alignment)
577	int need_64bit_alignment;)(long *from, long words, int need_64bit_alignment)
578	{
579	___SCMOBJlong *to;
580
581	#if ___WS8 == 4
582	if (need_64bit_alignment)
583	to = ___ALIGNUP((from+1), 8)((long*)((((long)((from+1)))+((8)-1))&~((8)-1))) - 1;
584	else
585	#endif
586	to = ___ALIGNUP(from, ___WS)((long*)((((long)(from))+((8)-1))&~((8)-1)));
587
588	if (from != to)
589	{
590	/* move object up */
591	int i;
592	for (i=words-1; i>=0; i--)
593	to[i] = from[i];
594	}
595
596	return to;
597	}
598
599
600	___HIDDENstatic ___SCMOBJlong align_subtyped
601	___P((___SCMOBJ ptr),(long ptr)
602	(ptr)(long *ptr)
603	___SCMOBJ ptr;)(long ptr)
604	{
605	___SCMOBJlong head = ptr[0];
606	int subtype = ___HD_SUBTYPE(head)((head)>>3&((1<<5)-1));
607	int words = ___HD_WORDS(head)(((((unsigned long)(head))+((8 -1)<<(3 +5))))>>(( 3 +5)+3));
608	return ___TAG(align (ptr, words+1, subtype>=___sS64VECTOR), ___tSUBTYPED)(((long)(align (ptr, words+1, subtype>=27)))+(1));
609	}
610
611
612	/---------------------------------------------------------------------------/
613
614	/*
615	* Routines to setup a module for execution.
616	*/
617
618	___HIDDENstatic ___mod_or_lnk linker_to_mod_or_lnk
619	___P((___mod_or_lnk (linker) (___global_state_struct)),(___mod_or_lnk (linker) (___global_state_struct))
620	(linker)(___mod_or_lnk (linker) (___global_state_struct))
621	___mod_or_lnk (linker) ();)(___mod_or_lnk (linker) (___global_state_struct*))
622	{
623	___mod_or_lnk mol = linker (&___gstate);
624	if (mol->module.kind == ___LINKFILE_KIND1)
625	{
626	void **p = mol->linkfile.linkertbl;
627	while (*p != 0)
628	{
629	*p = linker_to_mod_or_lnk
630	(___CAST(___mod_or_lnk () ___P((___global_state_struct),()),p)((___mod_or_lnk (*) (___global_state_struct))(p)));
631	p++;
632	}
633	}
634	return mol;
635	}
636
637
638	typedef struct fem_context
639	{
640	int module_count;
641	___SCMOBJlong module_descr;
642	___UTF_8STRINGchar* module_script_line;
643	} fem_context;
644
645
646	___HIDDENstatic ___SCMOBJlong for_each_module
647	___P((fem_context ctx,(fem_context ctx, ___mod_or_lnk mol, long (proc) (fem_context , ___module_struct*))
648	___mod_or_lnk mol,(fem_context ctx, ___mod_or_lnk mol, long (proc) (fem_context , ___module_struct))
649	___SCMOBJ (proc) (fem_context, ___module_struct)),(fem_context ctx, ___mod_or_lnk mol, long (proc) (fem_context , ___module_struct*))
650	(ctx,(fem_context ctx, ___mod_or_lnk mol, long (proc) (fem_context , ___module_struct))
651	mol,(fem_context ctx, ___mod_or_lnk mol, long (proc) (fem_context , ___module_struct))
652	proc)(fem_context ctx, ___mod_or_lnk mol, long (proc) (fem_context , ___module_struct))
653	fem_context ctx;(fem_context ctx, ___mod_or_lnk mol, long (proc) (fem_context , ___module_struct*))
654	___mod_or_lnk mol;(fem_context ctx, ___mod_or_lnk mol, long (proc) (fem_context , ___module_struct))
655	___SCMOBJ (proc) ();)(fem_context ctx, ___mod_or_lnk mol, long (proc) (fem_context , ___module_struct*))
656	{
657	if (mol->module.kind == ___LINKFILE_KIND1)
658	{
659	void **p = mol->linkfile.linkertbl;
660	while (*p != 0)
661	{
662	___SCMOBJlong e = for_each_module (ctx,
663	___CAST(___mod_or_lnk,p++)((___mod_or_lnk)(p++)),
664	proc);
665	if (e != ___FIX(___NO_ERR)(((long)(0))<<2))
666	return e;
667	}
668	return ___FIX(___NO_ERR)(((long)(0))<<2);
669	}
670	else
671	return proc (ctx, ___CAST(___module_struct,mol)((___module_struct)(mol)));
672	}
673
674
675	___HIDDENstatic void fixref
676	___P((___SCMOBJ p,(long p, long symtbl, long keytbl, long cnstbl, long subtbl )
677	___SCMOBJ symtbl,(long p, long symtbl, long keytbl, long cnstbl, long subtbl )
678	___SCMOBJ keytbl,(long p, long symtbl, long keytbl, long cnstbl, long subtbl )
679	___SCMOBJ cnstbl,(long p, long symtbl, long keytbl, long cnstbl, long subtbl )
680	___SCMOBJ subtbl),(long p, long symtbl, long keytbl, long cnstbl, long subtbl )
681	(p,(long p, long symtbl, long keytbl, long cnstbl, long *subtbl )
682	symtbl,(long p, long symtbl, long keytbl, long cnstbl, long *subtbl )
683	keytbl,(long p, long symtbl, long keytbl, long cnstbl, long *subtbl )
684	cnstbl,(long p, long symtbl, long keytbl, long cnstbl, long *subtbl )
685	subtbl)(long p, long symtbl, long keytbl, long cnstbl, long *subtbl )
686	___SCMOBJ p;(long p, long symtbl, long keytbl, long cnstbl, long subtbl )
687	___SCMOBJ symtbl;(long p, long symtbl, long keytbl, long cnstbl, long subtbl )
688	___SCMOBJ keytbl;(long p, long symtbl, long keytbl, long cnstbl, long subtbl )
689	___SCMOBJ cnstbl;(long p, long symtbl, long keytbl, long cnstbl, long subtbl )
690	___SCMOBJ subtbl;)(long p, long symtbl, long keytbl, long cnstbl, long subtbl )
691	{
692	___SCMOBJlong v = *p;
693	switch (___TYP(v)((v)&((1<<2)-1)))
694	{
695	case ___tMEM11:
696	if (___INT(v)((v)>>2)<0)
697	*p = keytbl[-1-___INT(v)((v)>>2)];
698	else
699	*p = subtbl[___INT(v)((v)>>2)];
700	break;
701
702	case ___tMEM23:
703	if (___INT(v)((v)>>2)<0)
704	*p = symtbl[-1-___INT(v)((v)>>2)];
705	else
706	p = ___TAG(___ALIGNUP(&cnstbl[(___PAIR_SIZE+1)___INT(v)],___WS),(((long)(((long)((((long)(&cnstbl[(2 +1)((v)>>2)] ))+((8)-1))&~((8)-1)))))+(3))
707	___tPAIR)(((long)(((long)((((long)(&cnstbl[(2 +1)((v)>>2)] ))+((8)-1))&~((8)-1)))))+(3));
708	break;
709	}
710	}
711
712
713	___HIDDENstatic ___SCMOBJlong setup_module_phase1
714	___P((fem_context ctx,(fem_context ctx, ___module_struct *module)
715	___module_struct module),(fem_context ctx, ___module_struct *module)
716	(ctx,(fem_context ctx, ___module_struct module)
717	module)(fem_context ctx, ___module_struct module)
718	fem_context ctx;(fem_context ctx, ___module_struct *module)
719	___module_struct module;)(fem_context ctx, ___module_struct *module)
720	{
721	int i, j;
722	___SCMOBJlong *cns;
723	int flags;
724	___FAKEWORDlong* *glotbl;
725	int supcount;
726	___UTF_8STRINGchar* *glo_names;
727	___SCMOBJlong *symtbl;
728	int symcount;
729	___UTF_8STRINGchar* *sym_names;
730	___SCMOBJlong *keytbl;
731	int keycount;
732	___UTF_8STRINGchar* *key_names;
733	___SCMOBJlong *lp;
734	___SCMOBJlong *lbltbl;
735	int lblcount;
736	___SCMOBJlong *ofdtbl;
737	int ofd_length;
738	___SCMOBJlong *cnstbl;
739	int cnscount;
740	___SCMOBJlong *subtbl;
741	int subcount;
742
743	lblcount = module->lblcount;
744
745	if (lblcount > 0)
746	ctx->module_count++;
747
748	flags = module->flags;
749
750	if (flags & ___SETUP_PHASE1_DONE2)
751	return ___FIX(___NO_ERR)(((long)(0))<<2);
752
753	module->flags = flags \| ___SETUP_PHASE1_DONE2;
754
755	cns = 0;
756	glotbl = module->glotbl;
757	supcount = module->supcount;
758	glo_names = module->glo_names;
759	symtbl = ___CAST(___SCMOBJ,module->symtbl)((long)(module->symtbl));
760	symcount = module->symcount;
761	sym_names = module->sym_names;
762	keytbl = ___CAST(___SCMOBJ,module->keytbl)((long)(module->keytbl));
763	keycount = module->keycount;
764	key_names = module->key_names;
765	lp = module->lp;
766	lbltbl = ___CAST(___SCMOBJ,module->lbltbl)((long)(module->lbltbl));
767	ofdtbl = module->ofdtbl;
768	ofd_length = module->ofd_length;
769	cnstbl = module->cnstbl;
770	cnscount = module->cnscount;
771	subtbl = ___CAST(___SCMOBJ,module->subtbl)((long)(module->subtbl));
772	subcount = module->subcount;
773
774	/*
775	* Check that the version of the compiler used to compile the module
776	* is compatible with the compiler used to compile the runtime
777	* system.
778	*/
779
780	if (module->version / 10000 < ___VERSION407000 / 10000)
781	return ___FIX(___MODULE_VERSION_TOO_OLD_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+8)))<<2);
782
783	if (module->version / 10000 > ___VERSION407000 / 10000)
784	return ___FIX(___MODULE_VERSION_TOO_NEW_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+9)))<<2);
785
786	/* Align module's pair table */
787
788	if (cnstbl != 0)
789	cns = align (cnstbl, (___PAIR_SIZE2+1)*cnscount, 0);
790
791	/* Setup module's global variable table */
792
793	if (glo_names != 0)
794	{
795	/*
796	* Create global variables in reverse order so that global
797	* variables bound to c-lambdas are created last.
798	*/
799	i = 0;
800	while (glo_names[i] != 0)
801	i++;
802	while (i-- > 0)
803	{
804	___glo_struct *glo = 0;
805	___SCMOBJlong e = make_global (glo_names[i], i<supcount, &glo);
806	if (e != ___FIX(___NO_ERR)(((long)(0))<<2))
807	return e;
808	glotbl[i] = ___CAST(___FAKEWORD,glo)((long*)(glo));
809	}
810	}
811
812	/* Setup module's symbol table */
813
814	if (sym_names != 0)
815	{
816	i = 0;
817	while (sym_names[i] != 0)
818	{
819	___SCMOBJlong sym = make_symkey (sym_names[i], ___sSYMBOL8);
820	if (___FIXNUMP(sym)(((sym)&((1<<2)-1))==(0)))
821	return sym;
822	symtbl[i] = sym;
823	i++;
824	}
825	}
826	else
827	for (i=symcount-1; i>=0; i--)
828	symtbl[i] = ___TAG(___ALIGNUP(symtbl[i], ___WS), ___tSUBTYPED)(((long)(((long*)((((long)(symtbl[i]))+((8)-1))&~((8)-1)) )))+(1));
829
830	/* Setup module's keyword table */
831
832	if (key_names != 0)
833	{
834	i = 0;
835	while (key_names[i] != 0)
836	{
837	___SCMOBJlong key = make_symkey (key_names[i], ___sKEYWORD9);
838	if (___FIXNUMP(key)(((key)&((1<<2)-1))==(0)))
839	return key;
840	keytbl[i] = key;
841	i++;
842	}
843	}
844	else
845	for (i=keycount-1; i>=0; i--)
846	keytbl[i] = ___TAG(___ALIGNUP(keytbl[i], ___WS), ___tSUBTYPED)(((long)(((long*)((((long)(keytbl[i]))+((8)-1))&~((8)-1)) )))+(1));
847
848	/* Setup module's subtyped object table */
849
850	for (i=subcount-1; i>=0; i--)
851	subtbl[i] = align_subtyped (___CAST(___SCMOBJ,subtbl[i])((long)(subtbl[i])));
852
853	/* Fix references in module's pair table */
854
855	for (i=cnscount-1; i>=0; i--)
856	{
857	fixref (cns+i*(___PAIR_SIZE2+1)+1, symtbl, keytbl, cnstbl, subtbl);
858	fixref (cns+i*(___PAIR_SIZE2+1)+2, symtbl, keytbl, cnstbl, subtbl);
859	}
860
861	/* Fix references in module's subtyped object table */
862
863	for (j=subcount-1; j>=0; j--)
864	{
865	___SCMOBJlong p = ___UNTAG_AS(subtbl[j],___tSUBTYPED)((long)((subtbl[j])-(1)));
866	___SCMOBJlong head = p[0];
867	int subtype = ___HD_SUBTYPE(head)((head)>>3&((1<<5)-1));
868	int words = ___HD_WORDS(head)(((((unsigned long)(head))+((8 -1)<<(3 +5))))>>(( 3 +5)+3));
869	switch (subtype)
870	{
871	case ___sSYMBOL8:
872	case ___sKEYWORD9:
873	case ___sVECTOR0:
874	case ___sSTRUCTURE4:
875	case ___sRATNUM2:
876	case ___sCPXNUM3:
877	for (i=1; i<=words; i++)
878	fixref (p+i, symtbl, keytbl, cnstbl, subtbl);
879	}
880	}
881
882	/* Align module's out-of-line frame descriptor table */
883
884	if (ofdtbl != 0)
885	ofdtbl = ___CAST(___SCMOBJ,align (ofdtbl, ofd_length, 0))((long)(align (ofdtbl, ofd_length, 0)));
886
887	/* Align module's label table */
888
889	if (lblcount > 0)
890	{
891	___host current_host = 0;
892	void **hlbl_ptr = 0;
893	___label_struct *new_lt;
894	___SCMOBJlong *ofd_alloc;
895
896	new_lt = ___CAST(___label_struct,align (lbltbl, lblcount___LS, 0))((___label_struct)(align (lbltbl, lblcount4, 0)));
897	ofd_alloc = ofdtbl;
898
899	for (i=0; i<lblcount; i++)
900	{
901	___label_struct *lbl = &new_lt[i];
902	___SCMOBJlong head = lbl->header;
903
904	if (___TESTHEADERTAG(head,___sVECTOR)(((head)&(((1<<5)-1)<<3))==((0)<<3)))
905	{
906	___UTF_8STRINGchar* name =
907	___CAST(___UTF_8STRING,((char)(((void)(lbl->host_label))))
908	___CAST_FAKEVOIDSTAR_TO_VOIDSTAR(lbl->host_label))((char)(((void)(lbl->host_label))));
909
910	if (name == 0)
911	lbl->host_label = ___CAST(___FAKEVOIDSTAR,___FAL)((void*)(((((long)(-1))<<2)+2)));
912	else
913	{
914	___SCMOBJlong sym =
915	find_symkey_from_UTF_8_string (name, ___sSYMBOL8);
916
917	if (___FIXNUMP(sym)(((sym)&((1<<2)-1))==(0)))
918	return sym;
919
920	if (sym == ___FAL((((long)(-1))<<2)+2))
921	return ___FIX(___UNKNOWN_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+3)))<<2);
922
923	lbl->host_label = ___CAST(___FAKEVOIDSTAR,sym)((void*)(sym));
924	}
925
926	fixref (&lbl->entry_or_descr, symtbl, keytbl, cnstbl, subtbl);
927
928	if (hlbl_ptr != 0)
929	hlbl_ptr++; /* skip INTRO label */
930	}
931	else
932	{
933	if (flags & ___USES_INDIRECT_GOTO1) /* module uses indirect goto statement? */
934	{
935	if (___CAST_FAKEHOST_TO_HOST(lbl->host)lbl->host != current_host)
936	{
937	current_host = ___CAST_FAKEHOST_TO_HOST(lbl->host)lbl->host;
938	hlbl_ptr = ___CAST(void,current_host (0))((void)(current_host (0)));
939	hlbl_ptr++; /* skip INTRO label */
940	}
941	lbl->host_label = ___CAST_VOIDSTAR_TO_FAKEVOIDSTAR(hlbl_ptr++)((void)(*hlbl_ptr++));
942	}
943	if (head == ___MAKE_HD((3<<___LWS),___sRETURN,___PERM)((((3<<3))<<(3 +5))+((15)<<3)+(6)))
944	{
945	___SCMOBJlong descr;
946	descr = lbl->entry_or_descr;
947	if (___IFD_GCMAP(descr)(((descr)>>12)&((1<<20)-1)) == 0) /* out-of-line descriptor? */
948	{
949	int fs;
950	lbl->entry_or_descr = ___CAST(___SCMOBJ,ofd_alloc)((long)(ofd_alloc));
951	fs = ___OFD_FS(ofd_alloc)(((ofd_alloc)>>2)&((1<<14)-1));
952	if (___IFD_KIND(descr)((descr)&((1<<2)-1)) == ___RETI2)
953	fs = ___RETI_CFS_TO_FS(fs)((((fs)+(4)-1)/(4))(4))+(((((5 +1)+3)+(4)-1)/(4))(4))-3;
954	ofd_alloc += 1 + ___CEILING_DIV(fs,___WORD_WIDTH)(((fs)+(64)-1)/(64));
955	}
956	}
957	else
958	lbl->entry_or_descr = ___TAG(&lbl->header,___tSUBTYPED)(((long)(&lbl->header))+(1));
959	}
960	}
961	*lp = ___TAG(new_lt,___tSUBTYPED)(((long)(new_lt))+(1));
962	}
963
964	return ___FIX(___NO_ERR)(((long)(0))<<2);
965	}
966
967
968	___HIDDENstatic char module_prefix[] = ___MODULE_PREFIX" ";
969
970	#define module_prefix_length(sizeof(module_prefix)-1) (sizeof(module_prefix)-1)
971
972
973	___HIDDENstatic ___SCMOBJlong setup_module_phase2
974	___P((fem_context ctx,(fem_context ctx, ___module_struct *module)
975	___module_struct module),(fem_context ctx, ___module_struct *module)
976	(ctx,(fem_context ctx, ___module_struct module)
977	module)(fem_context ctx, ___module_struct module)
978	fem_context ctx;(fem_context ctx, ___module_struct *module)
979	___module_struct module;)(fem_context ctx, ___module_struct *module)
980	{
981	___processor_state ___ps = ___PSTATE(&(&___gstate)->pstate);
982	___UTF_8STRINGchar* *glo_names = module->glo_names;
983
984	if (glo_names != 0)
985	{
986	___UTF_8STRINGchar* name = module->name;
987	___FAKEWORDlong* *glotbl = module->glotbl;
988	int glocount = module->glocount;
989	int supcount = module->supcount;
990	int i;
991	for (i=supcount; i<glocount; i++)
992	{
993	/*
994	* If the global variable is undefined, add it to the list
995	* of undefined variables in the module descriptor.
996	*/
997
998	___glo_struct glo = ___CAST(___glo_struct,glotbl[i])((___glo_struct*)(glotbl[i]));
999
1000	if (___GLOCELL(glo->val)glo->val == ___UNB1((((long)(-7))<<2)+2))
1001	{
1002	___SCMOBJlong err;
1003	___SCMOBJlong glo_name;
1004	___SCMOBJlong module_name;
1005	___SCMOBJlong pair1;
1006	___SCMOBJlong pair2;
1007
1008	if ((err = ___NONNULLUTF_8STRING_to_SCMOBJ
1009	(glo_names[i],
1010	&glo_name,
1011	0))
1012	!= ___FIX(___NO_ERR)(((long)(0))<<2))
1013	return err;
1014
1015	if ((err = ___NONNULLUTF_8STRING_to_SCMOBJ
1016	(name+module_prefix_length(sizeof(module_prefix)-1),
1017	&module_name,
1018	0))
1019	!= ___FIX(___NO_ERR)(((long)(0))<<2))
1020	{
1021	___release_scmobj (glo_name);
1022	return ___FIX(err)(((long)(err))<<2);
1023	}
1024
1025	pair1 = ___make_pair (glo_name, module_name, ___STILL5);
1026
1027	___release_scmobj (glo_name);
1028	___release_scmobj (module_name);
1029
1030	if (___FIXNUMP(pair1)(((pair1)&((1<<2)-1))==(0)))
1031	return pair1;
1032
1033	pair2 = ___make_pair (pair1, ___FIELD(ctx->module_descr,1)(((((long)((ctx->module_descr)-(1)))+1)+1)), ___STILL5);
1034
1035	___release_scmobj (pair1);
1036
1037	if (___FIXNUMP(pair2)(((pair2)&((1<<2)-1))==(0)))
1038	return pair2;
1039
1040	___FIELD(ctx->module_descr,1)(((((long)((ctx->module_descr)-(1)))+1)+1)) = pair2;
1041
1042	___release_scmobj (pair2);
1043	}
1044	}
1045	}
1046
1047	return ___FIX(___NO_ERR)(((long)(0))<<2);
1048	}
1049
1050
1051	___HIDDENstatic ___SCMOBJlong setup_module_phase3
1052	___P((fem_context ctx,(fem_context ctx, ___module_struct *module)
1053	___module_struct module),(fem_context ctx, ___module_struct *module)
1054	(ctx,(fem_context ctx, ___module_struct module)
1055	module)(fem_context ctx, ___module_struct module)
1056	fem_context ctx;(fem_context ctx, ___module_struct *module)
1057	___module_struct module;)(fem_context ctx, ___module_struct *module)
1058	{
1059	if (module->lblcount > 0)
1060	{
1061	___SCMOBJlong err;
1062	___SCMOBJlong mod_name;
1063	___SCMOBJlong descr = ___make_vector (2, ___FAL((((long)(-1))<<2)+2), ___STILL5);
1064
1065	if (___FIXNUMP(descr)(((descr)&((1<<2)-1))==(0)))
1066	return descr;
1067
1068	if ((err = ___NONNULLUTF_8STRING_to_SCMOBJ
1069	(module->name+1,
1070	&mod_name,
1071	0))
1072	!= ___FIX(___NO_ERR)(((long)(0))<<2))
1073	{
1074	___release_scmobj (descr);
1075	return err;
1076	}
1077
1078	___FIELD(descr,0)(((((long)((descr)-(1)))+1)+0)) = mod_name;
1079
1080	___release_scmobj (mod_name);
1081
1082	___FIELD(descr,1)(((((long)((descr)-(1)))+1)+1)) = module->lp+___LS4___WS8;
1083
1084	___FIELD(___FIELD(ctx->module_descr,0),ctx->module_count)(((((long)(((((((long)((ctx->module_descr)-(1)))+1)+0) ))-(1)))+1)+ctx->module_count)) = descr;
1085
1086	___release_scmobj (descr);
1087
1088	ctx->module_count++;
1089	}
1090
1091	return module->init_proc ();
1092	}
1093
1094
1095	___HIDDENstatic ___SCMOBJlong get_script_line_proc
1096	___P((fem_context ctx,(fem_context ctx, ___module_struct *module)
1097	___module_struct module),(fem_context ctx, ___module_struct *module)
1098	(ctx,(fem_context ctx, ___module_struct module)
1099	module)(fem_context ctx, ___module_struct module)
1100	fem_context ctx;(fem_context ctx, ___module_struct *module)
1101	___module_struct module;)(fem_context ctx, ___module_struct *module)
1102	{
1103	if (module->script_line != 0)
1104	ctx->module_script_line = module->script_line;
1105	return ___FIX(___NO_ERR)(((long)(0))<<2);
1106	}
1107
1108
1109	___HIDDENstatic ___UTF_8STRINGchar* get_script_line
1110	___P((___mod_or_lnk mol),(___mod_or_lnk mol)
1111	(mol)(___mod_or_lnk mol)
1112	___mod_or_lnk mol;)(___mod_or_lnk mol)
1113	{
1114	fem_context fem_ctx;
1115	fem_context *ctx = &fem_ctx;
1116
1117	ctx->module_script_line = 0;
1118
1119	if (for_each_module (ctx, mol, get_script_line_proc) == ___FIX(___NO_ERR)(((long)(0))<<2))
1120	return ctx->module_script_line;
1121
1122	return 0;
1123	}
1124
1125
1126	___HIDDENstatic ___SCMOBJlong setup_modules
1127	___P((___mod_or_lnk mol),(___mod_or_lnk mol)
1128	(mol)(___mod_or_lnk mol)
1129	___mod_or_lnk mol;)(___mod_or_lnk mol)
1130	{
1131	___SCMOBJlong result;
1132
1133	result = ___make_vector (3, ___NUL((((long)(-3))<<2)+2), ___STILL5);
1134
1135	if (!___FIXNUMP(result)(((result)&((1<<2)-1))==(0)))
1136	{
1137	fem_context fem_ctx;
1138	fem_context *ctx = &fem_ctx;
1139
1140	ctx->module_count = 0;
1141	ctx->module_descr = result;
1142
1143	if ((result = for_each_module (ctx,
1144	mol,
1145	setup_module_phase1))
1146	== ___FIX(___NO_ERR)(((long)(0))<<2))
1147	{
1148	if ((result = for_each_module (ctx,
1149	mol,
1150	setup_module_phase2))
1151	== ___FIX(___NO_ERR)(((long)(0))<<2))
1152	{
1153	result = ___make_vector (ctx->module_count, ___FAL((((long)(-1))<<2)+2), ___STILL5);
1154
1155	if (!___FIXNUMP(result)(((result)&((1<<2)-1))==(0)))
1156	{
1157	___FIELD(ctx->module_descr,0)(((((long)((ctx->module_descr)-(1)))+1)+0)) = result;
1158	___release_scmobj (result);
1159
1160	ctx->module_count = 0;
1161
1162	if ((result = for_each_module (ctx,
1163	mol,
1164	setup_module_phase3))
1165	== ___FIX(___NO_ERR)(((long)(0))<<2))
1166	{
1167	___SCMOBJlong script_line;
1168
1169	if ((result = ___UTF_8STRING_to_SCMOBJ
1170	(get_script_line (mol),
1171	&script_line,
1172	0))
1173	== ___FIX(___NO_ERR)(((long)(0))<<2))
1174	{
1175	___FIELD(ctx->module_descr,2)(((((long)((ctx->module_descr)-(1)))+1)+2)) = script_line;
1176	___release_scmobj (script_line);
1177	result = ctx->module_descr;
1178	}
1179	}
1180	}
1181	}
1182	}
1183
1184	if (___FIXNUMP(result)(((result)&((1<<2)-1))==(0)))
1185	___release_scmobj (ctx->module_descr);
1186	}
1187
1188	return result;
1189	}
1190
1191
1192	___SCMOBJlong ___os_load_object_file
1193	___P((___SCMOBJ path,(long path, long modname)
1194	___SCMOBJ modname),(long path, long modname)
1195	(path,(long path, long modname)
1196	modname)(long path, long modname)
1197	___SCMOBJ path;(long path, long modname)
1198	___SCMOBJ modname;)(long path, long modname)
1199	{
1200	___SCMOBJlong result;
1201	void *linker;
1202	___mod_or_lnk mol;
1203
1204	if ((result = ___dynamic_load (path, modname, &linker)) == ___FIX(___NO_ERR)(((long)(0))<<2))
1205	{
1206	mol = linker_to_mod_or_lnk
1207	(___CAST(___mod_or_lnk () ___P((___global_state_struct),()),((___mod_or_lnk () (___global_state_struct))(linker))
1208	linker)((___mod_or_lnk () (___global_state_struct))(linker)));
1209
1210	if (mol->linkfile.version < 0) /* was it already setup? */
1211	result = ___FIX(___MODULE_ALREADY_LOADED_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+10)))<<2);
1212	else
1213	{
1214	result = setup_modules (mol);
1215	mol->linkfile.version = -1; /* mark link file as 'setup' */
1216	}
1217	}
1218
1219	___release_scmobj (result);
1220
1221	return result;
1222	}
1223
1224
1225	/---------------------------------------------------------------------------/
1226
1227	/*
1228	* Character operations.
1229	*/
1230
1231
1232	___EXP_FUNC(___BOOL,___iswalpha)int ___iswalpha
1233	___P((___UCS_4 x),(unsigned int x)
1234	(x)(unsigned int x)
1235	___UCS_4 x;)(unsigned int x)
1236	{
1237	#ifdef USE_wctype
1238
1239	return iswalpha (x);
1240
1241	#else
1242
1243	return (x >= 97 && x <= 122) \|\| (x >= 65 && x <= 90);
1244
1245	#endif
1246	}
1247
1248
1249	___EXP_FUNC(___BOOL,___iswdigit)int ___iswdigit
1250	___P((___UCS_4 x),(unsigned int x)
1251	(x)(unsigned int x)
1252	___UCS_4 x;)(unsigned int x)
1253	{
1254	#ifdef USE_wctype
1255
1256	return iswdigit (x);
1257
1258	#else
1259
1260	return x>= 48 && x <= 57;
1261
1262	#endif
1263	}
1264
1265
1266	___EXP_FUNC(___BOOL,___iswspace)int ___iswspace
1267	___P((___UCS_4 x),(unsigned int x)
1268	(x)(unsigned int x)
1269	___UCS_4 x;)(unsigned int x)
1270	{
1271	#ifdef USE_wctype
1272
1273	return iswspace (x);
1274
1275	#else
1276
1277	return (x >= 9 && x <= 13) \|\| (x == 32);
1278
1279	#endif
1280	}
1281
1282
1283	___EXP_FUNC(___BOOL,___iswupper)int ___iswupper
1284	___P((___UCS_4 x),(unsigned int x)
1285	(x)(unsigned int x)
1286	___UCS_4 x;)(unsigned int x)
1287	{
1288	#ifdef USE_wctype
1289
1290	return iswupper (x);
1291
1292	#else
1293
1294	return x >= 65 && x <= 90;
1295
1296	#endif
1297	}
1298
1299
1300	___EXP_FUNC(___BOOL,___iswlower)int ___iswlower
1301	___P((___UCS_4 x),(unsigned int x)
1302	(x)(unsigned int x)
1303	___UCS_4 x;)(unsigned int x)
1304	{
1305	#ifdef USE_wctype
1306
1307	return iswlower (x);
1308
1309	#else
1310
1311	return x >= 97 && x <= 122;
1312
1313	#endif
1314	}
1315
1316
1317	___EXP_FUNC(___UCS_4,___towupper)unsigned int ___towupper
1318	___P((___UCS_4 x),(unsigned int x)
1319	(x)(unsigned int x)
1320	___UCS_4 x;)(unsigned int x)
1321	{
1322	#ifdef USE_wctype
1323
1324	return towupper (x);
1325
1326	#else
1327
1328	return (x >= 97 && x <= 122) ? x-32 : x;
1329
1330	#endif
1331	}
1332
1333
1334	___EXP_FUNC(___UCS_4,___towlower)unsigned int ___towlower
1335	___P((___UCS_4 x),(unsigned int x)
1336	(x)(unsigned int x)
1337	___UCS_4 x;)(unsigned int x)
1338	{
1339	#ifdef USE_wctype
1340
1341	return towlower (x);
1342
1343	#else
1344
1345	return (x >= 65 && x <= 90) ? x+32 : x;
1346
1347	#endif
1348	}
1349
1350
1351	#define STRING_COLLATE_BUF_LENGTH1000 1000
1352
1353
1354	___EXP_FUNC(___SCMOBJ,___string_collate)long ___string_collate
1355	___P((___SCMOBJ str1,(long str1, long str2)
1356	___SCMOBJ str2),(long str1, long str2)
1357	(str1,(long str1, long str2)
1358	str2)(long str1, long str2)
1359	___SCMOBJ str1;(long str1, long str2)
1360	___SCMOBJ str2;)(long str1, long str2)
1361	{
1362	int len1 = ___INT(___STRINGLENGTH(str1))(((((long)(((((unsigned long)((((long)((str1)-(1))))))>> (3 +5))>>2)))<<2))>>2);
1363	int len2 = ___INT(___STRINGLENGTH(str2))(((((long)(((((unsigned long)((((long)((str2)-(1))))))>> (3 +5))>>2)))<<2))>>2);
1364
1365	#ifdef USE_wchar
1366
1367	wchar_t buf[STRING_COLLATE_BUF_LENGTH1000];
1368	wchar_t *b1;
1369	wchar_t *b2;
1370	wchar_t *s1;
1371	wchar_t *s2;
1372	wchar_t *p;
1373	int i;
1374	int result;
1375
1376	if (len1 + len2 + 2 > STRING_COLLATE_BUF_LENGTH1000)
1377	{
1378	b1 = ___CAST(wchar_t,___alloc_mem (len1 + 1))((wchar_t)(___alloc_mem (len1 + 1)));
1379
1380	if (b1 == 0)
1381	return ___FIX(___HEAP_OVERFLOW_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+5)))<<2);
1382
1383	p = b1;
1384
1385	for (i=0; i<len1; i++)
1386	p++ = ___INT(___STRINGREF(str1,___FIX(i)))((((((long)(((unsigned int)((((unsigned int)((((long)((str1 )-(1)))+1)))+(((((long)(i))<<2))>>2))))))<< 2)+2))>>2);
1387
1388	*p = '\0';
1389
1390	b2 = ___CAST(wchar_t,___alloc_mem (len1 + 1))((wchar_t)(___alloc_mem (len1 + 1)));
1391
1392	if (b2 == 0)
1393	{
1394	___free_mem (b1);
1395	return ___FIX(___HEAP_OVERFLOW_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+5)))<<2);
1396	}
1397
1398	p = b2;
1399
1400	for (i=0; i<len2; i++)
1401	p++ = ___INT(___STRINGREF(str2,___FIX(i)))((((((long)(((unsigned int)((((unsigned int)((((long)((str2 )-(1)))+1)))+(((((long)(i))<<2))>>2))))))<< 2)+2))>>2);
1402
1403	*p = '\0';
1404	}
1405	else
1406	{
1407	p = buf;
1408
1409	b1 = p;
1410
1411	for (i=0; i<len1; i++)
1412	p++ = ___INT(___STRINGREF(str1,___FIX(i)))((((((long)(((unsigned int)((((unsigned int)((((long)((str1 )-(1)))+1)))+(((((long)(i))<<2))>>2))))))<< 2)+2))>>2);
1413
1414	*p++ = '\0';
1415
1416	b2 = p;
1417
1418	for (i=0; i<len2; i++)
1419	p++ = ___INT(___STRINGREF(str2,___FIX(i)))((((((long)(((unsigned int)((((unsigned int)((((long)((str2 )-(1)))+1)))+(((((long)(i))<<2))>>2))))))<< 2)+2))>>2);
1420
1421	*p++ = '\0';
1422	}
1423
1424	result = 0;
1425	s1 = b1;
1426	s2 = b2;
1427
1428	while (len1 > 0 && len2 > 0 && result == 0)
1429	{
1430	int l1;
1431	int l2;
1432
1433	result = wcscoll (s1, s2);
1434
1435	l1 = wcslen (s1) + 1;
1436	l2 = wcslen (s2) + 1;
1437
1438	s1 += l1;
1439	s2 += l2;
1440
1441	len1 -= l1;
1442	len2 -= l2;
1443	}
1444
1445	if (len1 + len2 + 2 > STRING_COLLATE_BUF_LENGTH1000)
1446	{
1447	___free_mem (b1);
1448	___free_mem (b2);
1449	}
1450
1451	if (result < 0)
1452	return ___FIX(0)(((long)(0))<<2);
1453
1454	if (result > 0)
1455	return ___FIX(2)(((long)(2))<<2);
1456
1457	if (len1 < len2)
1458	return ___FIX(0)(((long)(0))<<2);
1459
1460	if (len1 > len2)
1461	return ___FIX(2)(((long)(2))<<2);
1462
1463	return ___FIX(1)(((long)(1))<<2);
1464
1465	#else
1466
1467	int n;
1468	int i;
1469
1470	n = len1;
1471	if (len2 < n)
1472	n = len2;
1473
1474	for (i=0; i<n; i++)
1475	{
1476	___SCMOBJlong c1 = ___STRINGREF(str1,___FIX(i))((((long)(((unsigned int)((((unsigned int)((((long*)((str1) -(1)))+1)))+(((((long)(i))<<2))>>2))))))<<2 )+2);
1477	___SCMOBJlong c2 = ___STRINGREF(str2,___FIX(i))((((long)(((unsigned int)((((unsigned int)((((long*)((str2) -(1)))+1)))+(((((long)(i))<<2))>>2))))))<<2 )+2);
1478
1479	if (___CHARLTP(c1,c2)((c1)<(c2)))
1480	return ___FIX(0)(((long)(0))<<2);
1481
1482	if (___CHARGTP(c1,c2)((c1)>(c2)))
1483	return ___FIX(2)(((long)(2))<<2);
1484	}
1485
1486	if (len1 < len2)
1487	return ___FIX(0)(((long)(0))<<2);
1488
1489	if (len1 > len2)
1490	return ___FIX(2)(((long)(2))<<2);
1491
1492	return ___FIX(1)(((long)(1))<<2);
1493
1494	#endif
1495	}
1496
1497
1498	___EXP_FUNC(___SCMOBJ,___string_collate_ci)long ___string_collate_ci
1499	___P((___SCMOBJ str1,(long str1, long str2)
1500	___SCMOBJ str2),(long str1, long str2)
1501	(str1,(long str1, long str2)
1502	str2)(long str1, long str2)
1503	___SCMOBJ str1;(long str1, long str2)
1504	___SCMOBJ str2;)(long str1, long str2)
1505	{
1506	int len1 = ___INT(___STRINGLENGTH(str1))(((((long)(((((unsigned long)((((long)((str1)-(1))))))>> (3 +5))>>2)))<<2))>>2);
1507	int len2 = ___INT(___STRINGLENGTH(str2))(((((long)(((((unsigned long)((((long)((str2)-(1))))))>> (3 +5))>>2)))<<2))>>2);
1508
1509	#ifdef USE_wchar
1510
1511	return ___FIX(0)(((long)(0))<<2);
1512
1513	#else
1514
1515	int n;
1516	int i;
1517
1518	n = len1;
1519	if (len2 < n)
1520	n = len2;
1521
1522	for (i=0; i<n; i++)
1523	{
1524	___UCS_4unsigned int c1 = ___INT(___STRINGREF(str1,___FIX(i)))((((((long)(((unsigned int)((((unsigned int)((((long*)((str1 )-(1)))+1)))+(((((long)(i))<<2))>>2))))))<< 2)+2))>>2);
1525	___UCS_4unsigned int c2 = ___INT(___STRINGREF(str2,___FIX(i)))((((((long)(((unsigned int)((((unsigned int)((((long*)((str2 )-(1)))+1)))+(((((long)(i))<<2))>>2))))))<< 2)+2))>>2);
1526
1527	if (c1 >= 65 && c1 <= 90)
1528	c1 += 32;
1529
1530	if (c2 >= 65 && c2 <= 90)
1531	c2 += 32;
1532
1533	if (c1 < c2)
1534	return ___FIX(0)(((long)(0))<<2);
1535
1536	if (c1 > c2)
1537	return ___FIX(2)(((long)(2))<<2);
1538	}
1539
1540	if (len1 < len2)
1541	return ___FIX(0)(((long)(0))<<2);
1542
1543	if (len1 > len2)
1544	return ___FIX(2)(((long)(2))<<2);
1545
1546	return ___FIX(1)(((long)(1))<<2);
1547
1548	#endif
1549	}
1550
1551
1552	/---------------------------------------------------------------------------/
1553
1554	/*
1555	* Numerical library routines.
1556	*/
1557
1558	#ifdef ___BIG_ENDIAN
1559	#define F64_HI87 0
1560	#define F64_HI163 0
1561	#define F64_HI321 0
1562	#define F64_LO320 1
1563	#else
1564	#define F64_HI87 7
1565	#define F64_HI163 3
1566	#define F64_HI321 1
1567	#define F64_LO320 0
1568	#endif
1569
1570
1571	___EXP_FUNC(double,___copysign)double ___copysign
1572	___P((double x,(double x, double y)
1573	double y),(double x, double y)
1574	(x,(double x, double y)
1575	y)(double x, double y)
1576	double x;(double x, double y)
1577	double y;)(double x, double y)
1578	{
1579	___STORE_U8(&x,(((unsigned char)(&x))+(7)) = (((((unsigned char)(& x))+(7))&0x7f)\|((((unsigned char)(&y))+(7))&0x80 ))
1580	F64_HI8,(((unsigned char)(&x))+(7)) = (((((unsigned char)(& x))+(7))&0x7f)\|((((unsigned char)(&y))+(7))&0x80 ))
1581	(___FETCH_U8(&x,F64_HI8)&0x7f)\|(___FETCH_U8(&y,F64_HI8)&0x80))(((unsigned char)(&x))+(7)) = (((((unsigned char)(& x))+(7))&0x7f)\|((((unsigned char)(&y))+(7))&0x80 ));
1582
1583	return x;
1584	}
1585
1586
1587	___EXP_FUNC(___BOOL,___isfinite)int ___isfinite
1588	___P((double x),(double x)
1589	(x)(double x)
1590	double x;)(double x)
1591	{
1592	#ifdef ___CRAY_FP_FORMAT
1593
1594	return 1;
1595
1596	#else
1597
1598	union
1599	{
1600	___U16unsigned short u16[4];
1601	___F64double f64;
1602	} y;
1603
1604	y.f64 = x;
1605
1606	return ((y.u16[F64_HI163] ^ 0x7ff0) & 0x7fff) >= 0x10;
1607
1608	#endif
1609	}
1610
1611
1612	___EXP_FUNC(___BOOL,___isnan)int ___isnan
1613	___P((double x),(double x)
1614	(x)(double x)
1615	double x;)(double x)
1616	{
1617	#ifdef ___CRAY_FP_FORMAT
1618
1619	return 0;
1620
1621	#else
1622
1623	___UM32unsigned int tmp;
1624
1625	union
1626	{
1627	___U32unsigned int u32[2];
1628	___F64double f64;
1629	} y;
1630
1631	y.f64 = x;
1632
1633	tmp = (y.u32[F64_HI321] ^ 0x7ff00000) & 0x7fffffff;
1634
1635	return tmp < 0x100000 && (tmp \| y.u32[F64_LO320]) != 0;
1636
1637	#endif
1638	}
1639
1640
1641	___EXP_FUNC(double,___trunc)double ___trunc
1642	___P((double x),(double x)
1643	(x)(double x)
1644	double x;)(double x)
1645	{
1646	double f = floor (x);
1647	if (x < 0.0 && x != f)
1648	return f + 1.0;
1649	else
1650	return f;
1651	}
1652
1653
1654	___EXP_FUNC(double,___round)double ___round
1655	___P((double x),(double x)
1656	(x)(double x)
1657	double x;)(double x)
1658	{
1659	double f, i, t;
1660	if (x < 0.0)
1661	{
1662	f = modf (-x, &i);
1663	if (f > 0.5 \|\| (f == 0.5 && modf (i*0.5, &t) != 0.0))
1664	return -(i+1.0);
1665	else
1666	return -i;
1667	}
1668	else if (x == 0.0) /* so that round (-0.0) = -0.0 */
1669	return x;
1670	else
1671	{
1672	f = modf (x, &i);
1673	if (f > 0.5 \|\| (f == 0.5 && modf (i*0.5, &t) != 0.0))
1674	return i+1.0;
1675	else
1676	return i;
1677	}
1678	}
1679
1680
1681	#ifndef ___GOOD_ATAN2
1682
1683	___EXP_FUNC(double,___atan2)double ___atan2
1684	___P((double y,(double y, double x)
1685	double x),(double y, double x)
1686	(y,(double y, double x)
1687	x)(double y, double x)
1688	double y;(double y, double x)
1689	double x;)(double y, double x)
1690	{
1691	if (___isnan (x))
1692	return x;
1693	else if (___isnan (y))
1694	return y;
1695	else if (y == 0.0)
1696	{
1697	if (___copysign (1.0, y) > 0.0)
1698	{
1699	if (___copysign (1.0, x) > 0.0)
1700	return 0.0;
1701	else
1702	return 3.141592653589793; /* from "header.scm" */
1703	}
1704	else
1705	{
1706	if (___copysign (1.0, x) > 0.0)
1707	return -0.0;
1708	else
1709	return -3.141592653589793; /* from "header.scm" */
1710	}
1711	}
1712	else if (___isfinite (x) \|\| ___isfinite (y))
1713	return atan2 (y, x);
1714	else
1715	return ___copysign (x/y, xy); / returns NAN with appropriate sign */
1716	}
1717
1718	#endif
1719
1720
1721	#ifndef ___GOOD_POW
1722
1723	___EXP_FUNC(double,___pow)double ___pow
1724	___P((double x,(double x, double y)
1725	double y),(double x, double y)
1726	(x,(double x, double y)
1727	y)(double x, double y)
1728	double x;(double x, double y)
1729	double y;)(double x, double y)
1730	{
1731	if (y == 0.0)
1732	return 1.0;
1733	else if (___isnan (x))
1734	return x;
1735	else if (___isnan (y))
1736	return y;
1737	else
1738	return pow (x, y);
1739	}
1740
1741	#endif
1742
1743
1744	/---------------------------------------------------------------------------/
1745
1746	/*
1747	* Initialization of symbol and keyword tables, and global variables.
1748	*/
1749
1750	___HIDDENstatic void init_symkey_glo1
1751	___P((___mod_or_lnk mol),(___mod_or_lnk mol)
1752	(mol)(___mod_or_lnk mol)
1753	___mod_or_lnk mol;)(___mod_or_lnk mol)
1754	{
1755	if (mol->module.kind == ___LINKFILE_KIND1)
1756	{
1757	void **p1 = mol->linkfile.linkertbl;
1758	___FAKEWORDlong* *p2 = mol->linkfile.sym_list;
1759
1760	while (*p1 != 0)
1761	init_symkey_glo1 (___CAST(___mod_or_lnk,p1++)((___mod_or_lnk)(p1++)));
1762
1763	while (p2 != 0)
1764	{
1765	___SCMOBJlong *sym_ptr;
1766	___glo_struct *glo;
1767
1768	sym_ptr = ___CAST(___SCMOBJ,p2)((long)(p2));
1769
1770	p2 = ___CAST(___FAKEWORD,sym_ptr[0])((long*)(sym_ptr[0]));
1771	glo = ___CAST(___glo_struct,sym_ptr[1+___SYMBOL_GLOBAL])((___glo_struct)(sym_ptr[1+3]));
1772
1773	sym_ptr[1+___SYMKEY_HASH1] = glo->prm; /* move symbol's hash value */
1774	}
1775	}
1776	}
1777
1778
1779	___HIDDENstatic void init_symkey_glo2
1780	___P((___mod_or_lnk mol),(___mod_or_lnk mol)
1781	(mol)(___mod_or_lnk mol)
1782	___mod_or_lnk mol;)(___mod_or_lnk mol)
1783	{
1784	if (mol->module.kind == ___LINKFILE_KIND1)
1785	{
1786	void **p1 = mol->linkfile.linkertbl;
1787	___FAKEWORDlong* *p2 = mol->linkfile.sym_list;
1788	___FAKEWORDlong* *p3 = mol->linkfile.key_list;
1789	___processor_state ___ps = ___PSTATE(&(&___gstate)->pstate);
1790
1791	while (*p1 != 0)
1792	init_symkey_glo2 (___CAST(___mod_or_lnk,p1++)((___mod_or_lnk)(p1++)));
1793
1794	while (p2 != 0)
1795	{
1796	___SCMOBJlong sym;
1797	___SCMOBJlong str;
1798	___SCMOBJlong *sym_ptr;
1799	___glo_struct *glo;
1800
1801	sym_ptr = ___CAST(___SCMOBJ,p2)((long)(p2));
1802
1803	p2 = ___CAST(___FAKEWORD,sym_ptr[0])((long*)(sym_ptr[0]));
1804	str = align_subtyped (___CAST(___SCMOBJ,sym_ptr[1+___SYMKEY_NAME])((long)(sym_ptr[1+0])));
1805	glo = ___CAST(___glo_struct,sym_ptr[1+___SYMBOL_GLOBAL])((___glo_struct)(sym_ptr[1+3]));
1806
1807	#ifdef ___MULTIPLE_GLO
1808	{
1809	___SCMOBJlong tmp = glo->val;
1810	glo->val = ___gstate.nb_glo_vars;
1811	___GLOCELL(glo->val)glo->val = tmp;
1812	}
1813	#endif
1814
1815	#ifdef ___MULTIPLE_PRM
1816	{
1817	___SCMOBJlong tmp = glo->prm;
1818	glo->prm = ___gstate.nb_glo_vars;
1819	___PRMCELL(glo->prm)glo->prm = tmp;
1820	}
1821	#endif
1822
1823	#ifdef ___MULTIPLE_GLO
1824	___gstate.nb_glo_vars++;
1825	#else
1826	#ifdef ___MULTIPLE_PRM
1827	___gstate.nb_glo_vars++;
1828	#endif
1829	#endif
1830
1831	glo->next = 0;
1832	if (___ps->glo_list_head == 0)
1833	___ps->glo_list_head = ___CAST(___SCMOBJ,glo)((long)(glo));
1834	else
1835	___CAST(___glo_struct,___ps->glo_list_tail)((___glo_struct)(___ps->glo_list_tail))->next =
1836	___CAST(___SCMOBJ,glo)((long)(glo));
1837	___ps->glo_list_tail = ___CAST(___SCMOBJ,glo)((long)(glo));
1838
1839	*sym_ptr = ___MAKE_HD((___SYMBOL_SIZE<<___LWS),___sSYMBOL,___PERM)((((4<<3))<<(3 +5))+((8)<<3)+(6));
1840
1841	sym = align_subtyped (sym_ptr);
1842
1843	___FIELD(sym,___SYMKEY_NAME)(((((long)((sym)-(1)))+1)+0)) = str;
1844	___FIELD(sym,___SYMBOL_GLOBAL)(((((long)((sym)-(1)))+1)+3)) = ___CAST(___SCMOBJ,glo)((long)(glo));
1845
1846	symkey_add (sym);
1847	}
1848
1849	while (p3 != 0)
1850	{
1851	___SCMOBJlong key, str;
1852	___SCMOBJlong *key_ptr;
1853
1854	key_ptr = ___CAST(___SCMOBJ,p3)((long)(p3));
1855
1856	p3 = ___CAST(___FAKEWORD,key_ptr[0])((long*)(key_ptr[0]));
1857	str = align_subtyped (___CAST(___SCMOBJ,key_ptr[1+___SYMKEY_NAME])((long)(key_ptr[1+0])));
1858
1859	*key_ptr = ___MAKE_HD((___KEYWORD_SIZE<<___LWS),___sKEYWORD,___PERM)((((3<<3))<<(3 +5))+((9)<<3)+(6));
1860
1861	key = align_subtyped (key_ptr);
1862
1863	___FIELD(key,___SYMKEY_NAME)(((((long)((key)-(1)))+1)+0)) = str;
1864	___FIELD(key,___SYMKEY_HASH)(((((long)((key)-(1)))+1)+1)) = hash_scheme_string (str);
1865
1866	symkey_add (key);
1867	}
1868	}
1869	}
1870
1871
1872	/---------------------------------------------------------------------------/
1873
1874	/*
1875	* C to Scheme call handler.
1876	*/
1877
1878
1879	#ifdef EMSCRIPTEN
1880
1881	/*
1882	* The trampoline function must not be inlined into the ___call
1883	* function when using emscripten because the fact that ___call uses
1884	* setjmp will slow down the indirect calls.
1885	*/
1886
1887	__attribute__((noinline))
1888
1889	#endif
1890
1891	___HIDDENstatic void trampoline
1892	___P((___processor_state ___ps),(___processor_state ___ps)
1893	(___ps)(___processor_state ___ps)
1894	___processor_state ___ps;)(___processor_state ___ps)
1895	{
1896	___SCMOBJlong ___pc = ___ps->pc;
1897
1898	for (;;)
1899	{
1900	#define CALL_STEP___pc = (((___host)((___pc)+((3<<3)-1))))(___ps) ___pc = ___LABEL_HOST(___pc)(((___host)((___pc)+((3<<3)-1))))(___ps)
1901	CALL_STEP___pc = (((___host)((___pc)+((3<<3)-1))))(___ps);
1902	CALL_STEP___pc = (((___host)((___pc)+((3<<3)-1))))(___ps);
1903	CALL_STEP___pc = (((___host)((___pc)+((3<<3)-1))))(___ps);
1904	CALL_STEP___pc = (((___host)((___pc)+((3<<3)-1))))(___ps);
1905	CALL_STEP___pc = (((___host)((___pc)+((3<<3)-1))))(___ps);
1906	CALL_STEP___pc = (((___host)((___pc)+((3<<3)-1))))(___ps);
1907	CALL_STEP___pc = (((___host)((___pc)+((3<<3)-1))))(___ps);
1908	CALL_STEP___pc = (((___host)((___pc)+((3<<3)-1))))(___ps);
1909	}
1910	}
1911
1912
1913	___EXP_FUNC(___SCMOBJ,___call)long ___call
1914	___P((int nargs,(int nargs, long proc, long stack_marker)
1915	___SCMOBJ proc,(int nargs, long proc, long stack_marker)
1916	___SCMOBJ stack_marker),(int nargs, long proc, long stack_marker)
1917	(nargs,(int nargs, long proc, long stack_marker)
1918	proc,(int nargs, long proc, long stack_marker)
1919	stack_marker)(int nargs, long proc, long stack_marker)
1920	int nargs;(int nargs, long proc, long stack_marker)
1921	___SCMOBJ proc;(int nargs, long proc, long stack_marker)
1922	___SCMOBJ stack_marker;)(int nargs, long proc, long stack_marker)
1923	{
1924	___SCMOBJlong ___err;
1925	___processor_state ___ps = ___PSTATE(&(&___gstate)->pstate);
1926	___SCMOBJlong *___fp = ___ps->fp;
1927
1928	/*
1929	* The C function which has called ___call() has put the arguments
1930	* of the Scheme procedure on the stack above ___fp as shown in the
1931	* 'on entry' picture below. The free space under arg1 is for a
1932	* continuation frame that performs the return of control from
1933	* Scheme to C. This frame is set up by ___call() before the
1934	* destination Scheme procedure is invoked. The frame is accessed
1935	* by the return_to_c handler (in "_kernel.scm") which is invoked
1936	* when the called procedure returns. The frame contains a heap
1937	* allocated 'stack marker', allocated by the caller, which
1938	* indicates the destination Scheme procedure and if it is still possible
1939	* to return to the caller (i.e. its activation frame is still on
1940	* the C stack). The caller will store #f in the stack marker so
1941	* that any subsequent attempt to return to that invocation of the
1942	* caller will be detected and trigger an error.
1943	*
1944	*
1945	* ON ENTRY: JUST BEFORE JUMPING TO THE SCHEME PROCEDURE:
1946	*
1947	* STACK STACK HEAP
1948	* \| ^ \| \| ^ \|
1949	* \| \| \| \| \| \|
1950	* \| \| \| \|
1951	* \| \| \| \|
1952	* \| arg N \| \| arg N \|
1953	* \| ... \| ___fp -->\| ... \|
1954	* \| arg 1 \| \| arg 1 \|
1955	* +------------+ +------------+
1956	* \| RESERVED \| \| RESERVED \| stack marker
1957	* \| <PADDING> \| \| <PADDING> \| +------------+
1958	* \| undefined \| \| ---------->\| HEAD \|
1959	* \| undefined \| \| return adr \| \| procedure \|
1960	* +------------+ +------------+ +------------+
1961	* ___fp -->\| RESERVED \| \| RESERVED \|
1962	* \| ... \| \| ... \|
1963	* +------------+ +------------+
1964	* \| \| \| \|
1965	*/
1966
1967	___LD_ARG_REGSregister long ___r3; register long ___r2; register long ___r1 ; ___r1=___ps->r[1]; ___r2=___ps->r[2]; ___r3=___ps-> r[3]; /* declare and load GVM argument registers from ___ps */
1968
1969	___fp[-1] = ___PSR0___ps->r[0]; /* create a frame with the same format as the */
1970	___fp[-2] = stack_marker; /* one created for the return to C handler */
1971	/* in "_kernel.scm" */
1972
1973	___fp -= ___FRAME_SPACE(2)(((((2)+3)+(4)-1)/(4))(4)) + nargs; / move ___fp to point to last arg */
1974
1975	___POP_ARGS_IN_REGS(nargs)switch (nargs) { case 0: break; case 1: ___r1=(___fp++); break ; case 2: ___r2=(___fp++);___r1=(___fp++); break; default: ___r3 =(___fp++);___r2=(___fp++);___r1=(___fp++); } /* load arguments into appropriate registers */
1976
1977	___ST_ARG_REGS___ps->r[1]=___r1; ___ps->r[2]=___r2; ___ps->r[3]=___r3 ; /* write back GVM argument registers to ___ps */
1978
1979	___PSR0___ps->r[0] = ___GSTATE(&___gstate)->handler_return_to_c;
1980
1981	___ps->fp = ___fp;
1982	___ps->na = nargs;
1983	___ps->pc = ___CAST(___label_struct,proc-___tSUBTYPED)((___label_struct)(proc-1))->entry_or_descr;
1984	___PSSELF___ps->r[4] = proc;
1985
1986	___BEGIN_TRY{ ___jmpbuf_struct ___jbuf, *___old_catcher = ___ps->catcher ; ___ps->catcher = &___jbuf; ___err = _setjmp (___jbuf .buf); if (___err==(((long)(0))<<2)) {
1987
1988	trampoline(___ps);
1989
1990	___END_TRY} ___ps->catcher = ___old_catcher; }
1991
1992	if (___err != ___FIX(___UNWIND_C_STACK)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+0)))<<2) \|\|
1993	stack_marker != ___ps->fp[___FRAME_SPACE(2)(((((2)+3)+(4)-1)/(4))(4))-2]) /need more unwinding?*/
1994	___THROW(___err)longjmp (___ps->catcher->buf,___err);
1995
1996	___ps->fp += ___FRAME_SPACE(2)(((((2)+3)+(4)-1)/(4))*(4));
1997	___PSR0___ps->r[0] = ___ps->fp[-1];
1998
1999	return ___FIX(___NO_ERR)(((long)(0))<<2);
2000	}
2001
2002
2003	___EXP_FUNC(void,___propagate_error)void ___propagate_error
2004	___P((___SCMOBJ err),(long err)
2005	(err)(long err)
2006	___SCMOBJ err;)(long err)
2007	{
2008	if (err != ___FIX(___NO_ERR)(((long)(0))<<2))
2009	{
2010	___processor_state ___ps = ___PSTATE(&(&___gstate)->pstate);
2011	___THROW (err)longjmp (___ps->catcher->buf,err);
2012	}
2013	}
2014
2015
2016	#ifdef ___DEBUG
2017
2018	___SCMOBJlong find_global_var_bound_to
2019	___P((___SCMOBJ val),(long val)
2020	(val)(long val)
2021	___SCMOBJ val;)(long val)
2022	{
2023	___processor_state ___ps = ___PSTATE(&(&___gstate)->pstate);
2024	___SCMOBJlong sym = ___NUL((((long)(-3))<<2)+2);
2025	int i;
2026
2027	for (i = ___INT(___VECTORLENGTH(___GSTATE->symbol_table))(((((long)((((unsigned long)((((long)(((&___gstate)-> symbol_table)-(1))))))>>((3 +5)+3))))<<2))>> 2) - 1; i>0; i--)
2028	{
2029	sym = ___FIELD(___GSTATE->symbol_table,i)(((((long)(((&___gstate)->symbol_table)-(1)))+1)+i));
2030
2031	while (sym != ___NUL((((long)(-3))<<2)+2))
2032	{
2033	___SCMOBJlong g = ___FIELD(sym,___SYMBOL_GLOBAL)(((((long)((sym)-(1)))+1)+3));
2034
2035	if (g != ___FIX(0)(((long)(0))<<2))
2036	{
2037	___glo_struct p = ___CAST(___glo_struct,g)((___glo_struct*)(g));
2038
2039	if (___PRMCELL(p->prm)p->prm == val \|\| ___GLOCELL(p->val)p->val == val)
2040	{
2041	i = 0;
2042	break;
2043	}
2044	}
2045
2046	sym = ___FIELD(sym,___SYMKEY_NEXT)(((((long)((sym)-(1)))+1)+2));
2047	}
2048	}
2049
2050	return sym;
2051	}
2052
2053	#endif
2054
2055
2056	#ifdef ___DEBUG_HOST_CHANGES
2057
2058	___EXP_FUNC(void,___register_host_entry)void ___register_host_entry
2059	___P((___WORD start,(long start, char *module_name)
2060	char module_name),(long start, char module_name)
2061	(start,(long start, char *module_name)
2062	module_name)(long start, char *module_name)
2063	___WORD start;(long start, char *module_name)
2064	char module_name;)(long start, char module_name)
2065	{
2066	#ifdef ___DEBUG
2067
2068	___processor_state ___ps = ___PSTATE(&(&___gstate)->pstate);
2069	___SCMOBJlong sym;
2070
2071	___printf ("*** Entering ");
2072
2073	if ((sym = find_global_var_bound_to (___ps->pc)) != ___NUL((((long)(-3))<<2)+2) \|\|
2074	(sym = find_global_var_bound_to (start)) != ___NUL((((long)(-3))<<2)+2))
2075	{
2076	___SCMOBJlong name = ___FIELD(sym,___SYMKEY_NAME)(((((long)((sym)-(1)))+1)+0));
2077	int i;
2078	for (i=0; i<___INT(___STRINGLENGTH(name))(((((long)(((((unsigned long)((((long)((name)-(1))))))>> (3 +5))>>2)))<<2))>>2); i++)
2079	___printf ("%c", ___INT(___STRINGREF(name,___FIX(i)))((((((long)(((unsigned int)((((unsigned int)((((long*)((name )-(1)))+1)))+(((((long)(i))<<2))>>2))))))<< 2)+2))>>2));
2080	}
2081	else
2082	{
2083	___printf ("\|%s\| host=0x%08x", module_name, start);
2084	}
2085
2086	if (start == ___ps->pc)
2087	___printf ("\n");
2088	else
2089	___printf (" (subprocedure %d)\n",
2090	___CAST(___label_struct,___ps->pc)((___label_struct)(___ps->pc)) -
2091	___CAST(___label_struct,start)((___label_struct)(start)));
2092
2093	#endif
2094	}
2095
2096	#endif
2097
2098
2099	/---------------------------------------------------------------------------/
2100
2101	/*
2102	* Setup program and execute it.
2103	*/
2104
2105	___HIDDENstatic int setup_state = 0; /* 0=pre-setup, 1=post-setup, 2=post-cleanup */
2106
2107
2108	___EXP_FUNC(void,___cleanup)void ___cleanup ___PVOID(void)
2109	{
2110	/*
2111	* Only do cleanup once after successful setup.
2112	*/
2113
2114	if (setup_state != 1)
2115	return;
2116
2117	setup_state = 2;
2118
2119	___cleanup_mem ();
2120	___cleanup_os ();
2121	}
2122
2123
2124	___EXP_FUNC(void,___cleanup_and_exit_process)void ___cleanup_and_exit_process
2125	___P((int status),(int status)
2126	(status)(int status)
2127	int status;)(int status)
2128	{
2129	___cleanup ();
2130	___exit_process (status);
2131	}
2132
2133
2134	___EXP_FUNC(void,___setup_params_reset)void ___setup_params_reset
2135	___P((___setup_params_struct setup_params),(___setup_params_struct setup_params)
2136	(setup_params)(___setup_params_struct *setup_params)
2137	___setup_params_struct setup_params;)(___setup_params_struct setup_params)
2138	{
2139	setup_params->version = 0;
2140	setup_params->argv = reset_argv;
2141	setup_params->min_heap = 0;
2142	setup_params->max_heap = 0;
2143	setup_params->live_percent = 0;
2144	setup_params->gc_hook = 0;
2145	setup_params->display_error = 0;
2146	setup_params->fatal_error = 0;
2147	setup_params->standard_level = 0;
2148	setup_params->debug_settings = 0;
2149	setup_params->file_settings = 0;
2150	setup_params->terminal_settings = 0;
2151	setup_params->stdio_settings = 0;
2152	setup_params->gambcdir = 0;
2153	setup_params->gambcdir_map = 0;
2154	setup_params->remote_dbg_addr = 0;
2155	setup_params->rpc_server_addr = 0;
2156	setup_params->linker = 0;
2157	setup_params->dummy8 = 0;
2158	setup_params->dummy7 = 0;
2159	setup_params->dummy6 = 0;
2160	setup_params->dummy5 = 0;
2161	setup_params->dummy4 = 0;
2162	setup_params->dummy3 = 0;
2163	setup_params->dummy2 = 0;
2164	setup_params->dummy1 = 0;
2165	}
2166
2167
2168	___EXP_FUNC(___SIZE_T,___get_min_heap)unsigned long ___get_min_heap ___PVOID(void)
2169	{
2170	return ___setup_params.min_heap;
2171	}
2172
2173
2174	___EXP_FUNC(void,___set_min_heap)void ___set_min_heap
2175	___P((___SIZE_T bytes),(unsigned long bytes)
2176	(bytes)(unsigned long bytes)
2177	___SIZE_T bytes;)(unsigned long bytes)
2178	{
2179	___setup_params.min_heap = bytes;
2180	}
2181
2182
2183	___EXP_FUNC(___SIZE_T,___get_max_heap)unsigned long ___get_max_heap ___PVOID(void)
2184	{
2185	return ___setup_params.max_heap;
2186	}
2187
2188
2189	___EXP_FUNC(void,___set_max_heap)void ___set_max_heap
2190	___P((___SIZE_T bytes),(unsigned long bytes)
2191	(bytes)(unsigned long bytes)
2192	___SIZE_T bytes;)(unsigned long bytes)
2193	{
2194	___setup_params.max_heap = bytes;
2195	}
2196
2197
2198	___EXP_FUNC(int,___get_live_percent)int ___get_live_percent ___PVOID(void)
2199	{
2200	return ___setup_params.live_percent;
2201	}
2202
2203
2204	___EXP_FUNC(void,___set_live_percent)void ___set_live_percent
2205	___P((int percent),(int percent)
2206	(percent)(int percent)
2207	int percent;)(int percent)
2208	{
2209	___setup_params.live_percent = percent;
2210	}
2211
2212
2213	___EXP_FUNC(int,___get_standard_level)int ___get_standard_level ___PVOID(void)
2214	{
2215	return ___setup_params.standard_level;
2216	}
2217
2218
2219	___EXP_FUNC(void,___set_standard_level)void ___set_standard_level
2220	___P((int level),(int level)
2221	(level)(int level)
2222	int level;)(int level)
2223	{
2224	___setup_params.standard_level = level;
2225	}
2226
2227
2228	___EXP_FUNC(void,___set_gambcdir)void ___set_gambcdir
2229	___P((___UCS_2STRING gambcdir),(unsigned short* gambcdir)
2230	(gambcdir)(unsigned short* gambcdir)
2231	___UCS_2STRING gambcdir;)(unsigned short* gambcdir)
2232	{
2233	___setup_params.gambcdir = gambcdir;
2234	}
2235
2236
2237	___EXP_FUNC(int,___set_debug_settings)int ___set_debug_settings
2238	___P((int mask,(int mask, int new_settings)
2239	int new_settings),(int mask, int new_settings)
2240	(mask,(int mask, int new_settings)
2241	new_settings)(int mask, int new_settings)
2242	int mask;(int mask, int new_settings)
2243	int new_settings;)(int mask, int new_settings)
2244	{
2245	int old_settings = ___setup_params.debug_settings;
2246
2247	___setup_params.debug_settings =
2248	(old_settings & ~mask) \| (new_settings & mask);
2249
2250	return old_settings;
2251	}
2252
2253
2254	___EXP_FUNC(___program_startup_info_struct,___get_program_startup_info)___program_startup_info_struct ___get_program_startup_info
2255	___PVOID(void)
2256	{
2257	return &___program_startup_info;
2258	}
2259
2260
2261	___EXP_FUNC(___SCMOBJ,___setup)long ___setup
2262	___P((___setup_params_struct setup_params),(___setup_params_struct setup_params)
2263	(setup_params)(___setup_params_struct *setup_params)
2264	___setup_params_struct setup_params;)(___setup_params_struct setup_params)
2265	{
2266	___SCMOBJlong ___err;
2267	___processor_state ___ps;
2268	___mod_or_lnk mol;
2269	___SCMOBJlong ___start;
2270	___SCMOBJlong marker;
2271	int i;
2272
2273	/*
2274	* Check for valid setup_params structure.
2275	*/
2276
2277	if (setup_params == 0 \|\|
2278	setup_params->version != ___VERSION407000)
2279	return ___FIX(___UNKNOWN_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+3)))<<2);
2280
2281	/*
2282	* Only do setup once.
2283	*/
2284
2285	if (setup_state != 0)
2286	return ___FIX(___UNKNOWN_ERR)(((long)((((((int)(-1))<<29)+(((int)(448))<<16)+( 0))+3)))<<2);
2287
2288	setup_state = 2; /* disallow cleanup, in case setup fails */
2289
2290	/*
2291	* Remember setup parameters.
2292	*/
2293
2294	___setup_params = *setup_params;
2295
2296	/*
2297	* Setup the operating system module.
2298	*/
2299
2300	if ((___err = ___setup_os ()) != ___FIX(___NO_ERR)(((long)(0))<<2))
2301	return ___err;
2302
2303	/*
2304	* Setup stack and heap.
2305	*/
2306
2307	if ((___err = ___setup_mem ()) != ___FIX(___NO_ERR)(((long)(0))<<2))
2308	{
2309	___cleanup_os ();
2310	return ___err;
2311	}
2312
2313	setup_state = 1; /* allow cleanup */
2314
2315	/*
2316	* Setup global state to avoid problems on systems that don't
2317	* support the dynamic loading of files that import functions.
2318	*/
2319
2320	___gstate.dummy8 = 0;
2321	___gstate.dummy7 = 0;
2322	___gstate.dummy6 = 0;
2323	___gstate.dummy5 = 0;
2324	___gstate.dummy4 = 0;
2325	___gstate.dummy3 = 0;
2326	___gstate.dummy2 = 0;
2327	___gstate.dummy1 = 0;
2328
2329	#ifndef ___CAN_IMPORT_CLIB_DYNAMICALLY
2330
2331	___gstate.fabs = fabs;
2332	___gstate.floor = floor;
2333	___gstate.ceil = ceil;
2334	___gstate.exp = exp;
2335	___gstate.log = log;
2336	___gstate.sin = sin;
2337	___gstate.cos = cos;
2338	___gstate.tan = tan;
2339	___gstate.asin = asin;
2340	___gstate.acos = acos;
2341	___gstate.atan = atan;
2342	#ifdef ___GOOD_ATAN2
2343	___gstate.atan2 = atan2;
2344	#endif
2345	#ifdef ___GOOD_POW
2346	___gstate.pow = pow;
2347	#endif
2348	___gstate.sqrt = sqrt;
2349
2350	#endif
2351
2352	#ifdef ___USE_SETJMP
2353	#ifndef ___CAN_IMPORT_SETJMP_DYNAMICALLY
2354
2355	___gstate.setjmp = setjmp;
2356
2357	#endif
2358	#endif
2359
2360	#ifndef ___CAN_IMPORT_DYNAMICALLY
2361
2362	___gstate.___iswalpha
2363	= ___iswalpha;
2364
2365	___gstate.___iswdigit
2366	= ___iswdigit;
2367
2368	___gstate.___iswspace
2369	= ___iswspace;
2370
2371	___gstate.___iswupper
2372	= ___iswupper;
2373
2374	___gstate.___iswlower
2375	= ___iswlower;
2376
2377	___gstate.___towupper
2378	= ___towupper;
2379
2380	___gstate.___towlower
2381	= ___towlower;
2382
2383	___gstate.___string_collate
2384	= ___string_collate;
2385
2386	___gstate.___string_collate_ci
2387	= ___string_collate_ci;
2388
2389	___gstate.___copysign
2390	= ___copysign;
2391
2392	___gstate.___isfinite
2393	= ___isfinite;
2394
2395	___gstate.___isnan
2396	= ___isnan;
2397
2398	___gstate.___trunc
2399	= ___trunc;
2400
2401	___gstate.___round
2402	= ___round;
2403
2404	#ifndef ___GOOD_ATAN2
2405	___gstate.___atan2
2406	= ___atan2;
2407	#endif
2408
2409	#ifndef ___GOOD_POW
2410	___gstate.___pow
2411	= ___pow;
2412	#endif
2413
2414	___gstate.___S64_from_SM32_fn
2415	= ___S64_from_SM32_fn;
2416
2417	___gstate.___S64_from_SM32_UM32_fn
2418	= ___S64_from_SM32_UM32_fn;
2419
2420	___gstate.___S64_from_LONGLONG_fn
2421	= ___S64_from_LONGLONG_fn;
2422
2423	___gstate.___S64_to_LONGLONG_fn
2424	= ___S64_to_LONGLONG_fn;
2425
2426	___gstate.___S64_fits_in_width_fn
2427	= ___S64_fits_in_width_fn;
2428
2429	___gstate.___U64_from_UM32_fn
2430	= ___U64_from_UM32_fn;
2431
2432	___gstate.___U64_from_UM32_UM32_fn
2433	= ___U64_from_UM32_UM32_fn;
2434
2435	___gstate.___U64_from_ULONGLONG_fn
2436	= ___U64_from_ULONGLONG_fn;
2437
2438	___gstate.___U64_to_ULONGLONG_fn
2439	= ___U64_to_ULONGLONG_fn;
2440
2441	___gstate.___U64_fits_in_width_fn
2442	= ___U64_fits_in_width_fn;
2443
2444	___gstate.___U64_mul_UM32_UM32_fn
2445	= ___U64_mul_UM32_UM32_fn;
2446
2447	___gstate.___U64_add_U64_U64_fn
2448	= ___U64_add_U64_U64_fn;
2449
2450	___gstate.___SCMOBJ_to_S8
2451	= ___SCMOBJ_to_S8;
2452
2453	___gstate.___SCMOBJ_to_U8
2454	= ___SCMOBJ_to_U8;
2455
2456	___gstate.___SCMOBJ_to_S16
2457	= ___SCMOBJ_to_S16;
2458
2459	___gstate.___SCMOBJ_to_U16
2460	= ___SCMOBJ_to_U16;
2461
2462	___gstate.___SCMOBJ_to_S32
2463	= ___SCMOBJ_to_S32;
2464
2465	___gstate.___SCMOBJ_to_U32
2466	= ___SCMOBJ_to_U32;
2467
2468	___gstate.___SCMOBJ_to_S64
2469	= ___SCMOBJ_to_S64;
2470
2471	___gstate.___SCMOBJ_to_U64
2472	= ___SCMOBJ_to_U64;
2473
2474	___gstate.___SCMOBJ_to_F32
2475	= ___SCMOBJ_to_F32;
2476
2477	___gstate.___SCMOBJ_to_F64
2478	= ___SCMOBJ_to_F64;
2479
2480	___gstate.___SCMOBJ_to_CHAR
2481	= ___SCMOBJ_to_CHAR;
2482
2483	___gstate.___SCMOBJ_to_SCHAR
2484	= ___SCMOBJ_to_SCHAR;
2485
2486	___gstate.___SCMOBJ_to_UCHAR
2487	= ___SCMOBJ_to_UCHAR;
2488
2489	___gstate.___SCMOBJ_to_ISO_8859_1
2490	= ___SCMOBJ_to_ISO_8859_1;
2491
2492	___gstate.___SCMOBJ_to_UCS_2
2493	= ___SCMOBJ_to_UCS_2;
2494
2495	___gstate.___SCMOBJ_to_UCS_4
2496	= ___SCMOBJ_to_UCS_4;
2497
2498	___gstate.___SCMOBJ_to_WCHAR
2499	= ___SCMOBJ_to_WCHAR;
2500
2501	___gstate.___SCMOBJ_to_SIZE_T
2502	= ___SCMOBJ_to_SIZE_T;
2503
2504	___gstate.___SCMOBJ_to_SSIZE_T
2505	= ___SCMOBJ_to_SSIZE_T;
2506
2507	___gstate.___SCMOBJ_to_PTRDIFF_T
2508	= ___SCMOBJ_to_PTRDIFF_T;
2509
2510	___gstate.___SCMOBJ_to_SHORT
2511	= ___SCMOBJ_to_SHORT;
2512
2513	___gstate.___SCMOBJ_to_USHORT
2514	= ___SCMOBJ_to_USHORT;
2515
2516	___gstate.___SCMOBJ_to_INT
2517	= ___SCMOBJ_to_INT;
2518
2519	___gstate.___SCMOBJ_to_UINT
2520	= ___SCMOBJ_to_UINT;
2521
2522	___gstate.___SCMOBJ_to_LONG
2523	= ___SCMOBJ_to_LONG;
2524
2525	___gstate.___SCMOBJ_to_ULONG
2526	= ___SCMOBJ_to_ULONG;
2527
2528	___gstate.___SCMOBJ_to_LONGLONG
2529	= ___SCMOBJ_to_LONGLONG;
2530
2531	___gstate.___SCMOBJ_to_ULONGLONG
2532	= ___SCMOBJ_to_ULONGLONG;
2533
2534	___gstate.___SCMOBJ_to_FLOAT
2535	= ___SCMOBJ_to_FLOAT;
2536
2537	___gstate.___SCMOBJ_to_DOUBLE
2538	= ___SCMOBJ_to_DOUBLE;
2539
2540	___gstate.___SCMOBJ_to_STRUCT
2541	= ___SCMOBJ_to_STRUCT;
2542
2543	___gstate.___SCMOBJ_to_UNION
2544	= ___SCMOBJ_to_UNION;
2545
2546	___gstate.___SCMOBJ_to_TYPE
2547	= ___SCMOBJ_to_TYPE;
2548
2549	___gstate.___SCMOBJ_to_POINTER
2550	= ___SCMOBJ_to_POINTER;
2551
2552	___gstate.___SCMOBJ_to_NONNULLPOINTER
2553	= ___SCMOBJ_to_NONNULLPOINTER;
2554
2555	___gstate.___SCMOBJ_to_FUNCTION
2556	= ___SCMOBJ_to_FUNCTION;
2557
2558	___gstate.___SCMOBJ_to_NONNULLFUNCTION
2559	= ___SCMOBJ_to_NONNULLFUNCTION;
2560
2561	___gstate.___SCMOBJ_to_BOOL
2562	= ___SCMOBJ_to_BOOL;
2563
2564	___gstate.___SCMOBJ_to_STRING
2565	= ___SCMOBJ_to_STRING;
2566
2567	___gstate.___SCMOBJ_to_NONNULLSTRING
2568	= ___SCMOBJ_to_NONNULLSTRING;
2569
2570	___gstate.___SCMOBJ_to_NONNULLSTRINGLIST
2571	= ___SCMOBJ_to_NONNULLSTRINGLIST;
2572
2573	___gstate.___SCMOBJ_to_CHARSTRING
2574	= ___SCMOBJ_to_CHARSTRING;
2575
2576	___gstate.___SCMOBJ_to_NONNULLCHARSTRING
2577	= ___SCMOBJ_to_NONNULLCHARSTRING;
2578
2579	___gstate.___SCMOBJ_to_NONNULLCHARSTRINGLIST
2580	= ___SCMOBJ_to_NONNULLCHARSTRINGLIST;
2581
2582	___gstate.___SCMOBJ_to_ISO_8859_1STRING
2583	= ___SCMOBJ_to_ISO_8859_1STRING;
2584
2585	___gstate.___SCMOBJ_to_NONNULLISO_8859_1STRING
2586	= ___SCMOBJ_to_NONNULLISO_8859_1STRING;
2587
2588	___gstate.___SCMOBJ_to_NONNULLISO_8859_1STRINGLIST
2589	= ___SCMOBJ_to_NONNULLISO_8859_1STRINGLIST;
2590
2591	___gstate.___SCMOBJ_to_UTF_8STRING
2592	= ___SCMOBJ_to_UTF_8STRING;
2593
2594	___gstate.___SCMOBJ_to_NONNULLUTF_8STRING
2595	= ___SCMOBJ_to_NONNULLUTF_8STRING;
2596
2597	___gstate.___SCMOBJ_to_NONNULLUTF_8STRINGLIST
2598	= ___SCMOBJ_to_NONNULLUTF_8STRINGLIST;
2599
2600	___gstate.___SCMOBJ_to_UTF_16STRING
2601	= ___SCMOBJ_to_UTF_16STRING;
2602
2603	___gstate.___SCMOBJ_to_NONNULLUTF_16STRING
2604	= ___SCMOBJ_to_NONNULLUTF_16STRING;
2605
2606	___gstate.___SCMOBJ_to_NONNULLUTF_16STRINGLIST
2607	= ___SCMOBJ_to_NONNULLUTF_16STRINGLIST;
2608
2609	___gstate.___SCMOBJ_to_UCS_2STRING
2610	= ___SCMOBJ_to_UCS_2STRING;
2611
2612	___gstate.___SCMOBJ_to_NONNULLUCS_2STRING
2613	= ___SCMOBJ_to_NONNULLUCS_2STRING;
2614
2615	___gstate.___SCMOBJ_to_NONNULLUCS_2STRINGLIST
2616	= ___SCMOBJ_to_NONNULLUCS_2STRINGLIST;
2617
2618	___gstate.___SCMOBJ_to_UCS_4STRING
2619	= ___SCMOBJ_to_UCS_4STRING;
2620
2621	___gstate.___SCMOBJ_to_NONNULLUCS_4STRING
2622	= ___SCMOBJ_to_NONNULLUCS_4STRING;
2623
2624	___gstate.___SCMOBJ_to_NONNULLUCS_4STRINGLIST
2625	= ___SCMOBJ_to_NONNULLUCS_4STRINGLIST;
2626
2627	___gstate.___SCMOBJ_to_WCHARSTRING
2628	= ___SCMOBJ_to_WCHARSTRING;
2629
2630	___gstate.___SCMOBJ_to_NONNULLWCHARSTRING
2631	= ___SCMOBJ_to_NONNULLWCHARSTRING;
2632
2633	___gstate.___SCMOBJ_to_NONNULLWCHARSTRINGLIST
2634	= ___SCMOBJ_to_NONNULLWCHARSTRINGLIST;
2635
2636	___gstate.___SCMOBJ_to_VARIANT
2637	= ___SCMOBJ_to_VARIANT;
2638
2639	___gstate.___release_foreign
2640	= ___release_foreign;
2641
2642	___gstate.___release_pointer
2643	= ___release_pointer;
2644
2645	___gstate.___release_function
2646	= ___release_function;
2647
2648	___gstate.___addref_function
2649	= ___addref_function;
2650
2651	___gstate.___release_string
2652	= ___release_string;
2653
2654	___gstate.___addref_string
2655	= ___addref_string;
2656
2657	___gstate.___release_string_list
2658	= ___release_string_list;
2659
2660	___gstate.___addref_string_list
2661	= ___addref_string_list;
2662
2663	___gstate.___release_variant
2664	= ___release_variant;
2665
2666	___gstate.___addref_variant
2667	= ___addref_variant;
2668
2669	___gstate.___S8_to_SCMOBJ
2670	= ___S8_to_SCMOBJ;
2671
2672	___gstate.___U8_to_SCMOBJ
2673	= ___U8_to_SCMOBJ;
2674
2675	___gstate.___S16_to_SCMOBJ
2676	= ___S16_to_SCMOBJ;
2677
2678	___gstate.___U16_to_SCMOBJ
2679	= ___U16_to_SCMOBJ;
2680
2681	___gstate.___S32_to_SCMOBJ
2682	= ___S32_to_SCMOBJ;
2683
2684	___gstate.___U32_to_SCMOBJ
2685	= ___U32_to_SCMOBJ;
2686
2687	___gstate.___S64_to_SCMOBJ
2688	= ___S64_to_SCMOBJ;
2689
2690	___gstate.___U64_to_SCMOBJ
2691	= ___U64_to_SCMOBJ;
2692
2693	___gstate.___F32_to_SCMOBJ
2694	= ___F32_to_SCMOBJ;
2695
2696	___gstate.___F64_to_SCMOBJ
2697	= ___F64_to_SCMOBJ;
2698
2699	___gstate.___CHAR_to_SCMOBJ
2700	= ___CHAR_to_SCMOBJ;
2701
2702	___gstate.___SCHAR_to_SCMOBJ
2703	= ___SCHAR_to_SCMOBJ;
2704
2705	___gstate.___UCHAR_to_SCMOBJ
2706	= ___UCHAR_to_SCMOBJ;
2707
2708	___gstate.___ISO_8859_1_to_SCMOBJ
2709	= ___ISO_8859_1_to_SCMOBJ;
2710
2711	___gstate.___UCS_2_to_SCMOBJ
2712	= ___UCS_2_to_SCMOBJ;
2713
2714	___gstate.___UCS_4_to_SCMOBJ
2715	= ___UCS_4_to_SCMOBJ;
2716
2717	___gstate.___WCHAR_to_SCMOBJ
2718	= ___WCHAR_to_SCMOBJ;
2719
2720	___gstate.___SIZE_T_to_SCMOBJ
2721	= ___SIZE_T_to_SCMOBJ;
2722
2723	___gstate.___SSIZE_T_to_SCMOBJ
2724	= ___SSIZE_T_to_SCMOBJ;
2725
2726	___gstate.___PTRDIFF_T_to_SCMOBJ
2727	= ___PTRDIFF_T_to_SCMOBJ;
2728
2729	___gstate.___SHORT_to_SCMOBJ
2730	= ___SHORT_to_SCMOBJ;
2731
2732	___gstate.___USHORT_to_SCMOBJ
2733	= ___USHORT_to_SCMOBJ;
2734
2735	___gstate.___INT_to_SCMOBJ
2736	= ___INT_to_SCMOBJ;
2737
2738	___gstate.___UINT_to_SCMOBJ
2739	= ___UINT_to_SCMOBJ;
2740
2741	___gstate.___LONG_to_SCMOBJ
2742	= ___LONG_to_SCMOBJ;
2743
2744	___gstate.___ULONG_to_SCMOBJ
2745	= ___ULONG_to_SCMOBJ;
2746
2747	___gstate.___LONGLONG_to_SCMOBJ
2748	= ___LONGLONG_to_SCMOBJ;
2749
2750	___gstate.___ULONGLONG_to_SCMOBJ
2751	= ___ULONGLONG_to_SCMOBJ;
2752
2753	___gstate.___FLOAT_to_SCMOBJ
2754	= ___FLOAT_to_SCMOBJ;
2755
2756	___gstate.___DOUBLE_to_SCMOBJ
2757	= ___DOUBLE_to_SCMOBJ;
2758
2759	___gstate.___STRUCT_to_SCMOBJ
2760	= ___STRUCT_to_SCMOBJ;
2761
2762	___gstate.___UNION_to_SCMOBJ
2763	= ___UNION_to_SCMOBJ;
2764
2765	___gstate.___TYPE_to_SCMOBJ
2766	= ___TYPE_to_SCMOBJ;
2767
2768	___gstate.___POINTER_to_SCMOBJ
2769	= ___POINTER_to_SCMOBJ;
2770
2771	___gstate.___NONNULLPOINTER_to_SCMOBJ
2772	= ___NONNULLPOINTER_to_SCMOBJ;
2773
2774	___gstate.___FUNCTION_to_SCMOBJ
2775	= ___FUNCTION_to_SCMOBJ;
2776
2777	___gstate.___NONNULLFUNCTION_to_SCMOBJ
2778	= ___NONNULLFUNCTION_to_SCMOBJ;
2779
2780	___gstate.___BOOL_to_SCMOBJ
2781	= ___BOOL_to_SCMOBJ;
2782
2783	___gstate.___STRING_to_SCMOBJ
2784	= ___STRING_to_SCMOBJ;
2785
2786	___gstate.___NONNULLSTRING_to_SCMOBJ
2787	= ___NONNULLSTRING_to_SCMOBJ;
2788
2789	___gstate.___NONNULLSTRINGLIST_to_SCMOBJ
2790	= ___NONNULLSTRINGLIST_to_SCMOBJ;
2791
2792	___gstate.___CHARSTRING_to_SCMOBJ
2793	= ___CHARSTRING_to_SCMOBJ;
2794
2795	___gstate.___NONNULLCHARSTRING_to_SCMOBJ
2796	= ___NONNULLCHARSTRING_to_SCMOBJ;
2797
2798	___gstate.___NONNULLCHARSTRINGLIST_to_SCMOBJ
2799	= ___NONNULLCHARSTRINGLIST_to_SCMOBJ;
2800
2801	___gstate.___ISO_8859_1STRING_to_SCMOBJ
2802	= ___ISO_8859_1STRING_to_SCMOBJ;
2803
2804	___gstate.___NONNULLISO_8859_1STRING_to_SCMOBJ
2805	= ___NONNULLISO_8859_1STRING_to_SCMOBJ;
2806
2807	___gstate.___NONNULLISO_8859_1STRINGLIST_to_SCMOBJ
2808	= ___NONNULLISO_8859_1STRINGLIST_to_SCMOBJ;
2809
2810	___gstate.___UTF_8STRING_to_SCMOBJ
2811	= ___UTF_8STRING_to_SCMOBJ;
2812
2813	___gstate.___NONNULLUTF_8STRING_to_SCMOBJ
2814	= ___NONNULLUTF_8STRING_to_SCMOBJ;
2815
2816	___gstate.___NONNULLUTF_8STRINGLIST_to_SCMOBJ
2817	= ___NONNULLUTF_8STRINGLIST_to_SCMOBJ;
2818
2819	___gstate.___UTF_16STRING_to_SCMOBJ
2820	= ___UTF_16STRING_to_SCMOBJ;
2821
2822	___gstate.___NONNULLUTF_16STRING_to_SCMOBJ
2823	= ___NONNULLUTF_16STRING_to_SCMOBJ;
2824
2825	___gstate.___NONNULLUTF_16STRINGLIST_to_SCMOBJ
2826	= ___NONNULLUTF_16STRINGLIST_to_SCMOBJ;
2827
2828	___gstate.___UCS_2STRING_to_SCMOBJ
2829	= ___UCS_2STRING_to_SCMOBJ;
2830
2831	___gstate.___NONNULLUCS_2STRING_to_SCMOBJ
2832	= ___NONNULLUCS_2STRING_to_SCMOBJ;
2833
2834	___gstate.___NONNULLUCS_2STRINGLIST_to_SCMOBJ
2835	= ___NONNULLUCS_2STRINGLIST_to_SCMOBJ;
2836
2837	___gstate.___UCS_4STRING_to_SCMOBJ
2838	= ___UCS_4STRING_to_SCMOBJ;
2839
2840	___gstate.___NONNULLUCS_4STRING_to_SCMOBJ
2841	= ___NONNULLUCS_4STRING_to_SCMOBJ;
2842
2843	___gstate.___NONNULLUCS_4STRINGLIST_to_SCMOBJ
2844	= ___NONNULLUCS_4STRINGLIST_to_SCMOBJ;
2845
2846	___gstate.___WCHARSTRING_to_SCMOBJ
2847	= ___WCHARSTRING_to_SCMOBJ;
2848
2849	___gstate.___NONNULLWCHARSTRING_to_SCMOBJ
2850	= ___NONNULLWCHARSTRING_to_SCMOBJ;
2851
2852	___gstate.___NONNULLWCHARSTRINGLIST_to_SCMOBJ
2853	= ___NONNULLWCHARSTRINGLIST_to_SCMOBJ;
2854
2855	___gstate.___VARIANT_to_SCMOBJ
2856	= ___VARIANT_to_SCMOBJ;
2857
2858	___gstate.___CHARSTRING_to_UCS_2STRING
2859	= ___CHARSTRING_to_UCS_2STRING;
2860
2861	___gstate.___free_UCS_2STRING
2862	= ___free_UCS_2STRING;
2863
2864	___gstate.___NONNULLCHARSTRINGLIST_to_NONNULLUCS_2STRINGLIST
2865	= ___NONNULLCHARSTRINGLIST_to_NONNULLUCS_2STRINGLIST;
2866
2867	___gstate.___free_NONNULLUCS_2STRINGLIST
2868	= ___free_NONNULLUCS_2STRINGLIST;
2869
2870	___gstate.___make_sfun_stack_marker
2871	= ___make_sfun_stack_marker;
2872
2873	___gstate.___kill_sfun_stack_marker
2874	= ___kill_sfun_stack_marker;
2875
2876	___gstate.___alloc_rc
2877	= ___alloc_rc;
2878
2879	___gstate.___release_rc
2880	= ___release_rc;
2881
2882	___gstate.___addref_rc
2883	= ___addref_rc;
2884
2885	___gstate.___data_rc
2886	= ___data_rc;
2887
2888	___gstate.___set_data_rc
2889	= ___set_data_rc;
2890
2891	___gstate.___alloc_scmobj
2892	= ___alloc_scmobj;
2893
2894	___gstate.___release_scmobj
2895	= ___release_scmobj;
2896
2897	___gstate.___make_pair
2898	= ___make_pair;
2899
2900	___gstate.___make_vector
2901	= ___make_vector;
2902
2903	___gstate.___still_obj_refcount_inc
2904	= ___still_obj_refcount_inc;
2905
2906	___gstate.___still_obj_refcount_dec
2907	= ___still_obj_refcount_dec;
2908
2909	___gstate.___gc_hash_table_ref
2910	= ___gc_hash_table_ref;
2911
2912	___gstate.___gc_hash_table_set
2913	= ___gc_hash_table_set;
2914
2915	___gstate.___gc_hash_table_rehash
2916	= ___gc_hash_table_rehash;
2917
2918	___gstate.___get_min_heap
2919	= ___get_min_heap;
2920
2921	___gstate.___set_min_heap
2922	= ___set_min_heap;
2923
2924	___gstate.___get_max_heap
2925	= ___get_max_heap;
2926
2927	___gstate.___set_max_heap
2928	= ___set_max_heap;
2929
2930	___gstate.___get_live_percent
2931	= ___get_live_percent;
2932
2933	___gstate.___set_live_percent
2934	= ___set_live_percent;
2935
2936	___gstate.___get_standard_level
2937	= ___get_standard_level;
2938
2939	___gstate.___set_standard_level
2940	= ___set_standard_level;
2941
2942	___gstate.___set_debug_settings
2943	= ___set_debug_settings;
2944
2945	___gstate.___get_program_startup_info
2946	= ___get_program_startup_info;
2947
2948	___gstate.___cleanup
2949	= ___cleanup;
2950
2951	___gstate.___cleanup_and_exit_process
2952	= ___cleanup_and_exit_process;
2953
2954	___gstate.___call
2955	= ___call;
2956
2957	___gstate.___propagate_error
2958	= ___propagate_error;
2959
2960	#ifdef ___DEBUG_HOST_CHANGES
2961	___gstate.___register_host_entry
2962	= ___register_host_entry;
2963	#endif
2964
2965	___gstate.___raise_interrupt
2966	= ___raise_interrupt;
2967
2968	___gstate.___begin_interrupt_service
2969	= ___begin_interrupt_service;
2970
2971	___gstate.___check_interrupt
2972	= ___check_interrupt;
2973
2974	___gstate.___end_interrupt_service
2975	= ___end_interrupt_service;
2976
2977	___gstate.___disable_interrupts
2978	= ___disable_interrupts;
2979
2980	___gstate.___enable_interrupts
2981	= ___enable_interrupts;
2982
2983	___gstate.___alloc_mem
2984	= ___alloc_mem;
2985
2986	___gstate.___free_mem
2987	= ___free_mem;
2988
2989	___gstate.___alloc_mem_code
2990	= ___alloc_mem_code;
2991
2992	___gstate.___free_mem_code
2993	= ___free_mem_code;
2994
2995	___gstate.___disable_heartbeat_interrupts
2996	= ___disable_heartbeat_interrupts;
2997
2998	___gstate.___enable_heartbeat_interrupts
2999	= ___enable_heartbeat_interrupts;
3000
3001	#endif
3002
3003	/*
3004	* Get processor state.
3005	*/
3006
3007	___ps = ___PSTATE(&(&___gstate)->pstate);
3008
3009	/*
3010	* Setup multithreading structures.
3011	*/
3012
3013	___ps->current_thread = ___FAL((((long)(-1))<<2)+2);
3014	___ps->run_queue = ___FAL((((long)(-1))<<2)+2);
3015
3016	/*
3017	* Setup registers.
3018	*/
3019
3020	for (i=0; i<___NB_GVM_REGS5; i++)
3021	___ps->r[i] = ___VOID((((long)(-5))<<2)+2);
3022
3023	/*
3024	* Setup exception handling.
3025	*/
3026
3027	#ifdef ___USE_SETJMP
3028
3029	___ps->catcher = 0;
3030
3031	#endif
3032
3033	/*
3034	* Setup interrupt system.
3035	*/
3036
3037	___disable_interrupts (); /* globally disable all interrupts */
3038
3039	___ps->intr_mask = ___FIX(0)(((long)(0))<<2); /* None of the interrupts are ignored */
3040
3041	for (i=0; i<___NB_INTRS4; i++) /* None of the interrupts are requested */
3042	___ps->intr_flag[i] = ___FIX(0)(((long)(0))<<2);
3043
3044	___begin_interrupt_service ();
3045	___end_interrupt_service (0);
3046
3047	/*
3048	* Create empty global variable list, symbol table and keyword
3049	* table.
3050	*/
3051
3052	/* TODO: implement expansion of glos and prms arrays when number of globals grows beyond 20000 */
3053
3054	#ifdef ___MULTIPLE_GLO
3055	___ps->glos = ___CAST(___SCMOBJ,___alloc_mem (20000 sizeof (___SCMOBJ)))((long)(___alloc_mem (20000 sizeof (long))));
3056	#endif
3057
3058	#ifdef ___MULTIPLE_PRM
3059	___ps->prms = ___CAST(___SCMOBJ,___alloc_mem (20000 sizeof (___SCMOBJ)))((long)(___alloc_mem (20000 sizeof (long))));
3060	#endif
3061
3062	___ps->glo_list_head = 0;
3063	___ps->glo_list_tail = 0;
3064
3065	___GSTATE(&___gstate)->symbol_table =
3066	symkey_table_alloc (___sSYMBOL8, INIT_SYMKEY_TBL_LENGTH128);
3067
3068	if (___FIXNUMP(___GSTATE->symbol_table)((((&___gstate)->symbol_table)&((1<<2)-1))== (0)))
3069	{
3070	___cleanup ();
3071	return ___GSTATE(&___gstate)->symbol_table;
3072	}
3073
3074	___GSTATE(&___gstate)->keyword_table =
3075	symkey_table_alloc (___sKEYWORD9, INIT_SYMKEY_TBL_LENGTH128);
3076
3077	if (___FIXNUMP(___GSTATE->keyword_table)((((&___gstate)->keyword_table)&((1<<2)-1))== (0)))
3078	{
3079	___cleanup ();
3080	return ___GSTATE(&___gstate)->keyword_table;
3081	}
3082
3083	/*
3084	* Setup program's linker structure.
3085	*/
3086
3087	mol = linker_to_mod_or_lnk (___setup_params.linker);
3088
3089	/*
3090	* Initialize symbol table, keyword table, global variables
3091	* and primitives.
3092	*/
3093
3094	init_symkey_glo1 (mol);
3095	init_symkey_glo2 (mol);
3096
3097	/*
3098	* Setup each module.
3099	*/
3100
3101	___GSTATE(&___gstate)->program_descr = setup_modules (mol);
3102
3103	if (___FIXNUMP(___GSTATE->program_descr)((((&___gstate)->program_descr)&((1<<2)-1))== (0)))
3104	{
3105	___cleanup ();
3106	return ___GSTATE(&___gstate)->program_descr;
3107	}
3108
3109	/*
3110	* Create list of command line arguments (accessible through ##command-line).
3111	*/
3112
3113	{
3114	___UCS_2STRINGunsigned short* *argv = ___setup_params.argv;
3115
3116	if (argv[0] == 0) /* use dummy program name if none supplied */
3117	argv = reset_argv;
3118
3119	#define ___COMMAND_LINE_CE_SELECT(ISO_8859_1,UTF_8,UCS_2,UCS_4,wchar,native)UCS_2 UCS_2
3120
3121	if ((___err = ___NONNULLSTRINGLIST_to_SCMOBJ
3122	(argv,
3123	&___GSTATE(&___gstate)->command_line,
3124	0,
3125	___CE(___COMMAND_LINE_CE_SELECT)(13<<0)))
3126	!= ___FIX(___NO_ERR)(((long)(0))<<2))
3127	{
3128	___cleanup ();
3129	return ___err;
3130	}
3131	}
3132
3133	/*
3134	* Setup kernel handlers.
3135	*/
3136
3137	#define ___PH_LBL0 1
3138
3139	/*
3140	* The label numbers must match those in the procedure
3141	* "##kernel-handlers" in the file "_kernel.scm".
3142	*/
3143
3144	___start = ___PRMCELL(___G__23__23_kernel_2d_handlers.prm)___G__23__23_kernel_2d_handlers.prm;
3145
3146	___gstate.handler_sfun_conv_error = ___LBL(0)___start+((___PH_LBL0-1 +0)48);
3147	___gstate.handler_cfun_conv_error = ___LBL(1)___start+((___PH_LBL0-1 +1)48);
3148	___gstate.handler_stack_limit = ___LBL(2)___start+((___PH_LBL0-1 +2)48);
3149	___gstate.handler_heap_limit = ___LBL(3)___start+((___PH_LBL0-1 +3)48);
3150	___gstate.handler_not_proc = ___LBL(4)___start+((___PH_LBL0-1 +4)48);
3151	___gstate.handler_not_proc_glo = ___LBL(5)___start+((___PH_LBL0-1 +5)48);
3152	___gstate.handler_wrong_nargs = ___LBL(6)___start+((___PH_LBL0-1 +6)48);
3153	___gstate.handler_get_rest = ___LBL(7)___start+((___PH_LBL0-1 +7)48);
3154	___gstate.handler_get_key = ___LBL(8)___start+((___PH_LBL0-1 +8)48);
3155	___gstate.handler_get_key_rest = ___LBL(9)___start+((___PH_LBL0-1 +9)48);
3156	___gstate.handler_force = ___LBL(10)___start+((___PH_LBL0-1 +10)48);
3157	___gstate.handler_return_to_c = ___LBL(11)___start+((___PH_LBL0-1 +11)48);
3158	___gstate.handler_break = ___LBL(12)___start+((___PH_LBL0-1 +12)48);
3159	___gstate.internal_return = ___LBL(13)___start+((___PH_LBL0-1 +13)48);
3160
3161	/*
3162	* The label numbers must match those in the procedure
3163	* "##dynamic-env-bind" in the file "_kernel.scm".
3164	*/
3165
3166	___start = ___PRMCELL(___G__23__23_dynamic_2d_env_2d_bind.prm)___G__23__23_dynamic_2d_env_2d_bind.prm;
3167
3168	___gstate.dynamic_env_bind_return = ___LBL(1)___start+((___PH_LBL0-1 +1)48);
3169
3170	#undef ___PH_LBL0
3171
3172	/*
3173	* Call kernel to start executing program.
3174	*/
3175
3176	___ps->r[0] = ___gstate.handler_break;
3177
3178	___BEGIN_TRY{ ___jmpbuf_struct ___jbuf, *___old_catcher = ___ps->catcher ; ___ps->catcher = &___jbuf; ___err = _setjmp (___jbuf .buf); if (___err==(((long)(0))<<2)) {
3179
3180	if ((___err = ___make_sfun_stack_marker
3181	(&marker,
3182	___FIELD(___FIELD(___FIELD(___GSTATE->program_descr,0),0),1)(((((long)(((((((long)(((((((long)(((&___gstate)-> program_descr)-(1)))+1)+0)))-(1)))+1)+0)))-(1)))+1)+1))))
3183	== ___FIX(___NO_ERR)(((long)(0))<<2))
3184	{
3185	___err = ___call (0, ___FIELD(marker,0)(((((long)((marker)-(1)))+1)+0)), marker);
3186	___kill_sfun_stack_marker (marker);
3187	}
3188
3189	___END_TRY} ___ps->catcher = ___old_catcher; }
3190
3191	if (___err != ___FIX(___NO_ERR)(((long)(0))<<2))
3192	___cleanup ();
3193
3194	return ___err;
3195	}
3196
3197
3198	/---------------------------------------------------------------------------/