#ifndef lint
static char *RCSid = "$Id: error.c,v 1.9 1993/05/10 05:55:53 anders Exp anders $";
#endif

/*
 *  The Regina Rexx Interpreter
 *  Copyright (C) 1992-1994  Anders Christensen <anders@pvv.unit.no>
 *
 *  This library is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU Library General Public
 *  License as published by the Free Software Foundation; either
 *  version 2 of the License, or (at your option) any later version.
 *
 *  This library is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 *  Library General Public License for more details.
 *
 *  You should have received a copy of the GNU Library General Public
 *  License along with this library; if not, write to the Free
 *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

#include "rexx.h"
#include <errno.h>
#include <string.h>
#include <stdio.h>
#include <assert.h>
#include <stdarg.h>

static char *suberrortext( int , int  );

int lineno_of( nodeptr node )
{
   if (node)
      return (node->lineno>=0) ? node->lineno : 0 ;
   else
      return 0 ;
}

int charno_of( nodeptr node )
{
   if (node)
      return (node->charnr>=0) ? node->charnr : 0 ;
   else
      return 0 ;
}


/* only to be used by syntax and runtime errors, and the halt condition */
void exiterror( int errorno, int suberrorno, ... )
{
   va_list argptr;
   extern nodeptr currentnode ;
   extern sysinfo systeminfo ;
   extern int tline ;
   int lineno=0, charno=0, signtype=0 ;
   streng *inputfile=NULL ;
   static char err1[]="Error %d running \"%s\", line %d: %s" ;
   static char err2[]="Error %d running \"%s\": %s" ;
   streng *errmsg=NULL ;
   int ok=0 ;
   char *fmt = NULL ;

   if (currentnode) 
   {
      lineno = lineno_of( currentnode ) ; 
      charno = charno_of( currentnode ) ; 
   }
   else
   {
      charno =  0 ;
      lineno = tline ;
   }

   signtype = SIGNAL_SYNTAX ;
   if ( errorno==ERR_PROG_INTERRUPT )
     signtype = SIGNAL_HALT ;

   /* Here we should set sigtype to SIGNAL_FATAL for some 'errno's */

   /* enable a hook into the condition system */
   if (condition_hook( signtype, errorno, lineno, Str_cre(errortext(errorno))))  
     return ; /* if CALL ON */

   inputfile = systeminfo->input_file = Str_ify(systeminfo->input_file) ;   
   errmsg = Str_make( 256 ) ;
   ok = HOOK_GO_ON ;
   if (lineno>0) {
      traceback() ; 
      sprintf( errmsg->value, err1, errorno,inputfile->value, lineno, 
                                                 errortext(errorno) ) ; }
   else
      sprintf(errmsg->value,err2,errorno,inputfile->value,errortext(errorno));
   
   errmsg->len = strlen( errmsg->value ) ;
   assert( errmsg->len < errmsg->max ) ;
   if (systeminfo->hooks & HOOK_MASK(HOOK_STDERR))
      ok = hookup(HOOK_STDERR, errmsg) == HOOK_GO_ON ;
  
   if (ok==HOOK_GO_ON)
   {
      fprintf(stderr, "%s\n", errmsg->value ) ;
#ifdef HAVE_VFPRINTF
      if (errorno <= 100
      &&  errorno > 0
      &&  suberrorno != 0)
      {
         fmt = suberrortext( errorno, suberrorno );
         if (fmt)
         {
            va_start( argptr, suberrorno );
            fprintf(stderr, "Error %d.%d: ", errorno, suberrorno );
            vfprintf( stderr, fmt, argptr );
            va_end( argptr );
         }
      }
#endif
   }  

#ifndef NDEBUG
   if (errorno == ERR_INTERPRETER_FAILURE)
      abort() ;
#endif

   Free_string( errmsg ) ;
   if (systeminfo->panic)
   {
      systeminfo->result = NULL ;
      longjmp( *(systeminfo->panic), 1 ) ;
   }
   CloseOpenFiles();

#ifdef VMS
   exit( EXIT_SUCCESS ) ;
#else
   exit( errorno ) ;
#endif
}


void yyerror(char *errtext) 
{
   parse_error_flag = ERR_YACC_SYNTAX ;
   return ;
#if 0
   purge() ;
    exiterror( ERR_YACC_SYNTAX, 0 )  ;
#endif
}



