/*
 *
 * t o p l e v e l . c				-- The REP loop
 *
 * Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
 * 
 *
 * Permission to use, copy, and/or distribute this software and its
 * documentation for any purpose and without fee is hereby granted, provided
 * that both the above copyright notice and this permission notice appear in
 * all copies and derived works.  Fees for distribution or use of this
 * software or derived works may only be charged with express written
 * permission of the copyright holder.  
 * This software is provided ``as is'' without express or implied warranty.
 *
 * This software is a derivative work of other copyrighted softwares; the
 * copyright notices of these softwares are placed in the file COPYRIGHTS
 *
 *
 *           Author: Erick Gallesio [eg@kaolin.unice.fr]
 *    Creation date:  6-Apr-1994 14:46
 * Last file update: 16-Jul-1995 16:34
 */

#include "stk.h"
#include "gc.h"

/* The cell representing NIL */
static struct obj VNIL     = {0, tc_nil};

static long nointerrupt = 1;
static long interrupt_differed = 0;

/******************************************************************************
 *
 * Handlers
 *
 ******************************************************************************/

static void err_ctrl_c(void)
{
  Err("Control-C interrupt",NIL);
}

static void handle_sigfpe(int sig)
{
  signal(SIGFPE, handle_sigfpe);
  Err("Floating point exception",NIL);
}

static void handle_sigint(int sig)
{
  signal(SIGINT,handle_sigint);
  if (nointerrupt)
    interrupt_differed = 1;
  else
    err_ctrl_c();
}

static void print_banner(void)
{
  if (VCELL(Intern(PRINT_BANNER)) != Ntruth){
    fprintf(stderr, "Welcome to the STk interpreter version %s [%s]\n", 
	    	    STK_VERSION, MACHINE);
    fprintf(stderr, "Copyright (C) 1993,1994,1995 Erick Gallesio - ");
    fprintf(stderr, "I3S - CNRS / ESSI <eg@unice.fr>\n");
  }
}

long STk_no_interrupt(long n)
{
  long x;
  x = nointerrupt;
  nointerrupt = n;
  if ((nointerrupt == 0) && (interrupt_differed == 1)){
    interrupt_differed = 0;
    err_ctrl_c();
  }
  return(x);
}

static void load_init_file(void)
{
  /* Try to load init.stk in "." and, if not present, in $STK_LIBRARY/STk */
  char init_file[] = "init.stk";
  char file[2*MAX_PATH_LENGTH];

  sprintf(file, "./%s", init_file);
  if (STk_loadfile(file, 0) == Truth) return;

  sprintf(file, "%s/STk/%s", STk_library_path, init_file);
  STk_loadfile(file, 1);
}


static void init_library_path(char *argv0)
{
  char *s;

  if (s = getenv("STK_LIBRARY")) {
      /* Initialize STk_library_path with the content of STK_LIBRARY 
       * shell variable.
       * Make a copy of environment variable (copy is necessary for
       * images files) 
       */
    STk_library_path = (char *) must_malloc(strlen(s) + 1); 
    strcpy(STk_library_path, s);
  }
  else {
    fprintf(stderr, "STK_LIBRARY shell variable not set or not exported.\nAbort\n");
    exit(1);
  }
}

static void init_interpreter(void)
{
  /* Initialize the path of the library */
  init_library_path(STk_Argv0);

  /* Global variables to initialize */
  NIL           = &VNIL;
  STk_tkbuffer 	= (char *) must_malloc(TKBUFFERN+1);

  /* Initialize GC */
  STk_init_gc();

  /* Initialize symbol & keyword tables */
  STk_initialize_symbol_table();
  STk_initialize_keyword_table();

  /* 
   * Define some scheme objects used by the interpreter 
   * and protect them against GC 
   */
  NEWCELL(UNDEFINED, tc_undefined); STk_gc_protect(&UNDEFINED);
  NEWCELL(UNBOUND,   tc_unbound);   STk_gc_protect(&UNBOUND);
  NEWCELL(Truth,     tc_boolean);   STk_gc_protect(&Truth);
  NEWCELL(Ntruth,    tc_boolean);   STk_gc_protect(&Ntruth);

  Sym_lambda	   = Intern("lambda");	    	 STk_gc_protect(&Sym_lambda);
  Sym_quote	   = Intern("quote");	    	 STk_gc_protect(&Sym_quote);
  Sym_imply	   = Intern("=>");		 STk_gc_protect(&Sym_imply);
  Sym_dot	   = Intern(".");		 STk_gc_protect(&Sym_dot);
  Sym_debug	   = Intern(DEBUG_MODE);	 STk_gc_protect(&Sym_debug);
  Sym_else	   = Intern("else");	    	 STk_gc_protect(&Sym_else);
  Sym_quasiquote   = Intern("quasiquote");	 STk_gc_protect(&Sym_quasiquote);
  Sym_unquote	   = Intern("unquote");	    	 STk_gc_protect(&Sym_unquote);
  Sym_unq_splicing = Intern("unquote-splicing"); STk_gc_protect( &Sym_unq_splicing);

  STk_globenv      = STk_makeenv(NIL, 1);    	 STk_gc_protect(&STk_globenv);

  /* GC_VERBOSE and REPORT_ERROR must ABSOLUTLY initialized before any GC occurs
   * Otherwise, they will be allocated during a GC and this lead to an infinite 
   * loop
   */
  VCELL(Intern(GC_VERBOSE))	= Ntruth;
  VCELL(Intern(REPORT_ERROR))	= NIL;

  VCELL(Intern(LOAD_SUFFIXES))  = NIL;
  VCELL(Intern(LOAD_PATH))	= NIL;
  VCELL(Intern(LOAD_VERBOSE))   = Ntruth;

  /* Initialize standard ports */
  STk_init_standard_ports();

  /* Initialize Scheme primitives */
  STk_init_primitives();

  /* initialize STk_wind_stack and protect it against garbage colection */
  STk_wind_stack = NIL;  STk_gc_protect(&STk_wind_stack);
}

