home *** CD-ROM | disk | FTP | other *** search
/ Carousel Volume 2 #1 / carousel.iso / mactosh / lang / xlisp.sha / xldbug.c < prev    next >
Encoding:
C/C++ Source or Header  |  1985-02-17  |  3.8 KB  |  189 lines
  1. /* xldebug - xlisp debugging support */
  2.  
  3. #include "xlisp.h"
  4.  
  5. /* external variables */
  6. extern long total;
  7. extern int xldebug;
  8. extern int xltrace;
  9. extern NODE *s_unbound;
  10. extern NODE *s_stdin,*s_stdout;
  11. extern NODE *s_tracenable,*s_tlimit,*s_breakenable;
  12. extern NODE *s_continue,*s_quit;
  13. extern NODE *xlstack;
  14. extern NODE *true;
  15. extern NODE **trace_stack;
  16.  
  17. /* external routines */
  18. extern char *malloc();
  19.  
  20. /* forward declarations */
  21. FORWARD NODE *stacktop();
  22.  
  23. /* xlfail - xlisp error handler */
  24. xlfail(emsg)
  25.   char *emsg;
  26. {
  27.     xlerror(emsg,stacktop());
  28. }
  29.  
  30. /* xlabort - xlisp serious error handler */
  31. xlabort(emsg)
  32.   char *emsg;
  33. {
  34.     xlsignal(emsg,s_unbound);
  35. }
  36.  
  37. /* xlbreak - enter a break loop */
  38. xlbreak(emsg,arg)
  39.   char *emsg; NODE *arg;
  40. {
  41.     breakloop("break",NULL,emsg,arg,TRUE);
  42. }
  43.  
  44. /* xlerror - handle a fatal error */
  45. xlerror(emsg,arg)
  46.   char *emsg; NODE *arg;
  47. {
  48.     doerror(NULL,emsg,arg,FALSE);
  49. }
  50.  
  51. /* xlcerror - handle a recoverable error */
  52. xlcerror(cmsg,emsg,arg)
  53.   char *cmsg,*emsg; NODE *arg;
  54. {
  55.     doerror(cmsg,emsg,arg,TRUE);
  56. }
  57.  
  58. /* xlerrprint - print an error message */
  59. xlerrprint(hdr,cmsg,emsg,arg)
  60.   char *hdr,*cmsg,*emsg; NODE *arg;
  61. {
  62.     printf("%s: %s",hdr,emsg);
  63.     if (arg != s_unbound) { printf(" - "); stdprint(arg); }
  64.     else printf("\n");
  65.     if (cmsg) printf("if continued: %s\n",cmsg);
  66. }
  67.  
  68. /* doerror - handle xlisp errors */
  69. LOCAL doerror(cmsg,emsg,arg,cflag)
  70.   char *cmsg,*emsg; NODE *arg; int cflag;
  71. {
  72.     /* make sure the break loop is enabled */
  73.     if (s_breakenable->n_symvalue == NIL)
  74.     xlsignal(emsg,arg);
  75.  
  76.     /* call the debug read-eval-print loop */
  77.     breakloop("error",cmsg,emsg,arg,cflag);
  78. }
  79.  
  80. /* breakloop - the debug read-eval-print loop */
  81. LOCAL int breakloop(hdr,cmsg,emsg,arg,cflag)
  82.   char *hdr,*cmsg,*emsg; NODE *arg; int cflag;
  83. {
  84.     NODE *oldstk,expr,*val;
  85.     CONTEXT cntxt;
  86.  
  87.     /* increment the debug level */
  88.     xldebug++;
  89.  
  90.     /* flush the input buffer */
  91.     xlflush();
  92.  
  93.     /* print the error message */
  94.     xlerrprint(hdr,cmsg,emsg,arg);
  95.  
  96.     /* do the back trace */
  97.     if (s_tracenable->n_symvalue) {
  98.     val = s_tlimit->n_symvalue;
  99.     xlbaktrace(fixp(val) ? val->n_int : -1);
  100.     }
  101.  
  102.     /* create a new stack frame */
  103.     oldstk = xlsave(&expr,NULL);
  104.  
  105.     /* debug command processing loop */
  106.     xlbegin(&cntxt,CF_ERROR,true);
  107.     while (TRUE) {
  108.  
  109.     /* setup the continue trap */
  110.     if (setjmp(cntxt.c_jmpbuf)) {
  111.         xlflush();
  112.         continue;
  113.     }
  114.  
  115.     /* read an expression and check for eof */
  116.     if (!xlread(s_stdin->n_symvalue,&expr.n_ptr)) {
  117.         expr.n_ptr = s_quit;
  118.         break;
  119.     }
  120.  
  121.     /* check for commands */
  122.     if (expr.n_ptr == s_continue) {
  123.         if (cflag) break;
  124.         else xlabort("this error can't be continued");
  125.     }
  126.     else if (expr.n_ptr == s_quit)
  127.         break;
  128.  
  129.     /* evaluate the expression */
  130.     expr.n_ptr = xleval(expr.n_ptr);
  131.  
  132.     /* print it */
  133.     xlprint(s_stdout->n_symvalue,expr.n_ptr,TRUE);
  134.     xlterpri(s_stdout->n_symvalue);
  135.     }
  136.     xlend(&cntxt);
  137.  
  138.     /* restore the previous stack frame */
  139.     xlstack = oldstk;
  140.  
  141.     /* decrement the debug level */
  142.     xldebug--;
  143.  
  144.     /* continue the next higher break loop on quit */
  145.     if (expr.n_ptr == s_quit)
  146.     xlsignal("quit from break loop",s_unbound);
  147. }
  148.  
  149. /* tpush - add an entry to the trace stack */
  150. xltpush(nptr)
  151.     NODE *nptr;
  152. {
  153.     if (++xltrace < TDEPTH)
  154.     trace_stack[xltrace] = nptr;
  155. }
  156.  
  157. /* tpop - pop an entry from the trace stack */
  158. xltpop()
  159. {
  160.     xltrace--;
  161. }
  162.  
  163. /* stacktop - return the top node on the stack */
  164. LOCAL NODE *stacktop()
  165. {
  166.     return (xltrace >= 0 && xltrace < TDEPTH ? trace_stack[xltrace] : s_unbound);
  167. }
  168.  
  169. /* baktrace - do a back trace */
  170. xlbaktrace(n)
  171.   int n;
  172. {
  173.     int i;
  174.  
  175.     for (i = xltrace; (n < 0 || n--) && i >= 0; i--)
  176.     if (i < TDEPTH)
  177.         stdprint(trace_stack[i]);
  178. }
  179.  
  180. /* xldinit - debug initialization routine */
  181. xldinit()
  182. {
  183.     if ((trace_stack = (NODE **) malloc(TSTKSIZE)) == NULL)
  184.     xlabort("insufficient memory");
  185.     total += (long) TSTKSIZE;
  186.     xltrace = -1;
  187.     xldebug = 0;
  188. }
  189.