home *** CD-ROM | disk | FTP | other *** search
/ Amiga ACS 1998 #4 / amigaacscoverdisc1998-041998.iso / utilities / shareware / dev / ucb_logoppc / source / error.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-06-25  |  11.5 KB  |  414 lines
  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.  
  25. #ifdef HAVE_TERMIO_H
  26. #include <termio.h>
  27. #else
  28. #ifdef HAVE_SGTTY_H
  29. #include <sgtty.h>
  30. #endif
  31. #endif
  32.  
  33. #ifdef HAVE_UNISTD_H
  34. #include <unistd.h>
  35. #endif
  36.  
  37. #ifdef HAVE_STRING_H
  38. #include <string.h>
  39. #endif
  40.  
  41. #ifdef mac
  42. #include <console.h>
  43. #endif
  44.  
  45. NODE *throw_node = NIL;
  46. NODE *err_mesg = NIL;
  47. ERR_TYPES erract_errtype;
  48.  
  49. void err_print(void) {
  50.     int save_flag = stopping_flag;
  51.  
  52.     if (!err_mesg) return;
  53.  
  54.     stopping_flag = RUN;
  55.     print_backslashes = TRUE;
  56.  
  57.     real_print_help(stdout, cadr(err_mesg), 5, 80);
  58.     if (car(cddr(err_mesg)) != NIL) {
  59.    ndprintf(stdout, "  in %s\n%s",car(cddr(err_mesg)),
  60.        cadr(cddr(err_mesg)));
  61.     }
  62.     err_mesg = NIL;
  63.     new_line(stdout);
  64.  
  65.     print_backslashes = FALSE;
  66.     stopping_flag = save_flag;
  67. }
  68.  
  69. NODE *err_logo(ERR_TYPES error_type, NODE *error_desc) {
  70.     BOOLEAN recoverable = FALSE, warning = FALSE, uplevel = FALSE;
  71.     NODE *err_act, *val = UNBOUND;
  72.  
  73.     switch(error_type) {
  74.    case FATAL:
  75.        prepare_to_exit(FALSE);
  76.        ndprintf(stdout,"Logo: Fatal Internal Error.\n");
  77.        exit(1);
  78.    case OUT_OF_MEM_UNREC:
  79.        prepare_to_exit(FALSE);
  80.        ndprintf(stdout,"Logo: Out of Memory.\n");
  81.        exit(1);
  82.    case OUT_OF_MEM:
  83.        use_reserve_tank();
  84.        err_mesg = cons_list(0, make_static_strnode("out of space"),
  85.              END_OF_LIST);
  86.        break;
  87.    case STACK_OVERFLOW:
  88.        err_mesg = cons_list(0, make_static_strnode("stack overflow"),
  89.              END_OF_LIST);
  90.        break;
  91.    case TURTLE_OUT_OF_BOUNDS:
  92.        err_mesg = cons_list(0,make_static_strnode("turtle out of bounds"),
  93.              END_OF_LIST);
  94.        break;
  95.    case BAD_GRAPH_INIT:
  96.        err_mesg = cons_list(0,
  97.            make_static_strnode("couldn't initialize graphics"),
  98.            END_OF_LIST);
  99.        break;
  100.    case BAD_DATA_UNREC:
  101.        err_mesg = cons_list(0, fun,
  102.       make_static_strnode("doesn\'t like"), error_desc,
  103.       make_static_strnode("as input"), END_OF_LIST);
  104.        break;
  105.    case DIDNT_OUTPUT:
  106.        if (didnt_output_name != NIL) {
  107.       last_call = didnt_output_name;
  108.        }
  109.        if (error_desc == NIL) {
  110.       error_desc = car(didnt_get_output);
  111.       ufun = cadr(didnt_get_output);
  112.       this_line = cadr(cdr(didnt_get_output));
  113.        }
  114.        err_mesg = cons_list(0, last_call,
  115.              make_static_strnode("didn\'t output to"),
  116.              error_desc, END_OF_LIST);
  117.        recoverable = TRUE;
  118.        break;
  119.    case NOT_ENOUGH:
  120.        if (error_desc == NIL)
  121.       err_mesg = cons_list(0,make_static_strnode("not enough inputs to"),
  122.              fun, END_OF_LIST);
  123.        else
  124.       err_mesg = cons_list(0,make_static_strnode("not enough inputs to"),
  125.              error_desc, END_OF_LIST);
  126.        break;
  127.    case BAD_DATA:
  128.        err_mesg = cons_list(0, fun,
  129.       make_static_strnode("doesn\'t like"), error_desc,
  130.       make_static_strnode("as input"), END_OF_LIST);
  131.        recoverable = TRUE;
  132.        break;
  133.    case APPLY_BAD_DATA:
  134.        err_mesg = cons_list(0, make_static_strnode("APPLY doesn\'t like"),
  135.              error_desc,
  136.              make_static_strnode("as input"), END_OF_LIST);
  137.        recoverable = TRUE;
  138.        break;
  139.    case TOO_MUCH:
  140.        err_mesg = cons_list(0,
  141.              make_static_strnode("too much inside ()\'s"),
  142.              END_OF_LIST);
  143.        break;
  144.    case DK_WHAT_UP:
  145.        uplevel = TRUE;
  146.    case DK_WHAT:
  147.        err_mesg = cons_list(0,
  148.       make_static_strnode("You don\'t say what to do with"),
  149.       error_desc, END_OF_LIST);
  150.        break;
  151.    case PAREN_MISMATCH:
  152.        err_mesg = cons_list(0, make_static_strnode("too many (\'s"),
  153.              END_OF_LIST);
  154.        break;
  155.    case NO_VALUE:
  156.        err_mesg = cons_list(0, error_desc,
  157.              make_static_strnode("has no value"),
  158.              END_OF_LIST);
  159.        recoverable = TRUE;
  160.        break;
  161.    case UNEXPECTED_PAREN:
  162.        err_mesg = cons_list(0, make_static_strnode("unexpected \')\'"),
  163.              END_OF_LIST);
  164.        break;
  165.    case UNEXPECTED_BRACKET:
  166.        err_mesg = cons_list(0, make_static_strnode("unexpected \']\'"),
  167.              END_OF_LIST);
  168.        break;
  169.    case UNEXPECTED_BRACE:
  170.        err_mesg = cons_list(0, make_static_strnode("unexpected \'}\'"),
  171.              END_OF_LIST);
  172.        break;
  173.    case DK_HOW:
  174.        recoverable = TRUE;
  175.    case DK_HOW_UNREC:
  176.        err_mesg = cons_list(0,
  177.              make_static_strnode("I don\'t know how to"),
  178.              error_desc, END_OF_LIST);
  179.        break;
  180.    case NO_CATCH_TAG:
  181.        err_mesg = cons_list(0,
  182.          make_static_strnode("Can't find catch tag for"),
  183.          error_desc, END_OF_LIST);
  184.        break;
  185.    case ALREADY_DEFINED:
  186.        err_mesg = cons_list(0, error_desc,
  187.              make_static_strnode("is already defined"),
  188.              END_OF_LIST);
  189.        break;
  190.    case STOP_ERROR:
  191.        err_mesg = cons_list(0, make_static_strnode("Stopping..."),
  192.              END_OF_LIST);
  193.        break;
  194.    case ALREADY_DRIBBLING:
  195.        err_mesg = cons_list(0, make_static_strnode("Already dribbling"),
  196.              END_OF_LIST);
  197.        break;
  198.    case FILE_ERROR:
  199.        err_mesg = cons_list(0, make_static_strnode("File system error:"),
  200.              error_desc, END_OF_LIST);
  201.        break;
  202.    case IF_WARNING:
  203.        err_mesg = cons_list(0,
  204.       make_static_strnode("Assuming you mean IFELSE, not IF"),
  205.       END_OF_LIST);
  206.        warning = TRUE;
  207.        break;
  208.    case SHADOW_WARN:
  209.        err_mesg = cons_list(0, error_desc,
  210.       make_static_strnode("shadowed by local in procedure call"),
  211.       END_OF_LIST);
  212.        warning = TRUE;
  213.        break;
  214.    case USER_ERR:
  215.        if (error_desc == UNBOUND)
  216.       err_mesg = cons_list(0, make_static_strnode("Throw \"Error"),
  217.                  END_OF_LIST);
  218.        else {
  219.       uplevel = TRUE;
  220.       if (is_list(error_desc))
  221.           err_mesg = error_desc;
  222.       else
  223.           err_mesg = cons_list(0, error_desc, END_OF_LIST);
  224.        }
  225.        break;
  226.    case IS_PRIM:
  227.        err_mesg = cons_list(0, error_desc,
  228.              make_static_strnode("is a primitive"),
  229.              END_OF_LIST);
  230.        break;
  231.    case NOT_INSIDE:
  232.        err_mesg = cons_list(0,
  233.       make_static_strnode("Can't use TO inside a procedure"),
  234.       END_OF_LIST);
  235.        break;
  236.    case AT_TOPLEVEL:
  237.        err_mesg = cons_list(0, make_static_strnode("Can only use"),
  238.              error_desc,
  239.              make_static_strnode("inside a procedure"),
  240.              END_OF_LIST);
  241.        break;
  242.    case NO_TEST:
  243.        err_mesg = cons_list(0, fun, make_static_strnode("without TEST"),
  244.              END_OF_LIST);
  245.        break;
  246.    case ERR_MACRO:
  247.        err_mesg = cons_list(0, make_static_strnode("Macro returned"),
  248.              error_desc,
  249.              make_static_strnode("instead of a list"),
  250.              END_OF_LIST);
  251.        break;
  252.    case DEEPEND:
  253.        if (error_desc == NIL) {
  254.       err_mesg = cons_list(0,
  255.          make_static_strnode("END inside multi-line instruction.\n"),
  256.          END_OF_LIST);
  257.        } else {
  258.       err_mesg = cons_list(0,
  259.          make_static_strnode("END inside multi-line instruction in"),
  260.          error_desc,
  261.          END_OF_LIST);
  262.        }
  263.        break;
  264.    default:
  265.        prepare_to_exit(FALSE);
  266.        ndprintf(stdout,"Unknown error condition - internal error.\n");
  267.        exit(1);
  268.     }
  269.     didnt_output_name = NIL;
  270.     if (uplevel && ufun != NIL) {
  271.    ufun = last_ufun;
  272.    this_line = last_line;
  273.     }
  274.     if (ufun != NIL)
  275.    err_mesg = cons_list(0, err_mesg, ufun, this_line, END_OF_LIST);
  276.     else
  277.    err_mesg = cons_list(0, err_mesg, NIL, NIL, END_OF_LIST);
  278.     err_mesg = cons(make_intnode((FIXNUM)error_type), err_mesg);
  279. #ifdef mac
  280.    if (error_type == STOP_ERROR) sleep(1);
  281. #endif
  282.     if (warning) {
  283.    err_print();
  284.    return(UNBOUND);
  285.     }
  286.     err_act = valnode__caseobj(Erract);
  287.     if (err_act != NIL && err_act != UNDEFINED) {
  288.    if (error_type != erract_errtype) {
  289.        int sv_val_status = val_status;
  290.  
  291.        erract_errtype = error_type;
  292.        setvalnode__caseobj(Erract, NIL);
  293.        val_status = 5;
  294.        val = err_eval_driver(err_act);
  295.        val_status = sv_val_status;
  296.        setvalnode__caseobj(Erract, err_act);
  297.        if (recoverable == TRUE && val != UNBOUND) {
  298.       return(val);
  299.        } else if (recoverable == FALSE && val != UNBOUND) {
  300.       ndprintf(stdout,"You don't say what to do with %s\n", val);
  301.       val = UNBOUND;
  302.       throw_node = Toplevel;
  303.        } else {
  304.       return(UNBOUND);
  305.        }
  306.    } else {
  307.        ndprintf(stdout,"Erract loop\n");
  308.        throw_node = Toplevel;
  309.    }
  310.     } else {   /* no erract */
  311.    throw_node = Error;
  312.     }
  313.     stopping_flag = THROWING;
  314.     output_node = UNBOUND;
  315.     return(val);
  316. }
  317.  
  318. NODE *lerror(NODE *args) {
  319.     NODE *val;
  320.  
  321.     val = err_mesg;
  322.     err_mesg = NIL;
  323.     return(val);
  324. }
  325.  
  326. #ifndef HAVE_MEMCPY
  327. void memcpy(char *to, char *from, int len) {
  328.     while (--len >= 0)
  329.    *to++ = *from++;
  330. }
  331. #endif
  332.  
  333. NODE *lpause(NODE *args) {
  334.     NODE *elist = NIL, *val = UNBOUND, *uname = NIL;
  335.     int sav_input_blocking;
  336.     int sv_val_status;
  337. #ifndef TIOCSTI
  338.     jmp_buf sav_iblk;
  339. #endif
  340.  
  341.     if (err_mesg != NIL) err_print();
  342.  /* if (ufun != NIL) */ {
  343.    uname = ufun;
  344.    ndprintf(stdout, "Pausing...\n");
  345. #ifndef TIOCSTI
  346.    memcpy((char *)(&sav_iblk), (char *)(&iblk_buf), sizeof(jmp_buf));
  347. #endif
  348.    sav_input_blocking = input_blocking;
  349.    input_blocking = 0;
  350. #ifdef mac
  351.    csetmode(C_ECHO, stdin);
  352.    fflush(stdin);
  353. #endif
  354.    sv_val_status = val_status;
  355.    while (RUNNING) {
  356.        if (uname != NIL) print_node(stdout, uname);
  357.        elist = reader(stdin, "? ");
  358.        if (NOT_THROWING) elist = parser(elist, TRUE);
  359.        else elist = NIL;
  360. #ifndef WIN32
  361.        if (feof(stdin) && !isatty(0)) lbye(NIL);
  362. #endif
  363. #ifdef __ZTC__
  364.        if (feof(stdin)) rewind(stdin);
  365. #endif
  366.        val_status = 5;
  367.        if (elist != NIL) eval_driver(elist);
  368.        if (stopping_flag == THROWING) {
  369.       if (compare_node(throw_node, Pause, TRUE) == 0) {
  370.           val = output_node;
  371.           output_node = UNBOUND;
  372.           stopping_flag = RUN;
  373. #ifndef TIOCSTI
  374.           memcpy((char *)(&iblk_buf), (char *)(&sav_iblk),
  375.             sizeof(jmp_buf));
  376. #endif
  377.           input_blocking = sav_input_blocking;
  378.           val_status = sv_val_status;
  379.          if (uname != NIL) {
  380.             ufun = uname;
  381.          }
  382.           return(val);
  383.       } else if (compare_node(throw_node, Error, TRUE) == 0) {
  384.           err_print();
  385.           stopping_flag = RUN;
  386.       }
  387.        }
  388.    }
  389. #ifndef TIOCSTI
  390.    memcpy((char *)(&iblk_buf), (char *)(&sav_iblk), sizeof(jmp_buf));
  391. #endif
  392.    input_blocking = sav_input_blocking;
  393.    unblock_input();
  394.    val_status = sv_val_status;
  395.    if (uname != NIL) {
  396.       ufun = uname;
  397.    }
  398. /*  } else {
  399.    stopping_flag = THROWING;
  400.    throw_node = Toplevel;
  401.  */ }
  402.     return(val);
  403. }
  404.  
  405. NODE *lcontinue(NODE *args) {
  406.     stopping_flag = THROWING;
  407.     throw_node = Pause;
  408.     if (args != NIL)
  409.    output_node = car(args);
  410.     else
  411.    output_node = UNBOUND;
  412.     return(UNBOUND);
  413. }
  414.