home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / lisp / interpre / xlispplu / xlisp2tc / xlisp.c < prev    next >
C/C++ Source or Header  |  1988-03-25  |  4KB  |  173 lines
  1. /* xlisp.c - a small implementation of lisp with object-oriented programming */
  2. /*    Copyright (c) 1987, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. /* define the banner line string */
  9. #define BANNER    "XLISP version 2.0, Copyright (c) 1988, by David Betz"
  10.  
  11. /* global variables */
  12. jmp_buf top_level;
  13.  
  14. /* external variables */
  15. extern LVAL s_stdin,s_evalhook,s_applyhook;
  16. extern LVAL s_1plus,s_2plus,s_3plus,s_1star,s_2star,s_3star,s_minus;
  17. extern int xltrcindent;
  18. extern int xldebug;
  19. extern LVAL true;
  20. extern char buf[];
  21. extern FILE *tfp;
  22.  
  23. /* external routines */
  24. #ifndef osaopen
  25. extern FILE *osaopen();
  26. #endif osaopen
  27.  
  28. /* main - the main routine */
  29. #ifdef _TURBOC_
  30. cdecl
  31. #endif _TURBOC_
  32. main(argc,argv)
  33.   int argc; char *argv[];
  34. {
  35.     char *transcript;
  36.     CONTEXT cntxt;
  37.     int verbose,i;
  38.     LVAL expr;
  39.  
  40.     /* setup default argument values */
  41.     transcript = NULL;
  42.     verbose = FALSE;
  43.  
  44.     /* parse the argument list switches */
  45. #ifndef LSC
  46.     for (i = 1; i < argc; ++i)
  47.     if (argv[i][0] == '-')
  48.         switch(argv[i][1]) {
  49.         case 't':
  50.         case 'T':
  51.         transcript = &argv[i][2];
  52.         break;
  53.         case 'v':
  54.         case 'V':
  55.         verbose = TRUE;
  56.         break;
  57.         }
  58. #endif
  59.  
  60.     /* initialize and print the banner line */
  61.     osinit(BANNER);
  62.  
  63.     /* setup initialization error handler */
  64.     xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,(LVAL)1);
  65.     if (setjmp(cntxt.c_jmpbuf))
  66.     xlfatal("fatal initialization error");
  67.     if (setjmp(top_level))
  68.     xlfatal("RESTORE not allowed during initialization");
  69.  
  70.     /* initialize xlisp */
  71.     xlinit();
  72.     xlend(&cntxt);
  73.  
  74.     /* reset the error handler */
  75.     xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,true);
  76.  
  77.     /* open the transcript file */
  78.     if (transcript && (tfp = osaopen(transcript,"w")) == NULL) {
  79.     sprintf(buf,"error: can't open transcript file: %s",transcript);
  80.     stdputstr(buf);
  81.     }
  82.  
  83.     /* load "init.lsp" */
  84.     if (setjmp(cntxt.c_jmpbuf) == 0)
  85.     xlload("init.lsp",TRUE,FALSE);
  86.  
  87.     /* load any files mentioned on the command line */
  88.     if (setjmp(cntxt.c_jmpbuf) == 0)
  89.     for (i = 1; i < argc; i++)
  90.         if (argv[i][0] != '-' && !xlload(argv[i],TRUE,verbose))
  91.         xlerror("can't load file",cvstring(argv[i]));
  92.  
  93.     /* target for restore */
  94.     if (setjmp(top_level))
  95.     xlbegin(&cntxt,CF_TOPLEVEL|CF_CLEANUP|CF_BRKLEVEL,true);
  96.  
  97.     /* protect some pointers */
  98.     xlsave1(expr);
  99.  
  100.     /* main command processing loop */
  101.     for (;;) {
  102.  
  103.     /* setup the error return */
  104.     if (setjmp(cntxt.c_jmpbuf)) {
  105.         setvalue(s_evalhook,NIL);
  106.         setvalue(s_applyhook,NIL);
  107.         xltrcindent = 0;
  108.         xldebug = 0;
  109.         xlflush();
  110.     }
  111.  
  112.     /* print a prompt */
  113.     stdputstr("> ");
  114.  
  115.     /* read an expression */
  116.     if (!xlread(getvalue(s_stdin),&expr,FALSE))
  117.         break;
  118.  
  119.     /* save the input expression */
  120.     xlrdsave(expr);
  121.  
  122.     /* evaluate the expression */
  123.     expr = xleval(expr);
  124.  
  125.     /* save the result */
  126.     xlevsave(expr);
  127.  
  128.     /* print it */
  129.     stdprint(expr);
  130.     }
  131.     xlend(&cntxt);
  132.  
  133.     /* clean up */
  134.     wrapup();
  135. }
  136.  
  137. /* xlrdsave - save the last expression returned by the reader */
  138. void xlrdsave(expr)
  139.   LVAL expr;
  140. {
  141.     setvalue(s_3plus,getvalue(s_2plus));
  142.     setvalue(s_2plus,getvalue(s_1plus));
  143.     setvalue(s_1plus,getvalue(s_minus));
  144.     setvalue(s_minus,expr);
  145. }
  146.  
  147. /* xlevsave - save the last expression returned by the evaluator */
  148. void xlevsave(expr)
  149.   LVAL expr;
  150. {
  151.     setvalue(s_3star,getvalue(s_2star));
  152.     setvalue(s_2star,getvalue(s_1star));
  153.     setvalue(s_1star,expr);
  154. }
  155.  
  156. /* xlfatal - print a fatal error message and exit */
  157. void xlfatal(msg)
  158.   char *msg;
  159. {
  160.     oserror(msg);
  161.     wrapup();
  162. }
  163.  
  164. /* wrapup - clean up and exit to the operating system */
  165. void wrapup()
  166. {
  167.     if (tfp)
  168.     osclose(tfp);
  169.     osfinish();
  170.     exit(0);
  171. }
  172.  
  173.