static void
allocate_tospace (unsigned long n_words,
SCHEME_OBJECT ** start_r, SCHEME_OBJECT ** end_r)
{
if (n_words > 0)
{
SCHEME_OBJECT * p
= (((*start_r) == 0)
? (malloc (n_words * SIZEOF_SCHEME_OBJECT))
: (realloc ((*start_r), (n_words * SIZEOF_SCHEME_OBJECT))));
if (p == 0)
{
outf_fatal ("Unable to allocate temporary heap for GC.\n");
outf_flush_fatal ();
exit (1);
}
(*start_r) = p;
(*end_r) = (p + n_words);
}
else if ((*start_r) != 0)
{
free (*start_r);
(*start_r) = 0;
(*end_r) = 0;
}
}
static void
error (const char * procedure_name, const char * message)
{
outf_fatal ("%s: %s\n", procedure_name, message);
outf_flush_fatal ();
abort ();
}
void
setup_memory (unsigned long heap_size,
unsigned long stack_size,
unsigned long constant_size)
{
ALLOCATE_REGISTERS ();
/* Consistency check 1 */
if ((heap_size == 0) || (stack_size == 0) || (constant_size == 0))
{
outf_fatal ("Configuration won't hold initial data.\n");
outf_flush_fatal ();
exit (1);
}
/* Allocate */
ALLOCATE_HEAP_SPACE ((stack_size + heap_size + constant_size),
memory_block_start,
memory_block_end);
/* Consistency check 2 */
if (memory_block_start == 0)
{
outf_fatal ("Not enough memory for this configuration.\n");
outf_flush_fatal ();
exit (1);
}
/* Consistency check 3 */
if ((ADDRESS_TO_DATUM (memory_block_end)) > DATUM_MASK)
{
outf_fatal ("Requested allocation is too large.\n");
outf_fatal ("Try again with a smaller argument to '--heap'.\n");
outf_flush_fatal ();
reset_memory ();
exit (1);
}
saved_stack_size = stack_size;
saved_constant_size = constant_size;
saved_heap_size = heap_size;
reset_allocator_parameters (0);
initialize_gc (heap_size, (&heap_start), (&Free), allocate_tospace, abort_gc);
}
void
outf_flush (outf_channel chan)
{
switch (chan)
{
case CONSOLE_OUTPUT: outf_flush_console (); break;
case ERROR_OUTPUT: outf_flush_error (); break;
case FATAL_OUTPUT: outf_flush_fatal (); break;
}
}
void
NT_initialize_signals (void)
{
char * timer_error;
initialize_keyboard_interrupt_table ();
timer_error = (install_timer ());
if (timer_error)
{
outf_fatal ("install_timer: %s", timer_error);
outf_flush_fatal ();
abort ();
}
return;
}
static void
termination_suffix (int code, int value, bool abnormal_p)
{
#ifdef EXIT_HOOK
EXIT_HOOK (code, value, abnormal_p);
#endif
edwin_auto_save ();
delete_temp_files ();
#ifdef USING_MESSAGE_BOX_FOR_FATAL_OUTPUT
/* Don't put up message box for ordinary exit. */
if (code != TERM_HALT)
#endif
outf_flush_fatal();
reset_memory ();
EXIT_SCHEME (value);
}
int WINAPI
WinMain (HINSTANCE hInst, HINSTANCE hPrevInst, LPSTR lpCmdLine, int nCmdShow)
{
int argc;
char **argv;
extern int main (int, char **);
NT_preallocate_heap ();
ghInstance = hInst;
{
int cmdlen = strlen(lpCmdLine);
int maxargs = cmdlen/2+2;
char *cmdline = malloc(cmdlen+1);
char *s;
argv = malloc(sizeof(char*) * maxargs);
if (cmdline==0 || argv==0) {
outf_fatal ("WinMain cant malloc");
outf_flush_fatal ();
return FALSE;
}
argc = 1;
argv[0] = "scheme";
s = strcpy (cmdline, lpCmdLine);
while ((*s) != '\0')
{
while ((*s) == ' ')
s += 1;
if ((*s) == '"')
{
s += 1;
(argv[argc++]) = s;
while (1)
{
if ((*s) == '"')
{
(*s++) = '\0';
break;
}
if ((*s) == '\0')
{
outf_fatal ("WinMain: unterminated quoted argument.");
outf_flush_fatal ();
return (FALSE);
}
s += 1;
}
}
else
{
(argv[argc++]) = s;
while (1)
{
if ((*s) == ' ')
{
(*s++) = '\0';
break;
}
if ((*s) == '\0')
break;
s += 1;
}
}
}
argv[argc] = 0;
}
if (!hPrevInst)
if (!InitApplication(ghInstance))
return FALSE;
if (!InitInstance(ghInstance, nCmdShow))
return FALSE;
scheme_main (argc, ((const char **) argv));
return (0);
}
