#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.
 */

/*
    This code modified for Win32 port by Ataman Software, Inc. June 29, 1995.
*/

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


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 )
{
   extern nodeptr currentnode ;
   extern sysinfo systeminfo ;
   extern int tline ;
   int lineno, charno, signtype ;
   streng *inputfile ;
   static char err1[]="REXX: Error %d running \"%s\", line %d: %s" ;
   static char err2[]="REXX: Error %d running \"%s\": %s" ;
   streng *errmsg ;
   int ok ;

   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 ) ;

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

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

#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 ) ;
#endif
}



char *errortext( int errorno )
{
   extern char *sys_errlist[] ;
   static char *errmsg[] = {
/*  0 */     "" ,
/*  1 */     "" ,
/*  2 */     "" ,
/*  3 */     "Program is unreadable" ,
/*  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 */     "Symbol expected" ,
/* 21 */     "Invalid data on end of clause" ,
/* 22 */     "" ,
/* 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 aritmetric 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 */     "" ,
/* 48 */     "Failure in system service" ,
/* 49 */     "Interpreter failure",
/* 50 */     "",
/* 51 */     "",
/* 52 */     "",
/* 53 */     "",
/* 54 */     "",
/* 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)) {
#ifdef WIN32
      if (errorno == ERR_OLE_ERROR) {
         extern char *GetOLEErr();
         return (GetOLEErr());
      }

	  if (errorno == ERR_SYSTEM_FAILURE) {
	  	static char buf[40];
		extern unsigned long __stdcall GetLastError(void);
		sprintf(buf, "Failure in system service: %lu", GetLastError());
		return buf;
	  }
#endif
      return( errmsg[errorno] ) ;
   }

   if (errorno>100)
     return( sys_errlist[errorno-100] ) ;

   return ( "" ) ;
}

#ifndef NDEBUG

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

   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 ;

      }
}

 */
