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