char *errortext( int errorno ) 
{
   static char *errmsg[] = {
/*  0 */     "" ,
/*  1 */     "" ,
/*  2 */     "Failure during finalization" ,
/*  3 */     "Failure during initialization" ,
/*  4 */     "Program interrupted" ,
/*  5 */     "Machine storage exhausted" ,
/*  6 */     "Unmatched \"/*\" or quote" ,
/*  7 */     "WHEN or OTHERWISE expected" ,
/*  8 */     "Unexpected THEN or ELSE" ,
/*  9 */     "Unexpected WHEN or OTHERWISE" ,
/* 10 */     "Unexpected or unmatched END" ,
/* 11 */     "Control stack full" ,
/* 12 */     "Clause > 500 characters" ,
/* 13 */     "Invalid character in data" ,
/* 14 */     "Incomplete DO/SELECT/IF" ,
/* 15 */     "Invalid hexadecimal or binary constant" ,
/* 16 */     "Label not found" ,
/* 17 */     "Unexpected PROCEDURE" ,
/* 18 */     "THEN expected" ,
/* 19 */     "String or symbol expected" ,
/* 20 */     "Name expected" ,
/* 21 */     "Invalid data on end of clause" ,
/* 22 */     "Invalid character string" ,
/* 23 */     "Invalid data string" ,
/* 24 */     "Invalid TRACE request" ,
/* 25 */     "Invalid sub-keyword found" ,
/* 26 */     "Invalid whole number" ,
/* 27 */     "Invalid DO syntax" ,
/* 28 */     "Invalid LEAVE or ITERATE" ,
/* 29 */     "Environment name to long" ,
/* 30 */     "Name or String > 250 characters" ,
/* 31 */     "Name starts with number or \".\"" ,
/* 32 */     "Invalid use of stem" ,
/* 33 */     "Invalid expression result" ,
/* 34 */     "Logical value not 0 or 1",
/* 35 */     "Invalid expression" ,
/* 36 */     "Unmatched \"(\" in expression" ,
/* 37 */     "Unexpected \",\" or \")\"" ,
/* 38 */     "Invalid template or pattern" ,
/* 39 */     "Evaluation stack overflow" ,
/* 40 */     "Incorrect call to routine" ,
/* 41 */     "Bad arithmetic conversion" ,
/* 42 */     "Arithmetic Overflow/Underflow" ,
/* 43 */     "Routine not found" ,
/* 44 */     "Function did not return data" ,
/* 45 */     "No data specified on function" ,
/* 46 */     "Invalid variable reference" ,
/* 47 */     "Unexpected label" ,
/* 48 */     "Failure in system service" ,
/* 49 */     "Interpreter failure",
/* 50 */     "Unrecognized reserved symbol",
/* 51 */     "Invalid function name",
/* 52 */     "",
/* 53 */     "Invalid option",
/* 54 */     "Invalid STEM value",
/* 55 */     "",
/* 56 */     "",
/* 57 */     "",
/* 58 */     "",
/* 59 */     "",
/* 60 */     "Can't rewind transient file",
/* 61 */     "Improper seek operation on file",
/* 62 */     "Internal buffer too small",
/* 63 */     "Could not find REXX program",
/* 64 */     "Syntax error while parsing",
/* 65 */     "",
/* 66 */     "",
/* 67 */     "",
/* 68 */     "",
/* 69 */     "",
/* 70 */     "",
/* 71 */     "",
/* 72 */     "",
/* 73 */     "",
/* 74 */     "",
/* 75 */     "",
/* 76 */     "",
/* 77 */     "",
/* 78 */     "",
/* 79 */     "",
/* 80 */     "",
/* 81 */     "",
/* 82 */     "",
/* 83 */     "",
/* 84 */     "",
/* 85 */     "",
/* 86 */     "",
/* 87 */     "",
/* 88 */     "",
/* 89 */     "",
/* 90 */     "",
/* 91 */     "",
/* 92 */     "",
/* 93 */     "",
/* 94 */     "",
/* 95 */     "",
/* 96 */     "",
/* 97 */     "",
/* 98 */     "",
/* 99 */     "",
/* 100 */    "Unknown filsystem error",
             "",
             } ;

   if ((errorno<=100)&&(errorno>0)) 
      return( errmsg[errorno] ) ;
 
   if (errorno>100)
     return( strerror(errorno-100) ) ;

   return ( "" ) ;
}

