1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
/* Copyright (c) 1993-2008 by Richard Kelsey and Jonathan Rees.
See file COPYING. */
#include <stdlib.h>
#include <stdio.h>
#include "scheme48vm.h"
#include "scheme48heap.h"
#include "scheme48image.h"
extern long s48_get_file_size(unsigned char *);
#if !defined(DEFAULT_HEAP_SIZE)
/* 3 megacells = 12 megabytes */
#define DEFAULT_HEAP_SIZE 3000000L
#endif
#if !defined(DEFAULT_STACK_SIZE)
/* 2500 cells = 10000 bytes */
#define DEFAULT_STACK_SIZE 2500L
#endif
#if defined(STATIC_AREAS) && defined(S48_GC_BIBOP)
#error "The BIBOP GC doesn't support the STATIC_AREAS feature yet."
#endif
#if defined(STATIC_AREAS)
#define DEFAULT_IMAGE_NAME NULL
#else
/* DEFAULT_IMAGE_NAME should be defined using the -D switch to cc. */
#if !defined(DEFAULT_IMAGE_NAME)
#define DEFAULT_IMAGE_NAME "scheme48.image"
#endif
#endif /* STATIC_AREAS */
extern void s48_sysdep_init(void);
extern void s48_initialize_external_modules(void);
int
s48_main(int argc, char *argv[])
{
char *image_name = DEFAULT_IMAGE_NAME;
long heap_size = DEFAULT_HEAP_SIZE; /* in numbers of cells */
long stack_size = DEFAULT_STACK_SIZE; /* in numbers of cells */
int errors = 0;
long return_value;
char *stack;
#if defined(STATIC_AREAS)
extern long static_entry;
extern long static_symbol_table;
extern long static_imported_binding_table, static_exported_binding_table;
extern long p_count, *p_areas[], p_sizes[];
extern long i_count, *i_areas[], i_sizes[];
#endif
long vm_argc = 0;
char *me = *argv; /* Save program name. */
{
/* initialize floating-point printer */
extern void s48_free_init(void);
s48_free_init();
}
argv++; argc--; /* Skip program name. */
for (; argc > 0; argc--, argv++)
if (argv[0][0] == '-')
switch (argv[0][1]) {
case 'h':
argc--; argv++;
if (argc == 0) { errors++; break; }
heap_size = atoi(*argv);
if (heap_size < 0) errors++; /* 0 means now no limit */
break;
case 's':
argc--; argv++;
if (argc == 0) { errors++; break; }
stack_size = atoi(*argv);
if (stack_size <= 0) errors++;
break;
case 'i':
argc--; argv++;
if (argc == 0) { errors++; break; }
image_name = *argv;
break;
case 'a':
argc--;
vm_argc = argc; /* remaining args are passed to the VM */
argc = 0;
break;
default:
fprintf(stderr, "Invalid argument: %s\n", *argv);
errors++;
}
else
if (argv[0][0] != '\0') {
fprintf(stderr, "Invalid argument: %s\n", *argv);
errors++; }
if (errors != 0) {
fprintf(stderr,
"Usage: %s [options] [-a arguments]\n\
Options: -h <heap-size> %s heap size in words (default %d).%s\n\
-s <stack-size> Stack buffer size in words.\n\
-i <file> Load image from file (default \"%s\")\n",
me,
#if S48_GC_BIBOP
"Maximum",
DEFAULT_HEAP_SIZE,
"\n A heap size of 0 means the heap can grow\n\
unboundedly. This is dangerous because it can\n\
cause your system to run out of memory.",
#else
"Total",
DEFAULT_HEAP_SIZE,
"",
#endif
DEFAULT_IMAGE_NAME
);
return 1;
}
/* Disable GC to read the image and initialize the VM-stack */
s48_forbid_gcB();
s48_sysdep_init();
s48_heap_init();
s48_init();
if (image_name == NULL) {
#if defined(STATIC_AREAS)
s48_register_static_areas(p_count, p_areas, p_sizes,
i_count, i_areas, i_sizes);
s48_set_image_valuesB(static_entry,
static_symbol_table,
static_imported_binding_table,
static_exported_binding_table);
if (s48_initialize_heap(heap_size) == NULL) {
fprintf(stderr, "system is out of memory\n");
return 1; }
#else
fprintf(stderr, "No image file.\n");
return 1;
#endif
} else if (s48_read_image(image_name, heap_size) == -1) {
fprintf(stderr, "Image file \"%s\" is unusable.\n", image_name);
return 1; }
stack = (char *) malloc(stack_size * sizeof(long));
if (!stack) {
fprintf(stderr, "system is out of memory\n");
return 1; }
s48_initialize_vm(stack, stack_size);
s48_initialize_external_modules();
/* Heap und stack are ok. Enable the GC. */
s48_allow_gcB();
return_value = s48_call_startup_procedure(argv, vm_argc);
return(return_value);
}
|
