#include "scheme.h"

#if ZELK
# include <zelk.h>
#endif

#ifdef INCLUDE_UNISTD_H
#  include <unistd.h>
#endif
#include TIME_H
#ifndef MAX_STACK_SIZE
#  include <sys/resource.h>
#endif
#include <sys/types.h>
#include <sys/param.h>
#include <sys/stat.h>
#include <sys/file.h>

extern char *getenv();

char *stkbase;
int Max_Stack;
int Interpreter_Initialized;
int GC_Debug = 0;
int Case_Insensitive;
int Verbose;

char **Argv;
int Argc, First_Arg;

#if defined(USE_LD) || defined(CAN_DUMP) || defined(INIT_OBJECTS)
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 USE_LD
    Finit_Load ();
#endif
}

#ifndef ATEXIT
void exit (n) {
    Exit_Handler ();
    _cleanup ();
    _exit (n);
}
#endif

#ifdef CAN_DUMP
int Was_Dumped;
#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:
 */

main (ac, av) char **av; {
#ifdef CAN_DUMP
    char unused[INITIAL_STK_OFFSET];
#endif
    register char *initfile, *loadfile = 0, *loadpath = 0;
    register debug = 0, heap = HEAP_SIZE;
    Object file;
    char foo;

    if (ac == 0) {
	av[0] = "Elk"; ac = 1;
    }
    Get_Stack_Limit ();

#if defined(USE_LD) || defined(CAN_DUMP) || defined(INIT_OBJECTS)
    A_Out_Name = Find_Executable (av[0]);
#endif

    Argc = ac; Argv = av;
    First_Arg = 1;
#ifdef CAN_DUMP
    if (Was_Dumped) {
	Loader_Input[0] = '\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) {
	    Verbose = 1;
	} else if (strcmp (av[First_Arg], "-h") == 0) {
	    if (++First_Arg == ac)
		Usage ();
	    heap = atoi (av[First_Arg]);
	} 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;
    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
    if (Should_Init_Objects ()) {
	Error_Tag = "init-objects";
	The_Symbols = Open_File_And_Snarf_Symbols (A_Out_Name);
	(void)Call_Initializers (The_Symbols, (char *)0);
    }
#endif
    if (loadpath)
	Init_Loadpath (loadpath);
    
    Error_Tag = "scheme-init";
    initfile = INITFILE;
    file = Make_String (initfile, strlen (initfile));
    (void)General_Load (file, The_Environment);

    Install_Intr_Handler ();

    Error_Tag = "top-level";
    if (loadfile == 0)
	loadfile = "toplevel";
    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);
    return 0;
}

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 (comma-list of directories)",
    "   [-g]            Enable GC-debugging",
    "   [-i]            Case-insensitive symbols",
    "   [-v]            Verbose mode (print linker commands)",
    "   [--]            End options and begin arguments",
    0 };

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);
}

Init_Everything () {
    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
#if ZELK
    Init_Zelk ();
#endif
}

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;
}

#if defined(USE_LD) || defined(CAN_DUMP) || defined(INIT_OBJECTS)
Executable (fn) 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 (fn) char *fn; {
    char *path, *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";
    do {
	p = buf;
	while (*path && *path != ':')
	    *p++ = *path++;
	if (*path)
	    ++path;
	if (p > buf)
	    *p++ = '/';
	strcpy (p, fn);
	if (Executable (buf))
	    return buf;
    } while (*path);
    Fatal_Error ("cannot find pathname of %s", fn);
    /*NOTREACHED*/
}
#endif

Object P_Command_Line_Args () {
    Object ret, tail;
    register i;
    GC_Node2;

    ret = tail = P_Make_List (Make_Fixnum (Argc-First_Arg), Null);
    GC_Link2 (ret, tail);
    for (i = First_Arg; i < Argc; i++, tail = Cdr (tail)) {
	Object a = Make_String (Argv[i], strlen (Argv[i]));
	Car (tail) = a;
    }
    GC_Unlink;
    return ret;
}

Object P_Exit (argc, argv) Object *argv; {
    exit (argc == 0 ? 0 : Get_Integer (argv[0]));
    /*NOTREACHED*/
}

#ifdef INIT_OBJECTS

/* Returns true if DONT_INIT is not defined or if it is defined and
 * argv[0] is not equal to DONT_INIT and doesn't end in a slash followed
 * by DONT_INIT:
 */
Should_Init_Objects () {
#ifdef DONT_INIT
    register char *dont = DONT_INIT;
    register alen = strlen (A_Out_Name), dlen = strlen (dont);

    return strcmp (A_Out_Name, dont) != 0 &&
	!(alen > dlen && A_Out_Name[alen-dlen-1] == '/' &&
			strcmp (A_Out_Name + alen - dlen, dont) == 0);
#else
    return 1;
#endif
}

#endif /* INIT_OBJECTS */