static char *suberrortext( int errorno, int suberrorno )
{
   typedef struct 
   {
      unsigned int errorno ;
      unsigned int suberrorno ;
      char * suberrmsg ;
   } errormsg ;

   static errormsg errmsg[] = 
   {
      { 3,  1,   "Failure during initialization: %s\n" } ,
      { 6,  1,   "Unmatched comment delimiter (\"/*\")\n" } ,
      { 6,  2,   "Unmatched single quote (')\n" } ,
      { 6,  3,   "Unmatched double quote (\")\n" } ,
      { 8,  1,   "THEN has no corresponding IF or WHEN clause\n" } ,
      { 8,  2,   "ELSE has no corresponding THEN clause\n" } ,
      {10,  1,   "END has no corresponding DO or SELECT\n" } ,
      {14,  3,   "THEN requires a following instruction\n" } ,
      {14,  4,   "ELSE requires a following instruction\n" } ,
      {15,  1,   "Invalid location of blank in position %d in hexadecimal string\n" } ,
      {15,  2,   "Invalid location of blank in position %d in binary string\n" } ,
      {15,  3,   "Only 0-9, a-f, A-F, and blank are valid in hexadecimal string; found \"%s\"\n" } ,
      {15,  4,   "Only 0, 1, and blank are valid in binary string; found \"%s\"\n" } ,
      {20,  1,   "Name required; found \"%s\"\n" } ,
      {21,  1,   "The clause ended at an unexpected token; found \"%s\"\n" } ,
      {24,  1,   "TRACE request letter must be one of \"%s\"; found \"%c\"\n" } ,
      {25,  1,   "CALL ON must be followed by one of the keywords %s; found \"%s\"\n" } ,
      {25,  3,   "SIGNAL ON must be followed by one of the keywords %s; found \"%s\"\n" } ,
      {25, 11,   "NUMERIC FORM must be followed by one of the keywords %s; found \"%s\"\n" } ,
      {25, 12,   "PARSE must be followed by one of the keywords %s; found \"%s\"\n" } ,
      {25, 15,   "NUMERIC must be followed by one of the keywords %s; found \"%s\"\n" } ,
      {25, 17,   "PROCEDURE must be followed by one of the keywords %s; found \"%s\"\n" } ,
      {35,  1,   "Invalid expression detected at \"%s\"\n" } ,
      {38,  1,   "Invalid parsing template detected at \"%s\"\n" } ,
      {31,  2,   "Variable symbol must not start with a number; found \"%s\"\n" } ,
      {31,  3,   "Variable symbol must not start with a \".\"; found \"%s\"\n" } ,
      {38,  3,   "PARSE VALUE instruction requires WITH keyword\n" } ,
      {40,  3,   "Not enough arguments in invocation of \"%s\", minimum expected is %d\n" } ,
      {40,  4,   "Too many arguments in invocation of \"%s\", maximum expected is %d\n" } ,
      {40, 19,   "%s argument 2, \"%s\", is not in the format described by argument 3, \"%s\"\n" } ,
      {40, 21,   "%s argument %d must not be null\n" } ,
      {40, 28,   "%s argument %d, option must start with one of \"%s\"; found \"%s\"\n" } ,
   } ;
   register int i = 0 ;
   int num_errmsg = sizeof(errmsg)/sizeof(errormsg);

   for (i=0; i < num_errmsg; i++ )
   {
      if (errmsg[i].errorno == errorno
      &&  errmsg[i].suberrorno == suberrorno)
         return( errmsg[i].suberrmsg ) ;
   }
   return NULL;
}

#ifndef NDEBUG

