diff --git a/src/build b/src/build index e0546dd..4908c2b 100755 --- a/src/build +++ b/src/build @@ -61,7 +61,7 @@ C= autoload.c\\ io.c\\ list.c\\ load.c\\ - main.c\\ + libelk.c\\ malloc.c\\ math.c\\ onfork.c\\ @@ -112,15 +112,18 @@ OCOMMON=\\ type.o\\ vector.o -O1= \$(OCOMMON) main.o stab.o -O2= \$(OCOMMON) main2.o stab2.o -O3= \$(OCOMMON) main3.o stab2.o +O1= \$(OCOMMON) libelk.o stab.o +O2= \$(OCOMMON) libelk2.o stab2.o +O3= \$(OCOMMON) libelk3.o stab2.o -all: scheme standalone.a module.a +all: scheme libelk.so standalone.a module.a scheme: \$(O1) \$(CC) -o \$@ \$(CFLAGS) \$(O1) \$(LDFLAGS) +libelk.so: \$(O3) + gcc -shared -o \$@ \$(O3) \$(LDFLAGS) + standalone.a: \$(O2) ar cru \$@ \$(O2) @@ -154,7 +157,7 @@ heap.o: \$(H) heap.c heap-sc.c heap-gen.c io.o: \$(H) io.c list.o: \$(H) list.c load.o: \$(H) load.c $load -main.o: \$(H) main.c +libelk.o: \$(H) libelk.c malloc.o: \$(H) malloc.c math.o: \$(H) math.c onfork.o: \$(H) onfork.c @@ -172,20 +175,20 @@ terminate.o: \$(H) terminate.c type.o: \$(H) type.c vector.o: \$(H) vector.c -main2.o: \$(H) main.c - rm -f main2.c; ln main.c main2.c - \$(CC) -DINIT_OBJECTS \$(CFLAGS) -I\$(INC) -c main2.c - rm main2.c +libelk2.o: \$(H) libelk.c + rm -f libelk2.c; ln libelk.c libelk2.c + \$(CC) -DINIT_OBJECTS \$(CFLAGS) -I\$(INC) -c libelk2.c + rm libelk2.c stab2.o: \$(H) stab.c $stab rm -f stab2.c; ln stab.c stab2.c \$(CC) -DINIT_OBJECTS \$(CFLAGS) -I\$(INC) -c stab2.c rm stab2.c -main3.o: \$(H) main.c - rm -f main3.c; ln main.c main3.c - \$(CC) -DINIT_OBJECTS -DNOMAIN \$(CFLAGS) -I\$(INC) -c main3.c - rm main3.c +libelk3.o: \$(H) libelk.c + rm -f libelk3.c; ln libelk.c libelk3.c + \$(CC) -DINIT_OBJECTS -DNOMAIN \$(CFLAGS) -I\$(INC) -c libelk3.c + rm libelk3.c install: scheme standalone.a module.a -@if [ ! -d $install_dir/bin ]; then \\ @@ -208,8 +211,8 @@ lint: lint \$(LINTFLAGS) -I\$(INC) \$(C) clean: - rm -f *.o *.a core main2.c stab2.c main3.c + rm -f *.o *.a core libelk2.c stab2.c libelk3.c distclean: - rm -f *.o *.a core main2.c stab2.c main3.c lint.out scheme Makefile.local + rm -f *.o *.a core libelk2.c stab2.c libelk3.c lint.out scheme Makefile.local EOT diff --git a/src/libelk.c b/src/libelk.c new file mode 100644 index 0000000..3ae9a6a --- /dev/null +++ b/src/libelk.c @@ -0,0 +1,437 @@ +#include "kernel.h" + +#include +#include +#include +#include +#include +#include +#include + +#ifndef MAX_STACK_SIZE +# include +# include +#endif + +#ifdef FIND_AOUT +# ifdef INCLUDE_UNISTD_H +# include +# else +# include +# endif +#endif + +extern void Call_Initializers (SYMTAB *, char *, int); +extern void Load_Source (Object); +extern void Call_Finalizers (); +extern void Finit_Load (); +extern void Generational_GC_Reinitialize (); +extern int Check_Stack_Grows_Down (); +extern void Make_Heap (int); +extern void Free_Heap (); +extern void Init_Auto (void); +extern void Init_Cstring(); +extern void Init_Dump (); +extern void Init_Env (); +extern void Init_Error (); +extern void Init_Exception (); +extern void Init_Features (); +extern void Init_Heap (); +extern void Init_Io (); +extern void Init_Load (); +extern void Init_Loadpath (char *); +extern void Init_Math (); +extern void Init_Prim (); +extern void Init_Print (); +extern void Init_Proc (); +extern void Init_Read (); +extern void Init_Special (); +extern void Init_String (); +extern void Init_Symbol (); +extern void Init_Terminate (); +extern void Init_Type(); + +extern char *getenv(); + +void Get_Stack_Limit (); +void Usage (); +void Init_Everything (); + +char *stkbase; +int Stack_Grows_Down; +unsigned int Max_Stack; +int Interpreter_Initialized; +int GC_Debug = 0; +int Case_Insensitive; +int Verb_Load = 0, Verb_Init = 0; + +char **Argv; +int Argc, First_Arg; + +#ifdef FIND_AOUT +char *A_Out_Name; +char *Find_Executable(); +#endif + +#if defined(CAN_LOAD_OBJ) || defined(INIT_OBJECTS) +SYMTAB *The_Symbols; +#endif + +void Exit_Handler () { +#if defined(CAN_LOAD_OBJ) || defined(INIT_OBJECTS) + Call_Finalizers (); +#endif +#ifdef CAN_LOAD_OBJ + Finit_Load (); +#endif + Free_Heap (); +} + +#ifndef ATEXIT +/* Hack: __GNUC_MINOR__ was introduced together with __attribute__ */ +#ifdef __GNUC_MINOR__ +extern void _exit() __attribute__ ((noreturn)); +#endif +#ifndef PROFILING +void exit (n) { + Exit_Handler (); + _cleanup (); + _exit (n); +} +#endif +#endif + +#ifdef CAN_DUMP +int Was_Dumped; +char *Brk_On_Dump; +#endif + + +/* dump currently does not work for applications using Elk_Init(). + * The reason is that in this case the INITIAL_STK_OFFSET which + * compensates for differences in argv[] in the original/dumped a.out + * is not in effect (see comment below). + * This cannot be fixed without changing Elk_Init() and its use in + * an incompatible way. + */ +void Check_If_Dump_Works () { +#ifdef NOMAIN + Primitive_Error ("not yet supported for standalone applications"); +#endif +} + + +#ifdef NOMAIN + +void Elk_Init (int ac, char **av, int init_objects, char *toplevel) { + +#else + +int main (int ac, char **av) { + +#endif + +/* To avoid that the stack copying code overwrites argv if a dumped + * copy of the interpreter is invoked with more arguments than the + * original a.out, move the stack base INITIAL_STK_OFFSET bytes down. + * The call to memset() is there to prevent the optimizer from removing + * the array. + */ +#ifdef CAN_DUMP + char unused[INITIAL_STK_OFFSET]; +#endif + char *initfile, *loadfile = 0, *loadpath = 0; + int debug = 0, heap = HEAP_SIZE; + Object file; + struct stat st; + extern int errno; +#ifdef CAN_DUMP +#ifdef NOMAIN +# define foo (av[0][0]) +#else + char foo; +#endif +#endif + +#ifdef CAN_DUMP + memset (unused, 0, 1); /* see comment above */ +#endif + if (ac == 0) { + av[0] = "Elk"; ac = 1; + } + Get_Stack_Limit (); + +#ifdef FIND_AOUT + A_Out_Name = Find_Executable (av[0]); +#endif + + Argc = ac; Argv = av; + First_Arg = 1; +#ifdef CAN_DUMP + if (Was_Dumped) { + /* Check if beginning of stack has moved by a large amount. + * This is the case, for instance, on a Sun-4m when the + * interpreter was dumped on a Sun-4c and vice versa. + */ + if (abs (stkbase - &foo) > INITIAL_STK_OFFSET) { + fprintf (stderr, +"Can't restart dumped interpreter from a different machine architecture\n"); + fprintf (stderr, +" (Stack delta = %lld bytes).\n", (long long int)(ptrdiff_t)(stkbase - &foo)); + exit (1); + } + /* Check if program break must be reset. + */ + if ((ptrdiff_t)Brk_On_Dump && (ptrdiff_t)brk (Brk_On_Dump) + == (ptrdiff_t)-1) { + perror ("brk"); exit (1); + } +#if defined(HP9K) && defined(CAN_DUMP) && defined(HPSHLIB) + Restore_Shared_Data (); +#endif +#ifdef GENERATIONAL_GC + Generational_GC_Reinitialize (); +#endif + Loader_Input = 0; + Install_Intr_Handler (); + (void)Funcall_Control_Point (Dump_Control_Point, Arg_True, 0); + /*NOTREACHED*/ + } +#endif + + for ( ; First_Arg < ac; First_Arg++) { + if (strcmp (av[First_Arg], "-g") == 0) { + debug = 1; + } else if (strcmp (av[First_Arg], "-i") == 0) { + Case_Insensitive = 1; + } else if (strcmp (av[First_Arg], "-v") == 0) { + if (++First_Arg == ac) + Usage (); + if (strcmp (av[First_Arg], "load") == 0) + Verb_Load = 1; + else if (strcmp (av[First_Arg], "init") == 0) + Verb_Init = 1; + else Usage (); + } else if (strcmp (av[First_Arg], "-h") == 0) { + if (++First_Arg == ac) + Usage (); + if ((heap = atoi (av[First_Arg])) <= 0) { + fprintf (stderr, "Heap size must be a positive number.\n"); + exit (1); + } + } else if (strcmp (av[First_Arg], "-l") == 0) { + if (++First_Arg == ac || loadfile) + Usage (); + loadfile = av[First_Arg]; + } else if (strcmp (av[First_Arg], "-p") == 0) { + if (++First_Arg == ac || loadpath) + Usage (); + loadpath = av[First_Arg]; + } else if (strcmp (av[First_Arg], "--") == 0) { + First_Arg++; + break; + } else if (av[First_Arg][0] == '-') { + Usage (); + } else { + break; + } + } + + stkbase = &foo; + Stack_Grows_Down = Check_Stack_Grows_Down (); + ALIGN(stkbase); + Make_Heap (heap); + Init_Everything (); +#ifdef ATEXIT + if (atexit (Exit_Handler) != 0) + Fatal_Error ("atexit returned non-zero value"); +#endif +#ifdef INIT_OBJECTS +#ifdef NOMAIN + if (init_objects) { + Set_Error_Tag ("init-objects"); + The_Symbols = Open_File_And_Snarf_Symbols (A_Out_Name); + Call_Initializers (The_Symbols, (char *)0, PR_EXTENSION); + } +#else + Set_Error_Tag ("init-objects"); + The_Symbols = Open_File_And_Snarf_Symbols (A_Out_Name); + Call_Initializers (The_Symbols, (char *)0, PR_CONSTRUCTOR); + Call_Initializers (The_Symbols, (char *)0, PR_EXTENSION); +#endif +#endif + if (loadpath || (loadpath = getenv (LOADPATH_ENV))) + Init_Loadpath (loadpath); + + /* The following code is sort of a hack. initscheme.scm should not + * be resolved against load-path. However, the .scm-files may not + * have been installed yet (note that the interpreter is already + * used in the "make" process). + * Solution: if initscheme.scm hasn't been installed yet, do search + * the load-path, so that -p can be used. + */ + Set_Error_Tag ("scheme-init"); + initfile = Safe_Malloc (strlen (SCM_DIR) + 1 + sizeof (INITFILE) + 1); + sprintf (initfile, "%s/%s", SCM_DIR, INITFILE); + if (stat (initfile, &st) == -1 && errno == ENOENT) + file = Make_String (INITFILE, sizeof(INITFILE)-1); + else + file = Make_String (initfile, strlen (initfile)); + free (initfile); + (void)General_Load (file, The_Environment); + + Install_Intr_Handler (); + + Set_Error_Tag ("top-level"); +#ifdef NOMAIN + if (toplevel == 0) { + Interpreter_Initialized = 1; + GC_Debug = debug; + return; + } + /* Special case: if toplevel is "", act as if run from main() */ + if (loadfile == 0 && toplevel[0] != '\0') + loadfile = toplevel; +#endif + if (loadfile == 0) + loadfile = "toplevel.scm"; + file = Make_String (loadfile, strlen (loadfile)); + Interpreter_Initialized = 1; + GC_Debug = debug; + if (loadfile[0] == '-' && loadfile[1] == '\0') + Load_Source_Port (Standard_Input_Port); + else + (void)General_Load (file, The_Environment); +#ifndef NOMAIN + return 0; +#endif +} + +static char *Usage_Msg[] = { + "Options:", + " [-l filename] Load file instead of standard toplevel", + " [-l -] Load from standard input", + " [-h heapsize] Heap size in KBytes", + " [-p loadpath] Initialize load-path (colon-list of directories)", + " [-g] Enable GC-debugging", + " [-i] Case-insensitive symbols", + " [-v type] Be verbose. \"type\" controls what to print:", + " load linker command when loading object file", + " init names of extension [f]init functions when \ +called", + " [--] End options and begin arguments", + 0 }; + +void Usage () { + char **p; + + fprintf (stderr, "Usage: %s [options] [arguments]\n", Argv[0]); + for (p = Usage_Msg; *p; p++) + fprintf (stderr, "%s\n", *p); + exit (1); +} + +void Init_Everything () { + Init_Type (); + Init_Cstring (); + Init_String (); + Init_Symbol (); + Init_Env (); + Init_Error (); + Init_Exception (); + Init_Io (); + Init_Prim (); + Init_Math (); + Init_Print (); + Init_Auto (); + Init_Heap (); + Init_Load (); + Init_Proc (); + Init_Special (); + Init_Read (); + Init_Features (); + Init_Terminate (); +#ifdef CAN_DUMP + Init_Dump (); +#endif +} + +void Get_Stack_Limit () { +#ifdef MAX_STACK_SIZE + Max_Stack = MAX_STACK_SIZE; +#else + struct rlimit rl; + + if (getrlimit (RLIMIT_STACK, &rl) == -1) { + perror ("getrlimit"); + exit (1); + } + Max_Stack = rl.rlim_cur; +#endif + Max_Stack -= STACK_MARGIN; +} + +#ifdef FIND_AOUT +int Executable (char *fn) { + struct stat s; + + return stat (fn, &s) != -1 && (s.st_mode & S_IFMT) == S_IFREG + && access (fn, X_OK) != -1; +} + +char *Find_Executable (char *fn) { + char *path, *dir, *getenv(); + static char buf[1025]; /* Can't use Path_Max or Safe_Malloc here */ + register char *p; + + for (p = fn; *p; p++) { + if (*p == '/') { + if (Executable (fn)) + return fn; + else + Fatal_Error ("%s is not executable", fn); + } + } + if ((path = getenv ("PATH")) == 0) + path = ":/usr/ucb:/bin:/usr/bin"; + dir = path; + do { + p = buf; + while (*dir && *dir != ':') + *p++ = *dir++; + if (*dir) + ++dir; + if (p > buf) + *p++ = '/'; + strcpy (p, fn); + if (Executable (buf)) + return buf; + } while (*dir); + if (dir > path && dir[-1] == ':' && Executable (fn)) + return fn; + Fatal_Error ("cannot find pathname of %s", fn); + /*NOTREACHED*/ +} +#endif + +Object P_Command_Line_Args () { + Object ret, tail; + register int i; + GC_Node2; + + ret = tail = P_Make_List (Make_Integer (Argc-First_Arg), Null); + GC_Link2 (ret, tail); + for (i = First_Arg; i < Argc; i++, tail = Cdr (tail)) { + Object a; + + a = Make_String (Argv[i], strlen (Argv[i])); + Car (tail) = a; + } + GC_Unlink; + return ret; +} + +Object P_Exit (int argc, Object *argv) { + exit (argc == 0 ? 0 : Get_Unsigned (argv[0])); + /*NOTREACHED*/ +} diff --git a/src/main.c b/src/main.c index 3ae9a6a..afa67ec 100644 --- a/src/main.c +++ b/src/main.c @@ -1,437 +1,7 @@ -#include "kernel.h" +#include -#include -#include -#include -#include -#include -#include -#include - -#ifndef MAX_STACK_SIZE -# include -# include -#endif - -#ifdef FIND_AOUT -# ifdef INCLUDE_UNISTD_H -# include -# else -# include -# endif -#endif - -extern void Call_Initializers (SYMTAB *, char *, int); -extern void Load_Source (Object); -extern void Call_Finalizers (); -extern void Finit_Load (); -extern void Generational_GC_Reinitialize (); -extern int Check_Stack_Grows_Down (); -extern void Make_Heap (int); -extern void Free_Heap (); -extern void Init_Auto (void); -extern void Init_Cstring(); -extern void Init_Dump (); -extern void Init_Env (); -extern void Init_Error (); -extern void Init_Exception (); -extern void Init_Features (); -extern void Init_Heap (); -extern void Init_Io (); -extern void Init_Load (); -extern void Init_Loadpath (char *); -extern void Init_Math (); -extern void Init_Prim (); -extern void Init_Print (); -extern void Init_Proc (); -extern void Init_Read (); -extern void Init_Special (); -extern void Init_String (); -extern void Init_Symbol (); -extern void Init_Terminate (); -extern void Init_Type(); - -extern char *getenv(); - -void Get_Stack_Limit (); -void Usage (); -void Init_Everything (); - -char *stkbase; -int Stack_Grows_Down; -unsigned int Max_Stack; -int Interpreter_Initialized; -int GC_Debug = 0; -int Case_Insensitive; -int Verb_Load = 0, Verb_Init = 0; - -char **Argv; -int Argc, First_Arg; - -#ifdef FIND_AOUT -char *A_Out_Name; -char *Find_Executable(); -#endif - -#if defined(CAN_LOAD_OBJ) || defined(INIT_OBJECTS) -SYMTAB *The_Symbols; -#endif - -void Exit_Handler () { -#if defined(CAN_LOAD_OBJ) || defined(INIT_OBJECTS) - Call_Finalizers (); -#endif -#ifdef CAN_LOAD_OBJ - Finit_Load (); -#endif - Free_Heap (); -} - -#ifndef ATEXIT -/* Hack: __GNUC_MINOR__ was introduced together with __attribute__ */ -#ifdef __GNUC_MINOR__ -extern void _exit() __attribute__ ((noreturn)); -#endif -#ifndef PROFILING -void exit (n) { - Exit_Handler (); - _cleanup (); - _exit (n); -} -#endif -#endif - -#ifdef CAN_DUMP -int Was_Dumped; -char *Brk_On_Dump; -#endif - - -/* dump currently does not work for applications using Elk_Init(). - * The reason is that in this case the INITIAL_STK_OFFSET which - * compensates for differences in argv[] in the original/dumped a.out - * is not in effect (see comment below). - * This cannot be fixed without changing Elk_Init() and its use in - * an incompatible way. - */ -void Check_If_Dump_Works () { -#ifdef NOMAIN - Primitive_Error ("not yet supported for standalone applications"); -#endif -} - - -#ifdef NOMAIN - -void Elk_Init (int ac, char **av, int init_objects, char *toplevel) { - -#else - -int main (int ac, char **av) { - -#endif - -/* To avoid that the stack copying code overwrites argv if a dumped - * copy of the interpreter is invoked with more arguments than the - * original a.out, move the stack base INITIAL_STK_OFFSET bytes down. - * The call to memset() is there to prevent the optimizer from removing - * the array. - */ -#ifdef CAN_DUMP - char unused[INITIAL_STK_OFFSET]; -#endif - char *initfile, *loadfile = 0, *loadpath = 0; - int debug = 0, heap = HEAP_SIZE; - Object file; - struct stat st; - extern int errno; -#ifdef CAN_DUMP -#ifdef NOMAIN -# define foo (av[0][0]) -#else - char foo; -#endif -#endif - -#ifdef CAN_DUMP - memset (unused, 0, 1); /* see comment above */ -#endif - if (ac == 0) { - av[0] = "Elk"; ac = 1; - } - Get_Stack_Limit (); - -#ifdef FIND_AOUT - A_Out_Name = Find_Executable (av[0]); -#endif - - Argc = ac; Argv = av; - First_Arg = 1; -#ifdef CAN_DUMP - if (Was_Dumped) { - /* Check if beginning of stack has moved by a large amount. - * This is the case, for instance, on a Sun-4m when the - * interpreter was dumped on a Sun-4c and vice versa. - */ - if (abs (stkbase - &foo) > INITIAL_STK_OFFSET) { - fprintf (stderr, -"Can't restart dumped interpreter from a different machine architecture\n"); - fprintf (stderr, -" (Stack delta = %lld bytes).\n", (long long int)(ptrdiff_t)(stkbase - &foo)); - exit (1); - } - /* Check if program break must be reset. - */ - if ((ptrdiff_t)Brk_On_Dump && (ptrdiff_t)brk (Brk_On_Dump) - == (ptrdiff_t)-1) { - perror ("brk"); exit (1); - } -#if defined(HP9K) && defined(CAN_DUMP) && defined(HPSHLIB) - Restore_Shared_Data (); -#endif -#ifdef GENERATIONAL_GC - Generational_GC_Reinitialize (); -#endif - Loader_Input = 0; - Install_Intr_Handler (); - (void)Funcall_Control_Point (Dump_Control_Point, Arg_True, 0); - /*NOTREACHED*/ - } -#endif - - for ( ; First_Arg < ac; First_Arg++) { - if (strcmp (av[First_Arg], "-g") == 0) { - debug = 1; - } else if (strcmp (av[First_Arg], "-i") == 0) { - Case_Insensitive = 1; - } else if (strcmp (av[First_Arg], "-v") == 0) { - if (++First_Arg == ac) - Usage (); - if (strcmp (av[First_Arg], "load") == 0) - Verb_Load = 1; - else if (strcmp (av[First_Arg], "init") == 0) - Verb_Init = 1; - else Usage (); - } else if (strcmp (av[First_Arg], "-h") == 0) { - if (++First_Arg == ac) - Usage (); - if ((heap = atoi (av[First_Arg])) <= 0) { - fprintf (stderr, "Heap size must be a positive number.\n"); - exit (1); - } - } else if (strcmp (av[First_Arg], "-l") == 0) { - if (++First_Arg == ac || loadfile) - Usage (); - loadfile = av[First_Arg]; - } else if (strcmp (av[First_Arg], "-p") == 0) { - if (++First_Arg == ac || loadpath) - Usage (); - loadpath = av[First_Arg]; - } else if (strcmp (av[First_Arg], "--") == 0) { - First_Arg++; - break; - } else if (av[First_Arg][0] == '-') { - Usage (); - } else { - break; - } - } - - stkbase = &foo; - Stack_Grows_Down = Check_Stack_Grows_Down (); - ALIGN(stkbase); - Make_Heap (heap); - Init_Everything (); -#ifdef ATEXIT - if (atexit (Exit_Handler) != 0) - Fatal_Error ("atexit returned non-zero value"); -#endif -#ifdef INIT_OBJECTS -#ifdef NOMAIN - if (init_objects) { - Set_Error_Tag ("init-objects"); - The_Symbols = Open_File_And_Snarf_Symbols (A_Out_Name); - Call_Initializers (The_Symbols, (char *)0, PR_EXTENSION); - } -#else - Set_Error_Tag ("init-objects"); - The_Symbols = Open_File_And_Snarf_Symbols (A_Out_Name); - Call_Initializers (The_Symbols, (char *)0, PR_CONSTRUCTOR); - Call_Initializers (The_Symbols, (char *)0, PR_EXTENSION); -#endif -#endif - if (loadpath || (loadpath = getenv (LOADPATH_ENV))) - Init_Loadpath (loadpath); - - /* The following code is sort of a hack. initscheme.scm should not - * be resolved against load-path. However, the .scm-files may not - * have been installed yet (note that the interpreter is already - * used in the "make" process). - * Solution: if initscheme.scm hasn't been installed yet, do search - * the load-path, so that -p can be used. - */ - Set_Error_Tag ("scheme-init"); - initfile = Safe_Malloc (strlen (SCM_DIR) + 1 + sizeof (INITFILE) + 1); - sprintf (initfile, "%s/%s", SCM_DIR, INITFILE); - if (stat (initfile, &st) == -1 && errno == ENOENT) - file = Make_String (INITFILE, sizeof(INITFILE)-1); - else - file = Make_String (initfile, strlen (initfile)); - free (initfile); - (void)General_Load (file, The_Environment); - - Install_Intr_Handler (); - - Set_Error_Tag ("top-level"); -#ifdef NOMAIN - if (toplevel == 0) { - Interpreter_Initialized = 1; - GC_Debug = debug; - return; - } - /* Special case: if toplevel is "", act as if run from main() */ - if (loadfile == 0 && toplevel[0] != '\0') - loadfile = toplevel; -#endif - if (loadfile == 0) - loadfile = "toplevel.scm"; - file = Make_String (loadfile, strlen (loadfile)); - Interpreter_Initialized = 1; - GC_Debug = debug; - if (loadfile[0] == '-' && loadfile[1] == '\0') - Load_Source_Port (Standard_Input_Port); - else - (void)General_Load (file, The_Environment); -#ifndef NOMAIN +int main(int ac, char **av) { + Elk_Init(ac, av, 1, ""); return 0; -#endif } -static char *Usage_Msg[] = { - "Options:", - " [-l filename] Load file instead of standard toplevel", - " [-l -] Load from standard input", - " [-h heapsize] Heap size in KBytes", - " [-p loadpath] Initialize load-path (colon-list of directories)", - " [-g] Enable GC-debugging", - " [-i] Case-insensitive symbols", - " [-v type] Be verbose. \"type\" controls what to print:", - " load linker command when loading object file", - " init names of extension [f]init functions when \ -called", - " [--] End options and begin arguments", - 0 }; - -void Usage () { - char **p; - - fprintf (stderr, "Usage: %s [options] [arguments]\n", Argv[0]); - for (p = Usage_Msg; *p; p++) - fprintf (stderr, "%s\n", *p); - exit (1); -} - -void Init_Everything () { - Init_Type (); - Init_Cstring (); - Init_String (); - Init_Symbol (); - Init_Env (); - Init_Error (); - Init_Exception (); - Init_Io (); - Init_Prim (); - Init_Math (); - Init_Print (); - Init_Auto (); - Init_Heap (); - Init_Load (); - Init_Proc (); - Init_Special (); - Init_Read (); - Init_Features (); - Init_Terminate (); -#ifdef CAN_DUMP - Init_Dump (); -#endif -} - -void Get_Stack_Limit () { -#ifdef MAX_STACK_SIZE - Max_Stack = MAX_STACK_SIZE; -#else - struct rlimit rl; - - if (getrlimit (RLIMIT_STACK, &rl) == -1) { - perror ("getrlimit"); - exit (1); - } - Max_Stack = rl.rlim_cur; -#endif - Max_Stack -= STACK_MARGIN; -} - -#ifdef FIND_AOUT -int Executable (char *fn) { - struct stat s; - - return stat (fn, &s) != -1 && (s.st_mode & S_IFMT) == S_IFREG - && access (fn, X_OK) != -1; -} - -char *Find_Executable (char *fn) { - char *path, *dir, *getenv(); - static char buf[1025]; /* Can't use Path_Max or Safe_Malloc here */ - register char *p; - - for (p = fn; *p; p++) { - if (*p == '/') { - if (Executable (fn)) - return fn; - else - Fatal_Error ("%s is not executable", fn); - } - } - if ((path = getenv ("PATH")) == 0) - path = ":/usr/ucb:/bin:/usr/bin"; - dir = path; - do { - p = buf; - while (*dir && *dir != ':') - *p++ = *dir++; - if (*dir) - ++dir; - if (p > buf) - *p++ = '/'; - strcpy (p, fn); - if (Executable (buf)) - return buf; - } while (*dir); - if (dir > path && dir[-1] == ':' && Executable (fn)) - return fn; - Fatal_Error ("cannot find pathname of %s", fn); - /*NOTREACHED*/ -} -#endif - -Object P_Command_Line_Args () { - Object ret, tail; - register int i; - GC_Node2; - - ret = tail = P_Make_List (Make_Integer (Argc-First_Arg), Null); - GC_Link2 (ret, tail); - for (i = First_Arg; i < Argc; i++, tail = Cdr (tail)) { - Object a; - - a = Make_String (Argv[i], strlen (Argv[i])); - Car (tail) = a; - } - GC_Unlink; - return ret; -} - -Object P_Exit (int argc, Object *argv) { - exit (argc == 0 ? 0 : Get_Unsigned (argv[0])); - /*NOTREACHED*/ -}