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