char *getsym( int numb )
{
   char *symb=NULL ;

   switch (numb)
   {
       
      case X_NULL: symb="Null statement" ; break ;
      case X_PROGRAM: symb="Program" ; break ;
      case X_STATS: symb="Statements" ; break ;
      case X_COMMAND: symb="External command" ; break ;
      case X_ADDR_V: symb="ADDRESS (value) statement" ; break ;
      case X_ADDR_N: symb="ADDRESS (normal) statement" ; break ;
      case X_ARG: symb="ARG statement" ; break ;
      case X_CALL: symb="CALL statement" ; break ;
      case X_DO: symb="DO statement" ; break ;
      case X_REP: symb="Repetitor in DO" ; break ;
      case X_REP_FOREVER: symb="Forever in DO" ; break ;
      case X_REP_COUNT: symb="Counter in DO" ; break ;
      case X_DO_TO: symb="Upper limit in DO" ; break ;
      case X_DO_BY: symb="Step-size in DO" ; break ;
      case X_DO_FOR: symb="Max number in DO" ; break ;
      case X_WHILE: symb="WHILE expr in DO" ; break ;
      case X_UNTIL: symb="UNTIL expr in DO" ; break ;
      case X_DROP: symb="DROP statement" ; break ;
      case X_EXIT: symb="EXIT statement" ; break ;
      case X_IF: symb="IF statement" ; break ;
      case X_IPRET: symb="INTERPRET statement" ; break ;
      case X_ITERATE: symb="ITERATE statement" ; break ;
      case X_LABEL: symb="Label specification" ; break ;
      case X_LEAVE: symb="LEAVE statement" ; break ;
      case X_NUM_D: symb="NUMERIC DIGIT statement" ; break ;
      case X_NUM_F: symb="NUMERIC FORM statement" ; break ;
      case X_NUM_FUZZ: symb="NUMERIC FUZZ statement" ; break ;
      case X_NUM_SCI: symb="Scientific numeric form" ; break ;
      case X_NUM_ENG: symb="Engeenering scientific form" ; break ;
      case X_PARSE: symb="PARSE statement" ; break ;
      case X_PARSE_U: symb="UPPER PARSE statement" ; break ;
      case X_PARSE_ARG: symb="PARSE ARG atatement" ; break ;
      case X_PARSE_EXT: symb="External parsing" ; break ;
      case X_PARSE_NUM: symb="Numeric parsing" ; break ;
      case X_PARSE_PULL: symb="Parse pull" ; break ;
      case X_PARSE_SRC: symb="Parse source" ; break ;
      case X_PARSE_VAR: symb="Parse variable" ; break ;
      case X_PARSE_VAL: symb="Parse value" ; break ;
      case X_PARSE_VER: symb="Parse version" ; break ;
      case X_PARSE_ARG_U: symb="PARSE UPPER ARG statement" ; break ;
      case X_PROC: symb="PROCEDURE statement" ; break ;
      case X_PULL: symb="PULL statement" ; break ;
      case X_PUSH: symb="PUSH statement" ; break ;
      case X_QUEUE: symb="QUEUE statement" ; break ;
      case X_RETURN: symb="RETURN statement" ; break ;
      case X_SAY: symb="SAY statement" ; break ;
      case X_SELECT: symb="SELECT statement" ; break ;
      case X_WHENS: symb="WHEN connector" ; break ;
      case X_WHEN: symb="WHEN clause" ; break ;
      case X_OTHERWISE: symb="OTHERWISE clause" ; break ;
      case X_SIG_VAL: symb="SIGNAL VALUE statement" ; break ;
      case X_SIG_LAB: symb="SIGNAL (label) statement" ; break ;
      case X_SIG_SET: symb="SIGNAL (setting) statement" ; break ;
      case X_ON: symb="Setting is ON" ; break ;
      case X_OFF: symb="Setting is OFF" ; break ;
      case X_S_ERROR: symb="ERROR option" ; break ;
      case X_S_HALT: symb="HALT option" ; break ;
      case X_S_NOVALUE: symb="NOVALUE option" ; break ;
      case X_S_SYNTAX: symb="SYNTAX option" ; break ;
      case X_TRACE: symb="TRACE statement" ; break ;
      case X_T_ALL: symb="ALL option" ; break ;
      case X_T_COMM: symb="COMMAND option" ; break ;
      case X_T_ERR: symb="ERROR option" ; break ;
      case X_T_INTER: symb="INTERMEDIATE option" ; break ;
      case X_T_LABEL: symb="LABEL option" ; break ;
      case X_T_NORMAL: symb="NORMAL option" ; break ;
      case X_T_OFF: symb="OFF option" ; break ;
      case X_T_SCAN: symb="SCAN option" ; break ;
      case X_UPPER_VAR: symb="UPPER statement" ; break ;
      case X_ASSIGN: symb="Assignment" ; break ;
      case X_LOG_NOT: symb="Logical NOT" ; break ;
      case X_PLUSS: symb="Plus operator" ; break ;
      case X_EQUAL: symb="Equal operator" ; break ;
      case X_MINUS: symb="Minus operator" ; break ;
      case X_MULT: symb="Multiplication operator" ; break ;
      case X_DEVIDE: symb="Division operator" ; break ;
      case X_MODULUS: symb="Modulus operator" ; break ;
      case X_LOG_OR: symb="Logical or" ; break ;
      case X_LOG_AND: symb="Logical and" ; break ;
      case X_LOG_XOR: symb="Logical xor" ; break ;
      case X_EXP: symb="Exponent operator" ; break ;
      case X_CONCAT: symb="String concatenation" ; break ;
      case X_SPACE: symb="Space separator" ; break ;
      case X_GTE: symb="Greater than or equal operator" ; break ;
      case X_LTE: symb="Less than or equal operator" ; break ;
      case X_GT: symb="Greater than operator" ; break ;
      case X_LT: symb="Less than operator" ; break ;
      case X_DIFF: symb="Different operator" ; break ;
      case X_SIM_SYMBOL: symb="Simple symbol" ; break ;
      case X_CON_SYMBOL: symb="Constant symbol" ; break ;
      case X_HEX_STR: symb="Hexadecimal string" ; break ;
      case X_STRING: symb="Constant string" ; break ;
      case X_FUNC: symb="Function call" ; break ;
      case X_U_MINUS: symb="Unary minus" ; break ;
      case X_S_EQUAL: symb="String equal operator" ; break ;
      case X_S_DIFF: symb="String different operator" ; break ;
      case X_SIMSYMB: symb="Simple symbol (2)" ; break ;
      case X_INTDIV: symb="Integer division" ; break ;
      case X_EX_FUNC: symb="External function call" ; break ;
      case X_IN_FUNC: symb="Internal function call" ; break ;
      case X_TPL_SOLID: symb="Solid point in template" ; break ;
      case X_TPL_MVE: symb="Constant pattern" ; break ;
      case X_TPL_VAR: symb="Variable pattern" ; break ;
      case X_TPL_TO: symb="Ehh, what does \"TO\" mean???" ; break ;
      case X_TPL_SYMBOL: symb="Variable in tamplate" ; break ;
      case X_TPL_SPACE: symb="Space in template" ; break ;
      case X_TPL_POINT: symb="Placeholder in template" ; break ;
      case X_TMPLS: symb="Template connector" ; break ;
      case X_TPL_OFF: symb="Offset in template" ; break ;
      case X_TPL_PATT: symb="Pattern in template" ; break ;
      case X_NEG_OFFS: symb="Negative offset" ; break ;
      case X_POS_OFFS: symb="Positive offset" ; break ;
      case X_ABS_OFFS: symb="Absolute offset" ; break ;
      case X_EXPRLIST: symb="Expression connector" ; break ;
      case X_SYMBOLS: symb="Symbol connector" ; break ;
      case X_SYMBOL: symb="Symbol?" ; break ;
      case X_END: symb="End statement" ; break ;
      default: symb="Unrecognized value" ;
   }

   return symb ;
}

