/* xlinit.c - xlisp initialization module */
/* Copyright (c) 1989, by David Michael Betz.                            */
/* You may give out copies of this software; for conditions see the file */
/* COPYING included with this distribution.                              */

#include "xlisp.h"
#include "osdef.h"
#ifdef ANSI
#include "xlproto.h"
#include "xlsproto.h"
#include "osproto.h"
#else
#include "xlfun.h"
#include "xlsfun.h"
#include "osfun.h"
#endif ANSI
#include "xlvar.h"

#ifdef ANSI
void initwks(void);
#else
void initwks();
#endif ANSI

/* xlinit - xlisp initialization routine */
void xlinit()
{
    /* initialize xlisp (must be in this order) */
    xlminit();	/* initialize xldmem.c */
    xldinit();	/* initialize xldbug.c */

    /* finish initializing */
#ifdef SAVERESTORE
    if (!xlirestore("xlisp.wks"))
#endif
	initwks();
#ifndef XLISP_ONLY
#ifdef SAVERESTORE /* L. Tierney */
  else if (consp(getvalue(xlenter("*HARDWARE-OBJECTS*")))) {
    LVAL hlist, s_hardware_objects = xlenter("*HARDWARE-OBJECTS*");
    LVAL sk_allocate = xlenter(":ALLOCATE");
    LVAL copylist();
    
    xlsave1(hlist);
    hlist = copylist(getvalue(s_hardware_objects));
    setvalue(s_hardware_objects, NIL);
    for (; consp(hlist); hlist = cdr(hlist))
      send_message(car(cdr(cdr(car(hlist)))), sk_allocate);
    xlpop();
  }
#endif /* SAVERESTORE */
#endif /* XLISP_ONLY */
}

/* initwks - build an initial workspace */
LOCAL void initwks()
{
    FUNDEF *p;
    int i;
    
    xlsinit();	/* initialize xlsym.c */
    xlsymbols();/* enter all symbols used by the interpreter */
    xlrinit();	/* initialize xlread.c */
    xloinit();	/* initialize xlobj.c */

    /* setup defaults */
    setvalue(s_evalhook,NIL);		/* no evalhook function */
    setvalue(s_applyhook,NIL);		/* no applyhook function */
    setvalue(s_tracelist,NIL);		/* no functions being traced */
    setvalue(s_tracenable,NIL);		/* traceback disabled */
    setvalue(s_tlimit,NIL); 		/* trace limit infinite */
    setvalue(s_breakenable,NIL);	/* don't enter break loop on errors */
    setvalue(s_gcflag,NIL);		/* don't show gc information */
    setvalue(s_gchook,NIL);		/* no gc hook active */
    setvalue(s_ifmt,cvstring(IFMT));	/* integer print format */
    setvalue(s_ffmt,cvstring("%g"));	/* float print format */
    setvalue(s_printcase,k_upcase);	/* upper case output of symbols */

    /* install the built-in functions and special forms */
    for (i = 0, p = funtab; p->fd_subr != NULL; ++i, ++p)
	if (p->fd_name)
	    xlsubr(p->fd_name,p->fd_type,p->fd_subr,i);

    /* add some synonyms */
    setfunction(xlenter("NOT"),getfunction(xlenter("NULL")));
    setfunction(xlenter("FIRST"),getfunction(xlenter("CAR")));
    setfunction(xlenter("SECOND"),getfunction(xlenter("CADR")));
    setfunction(xlenter("THIRD"),getfunction(xlenter("CADDR")));
    setfunction(xlenter("FOURTH"),getfunction(xlenter("CADDDR")));
    setfunction(xlenter("REST"),getfunction(xlenter("CDR")));

    osfinit();  /* L. Tierney */
}

