home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / zip / language / xlisp_21.zoo / xldbug.c < prev    next >
C/C++ Source or Header  |  1990-02-28  |  4KB  |  203 lines
  1. /* xldebug - xlisp debugging support */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. /* external variables */
  9. extern int xldebug;
  10. extern int xlsample;
  11. extern LVAL s_debugio,s_unbound;
  12. extern LVAL s_tracenable,s_tlimit,s_breakenable;
  13. extern LVAL true;
  14. extern char buf[];
  15.  
  16. /* external routines */
  17. extern char *malloc();
  18.  
  19. /* forward declarations */
  20. FORWARD LVAL stacktop();
  21.  
  22. /* xlabort - xlisp serious error handler */
  23. xlabort(emsg)
  24.   char *emsg;
  25. {
  26.     xlsignal(emsg,s_unbound);
  27.     xlerrprint("error",NULL,emsg,s_unbound);
  28.     xlbrklevel();
  29. }
  30.  
  31. /* xlbreak - enter a break loop */
  32. xlbreak(emsg,arg)
  33.   char *emsg; LVAL arg;
  34. {
  35.     breakloop("break","return from BREAK",emsg,arg,TRUE);
  36. }
  37.  
  38. /* xlfail - xlisp error handler */
  39. xlfail(emsg)
  40.   char *emsg;
  41. {
  42.     xlerror(emsg,s_unbound);
  43. }
  44.  
  45. /* xlerror - handle a fatal error */
  46. xlerror(emsg,arg)
  47.   char *emsg; LVAL arg;
  48. {
  49.     if (getvalue(s_breakenable) != NIL)
  50.     breakloop("error",NULL,emsg,arg,FALSE);
  51.     else {
  52.     xlsignal(emsg,arg);
  53.     xlerrprint("error",NULL,emsg,arg);
  54.     xlbrklevel();
  55.     }
  56. }
  57.  
  58. /* xlcerror - handle a recoverable error */
  59. xlcerror(cmsg,emsg,arg)
  60.   char *cmsg,*emsg; LVAL arg;
  61. {
  62.     if (getvalue(s_breakenable) != NIL)
  63.     breakloop("error",cmsg,emsg,arg,TRUE);
  64.     else {
  65.     xlsignal(emsg,arg);
  66.     xlerrprint("error",NULL,emsg,arg);
  67.     xlbrklevel();
  68.     }
  69. }
  70.  
  71. /* xlerrprint - print an error message */
  72. xlerrprint(hdr,cmsg,emsg,arg)
  73.   char *hdr,*cmsg,*emsg; LVAL arg;
  74. {
  75.     /* print the error message */
  76.     sprintf(buf,"%s: %s",hdr,emsg);
  77.     errputstr(buf);
  78.  
  79.     /* print the argument */
  80.     if (arg != s_unbound) {
  81.     errputstr(" - ");
  82.     errprint(arg);
  83.     }
  84.  
  85.     /* no argument, just end the line */
  86.     else
  87.     errputstr("\n");
  88.  
  89.     /* print the continuation message */
  90.     if (cmsg) {
  91.     sprintf(buf,"if continued: %s\n",cmsg);
  92.     errputstr(buf);
  93.     }
  94. }
  95.  
  96. /* breakloop - the debug read-eval-print loop */
  97. LOCAL int breakloop(hdr,cmsg,emsg,arg,cflag)
  98.   char *hdr,*cmsg,*emsg; LVAL arg; int cflag;
  99. {
  100.     LVAL expr,val;
  101.     CONTEXT cntxt;
  102.     int type;
  103.  
  104.     /* print the error message */
  105.     xlerrprint(hdr,cmsg,emsg,arg);
  106.  
  107.     /* flush the input buffer */
  108.     xlflush();
  109.  
  110.     /* do the back trace */
  111.     if (getvalue(s_tracenable)) {
  112.     val = getvalue(s_tlimit);
  113.     xlbaktrace(fixp(val) ? (int)getfixnum(val) : -1);
  114.     }
  115.  
  116.     /* protect some pointers */
  117.     xlsave1(expr);
  118.  
  119.     /* increment the debug level */
  120.     ++xldebug;
  121.  
  122.     /* debug command processing loop */
  123.     xlbegin(&cntxt,CF_BRKLEVEL|CF_CLEANUP|CF_CONTINUE,true);
  124.     for (type = 0; type == 0; ) {
  125.  
  126.     /* setup the continue trap */
  127.     if (type = setjmp(cntxt.c_jmpbuf))
  128.         switch (type) {
  129.         case CF_CLEANUP:
  130.         continue;
  131.         case CF_BRKLEVEL:
  132.         type = 0;
  133.         break;
  134.         case CF_CONTINUE:
  135.         if (cflag) {
  136.             dbgputstr("[ continue from break loop ]\n");
  137.             continue;
  138.         }
  139.         else xlabort("this error can't be continued");
  140.         }
  141.  
  142.     /* print a prompt */
  143.     sprintf(buf,"%d> ",xldebug);
  144.     dbgputstr(buf);
  145.  
  146.     /* read an expression and check for eof */
  147.     if (!xlread(getvalue(s_debugio),&expr,FALSE)) {
  148.         type = CF_CLEANUP;
  149.         break;
  150.     }
  151.  
  152.     /* save the input expression */
  153.     xlrdsave(expr);
  154.  
  155.     /* evaluate the expression */
  156.     expr = xleval(expr);
  157.  
  158.     /* save the result */
  159.     xlevsave(expr);
  160.  
  161.     /* print it */
  162.     dbgprint(expr);
  163.     }
  164.     xlend(&cntxt);
  165.  
  166.     /* decrement the debug level */
  167.     --xldebug;
  168.  
  169.     /* restore the stack */
  170.     xlpop();
  171.  
  172.     /* check for aborting to the previous level */
  173.     if (type == CF_CLEANUP)
  174.     xlbrklevel();
  175. }
  176.  
  177. /* baktrace - do a back trace */
  178. xlbaktrace(n)
  179.   int n;
  180. {
  181.     LVAL *fp,*p;
  182.     int argc;
  183.     for (fp = xlfp; (n < 0 || n--) && *fp; fp = fp - (int)getfixnum(*fp)) {
  184.     p = fp + 1;
  185.     errputstr("Function: ");
  186.     errprint(*p++);
  187.     if (argc = (int)getfixnum(*p++))
  188.         errputstr("Arguments:\n");
  189.     while (--argc >= 0) {
  190.         errputstr("  ");
  191.         errprint(*p++);
  192.     }
  193.     }
  194. }
  195.  
  196. /* xldinit - debug initialization routine */
  197. xldinit()
  198. {
  199.     xlsample = 0;
  200.     xldebug = 0;
  201. }
  202.  
  203.