home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / Programming / Source / winterp-1.13 / src-server / xlisp / xlinit.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-10-04  |  10.6 KB  |  301 lines
  1. /* -*-C-*-
  2. ********************************************************************************
  3. *
  4. * File:         xlinit.c
  5. * RCS:          $Header: xlinit.c,v 1.7 91/03/24 22:24:55 mayer Exp $
  6. * Description:  xlisp initialization module
  7. * Author:       David Michael Betz
  8. * Created:      
  9. * Modified:     Fri Oct  4 04:16:38 1991 (Niels Mayer) mayer@hplnpm
  10. * Language:     C
  11. * Package:      N/A
  12. * Status:       X11r5 contrib tape release
  13. *
  14. * WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. * XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. *
  17. * Permission to use, copy, modify, distribute, and sell this software and its
  18. * documentation for any purpose is hereby granted without fee, provided that
  19. * the above copyright notice appear in all copies and that both that
  20. * copyright notice and this permission notice appear in supporting
  21. * documentation, and that the name of Hewlett-Packard and David Betz not be
  22. * used in advertising or publicity pertaining to distribution of the software
  23. * without specific, written prior permission.  Hewlett-Packard and David Betz
  24. * make no representations about the suitability of this software for any
  25. * purpose. It is provided "as is" without express or implied warranty.
  26. *
  27. * HEWLETT-PACKARD AND DAVID BETZ DISCLAIM ALL WARRANTIES WITH REGARD TO THIS
  28. * SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS,
  29. * IN NO EVENT SHALL HEWLETT-PACKARD NOR DAVID BETZ BE LIABLE FOR ANY SPECIAL,
  30. * INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
  31. * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
  32. * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
  33. * PERFORMANCE OF THIS SOFTWARE.
  34. *
  35. * See ./winterp/COPYRIGHT for information on contacting the authors.
  36. * 
  37. * Please send modifications, improvements and bugfixes to mayer@hplabs.hp.com
  38. * Post XLISP-specific questions/information to the newsgroup comp.lang.lisp.x
  39. *
  40. ********************************************************************************
  41. */
  42. static char rcs_identity[] = "@(#)$Header: xlinit.c,v 1.7 91/03/24 22:24:55 mayer Exp $";
  43.  
  44. #include "xlisp.h"
  45.  
  46. /* external variables */
  47. extern LVAL true,s_dot,s_unbound;
  48. extern LVAL s_quote,s_function,s_bquote,s_comma,s_comat;
  49. extern LVAL s_lambda,s_macro;
  50. extern LVAL s_stdin,s_stdout,s_stderr,s_debugio,s_traceout;
  51. extern LVAL s_evalhook,s_applyhook,s_tracelist;
  52. extern LVAL s_tracenable,s_tlimit,s_breakenable;
  53. extern LVAL s_setf,s_car,s_cdr,s_nth,s_aref,s_get,s_eql;
  54. extern LVAL s_svalue,s_sfunction,s_splist;
  55. extern LVAL s_rtable,k_wspace,k_const,k_nmacro,k_tmacro;
  56. extern LVAL k_sescape,k_mescape;
  57. extern LVAL s_ifmt,s_ffmt,s_printcase;
  58. extern LVAL s_1plus,s_2plus,s_3plus,s_1star,s_2star,s_3star,s_minus;
  59. extern LVAL k_test,k_tnot;
  60. extern LVAL k_direction,k_input,k_output;
  61. extern LVAL k_start,k_end,k_1start,k_1end,k_2start,k_2end;
  62. extern LVAL k_verbose,k_print,k_count,k_key,k_upcase,k_downcase;
  63. extern LVAL lk_optional,lk_rest,lk_key,lk_aux,lk_allow_other_keys;
  64. extern LVAL a_subr,a_fsubr,a_cons,a_symbol;
  65. extern LVAL a_fixnum,a_flonum,a_string,a_stream,a_object;
  66. extern LVAL a_vector,a_closure,a_char,a_ustream;
  67. extern LVAL s_gcflag,s_gchook;
  68. extern FUNDEF funtab[];
  69.  
  70. #if (defined(UNIX) || defined(WINTERP))
  71. extern LVAL a_PIPE;
  72. #endif /* (defined(UNIX) || defined(WINTERP)) */
  73.  
  74. #ifdef WINTERP
  75. extern LVAL a_XtAccelerators, a_XtTranslations, a_XEvent, a_Window, a_Pixel,
  76.   a_Pixmap, a_XImage, a_XmString, a_XmFontList, a_XT_RESOURCE, a_CALLBACKOBJ,
  77.   a_TIMEOUTOBJ, a_PIXMAP_REFOBJ, a_WIDGETOBJ, a_EVHANDLEROBJ;
  78. #endif
  79.  
  80.  
  81. /* xlinit - xlisp initialization routine */
  82. xlinit()
  83. {
  84.     /* initialize xlisp (must be in this order) */
  85.     xlminit();    /* initialize xldmem.c */
  86.     xldinit();    /* initialize xldbug.c */
  87.  
  88.     /* finish initializing */
  89. #ifdef SAVERESTORE
  90.     if (!xlirestore("xlisp.wks"))
  91. #endif
  92.     initwks();
  93. }
  94.  
  95. /* initwks - build an initial workspace */
  96. LOCAL initwks()
  97. {
  98.     FUNDEF *p;
  99.     int i;
  100.     
  101.     xlsinit();    /* initialize xlsym.c */
  102.     xlsymbols();/* enter all symbols used by the interpreter */
  103.     xlrinit();    /* initialize xlread.c */
  104.     xloinit();    /* initialize xlobj.c */
  105.  
  106.     /* setup defaults */
  107.     setvalue(s_evalhook,NIL);        /* no evalhook function */
  108.     setvalue(s_applyhook,NIL);        /* no applyhook function */
  109.     setvalue(s_tracelist,NIL);        /* no functions being traced */
  110.     setvalue(s_tracenable,NIL);        /* traceback disabled */
  111.     setvalue(s_tlimit,NIL);         /* trace limit infinite */
  112.     setvalue(s_breakenable,NIL);    /* don't enter break loop on errors */
  113.     setvalue(s_gcflag,NIL);        /* don't show gc information */
  114.     setvalue(s_gchook,NIL);        /* no gc hook active */
  115.     setvalue(s_ifmt,cvstring(IFMT));    /* integer print format */
  116.     setvalue(s_ffmt,cvstring("%g"));    /* float print format */
  117.     setvalue(s_printcase,k_upcase);    /* upper case output of symbols */
  118.  
  119.     /* install the built-in functions and special forms */
  120.     for (i = 0, p = funtab; p->fd_subr != NULL; ++i, ++p)
  121.     if (p->fd_name)
  122.         xlsubr(p->fd_name,p->fd_type,p->fd_subr,i);
  123.  
  124.     /* add some synonyms */
  125.     setfunction(xlenter("NOT"),getfunction(xlenter("NULL")));
  126.     setfunction(xlenter("FIRST"),getfunction(xlenter("CAR")));
  127.     setfunction(xlenter("SECOND"),getfunction(xlenter("CADR")));
  128.     setfunction(xlenter("THIRD"),getfunction(xlenter("CADDR")));
  129.     setfunction(xlenter("FOURTH"),getfunction(xlenter("CADDDR")));
  130.     setfunction(xlenter("REST"),getfunction(xlenter("CDR")));
  131. }
  132.  
  133. /* xlsymbols - enter all of the symbols used by the interpreter */
  134. xlsymbols()
  135. {
  136. #ifndef WINTERP
  137.     LVAL sym;
  138. #endif
  139.  
  140.     /* enter the unbound variable indicator (must be first) */
  141.     s_unbound = xlenter("*UNBOUND*");
  142.     setvalue(s_unbound,s_unbound);
  143.  
  144.     /* enter the 't' symbol */
  145.     true = xlenter("T");
  146.     setvalue(true,true);
  147.  
  148.     /* enter some important symbols */
  149.     s_dot    = xlenter(".");
  150.     s_quote    = xlenter("QUOTE");
  151.     s_function    = xlenter("FUNCTION");
  152.     s_bquote    = xlenter("BACKQUOTE");
  153.     s_comma    = xlenter("COMMA");
  154.     s_comat    = xlenter("COMMA-AT");
  155.     s_lambda    = xlenter("LAMBDA");
  156.     s_macro    = xlenter("MACRO");
  157.     s_eql    = xlenter("EQL");
  158.     s_ifmt    = xlenter("*INTEGER-FORMAT*");
  159.     s_ffmt    = xlenter("*FLOAT-FORMAT*");
  160.  
  161.     /* symbols set by the read-eval-print loop */
  162.     s_1plus    = xlenter("+");
  163.     s_2plus    = xlenter("++");
  164.     s_3plus    = xlenter("+++");
  165.     s_1star    = xlenter("*");
  166.     s_2star    = xlenter("**");
  167.     s_3star    = xlenter("***");
  168.     s_minus    = xlenter("-");
  169.  
  170.     /* enter setf place specifiers */
  171.     s_setf    = xlenter("*SETF*");
  172.     s_car    = xlenter("CAR");
  173.     s_cdr    = xlenter("CDR");
  174.     s_nth    = xlenter("NTH");
  175.     s_aref    = xlenter("AREF");
  176.     s_get    = xlenter("GET");
  177.     s_svalue    = xlenter("SYMBOL-VALUE");
  178.     s_sfunction    = xlenter("SYMBOL-FUNCTION");
  179.     s_splist    = xlenter("SYMBOL-PLIST");
  180.  
  181.     /* enter the readtable variable and keywords */
  182.     s_rtable    = xlenter("*READTABLE*");
  183.     k_wspace    = xlenter(":WHITE-SPACE");
  184.     k_const    = xlenter(":CONSTITUENT");
  185.     k_nmacro    = xlenter(":NMACRO");
  186.     k_tmacro    = xlenter(":TMACRO");
  187.     k_sescape    = xlenter(":SESCAPE");
  188.     k_mescape    = xlenter(":MESCAPE");
  189.  
  190.     /* enter parameter list keywords */
  191.     k_test    = xlenter(":TEST");
  192.     k_tnot    = xlenter(":TEST-NOT");
  193.  
  194.     /* "open" keywords */
  195.     k_direction = xlenter(":DIRECTION");
  196.     k_input     = xlenter(":INPUT");
  197.     k_output    = xlenter(":OUTPUT");
  198.  
  199.     /* enter *print-case* symbol and keywords */
  200.     s_printcase = xlenter("*PRINT-CASE*");
  201.     k_upcase    = xlenter(":UPCASE");
  202.     k_downcase  = xlenter(":DOWNCASE");
  203.  
  204.     /* other keywords */
  205.     k_start    = xlenter(":START");
  206.     k_end    = xlenter(":END");
  207.     k_1start    = xlenter(":START1");
  208.     k_1end    = xlenter(":END1");
  209.     k_2start    = xlenter(":START2");
  210.     k_2end    = xlenter(":END2");
  211.     k_verbose    = xlenter(":VERBOSE");
  212.     k_print    = xlenter(":PRINT");
  213.     k_count    = xlenter(":COUNT");
  214.     k_key    = xlenter(":KEY");
  215.  
  216.     /* enter lambda list keywords */
  217.     lk_optional    = xlenter("&OPTIONAL");
  218.     lk_rest    = xlenter("&REST");
  219.     lk_key    = xlenter("&KEY");
  220.     lk_aux    = xlenter("&AUX");
  221.     lk_allow_other_keys = xlenter("&ALLOW-OTHER-KEYS");
  222.  
  223.     /* enter *standard-input*, *standard-output* and *error-output* */
  224.     s_stdin = xlenter("*STANDARD-INPUT*");
  225.     setvalue(s_stdin,cvfile(stdin));
  226.     s_stdout = xlenter("*STANDARD-OUTPUT*");
  227.     setvalue(s_stdout,cvfile(stdout));
  228.     s_stderr = xlenter("*ERROR-OUTPUT*");
  229.     setvalue(s_stderr,cvfile(stderr));
  230.  
  231.     /* enter *debug-io* and *trace-output* */
  232.     s_debugio = xlenter("*DEBUG-IO*");
  233.     setvalue(s_debugio,getvalue(s_stderr));
  234.     s_traceout = xlenter("*TRACE-OUTPUT*");
  235.     setvalue(s_traceout,getvalue(s_stderr));
  236.  
  237.     /* enter the eval and apply hook variables */
  238.     s_evalhook = xlenter("*EVALHOOK*");
  239.     s_applyhook = xlenter("*APPLYHOOK*");
  240.  
  241.     /* enter the symbol pointing to the list of functions being traced */
  242.     s_tracelist = xlenter("*TRACELIST*");
  243.  
  244.     /* enter the error traceback and the error break enable flags */
  245.     s_tracenable = xlenter("*TRACENABLE*");
  246.     s_tlimit = xlenter("*TRACELIMIT*");
  247.     s_breakenable = xlenter("*BREAKENABLE*");
  248.  
  249.     /* enter a symbol to control printing of garbage collection messages */
  250.     s_gcflag = xlenter("*GC-FLAG*");
  251.     s_gchook = xlenter("*GC-HOOK*");
  252.  
  253. #ifndef WINTERP
  254.     /* enter a copyright notice into the oblist */
  255.     sym = xlenter("**Copyright-1989-by-David-Betz**");
  256.     setvalue(sym,true);
  257. #endif
  258.  
  259.     /* enter type names */
  260.     a_subr    = xlenter("SUBR");
  261.     a_fsubr    = xlenter("FSUBR");
  262.     a_cons    = xlenter("CONS");
  263.     a_symbol    = xlenter("SYMBOL");
  264.     a_fixnum    = xlenter("FIXNUM");
  265.     a_flonum    = xlenter("FLONUM");
  266.     a_string    = xlenter("STRING");
  267.     a_object    = xlenter("OBJECT");
  268.     a_stream    = xlenter("FILE-STREAM");
  269.     a_vector    = xlenter("ARRAY");
  270.     a_closure    = xlenter("CLOSURE");
  271.     a_char      = xlenter("CHARACTER");
  272.     a_ustream    = xlenter("UNNAMED-STREAM");
  273.  
  274. #if (defined(UNIX) || defined(WINTERP))
  275.     a_PIPE = xlenter("PIPE");
  276. #endif /* (defined(UNIX) || defined(WINTERP)) */
  277.  
  278. #ifdef WINTERP
  279.     a_XtAccelerators = xlenter("XT_ACCELERATORS");
  280.     a_XtTranslations = xlenter("XT_TRANSLATIONS");
  281.     a_XEvent = xlenter("XEVENT");
  282.     a_Window = xlenter("WINDOW");
  283.     a_Pixel = xlenter("PIXEL");
  284.     a_Pixmap = xlenter("PIXMAP");
  285.     a_XImage = xlenter("XIMAGE");
  286.     a_XmString = xlenter("XM_STRING");
  287.     a_XmFontList = xlenter("XM_FONT_LIST");
  288.     a_XT_RESOURCE = xlenter("XT_RESOURCE");
  289.     a_CALLBACKOBJ = xlenter("CALLBACK_OBJ");
  290.     a_TIMEOUTOBJ = xlenter("TIMEOUT_OBJ");
  291.     a_PIXMAP_REFOBJ = xlenter("PIXMAP_REFOBJ");
  292.     a_WIDGETOBJ = xlenter("WIDGET_OBJ");
  293.     a_EVHANDLEROBJ = xlenter("EVHANDLER_OBJ");
  294. #endif
  295.  
  296.     /* add the object-oriented programming symbols and os specific stuff */
  297.     obsymbols();    /* object-oriented programming symbols */
  298.     ossymbols();    /* os specific symbols */
  299. }
  300.  
  301.