home *** CD-ROM | disk | FTP | other *** search
/ Fish 'n' More 2 / fishmore-publicdomainlibraryvol.ii1991xetec.iso / fish / applications / xlispstat / xlisp / xlisp.c < prev    next >
Encoding:
C/C++ Source or Header  |  1990-10-05  |  4.2 KB  |  183 lines
  1. /* xlisp.c - a small implementation of lisp with object-oriented programming */
  2. /* Copyright (c) 1989, by David Michael Betz.                            */
  3. /* You may give out copies of this software; for conditions see the file */
  4. /* COPYING included with this distribution.                              */
  5.  
  6. #include <stdlib.h>
  7. #include "xlisp.h"
  8. #include "osdef.h"
  9. #ifdef ANSI
  10. #include "xlproto.h"
  11. #include "osproto.h"
  12. void main(int,unsigned char *[]);
  13. #else
  14. #include "xlfun.h"
  15. #include "osfun.h"
  16. #endif ANSI
  17. #ifdef AMIGA
  18. #include "autil1.h"
  19. extern char deftool[];
  20. #endif AMIGA
  21. #include "xlvar.h"
  22.  
  23. /* define the banner line string */
  24. #define BANNER    "XLISP version 2.1, Copyright (c) 1989, by David Betz"
  25.  
  26. /* global variables */
  27. jmp_buf top_level;
  28. char *progname;  /* used for reading the symbol table - L. Tierney */
  29.  
  30. /* main - the main routine */
  31. void main(argc,argv)
  32.   int argc; unsigned char *argv[];
  33. {
  34.     char *transcript;
  35.     CONTEXT cntxt;
  36.     int verbose,i;
  37.     LVAL expr;
  38. #ifdef AMIGA
  39.     char project[30],defdir[50];
  40. #endif AMIGA
  41.  
  42.     /* setup default argument values */
  43.     transcript = NULL;
  44.     verbose = FALSE;
  45.  
  46.     /* parse the argument list switches */
  47. #ifndef MACINTOSH
  48. #ifdef AMIGA
  49.     FindStart(&argc,argv,deftool,project,defdir);
  50. #endif AMIGA
  51.     progname = argv[0];  /* L. Tierney */
  52.     for (i = 1; i < argc; ++i)
  53.     if (argv[i][0] == '-')
  54.         switch(argv[i][1]) {
  55.          case 't':
  56.         case 'T':
  57.         transcript = &argv[i][2];
  58.         break;
  59.         case 'v':
  60.         case 'V':
  61.          verbose = TRUE;
  62.         break;
  63.         }
  64. #endif /* MACINTOSH */
  65.  
  66.     /* initialize and print the banner line */
  67.     osinit(BANNER);
  68.  
  69.     /* setup initialization error handler */
  70.     xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,(LVAL)1);
  71.     if (setjmp(cntxt.c_jmpbuf))
  72.     xlfatal("fatal initialization error");
  73.     if (setjmp(top_level))
  74.     xlfatal("RESTORE not allowed during initialization");
  75.  
  76.     /* initialize xlisp */
  77.     xlinit();
  78.     xlend(&cntxt);
  79.  
  80.     /* reset the error handler */
  81.     xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,true);
  82.  
  83.     /* open the transcript file */
  84.     if (transcript && (tfp = osaopen(transcript,"w")) == NULL) {
  85.     sprintf(buf,"error: can't open transcript file: %s",transcript);
  86.     stdputstr(buf);
  87.     }
  88.  
  89.     /* load "init.lsp" */
  90.     if (setjmp(cntxt.c_jmpbuf) == 0)
  91.     xlload("init.lsp",TRUE,FALSE);
  92.  
  93.     /* load any files mentioned on the command line */
  94.     if (setjmp(cntxt.c_jmpbuf) == 0)
  95.     for (i = 1; i < argc; i++)
  96.         if (argv[i][0] != '-' && !xlload(argv[i],TRUE,verbose))
  97.         xlerror("can't load file",cvstring(argv[i]));
  98.  
  99.     /* target for restore */
  100.     if (setjmp(top_level))
  101.     xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,true);
  102.  
  103.     /* protect some pointers */
  104.     xlsave1(expr);
  105.  
  106.     /* main command processing loop */
  107.     for (;;) {
  108.  
  109.     /* setup the error return */
  110.     if (setjmp(cntxt.c_jmpbuf)) {
  111.         setvalue(s_evalhook,NIL);
  112.         setvalue(s_applyhook,NIL);
  113.         xltrcindent = 0;
  114.         xldebug = 0;
  115.         osreset();   /* L. Tierney */
  116.         xlflush();
  117.     }
  118.  
  119.     /* print a prompt */
  120.     stdputstr("> ");
  121.  
  122.     /* read an expression */
  123.     if (!xlread(getvalue(s_stdin),&expr,FALSE))
  124.         break;
  125.  
  126.     /* process carriage return (to clean up dribble) - L. Tierney */
  127.     if (xlpeek(getvalue(s_stdin)) == '\n')
  128.       xlgetc(getvalue(s_stdin));
  129.   
  130.     /* save the input expression */
  131.     xlrdsave(expr);
  132.  
  133.     /* evaluate the expression */
  134.     expr = xleval(expr);
  135.  
  136.     /* save the result */
  137.     xlevsave(expr);
  138.  
  139.     /* print it */
  140.     stdprint(expr);
  141.     }
  142.     xlend(&cntxt);
  143.  
  144.     /* clean up */
  145.     wrapup();
  146. }
  147.  
  148. /* xlrdsave - save the last expression returned by the reader */
  149. void xlrdsave(expr)
  150.   LVAL expr;
  151. {
  152.     setvalue(s_3plus,getvalue(s_2plus));
  153.     setvalue(s_2plus,getvalue(s_1plus));
  154.     setvalue(s_1plus,getvalue(s_minus));
  155.     setvalue(s_minus,expr);
  156. }
  157.  
  158. /* xlevsave - save the last expression returned by the evaluator */
  159. void xlevsave(expr)
  160.   LVAL expr;
  161. {
  162.     setvalue(s_3star,getvalue(s_2star));
  163.     setvalue(s_2star,getvalue(s_1star));
  164.     setvalue(s_1star,expr);
  165. }
  166.  
  167. /* xlfatal - print a fatal error message and exit */
  168. void xlfatal(msg)
  169.   char *msg;
  170. {
  171.     oserror(msg);
  172.     wrapup();
  173. }
  174.  
  175. /* wrapup - clean up and exit to the operating system */
  176. void wrapup()
  177. {
  178.     if (tfp)
  179.     osclose(tfp);
  180.     osfinish();
  181.     exit(0);
  182. }
  183.