conservatory
/
elk
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* Renamed main.c into libelk.c. 

* Added a new main.c that uses libelk. Can be built this way:
      gcc main.c -o scheme -L. -lelk


git-svn-id: svn://svn.zoy.org/elk/trunk@18 55e467fa-43c5-0310-a8a2-de718669efc6
This commit is contained in:
sam 2003-08-21 09:58:05 +00:00
parent f66cc0d573
commit 166aa29795
3 changed files with 459 additions and 449 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
src/build
View File

@ -61,7 +61,7 @@ C= autoload.c\\
io.c\\ io.c\\
list.c\\ list.c\\
load.c\\ load.c\\
main.c\\ libelk.c\\
malloc.c\\ malloc.c\\
math.c\\ math.c\\
onfork.c\\ onfork.c\\
@ -112,15 +112,18 @@ OCOMMON=\\
type.o\\ type.o\\
vector.o vector.o
O1= \$(OCOMMON) main.o stab.o O1= \$(OCOMMON) libelk.o stab.o
O2= \$(OCOMMON) main2.o stab2.o O2= \$(OCOMMON) libelk2.o stab2.o
O3= \$(OCOMMON) main3.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) scheme: \$(O1)
\$(CC) -o \$@ \$(CFLAGS) \$(O1) \$(LDFLAGS) \$(CC) -o \$@ \$(CFLAGS) \$(O1) \$(LDFLAGS)
libelk.so: \$(O3)
gcc -shared -o \$@ \$(O3) \$(LDFLAGS)
standalone.a: \$(O2) standalone.a: \$(O2)
ar cru \$@ \$(O2) ar cru \$@ \$(O2)
@ -154,7 +157,7 @@ heap.o: \$(H) heap.c heap-sc.c heap-gen.c
io.o: \$(H) io.c io.o: \$(H) io.c
list.o: \$(H) list.c list.o: \$(H) list.c
load.o: \$(H) load.c $load load.o: \$(H) load.c $load
main.o: \$(H) main.c libelk.o: \$(H) libelk.c
malloc.o: \$(H) malloc.c malloc.o: \$(H) malloc.c
math.o: \$(H) math.c math.o: \$(H) math.c
onfork.o: \$(H) onfork.c onfork.o: \$(H) onfork.c
@ -172,20 +175,20 @@ terminate.o: \$(H) terminate.c
type.o: \$(H) type.c type.o: \$(H) type.c
vector.o: \$(H) vector.c vector.o: \$(H) vector.c
main2.o: \$(H) main.c libelk2.o: \$(H) libelk.c
rm -f main2.c; ln main.c main2.c rm -f libelk2.c; ln libelk.c libelk2.c
\$(CC) -DINIT_OBJECTS \$(CFLAGS) -I\$(INC) -c main2.c \$(CC) -DINIT_OBJECTS \$(CFLAGS) -I\$(INC) -c libelk2.c
rm main2.c rm libelk2.c
stab2.o: \$(H) stab.c $stab stab2.o: \$(H) stab.c $stab
rm -f stab2.c; ln stab.c stab2.c rm -f stab2.c; ln stab.c stab2.c
\$(CC) -DINIT_OBJECTS \$(CFLAGS) -I\$(INC) -c stab2.c \$(CC) -DINIT_OBJECTS \$(CFLAGS) -I\$(INC) -c stab2.c
rm stab2.c rm stab2.c
main3.o: \$(H) main.c libelk3.o: \$(H) libelk.c
rm -f main3.c; ln main.c main3.c rm -f libelk3.c; ln libelk.c libelk3.c
\$(CC) -DINIT_OBJECTS -DNOMAIN \$(CFLAGS) -I\$(INC) -c main3.c \$(CC) -DINIT_OBJECTS -DNOMAIN \$(CFLAGS) -I\$(INC) -c libelk3.c
rm main3.c rm libelk3.c
install: scheme standalone.a module.a install: scheme standalone.a module.a
-@if [ ! -d $install_dir/bin ]; then \\ -@if [ ! -d $install_dir/bin ]; then \\
@ -208,8 +211,8 @@ lint:
lint \$(LINTFLAGS) -I\$(INC) \$(C) lint \$(LINTFLAGS) -I\$(INC) \$(C)
clean: clean:
rm -f *.o *.a core main2.c stab2.c main3.c rm -f *.o *.a core libelk2.c stab2.c libelk3.c
distclean: 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 EOT

437
src/libelk.c Normal file
View File

@ -0,0 +1,437 @@
#include "kernel.h"
#include <errno.h>
#include <limits.h>
#include <string.h>
#include <stdlib.h>
#include <malloc.h>
#include <sys/types.h>
#include <sys/stat.h>
#ifndef MAX_STACK_SIZE
# include <sys/time.h>
# include <sys/resource.h>
#endif
#ifdef FIND_AOUT
# ifdef INCLUDE_UNISTD_H
# include <unistd.h>
# else
# include <sys/file.h>
# 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*/
}

436
src/main.c
View File

@ -1,437 +1,7 @@
#include "kernel.h" #include <elk/scheme.h>
#include <errno.h> int main(int ac, char **av) {
#include <limits.h> Elk_Init(ac, av, 1, "");
#include <string.h>
#include <stdlib.h>
#include <malloc.h>
#include <sys/types.h>
#include <sys/stat.h>
#ifndef MAX_STACK_SIZE
# include <sys/time.h>
# include <sys/resource.h>
#endif
#ifdef FIND_AOUT
# ifdef INCLUDE_UNISTD_H
# include <unistd.h>
# else
# include <sys/file.h>
# 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; 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*/
}