home *** CD-ROM | disk | FTP | other *** search
/ CICA 1995 May / cica_0595_4.zip / cica_0595_4 / UTIL / MSWSRC35 / ERROR.CPP < prev    next >
C/C++ Source or Header  |  1993-07-19  |  11KB  |  378 lines
  1. /*
  2.  *      error.c         logo error module                       dvb
  3.  *
  4.  *    Copyright (C) 1989 The Regents of the University of California
  5.  *    This Software may be copied and distributed for educational,
  6.  *    research, and not for profit purposes provided that this
  7.  *    copyright and statement are included in all such copies.
  8.  *
  9.  */
  10.  
  11. #include "logo.h"
  12. #include "globals.h"
  13. #ifdef unix
  14. #include <sgtty.h>
  15. #endif
  16.  
  17. #ifndef TIOCSTI
  18. #include <setjmp.h>
  19. extern jmp_buf iblk_buf;
  20. #endif
  21.  
  22. NODE *throw_node = NIL;
  23. NODE *err_mesg = NIL;
  24. ERR_TYPES erract_errtype;
  25.  
  26. void err_print()
  27. {
  28.     int save_flag = stopping_flag;
  29.     
  30.     if (!err_mesg) return;
  31.  
  32.     stopping_flag = RUN;
  33.     print_backslashes = TRUE;
  34.  
  35.     print_help(stdout, cadr(err_mesg));
  36.     if (car(cddr(err_mesg)) != NIL) {
  37.     ndprintf(stdout, "  in %s\n%s",car(cddr(err_mesg)),
  38.          cadr(cddr(err_mesg)));
  39.     }
  40.     new_line(stdout);
  41.     deref(err_mesg);
  42.     err_mesg = NIL;
  43.  
  44.     print_backslashes = FALSE;
  45.     stopping_flag = save_flag;
  46. }
  47.  
  48. NODE *err_logo(ERR_TYPES error_type, NODE *error_desc)
  49. {
  50.     BOOLEAN recoverable = FALSE, warning = FALSE, uplevel = FALSE;
  51.     NODE *err_act, *val = UNBOUND;
  52.  
  53.     ref(error_desc);
  54.     switch(error_type) {
  55.     case FATAL:
  56.         prepare_to_exit(FALSE);
  57.         printfx("Logo: Fatal Internal Error.\n");
  58.         exit(1);
  59.     case OUT_OF_MEM:
  60.         prepare_to_exit(FALSE);
  61.         printfx("Logo: Out of Memory.\n");
  62.         exit(1);
  63.     case STACK_OVERFLOW:
  64.         err_mesg = reref(err_mesg, cons_list(0, make_static_strnode(
  65.         "stack overflow"), END_OF_LIST));
  66.         break;
  67.     case TURTLE_OUT_OF_BOUNDS:
  68.         err_mesg = reref(err_mesg, cons_list(0, make_static_strnode(
  69.         "turtle out of bounds"), END_OF_LIST));
  70.         break;
  71.     case BAD_GRAPH_INIT:
  72.         err_mesg = reref(err_mesg, cons_list(0, make_static_strnode(
  73.         "couldn't initialize graphics"), END_OF_LIST));
  74.         break;
  75.     case BAD_DATA_UNREC:
  76.         err_mesg = reref(err_mesg, cons_list(0, fun,
  77.         make_static_strnode("doesn\'t like"), error_desc,
  78.         make_static_strnode("as input"), END_OF_LIST));
  79.         break;
  80.     case DIDNT_OUTPUT:
  81.         if (didnt_output_name != NIL) {
  82.         last_call = reref(last_call, didnt_output_name);
  83.         }
  84.         if (error_desc == NIL) {
  85.         error_desc = vref(car(didnt_get_output));
  86.         ufun = reref(ufun, cadr(didnt_get_output));
  87.         this_line = reref(this_line,
  88.                   cadr(cdr(didnt_get_output)));
  89.         }
  90.         err_mesg = reref(err_mesg, cons_list(0, last_call,
  91.         make_static_strnode("didn\'t output to"),
  92.         error_desc, END_OF_LIST));
  93.         recoverable = TRUE;
  94.         break;
  95.     case NOT_ENOUGH:
  96.         err_mesg = reref(err_mesg, cons_list(0, make_static_strnode(
  97.         "not enough inputs to"), fun, END_OF_LIST));
  98.         break;
  99.     case BAD_DATA:
  100.         err_mesg = reref(err_mesg, cons_list(0, fun,
  101.         make_static_strnode("doesn\'t like"), error_desc,
  102.         make_static_strnode("as input"), END_OF_LIST));
  103.         recoverable = TRUE;
  104.             break;
  105.         case APPLY_BAD_DATA:
  106.             err_mesg = reref(err_mesg, cons_list(0, 
  107.                 make_static_strnode("APPLY doesn\'t like"),
  108.                 error_desc,
  109.                 make_static_strnode("as input"), END_OF_LIST));
  110.             recoverable = TRUE;
  111.         break;
  112.     case TOO_MUCH:
  113.         err_mesg = reref(err_mesg, cons_list(0, make_static_strnode(
  114.         "too much inside ()\'s"), END_OF_LIST));
  115.         break;
  116.     case DK_WHAT_UP:
  117.         uplevel = TRUE;
  118.     case DK_WHAT:
  119.         err_mesg = reref(err_mesg, cons_list(0, make_static_strnode(
  120.         "I don\'t know what to do with"), error_desc, END_OF_LIST));
  121.         break;
  122.     case PAREN_MISMATCH:
  123.         err_mesg = reref(err_mesg, cons_list(0, make_static_strnode(
  124.          "too many (\'s"), END_OF_LIST));
  125.         break;
  126.     case NO_VALUE:
  127.         err_mesg = reref(err_mesg, cons_list(0, error_desc,
  128.         make_static_strnode("has no value"), END_OF_LIST));
  129.         recoverable = TRUE;
  130.         break;
  131.     case UNEXPECTED_PAREN:
  132.         err_mesg = reref(err_mesg, cons_list(0, make_static_strnode(
  133.         "unexpected \')\'"), END_OF_LIST));
  134.         break;
  135.     case UNEXPECTED_BRACKET:
  136.         err_mesg = reref(err_mesg, cons_list(0, make_static_strnode(
  137.         "unexpected \']\'"), END_OF_LIST));
  138.         break;
  139.     case UNEXPECTED_BRACE:
  140.         err_mesg = reref(err_mesg, cons_list(0, make_static_strnode(
  141.         "unexpected \'}\'"), END_OF_LIST));
  142.         break;
  143.     case DK_HOW:
  144.         recoverable = TRUE;
  145.     case DK_HOW_UNREC:
  146.         err_mesg = reref(err_mesg, cons_list(0, make_static_strnode(
  147.         "I don\'t know how  to"), error_desc, END_OF_LIST));
  148.         break;
  149.     case NO_CATCH_TAG:
  150.         err_mesg = reref(err_mesg, cons_list(0, make_static_strnode(
  151.         "Can't find catch tag for"), error_desc, END_OF_LIST));
  152.         break;
  153.     case ALREADY_DEFINED:
  154.         err_mesg = reref(err_mesg, cons_list(0, error_desc,
  155.             make_static_strnode("is already defined"), END_OF_LIST));
  156.         break;
  157.     case STOP_ERROR:
  158.         err_mesg = reref(err_mesg, cons_list(0, make_static_strnode(
  159.         "Stopping..."), END_OF_LIST));
  160.         break;
  161.     case ALREADY_DRIBBLING:
  162.         err_mesg = reref(err_mesg, cons_list(0, make_static_strnode(
  163.         "Already dribbling"), END_OF_LIST));
  164.         break;
  165.     case FILE_ERROR:
  166.         err_mesg = reref(err_mesg, cons_list(0, make_static_strnode(
  167.         "File system error:"), error_desc, END_OF_LIST));
  168.         break;
  169.     case IF_WARNING:
  170.         err_mesg = reref(err_mesg, cons_list(0, make_static_strnode(
  171.         "Assuming you mean IFELSE, not IF"), END_OF_LIST));
  172.         warning = TRUE;
  173.         break;
  174.     case SHADOW_WARN:
  175.         err_mesg = reref(err_mesg, cons_list(0, error_desc,
  176.         make_static_strnode(
  177.             "shadowed by local in procedure call"), END_OF_LIST));
  178.         warning = TRUE;
  179.         break;
  180.     case USER_ERR:
  181.         if (error_desc == UNBOUND)
  182.         err_mesg = reref(err_mesg,cons_list(0, make_static_strnode(
  183.             "Throw \"Error"), END_OF_LIST));
  184.         else {
  185.         uplevel = TRUE;
  186.         if (is_list(error_desc))
  187.             err_mesg = reref(err_mesg,error_desc);
  188.         else
  189.             err_mesg = reref(err_mesg,
  190.               cons_list(0, error_desc, END_OF_LIST));
  191.         }
  192.         break;
  193.     case IS_PRIM:
  194.         err_mesg = reref(err_mesg, cons_list(0, error_desc,
  195.         make_static_strnode("is a primitive"),
  196.         END_OF_LIST));
  197.         break;
  198.     case NOT_INSIDE:
  199.         err_mesg = reref(err_mesg, cons_list(
  200.         0, make_static_strnode("Can't use TO inside a procedure"),
  201.         END_OF_LIST));
  202.         break;
  203.     case AT_TOPLEVEL:
  204.         err_mesg = reref(err_mesg, cons_list(
  205.         0, make_static_strnode("Can only use"),
  206.         error_desc, make_static_strnode("inside a procedure"),
  207.         END_OF_LIST));
  208.         break;
  209.     case NO_TEST:
  210.         err_mesg = reref(err_mesg, cons_list(0, fun,
  211.         make_static_strnode("without TEST"),
  212.         END_OF_LIST));
  213.         break;
  214.     case ERR_MACRO:
  215.         err_mesg = reref(err_mesg, cons_list(0,
  216.         make_static_strnode("Macro returned"), error_desc,
  217.         make_static_strnode("instead of a list"),
  218.         END_OF_LIST));
  219.         break;
  220.     default:
  221.         prepare_to_exit(FALSE);
  222.         printfx("Unknown error condition - internal error.\n");
  223.         exit(1);
  224.     }
  225.     deref(error_desc);
  226.     deref(didnt_output_name);
  227.     didnt_output_name = NIL;
  228.     if (uplevel && ufun != NIL) {
  229.     ufun = reref(ufun,last_ufun);
  230.     this_line = reref(this_line,last_line);
  231.     }
  232.     if (ufun != NIL)
  233. //    err_mesg = reref(err_mesg, cons(err_mesg, cons(ufun, this_line)));
  234. //    err_mesg = reref(err_mesg, cons_list(0, err_mesg, ufun,
  235. //                         this_line, END_OF_LIST));
  236.     err_mesg = reref(err_mesg, cons_list3(err_mesg, ufun, this_line));
  237.     else
  238.     err_mesg = reref(err_mesg, cons_list(0, err_mesg, NIL, NIL,
  239.                          END_OF_LIST));
  240.     err_mesg = reref(err_mesg, cons(make_intnode((FIXNUM)error_type),
  241.                     err_mesg));
  242.     if (warning) {
  243.     err_print();
  244.     return(UNBOUND);
  245.     }
  246.     err_act = vref(valnode__caseobj(Erract));
  247.     if (err_act != NIL && err_act != UNDEFINED) {
  248.     if (error_type != erract_errtype) {
  249.         int sv_val_status = val_status;
  250.  
  251.         erract_errtype = error_type;
  252.         setvalnode__caseobj(Erract, NIL);
  253.         val_status = 5;
  254.         val = err_eval_driver(err_act);
  255.         ref(val);
  256.         val_status = sv_val_status;
  257.         setvalnode__caseobj(Erract, err_act);
  258.         deref(err_act);
  259.         if (recoverable == TRUE && val != UNBOUND) {
  260.         return(unref(val));
  261.         } else if (recoverable == FALSE && val != UNBOUND) {
  262.         ndprintf(stdout,"I don't know what to do with %s\n", val);
  263.         val = reref(val, UNBOUND);
  264.         throw_node = reref(throw_node, Toplevel);
  265.         } else {
  266.         return(UNBOUND);
  267.         }
  268.     } else {
  269.         ndprintf(stdout,"Erract loop\n");
  270.         throw_node = reref(throw_node, Toplevel);
  271.     }
  272.     } else {    /* no erract */
  273.     throw_node = reref(throw_node, Error);
  274.     }
  275.     stopping_flag = THROWING;
  276.     output_node = UNBOUND;
  277.     return(unref(val));
  278. }
  279.  
  280. NODE *lerror()
  281. {
  282.     NODE *val;
  283.  
  284.     val = err_mesg;
  285.     err_mesg = NIL;
  286.     return(unref(val));
  287. }
  288.  
  289. #ifndef TIOCSTI
  290. void bcopy(char *from, char *to, int len)
  291. {
  292.     while (--len >= 0)
  293.     *to++ = *from++;
  294. }
  295. #endif
  296.  
  297. NODE *lpause()
  298. {
  299.     NODE *elist = NIL, *val = UNBOUND, *uname = NIL;
  300.     int sav_input_blocking;
  301.     int sv_val_status;
  302. #ifndef TIOCSTI
  303.     jmp_buf sav_iblk;
  304. #endif
  305.  
  306.     if (err_mesg != NIL) err_print();
  307.     /* if (ufun != NIL) */ {
  308.       uname = reref(uname, ufun);
  309.       ufun = NIL;
  310.       }
  311.     ndprintf(stdout, "Pausing...");
  312. #ifndef TIOCSTI
  313.     bcopy((char *)(&iblk_buf),(char *)(&sav_iblk),sizeof(jmp_buf));
  314. #endif
  315.     sav_input_blocking = input_blocking;
  316.     input_blocking = 0;
  317.     sv_val_status = val_status;
  318.     while (RUNNING) {
  319.         if (uname != NIL) print_node(stdout, uname);
  320.             new_line(stdout);
  321.             input_mode = PAUSE_MODE;
  322.         elist = reref(elist, parser(reader(stdin, "? "), TRUE));
  323.             input_mode = NO_MODE;
  324.         MyMessageScan();
  325.         if (feof(stdin) /*ggm && !isatty(0)*/) lbye();
  326.         val_status = 5;
  327.         if (elist != NIL) eval_driver(elist);
  328.         if (stopping_flag == THROWING) {
  329.         if (compare_node(throw_node, Pause, TRUE) == 0) {
  330.             val = vref(output_node);
  331.             output_node = reref(output_node, UNBOUND);
  332.             stopping_flag = RUN;
  333.             deref(elist);
  334. #ifndef TIOCSTI
  335.             bcopy((char *)(&sav_iblk),
  336.               (char *)(&iblk_buf),sizeof(jmp_buf));
  337. #endif
  338.             input_blocking = sav_input_blocking;
  339.             val_status = sv_val_status;
  340.                     if (uname != NIL) 
  341.                       {
  342.                       ufun = reref(ufun, uname);
  343.                       deref(uname);
  344.                       }
  345.             return(unref(val));
  346.         } else if (compare_node(throw_node, Error, TRUE) == 0) {
  347.             err_print();
  348.             stopping_flag = RUN;
  349.         }
  350.         }
  351.     }
  352.     deref(elist);
  353. #ifndef TIOCSTI
  354.     bcopy((char *)(&sav_iblk),(char *)(&iblk_buf),sizeof(jmp_buf));
  355. #endif
  356.     input_blocking = sav_input_blocking;
  357.     unblock_input();
  358.     val_status = sv_val_status;
  359.     if (uname != NIL) 
  360.            {
  361.            ufun = reref(ufun, uname);
  362.            deref(uname);
  363.            }
  364.  
  365.     return(unref(val));
  366. }
  367.  
  368. NODE *lcontinue(NODE *args)
  369. {
  370.     stopping_flag = THROWING;
  371.     throw_node = reref(throw_node, Pause);
  372.     if (args != NIL)
  373.     output_node = reref(output_node, car(args));
  374.     else
  375.     output_node = reref(output_node, UNBOUND);
  376.     return(UNBOUND);
  377. }
  378.