/* xlsymbols - enter all of the symbols used by the interpreter */
void xlsymbols()
{
    LVAL sym;

    /* enter the unbound variable indicator (must be first) */
    s_unbound = xlenter("*UNBOUND*");
    setvalue(s_unbound,s_unbound);

    /* enter the 't' symbol */
    true = xlenter("T");
    setvalue(true,true);

    /* enter some important symbols */
    s_dot	= xlenter(".");
    s_quote	= xlenter("QUOTE");
    s_function	= xlenter("FUNCTION");
    s_bquote	= xlenter("BACKQUOTE");
    s_comma	= xlenter("COMMA");
    s_comat	= xlenter("COMMA-AT");
    s_lambda	= xlenter("LAMBDA");
    s_macro	= xlenter("MACRO");
    s_eql	= xlenter("EQL");
    s_ifmt	= xlenter("*INTEGER-FORMAT*");
    s_ffmt	= xlenter("*FLOAT-FORMAT*");

    /* symbols set by the read-eval-print loop */
    s_1plus	= xlenter("+");
    s_2plus	= xlenter("++");
    s_3plus	= xlenter("+++");
    s_1star	= xlenter("*");
    s_2star	= xlenter("**");
    s_3star	= xlenter("***");
    s_minus	= xlenter("-");

    /* enter setf place specifiers */
    s_setf	= xlenter("*SETF*");
    s_car	= xlenter("CAR");
    s_cdr	= xlenter("CDR");
    s_nth	= xlenter("NTH");
    s_aref	= xlenter("AREF");
    s_get	= xlenter("GET");
    s_svalue	= xlenter("SYMBOL-VALUE");
    s_sfunction	= xlenter("SYMBOL-FUNCTION");
    s_splist	= xlenter("SYMBOL-PLIST");

    /* enter the readtable variable and keywords */
    s_rtable	= xlenter("*READTABLE*");
    k_wspace	= xlenter(":WHITE-SPACE");
    k_const	= xlenter(":CONSTITUENT");
    k_nmacro	= xlenter(":NMACRO");
    k_tmacro	= xlenter(":TMACRO");
    k_sescape	= xlenter(":SESCAPE");
    k_mescape	= xlenter(":MESCAPE");

    /* enter parameter list keywords */
    k_test	= xlenter(":TEST");
    k_tnot	= xlenter(":TEST-NOT");

    /* "open" keywords */
    k_direction = xlenter(":DIRECTION");
    k_input     = xlenter(":INPUT");
    k_output    = xlenter(":OUTPUT");

    /* enter *print-case* symbol and keywords */
    s_printcase = xlenter("*PRINT-CASE*");
    k_upcase	= xlenter(":UPCASE");
    k_downcase  = xlenter(":DOWNCASE");

    /* other keywords */
    k_start	= xlenter(":START");
    k_end	= xlenter(":END");
    k_1start	= xlenter(":START1");
    k_1end	= xlenter(":END1");
    k_2start	= xlenter(":START2");
    k_2end	= xlenter(":END2");
    k_verbose	= xlenter(":VERBOSE");
    k_print	= xlenter(":PRINT");
    k_count	= xlenter(":COUNT");
    k_key	= xlenter(":KEY");

    /* enter lambda list keywords */
    lk_optional	= xlenter("&OPTIONAL");
    lk_rest	= xlenter("&REST");
    lk_key	= xlenter("&KEY");
    lk_aux	= xlenter("&AUX");
    lk_allow_other_keys = xlenter("&ALLOW-OTHER-KEYS");

    /* enter *standard-input*, *standard-output* and *error-output* */
    s_stdin = xlenter("*STANDARD-INPUT*");
    setvalue(s_stdin,cvfile(stdin));
    s_stdout = xlenter("*STANDARD-OUTPUT*");
    setvalue(s_stdout,cvfile(stdout));
    s_stderr = xlenter("*ERROR-OUTPUT*");
    setvalue(s_stderr,cvfile(stderr));

    /* enter *debug-io* and *trace-output* */
    s_debugio = xlenter("*DEBUG-IO*");
    setvalue(s_debugio,getvalue(s_stderr));
    s_traceout = xlenter("*TRACE-OUTPUT*");
    setvalue(s_traceout,getvalue(s_stderr));

    /* enter the eval and apply hook variables */
    s_evalhook = xlenter("*EVALHOOK*");
    s_applyhook = xlenter("*APPLYHOOK*");

    /* enter the symbol pointing to the list of functions being traced */
    s_tracelist = xlenter("*TRACELIST*");

    /* enter the error traceback and the error break enable flags */
    s_tracenable = xlenter("*TRACENABLE*");
    s_tlimit = xlenter("*TRACELIMIT*");
    s_breakenable = xlenter("*BREAKENABLE*");

    /* enter a symbol to control printing of garbage collection messages */
    s_gcflag = xlenter("*GC-FLAG*");
    s_gchook = xlenter("*GC-HOOK*");

    /* Added so gc works during initialization. L. Tierney */
    setvalue(s_gcflag,NIL);		/* don't show gc information */
    setvalue(s_gchook,NIL);		/* no gc hook active */

    /* enter a copyright notice into the oblist */
    sym = xlenter("**Copyright-1988-by-David-Betz**");
    setvalue(sym,true);

    /* enter type names */
    a_subr	= xlenter("SUBR");
    a_fsubr	= xlenter("FSUBR");
    a_cons	= xlenter("CONS");
    a_symbol	= xlenter("SYMBOL");
    a_fixnum	= xlenter("FIXNUM");
    a_flonum	= xlenter("FLONUM");
    a_string	= xlenter("STRING");
    a_object	= xlenter("OBJECT");
    a_stream	= xlenter("FILE-STREAM");
    a_vector	= xlenter("VECTOR");        /* L. Tierney */
    a_closure	= xlenter("CLOSURE");
    a_char      = xlenter("CHARACTER");
    a_ustream	= xlenter("UNNAMED-STREAM");
    a_complex   = xlenter("COMPLEX");       /* L. Tierney */
    a_array     = xlenter("ARRAY");         /* L. Tierney */

    /* add the object-oriented programming symbols and os specific stuff */
    obsymbols();	/* object-oriented programming symbols */
    ossymbols();	/* os specific symbols */
}