static void finish_initialisation(void)
{
  /* 
   * Initialize user extensions 
   */
  STk_user_init();

  /* 
   * Manage -file if it exists. Behaviour is different if TK is used and inited
   */
  if (STk_arg_file) {
    STk_loadfile(STk_arg_file, TRUE);
    /* Reset default action on SIGINT */
    signal(SIGINT, SIG_DFL);
    STk_interactivep = 0;
#ifdef USE_TK
    if (Tk_initialized) Tk_MainLoop();
#endif
    exit(0);
  }
#ifdef USE_TK
  else {
    /*
     * Commands come from standard input. Set up a handler to receive 
     * stdin characters and print a prompt if the input device is a terminal.
     */
    Tk_CreateFileHandler(0,
			 TK_READABLE,
			 (Tk_FileProc *) STk_StdinProc, 
			 (ClientData) 0);
  }
#endif

  /* 
   * See if we are interactive; if so, 
   *	- unbufferize stdout and stderr so that the interpreter can
   *	  be used with Emacs.
   * 	- print the STk banner
   */
  if (STk_interactivep) {
    setbuf(stdout, NULL);
    setbuf(stderr, NULL);
    print_banner();
  }
  /* 
   * Manage -load option 
   */
  if (STk_arg_load) {
    STk_loadfile(STk_arg_load, TRUE);
#ifdef USE_TK
    if (Tk_initialized) Tcl_GlobalEval(STk_main_interp, "(update)");
#endif
  }
}

static void repl_loop(void)
{
  /* The print/eval/read loop */
  for( ; ; ) {
    SCM x;

    if (STk_interactivep) { 
      fprintf(stderr, "STk> ");
      fflush(stderr); 
      fflush(stdout);	/* This is for Ilisp users */
    }
    if (EQ(x=STk_readf(stdin, FALSE), STk_eof_object)) return;
    x = STk_eval(x, NIL);
    if (STk_dumped_core) {
      /* 
       * When restoring an image we arrive here x contains the result of applying
       * the saved continuation.
       */
      STk_dumped_core = 0;
      longjmp(*Top_jmp_buf, JMP_RESTORE);
    }
    else {
      STk_print(x, STk_curr_oport, WRT_MODE);
      Putc('\n', stdout);
    }
  }
}

static void repl_driver(int argc, char **argv)
{
  static int k;
  static char **new_argv;
  
  new_argv = STk_process_argc_argv(argc, argv);

  if (STk_arg_image) {
    STk_save_unix_args_and_environment(argc, argv);
    STk_restore_image(STk_arg_image);
  }
  else {
    /* Normal initialisation */
    STk_reset_eval_stack();
  }

  /* Point where we come back on errors, image restoration, ... */
  k = setjmp(*Top_jmp_buf);
  
  signal(SIGINT, handle_sigint);
  signal(SIGFPE, handle_sigfpe);
  
  interrupt_differed = 0;
  nointerrupt 	     = 0;
  Error_context      = ERR_OK;  
  STk_interactivep   = STk_arg_interactive || isatty(fileno(stdin));

  switch (k) {
    case 0: 		init_interpreter();
			STk_initialize_scheme_args(new_argv);
			load_init_file();
#ifdef USE_TK
      			if (!STk_arg_no_tk && (STk_arg_Xdisplay||getenv("DISPLAY")))
			  Tk_main(STk_arg_sync,
				  STk_arg_name,
				  STk_arg_file,
				  STk_arg_Xdisplay,
				  STk_arg_geometry);
#endif
			finish_initialisation();
		        break;
    case JMP_RESTORE:   STk_restore_unix_args_and_environment(&argc, &argv);
      			/* Process another time args since we have lost them ! */
			new_argv = STk_process_argc_argv(argc, argv);
      			STk_initialize_scheme_args(new_argv);
#ifdef USE_TK
      			if (!STk_arg_no_tk && (STk_arg_Xdisplay||getenv("DISPLAY")))
			  Tk_main(STk_arg_sync, 
				  STk_arg_name, 
				  STk_arg_file, 
				  STk_arg_Xdisplay,
				  STk_arg_geometry);
#endif
			finish_initialisation();
			break;
    case JMP_THROW:
    case JMP_ERROR:     break;
  }

  repl_loop();
  if (STk_interactivep) fprintf(stderr, "Bye.\n");
  STk_quit_interpreter(UNBOUND);
}

/******************************************************************************
 *
 * Toplevel
 * 
 ******************************************************************************/

void STk_toplevel(int argc, char **argv)
{
  SCM stack_start; /* Unused variable. Its the first stack allocated variable */

  STk_stack_start_ptr = &stack_start;
  repl_driver(argc, argv);
}