/* 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"
#ifdef XLISP_STAT
#include "xlstat.h"
#endif

#ifdef MACINTOSH
extern int hasAppleEvents;
#endif /* MACINTOSH */

/* Forward declarations */
LOCAL VOID initwks(V);
#ifdef IEEEFP
LOCAL double compute_infinity P2H(double, double);
#endif

#ifdef PACKAGES
/* enter an internal rather than external symbol */
#define ienter(x) xlintern(x, xlisppack)
#else
#define ienter(x) xlenter(x)
#endif

/* $putpatch.c$: "MODULE_XLINIT_C_GLOBALS" */

/* xlinit - xlisp initialization routine */
int xlinit P1C(char *, resfile) /* TAA Mod -- return true if load of init.lsp needed */
{
    /* initialize xlisp (must be in this order) */
    xlminit();  /* initialize xldmem.c */
    xldinit();  /* initialize xldbug.c */
#ifdef BYTECODE
    init_bytecode();
#endif /* BYTECODE */

    /* finish initializing */
#ifdef SAVERESTORE
    if (*resfile=='\0' || !xlirestore(resfile)) {
        initwks();
        /* $putpatch.c$: "MODULE_XLINIT_C_XLINIT" */
        return TRUE;
    }
    return FALSE;
#else
    initwks();
    /* $putpatch.c$: "MODULE_XLINIT_C_XLINIT" */
    return TRUE;
#endif
}

/* initwks - build an initial workspace */
LOCAL VOID initwks(V)
{
    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 */

    /*can't mark as unbound until #<unbound> created*/
    setfunction(s_unbound, s_unbound);
#ifdef PACKAGES
    setfunction(s_package, s_unbound);
#else
    setfunction(obarray, s_unbound);
#endif /* PACKAGES */
    setfunction(NIL, s_unbound);

    setsvalue(a_readpw, NIL);           /* Don't preserve white space */

    setsvalue(s_evalhook, NIL);         /* no evalhook function */
    setsvalue(s_applyhook, NIL);        /* no applyhook function */
    setsvalue(s_tracelist, NIL);        /* no functions being traced */
    setsvalue(s_tracenable, NIL);       /* traceback disabled */
    setsvalue(s_tlimit, NIL);           /* trace limit infinite */
    setsvalue(s_breakenable, NIL);      /* don't enter break loop on errors */
    setsvalue(s_gcflag, NIL);           /* don't show gc information */
    setsvalue(s_gchook, NIL);           /* no gc hook active */
    setsvalue(s_baktraceprargs, s_true);/* print args in baktrace */

    setsvalue(s_features, NIL);         /* initial set of features */
    setvalue(s_features, cons(xlenter(":XLISP"), getvalue(s_features)));
    setvalue(s_features, cons(xlenter(":XLISP-PLUS"), getvalue(s_features)));
#ifdef XLISP_STAT
    setvalue(s_features, cons(xlenter(":XLISP-STAT"), getvalue(s_features)));
#endif /* XLISP_STAT */
#ifdef MACINTOSH
    setvalue(s_features, cons(xlenter(":MACINTOSH"), getvalue(s_features)));
    if (hasAppleEvents)
      setvalue(s_features, cons(xlenter(":APPLE-EVENTS"), getvalue(s_features)));
#endif /* MACINTOSH */
#ifdef SUNVIEW
    setvalue(s_features, cons(xlenter(":SUNVIEW"), getvalue(s_features)));
#endif /* SUNVIEW */
#ifdef X11WINDOWS
    setvalue(s_features, cons(xlenter(":X11"), getvalue(s_features)));
#endif /* X11WINDOWS */
#ifdef UNIX
    setvalue(s_features, cons(xlenter(":UNIX"), getvalue(s_features)));
#endif /* UNIX */
#ifdef MSDOS
    setvalue(s_features, cons(xlenter(":MSDOS"), getvalue(s_features)));
#endif /* MSDOS */
#ifdef WIN32
    setvalue(s_features, cons(xlenter(":WIN32"), getvalue(s_features)));
#endif /* WIN32 */
#ifdef AMIGA
    setvalue(s_features, cons(xlenter(":AMIGA"), getvalue(s_features)));
#endif /* AMIGA */

#ifdef BIGNUMS
    setsvalue(s_readbase, NIL);		/* default read base (decimal) */
    setsvalue(s_printbase, NIL);	/* default print base (decimal) */
#else
    setsvalue(s_ifmt, NIL);             /* default integer print format */
#endif
    setsvalue(s_ffmt, NIL);             /* float print format */

    setsvalue(s_printcase, k_upcase);   /* upper case output of symbols */
    setsvalue(s_printlevel, NIL);       /* printing depth is infinite */
    setsvalue(s_printlength, NIL);      /* printing length is infinite */
    setsvalue(s_printgensym, s_true);   /* print uninterned symbols with #: */
    setsvalue(s_printreadably, NIL);    /* print readable representations */
    setsvalue(s_printescape, s_true);   /* print excape characters */
    setsvalue(s_read_suppress, NIL);    /* do not suppress read operations */
#ifdef PRINTCIRCLE
    setsvalue(s_printcircle, NIL);      /* do not detect circles */
#endif /* PRINTCIRCLE */
#ifdef READTABLECASE
    setsvalue(s_rtcase, k_upcase);      /* read converting to uppercase */
#endif
    setsvalue(s_dispmacros, NIL);       /* don't displace macros */
    setsvalue(s_startup_functions, NIL);/* no startup functions */
    setsvalue(s_keepdocs,s_true);       /* keep doc strings */
    setsvalue(s_strict_keywords,s_true);/* enforce strict keyword use */
#ifdef CONDITIONS
    setsvalue(s_condition_hook, NIL);   /* no condition hook */
#endif /* CONDITIONS */
    setsvalue(s_loadfileargs, s_true);  /* load command line files on start */

    /* install the built-in functions and special forms */
    for (i = 0, p = funtab; (p->fd_subr) != (LVAL(*) _((void)))NULL; ++i, ++p)
        if (p->fd_name != NULL)
            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")));

    /* set the initial top level function */
    setsvalue(s_toplevelloop, getfunction(xlenter("TOP-LEVEL-LOOP")));

    /* set the initial interrupt action */
    setsvalue(s_intaction, getfunction(xlenter("TOP-LEVEL")));

#ifdef BYTECODE
    /* initial version of CHECK-FSL-VERSION for bootstrapping */
    setfunction(ienter("CHECK-FSL-VERSION"), getfunction(xlenter("LIST")));
#endif /* BYTECODE */

#ifdef XLISP_STAT
    init_objects();
#endif /* XLISP_STAT */
#ifdef PACKAGES
    setvalue(s_package, xluserpack);
#endif /* PACKAGES */
}