#endif /* !NDEBUG */
  
/*    
   switch ( numb ) {     
   
      case ADDRESS:
      case VALUE:
      case ARG:
      case CALL:
      case DO:
      case FOREVER:
      case TO:
      case BY:
      case FOR:
      case WHILE:
      case UNTIL:
      case END:
      case DROP:
      case EXIT:
      case IF:
      case THEN:
      case ELSE:
      case INTERPRET:
      case ITERATE:
      case LEAVE:
      case NOP:
      case NUMBERIC:
      case DIGITS:
      case FORM:
      case SCIENTIFIC:
      case ENGINEERING:
      case FUZZ:
      case UPPER:
      case PARSE:
      case EXTERNAL:
      case PULL:
      case SOURCE:
      case WITH:
      case VAR:
      case PROCEDURE:
      case PUSH:
      case QUEUE:
      case RETURN:
      case SAY:
      case SELECT:
      case WHEN:
      case OTHERWISE:
      case SIGNAL:
      case ON:
      case OFF:
      case ERROR:
      case HALT:
      case NOVALUE:
      case SYNTAX:
      case TRACE:
      case ALL:
      case COMMANDS:
      case COMMAND:
      case ERRORS:
      case INTERMEDIATES:
      case LABELS:
      case NORMAL:
      case RESULTS:
      case SCAN:
         printf("Debug: found keyword/instruction :%s:\n", symb ) ;
         break ;

      case SYMBOL:
         printf("Debug: found symbol :%s:\n", symb ) ;
         break ;

      case STRING: 
         printf("Debug: found string :%s:\n", symb ) ;
         break ;

      }
}

 */