/* xlsymbols - enter all of the symbols used by the interpreter */
VOID xlsymbols(V)
{
    LVAL sym;
#ifdef PACKAGES
    LVAL oldpack;

    /* find the system packages */
    xlisppack = xlfindpackage("XLISP");
    xlkeypack = xlfindpackage("KEYWORD");
    xluserpack = xlfindpackage("USER");
    xlfindsymbol("*PACKAGE*", xlisppack, &s_package);
    oldpack = getvalue(s_package);
    setvalue(s_package,xlisppack);
#endif /* PACKAGES */

    /* make the unbound variable indicator (must be first) */
    /* TAA MOD 1/93 -- now not interned */

    if (s_unbound == NIL) { /* don't make twice */
        s_unbound = xlmakesym("U"); /* name doesn't really matter */
        setvalue(s_unbound, s_unbound);
    }

    /* put NIL in oblist */
#ifdef PACKAGES
    setpackage(NIL, xlisppack);
    xlimport(NIL,xlisppack);
    xlexport(NIL,xlisppack);
#else
    {   /* duplicate code in xlenter, with different ending */
        char *name= "NIL";
        LVAL array = getvalue(obarray);
        int i = hash(name, HSIZE);
        
        for (sym = getelement(array,i); consp(sym); sym = cdr(sym))
            if (STRCMP(name, getstring(getpname(car(sym)))) == 0)
                goto noEnterNecessary;

        sym = consd(getelement(array,i));
        rplaca(sym, NIL);
        setelement(array, i, sym);
noEnterNecessary: ;
    }
#endif /* PACKAGES */

    /* enter the 't' symbol */
    s_true = xlenter("T");
    defconstant(s_true, s_true);        /* TAA mod -- was setvalue */

    /* enter some other constants */
#ifdef TIMES
    sym = xlenter("INTERNAL-TIME-UNITS-PER-SECOND");
    defconstant(sym, cvfixnum((FIXTYPE) ticks_per_second()));
#endif
    sym = xlenter("PI");
    defconstant(sym, cvflonum((FLOTYPE) PI));
#ifdef IEEEFP
    {
      double posinfinity, neginfinity, notanumber;

      /**** it may be necessary to turn off signals here  and above */
      posinfinity = compute_infinity(1.0, 0.0);
      neginfinity = -posinfinity;
      notanumber = posinfinity + neginfinity;
      s_posinfinity = xlenter("POSITIVE-INFINITY");
      s_neginfinity = xlenter("NEGATIVE-INFINITY");
      s_notanumber  = xlenter("NOT-A-NUMBER");
      defconstant(s_posinfinity, cvflonum((FLOTYPE) posinfinity));
      defconstant(s_neginfinity, cvflonum((FLOTYPE) neginfinity));
      defconstant(s_notanumber,  cvflonum((FLOTYPE) notanumber));
    }
#endif

    /* enter some important symbols */
    s_dot       = xlenter(".");
    s_quote     = xlenter("QUOTE");
    s_identity  = xlenter("IDENTITY");
    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_eq        = xlenter("EQ");
    s_eql       = xlenter("EQL");
    s_equal     = xlenter("EQUAL");
    s_features  = xlenter("*FEATURES*");
#ifdef BIGNUMS
    s_readbase  = xlenter("*READ-BASE*");
    s_printbase = xlenter("*PRINT-BASE*");
#else
    s_ifmt      = xlenter("*INTEGER-FORMAT*");
#endif
    s_ffmt      = xlenter("*FLOAT-FORMAT*");
    s_otherwise = xlenter("OTHERWISE");
    s_destructbind = xlenter("DESTRUCTURING-BIND");

    s_batchmode = xlenter("*BATCH-MODE*");
    setsvalue(s_batchmode, batchmode ? s_true : NIL);

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

    /* enter setf place specifiers */
    s_setf      = xlenter("*SETF*");
    s_setfl     = xlenter("*SETF-LAMBDA*");  /* TAA added 7/92 */
    s_getf      = xlenter("GETF");           /* TAA added 7/93 */
    s_car       = xlenter("CAR");
    s_cdr       = xlenter("CDR");
    s_nth       = xlenter("NTH");
    s_aref      = xlenter("AREF");
    s_row_major_aref = xlenter("ROW-MAJOR-AREF");
    s_get       = xlenter("GET");
    s_svalue    = xlenter("SYMBOL-VALUE");
    s_sfunction = xlenter("SYMBOL-FUNCTION");
    s_splist    = xlenter("SYMBOL-PLIST");
    s_elt       = xlenter("ELT");
    s_apply     = xlenter("APPLY");
#ifdef HASHFCNS
    s_gethash   = xlenter("GETHASH");
#endif
    s_read_suppress = xlenter("*READ-SUPPRESS*");

    /* property for use by deftype */
    s_typespec  = xlenter("*TYPE-SPEC*");

    /* enter the readtable variable and keywords */
    s_rtable    = xlenter("*READTABLE*");
#ifdef BYTECODE
    s_stdrtable = xlenter("*STANDARD-READTABLE*");
#endif /* BYTECODE */
    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");
    k_io        = xlenter(":IO");
    k_probe     = xlenter(":PROBE");
    k_elementtype = xlenter(":ELEMENT-TYPE");
    k_exist     = xlenter(":IF-EXISTS");
    k_nexist    = xlenter(":IF-DOES-NOT-EXIST");
    k_error     = xlenter(":ERROR");
    k_rename    = xlenter(":RENAME");
    k_newversion = xlenter(":NEW-VERSION");
    k_overwrite = xlenter(":OVERWRITE");
    k_append    = xlenter(":APPEND");
    k_supersede = xlenter(":SUPERSEDE");
    k_rendel    = xlenter(":RENAME-AND-DELETE");
    k_create    = xlenter(":CREATE");

    /* enter *print-case* symbol and keywords */
    s_printcase = xlenter("*PRINT-CASE*");
    k_upcase    = xlenter(":UPCASE");
    k_downcase  = xlenter(":DOWNCASE");
    k_capitalize= xlenter(":CAPITALIZE");
#ifdef PRINTCIRCLE
    s_printcircle=xlenter("*PRINT-CIRCLE*");
    s_prcircdat = xlenter("*PRINT-CIRCLE-DATA*");
    setsvalue(s_prcircdat, s_unbound);
    s_rdcircdat = xlenter("*READ-CIRCLE-DATA*");
    setsvalue(s_rdcircdat, s_unbound);
#endif /* PRINTCIRCLE */

#ifdef READTABLECASE
    /* enter *readtable-case* symbol and keywords */
    s_rtcase    = xlenter("*READTABLE-CASE*");
    k_preserve  = xlenter(":PRESERVE");
    k_invert    = xlenter(":INVERT");
#endif

    /* more printing symbols */
    s_printlevel= xlenter("*PRINT-LEVEL*");
    s_printlength = xlenter("*PRINT-LENGTH*");
    s_printgensym = xlenter("*PRINT-GENSYM*");
    s_printreadably = xlenter("*PRINT-READABLY*");
    s_printescape = xlenter("*PRINT-ESCAPE*");

    s_load = xlenter("LOAD");

    /* 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_fromend   = xlenter(":FROM-END");
    k_verbose   = xlenter(":VERBOSE");
    k_print     = xlenter(":PRINT");
    k_count     = xlenter(":COUNT");
    k_concname  = xlenter(":CONC-NAME"); /* TAA-- added to save xlenters */
    k_include   = xlenter(":INCLUDE");
    k_prntfunc  = xlenter(":PRINT-FUNCTION");
    k_construct = xlenter(":CONSTRUCTOR");
    k_predicate = xlenter(":PREDICATE");
    k_initelem  = xlenter(":INITIAL-ELEMENT");
    k_initcont  = xlenter(":INITIAL-CONTENTS");
    k_displacedto = xlenter(":DISPLACED-TO");
    k_allow_other_keys = xlenter(":ALLOW-OTHER-KEYS"); /* TAA added 9/93 */

#ifdef KEYARG   
    k_key       = xlenter(":KEY");
#endif

    k_ivalue    = xlenter(":INITIAL-VALUE");

#ifdef HASHFCNS
    k_size = xlenter(":SIZE");
    k_rhthresh = xlenter(":REHASH-THRESHOLD");
    k_rhsize = xlenter(":REHASH-SIZE");
#endif

#ifdef PACKAGES
    k_nicknames = xlenter(":NICKNAMES");
    k_use = xlenter(":USE");
#ifdef MULVALS
    k_internal = xlenter(":INTERNAL");
    k_external = xlenter(":EXTERNAL");
    k_inherited = xlenter(":INHERITED");
#endif /* MULVALS */
#endif /* PACKAGES */

    /* Startup variables (from L. Tierney 9/93) */
    s_startup_functions = xlenter("*STARTUP-FUNCTIONS*");
    s_command_line = xlenter("*COMMAND-LINE*");
    s_loadfileargs = xlenter("*LOAD-FILE-ARGUMENTS*");
    s_toplevelloop = xlenter("*TOP-LEVEL-LOOP*");
    s_exit_functions = xlenter("SYSTEM::*EXIT-FUNCTIONS*");
    setvalue(s_exit_functions, NIL);

    /* 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");
    lk_whole    = xlenter("&WHOLE");
    lk_body     = xlenter("&BODY");
    lk_environment = xlenter("&ENVIRONMENT");

    /* enter *standard-input*, *standard-output* and *error-output* */
    /* TAA Modified so that stderr (CONSOLE) is used if no redirection */

    s_stderr = xlenter("*ERROR-OUTPUT*");
    setsvalue(s_stderr,cvfile(CONSOLE,S_FORREADING|S_FORWRITING));
    s_termio = xlenter("*TERMINAL-IO*");
    setsvalue(s_termio,getvalue(s_stderr));
    s_stdin = xlenter("*STANDARD-INPUT*");
    setsvalue(s_stdin,redirectin ? 
        cvfile(STDIN,S_FORREADING): getvalue(s_stderr));
    s_stdout = xlenter("*STANDARD-OUTPUT*");
    setsvalue(s_stdout,redirectout ? 
        cvfile(STDOUT,S_FORWRITING): getvalue(s_stderr));

    /* enter *debug-io* and *trace-output* */
    s_debugio = xlenter("*DEBUG-IO*");
    setsvalue(s_debugio,getvalue(s_stderr));
    s_traceout = xlenter("*TRACE-OUTPUT*");
    setsvalue(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*");
    s_baktraceprargs = xlenter("*BAKTRACE-PRINT-ARGUMENTS*");

    /* enter symbols to control printing of garbage collection messages */
    /* Added set's so gc works during initialization. L. Tierney */
    s_gcflag = xlenter("*GC-FLAG*");
    setvalue(s_gcflag,NIL);             /* don't show gc information */
    s_gchook = xlenter("*GC-HOOK*");
    setvalue(s_gchook,NIL);             /* no gc hook active */

    /* enter symbol to control displacing of macros with expanded version */
    s_dispmacros = xlenter("*DISPLACE-MACROS*");

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

#ifdef CONDITIONS
    /* enter condition hook and symbols*/
    s_condition_hook = xlenter("*CONDITION-HOOK*");
    s_error          = xlenter("ERROR");
    s_cerror         = xlenter("CERROR");
    s_signal         = xlenter("SIGNAL");
    s_warn           = xlenter("WARN");
    s_break          = xlenter("BREAK");
    s_debug          = xlenter("DEBUG");
    s_unboundvar     = xlenter("UNBOUND-VARIABLE");
    s_unboundfun     = xlenter("UNDEFINED-FUNCTION");
    k_name           = xlenter(":NAME");
#endif /* CONDITIONS */

    /* interrupt key action */
    s_intaction = xlenter("*INTERRUPT-ACTION*");

    /* 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("FLOAT");
    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_list      = xlenter("LIST");
    a_number    = xlenter("NUMBER");
    a_null      = xlenter("NULL");
    a_atom      = xlenter("ATOM");
    a_anystream = xlenter("STREAM");
    s_and       = xlenter("AND");
    s_or        = xlenter("OR");
    s_not       = xlenter("NOT");
    k_and       = xlenter(":AND");
    k_or        = xlenter(":OR");
    k_not       = xlenter(":NOT");
    s_satisfies = xlenter("SATISFIES");
    s_member    = xlenter("MEMBER");
    a_struct    = xlenter("STRUCTURE");
    a_complex   = xlenter("COMPLEX");
    a_rndstate  = xlenter("RANDOM-STATE");
    a_array     = xlenter("ARRAY");         /* L. Tierney */
#ifdef HASHFCNS
    a_hashtable = xlenter("HASH-TABLE");
#endif
    a_integer   = xlenter("INTEGER");
    a_real	= xlenter("REAL");
#ifdef BIGNUMS
    a_ratio     = xlenter("RATIO");
    a_rational  = xlenter("RATIONAL");
    a_bignum    = xlenter("BIGNUM");
    a_unbyte	= xlenter("UNSIGNED-BYTE");
    a_sbyte	= xlenter("SIGNED-BYTE");
#endif
#ifdef BYTECODE
    a_bcclosure = xlenter("BYTE-CODE-CLOSURE");
    a_cpsnode   = xlenter("CPS-NODE");
    a_bcode     = xlenter("BYTE-CODE");
#endif /* BYTECODE */
#ifdef PACKAGES
    a_package   = xlenter("PACKAGE");
#endif /* PACKAGES */
    k_symbol_macro = xlenter(":SYMBOL-MACRO");
#ifdef XLISP_STAT
    a_adata     = xlenter("ALLOCATED-DATA");
#endif /* XLISP_STAT */
    a_ptr        = xlenter("SYSTEM:POINTER");
    a_weakbox    = xlenter("SYSTEM:WEAK-BOX");
    a_tvec       = xlenter("TYPED-VECTOR");
    s_c_char     = xlenter("C-CHAR");
    s_c_uchar    = xlenter("C-UCHAR");
    s_c_short    = xlenter("C-SHORT");
    s_c_int      = xlenter("C-INT");
    s_c_long     = xlenter("C-LONG");
    s_c_float    = xlenter("C-FLOAT");
    s_c_double   = xlenter("C-DOUBLE");
    s_c_complex  = xlenter("C-COMPLEX");
    s_c_dcomplex = xlenter("C-DCOMPLEX");
    s_make_array = xlenter("MAKE-ARRAY");

    /* struct feature symbols */
    s_strtypep  = ienter("%STRUCT-TYPE-P");
    s_mkstruct  = ienter("%MAKE-STRUCT");
    s_cpystruct = ienter("%COPY-STRUCT");
    s_strref    = ienter("%STRUCT-REF");
    s_strset    = ienter("%STRUCT-SET");
    s_x         = ienter("X");
    s_s         = ienter("S");
    s_prntfunc  = xlenter("*STRUCT-PRINT-FUNCTION*");
    s_sslots    = xlenter("*STRUCT-SLOTS*");
    s_strinclude= xlenter("*STRUCT-INCLUDE*");
    s_strconstruct= xlenter("*STRUCT-CONSTRUCTOR*");
    a_readpw    = ienter("*PRESERVE-WHITESPACE*");

    s_keepdocs = xlenter("*KEEP-DOCUMENTATION-STRINGS*");
    s_fundoc = xlenter("FUNCTION-DOCUMENTATION");
    s_vardoc = xlenter("VARIABLE-DOCUMENTATION");

    s_strict_keywords = xlenter("*STRICT-KEYWORDS*");

    s_rndstate     = xlenter("*RANDOM-STATE*");
#ifdef PACKAGES
    s_printsympack = xlenter("*PRINT-SYMBOL-PACKAGE*");
    setsvalue(s_printsympack, NIL);
#endif /* PACKAGES */

#ifdef MSDOS
    k_data = xlenter(":DATA");
    k_type = xlenter(":TYPE");
    k_item = xlenter(":ITEM");
    k_timeout = xlenter(":TIMEOUT");
    k_request = xlenter(":REQUEST");
#endif /* MSDOS */

#ifdef MACINTOSH
    k_appllistlabel = xlenter(":APPLICATION-LIST-LABEL");
    k_canswitch = xlenter(":CAN-SWITCH-LAYER");
    k_data = xlenter(":DATA");
    k_name = xlenter(":NAME");
    k_object = xlenter(":OBJECT");
    k_prompt = xlenter(":PROMPT");
    k_signature = xlenter(":SIGNATURE");
    k_timeout = xlenter(":TIMEOUT");
    k_type = xlenter(":TYPE");
    k_waitreply = xlenter(":WAIT-REPLY");
    k_zone = xlenter(":ZONE");
#endif /* MACINTOSH */

    /* add the object-oriented programming symbols and os specific stuff */
    obsymbols();        /* object-oriented programming symbols */
    ossymbols();        /* os specific symbols */
    initrndstate();
#ifdef BYTECODE
    bcsymbols();
#endif /* BYTECODE */
    /* $putpatch.c$: "MODULE_XLINIT_C_XLSYMBOLS" */
#ifdef PACKAGES
    setvalue(s_package, oldpack);
#endif /* PACKAGES */
#ifdef BIGNUMS
    {
        LVAL sym = ienter("*big0*");
        if (!boundp(sym)) 
            defconstant(sym, n_bigzero=cvtfixbignum(0L));
        else
            n_bigzero = getvalue(sym);
        sym = ienter("*big-1*");
        if (!boundp(sym))
            defconstant(sym, n_bigmone=cvtfixbignum(-1L));
        else
            n_bigmone = getvalue(sym);
    }
#endif
}

#ifdef IEEEFP
LOCAL double compute_infinity P2C(double, one, double, zero)
{
  return(one / zero);
}
#endif


syntax highlighted by Code2HTML, v. 0.9.1