#ifndef lint
static char *RCSid = "$Id: rexx.c,v 1.5 1999/12/24 04:49:16 mark Exp $";
#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 Multithread Win32 port by Les Moull April 1999.  *
****************************************************************************/
#if defined(WIN32) && defined(__IBMC__)
#include <windows.h>
#pragma warning(default: 4115 4201 4214)
#else
# ifdef RXLIB
#  define APIENTRY
#  if defined(__WATCOMC__) && defined(__NT__)
#   undef APIENTRY
#   include <windows.h>
#  endif

#  if defined(_MSC_VER)
#   undef APIENTRY
#   if _MSC_VER >= 1100
/* Stupid MSC can't compile own headers without warning at least in VC 5.0 */
#    pragma warning(disable: 4115 4201 4214)
#   endif
#   include <windows.h>
#   if _MSC_VER >= 1100
#    pragma warning(default: 4115 4201 4214)
#   endif
#  endif
# endif
#endif

#include "rexx.h"
#include <string.h>
#include <stdio.h>
#include <ctype.h>
#include <assert.h>
#ifdef VMS
# include <stat.h>
#else
# include <sys/stat.h>
#endif

#if defined(DJGPP) || defined(__EMX__) || defined(_MSC_VER) || (defined(__WATCOMC__) && !defined(__QNX__))
# include <fcntl.h>
# include <io.h>
#endif

/*
 * Since development of Ultrix has ceased, and they never managed to 
 * fix a few things, we want to define a few things, just in order 
 * to kill a few warnings ...
 */
#if defined(FIX_PROTOS) && defined(FIX_ALL_PROTOS) && defined(ultrix)
   int fstat( int fd, struct stat *buf ) ;
   int stat( char *path, struct stat *buf ) ;
#endif




#if defined(HAVE_WINMULTITHREADING)
extern globalext SG;
globalext *G=0L;
long dwsysteminfo=-1L;
#else
proclevel currlevel, mainlevel ;
sysinfo systeminfo ;
nodeptr parseroot=NULL ;
int nextstart=1, thischar=0, nextline=1, tstart, tline ;
int isclient=0 ;
FILE *stddump=NULL ;
int parse_error_flag=0 ;
/* this does not appear to be used - MH 17-01-97 */
char *environments[] = { "SH", "CSH", "COMMAND", "CMD", "PATH", "SYSTEM" } ;
#endif

/* 
 * Note: must match the settings of NUM_FORM_* in flags.h
 */
char *numeric_forms[] = { "SCIENTIFIC", "ENGINEERING" } ;

char *WeekDays[] = { "Sunday", "Monday", "Tuesday", "Wednesday",
   "Thursday", "Friday", "Saturday" } ;

char *months[] = {
   "January", "February", "March", "April", "May", "June",
   "July", "August", "September", "October", "November", "December" } ;

int DaysInYear[] = {0,31,59,90,120,151,181,212,243,273,304,334};
int MonthDays[] = {31,28,31,30,31,30,31,31,30,31,30,31};

/*
 * Note: these must match the definitions of INVO_* in defs.h
 */
char *invo_strings[] = {
   "COMMAND", "FUNCTION", "SUBROUTINE" } ;

#if defined(HAVE_WINMULTITHREADING)
void AddFunctions(void);
#endif

#ifdef TRACEMEM
void marksubtree( nodeptr ptr )
{
   int i=0 ;
   if ( ptr ) 
   {
      markmemory(ptr,TRC_TREENODE) ;
      if (ptr->name) markmemory(ptr->name, TRC_TREENODE) ;
      for (i=0;i<5;marksubtree(ptr->p[i++])) ; 
      if (ptr->next) marksubtree( ptr->next ) ;

      if (ptr->type == X_STRING || ptr->type == X_CON_SYMBOL)
         if (ptr->u.number)
         {
            markmemory( ptr->u.number, TRC_TREENODE ) ;
            markmemory( ptr->u.number->num, TRC_TREENODE ) ;
         }

      if (ptr->type == X_CEXPRLIST)
         if (ptr->u.strng)
            markmemory( ptr->u.strng, TRC_TREENODE ) ;
   }
}
         

#endif /* TRACEMEM */



nodeptr treadit( nodeptr tree )
{
/* 
   nodeptr left, mid, right ;
 */
   return NULL ;   
/*
   if (!tree)
      return NULL ;

   left = tree->p[0] ;
   mid = tree->p[1] ;
   right = tree->p[2] ;

   switch (tree->type)
   {
      case X_OTHERWISE:
      case X_PROGRAM: 
         treadit( left ) ;
         tree = NULL ;
         break ;

      case X_STATS:
      case X_WHENS:
         left->next = treadit( mid ) ;
         treadit( left ) ;
         tree = left ;
         break ;

      case X_IF:
         treadit( mid ) ;
      case X_DO:
         treadit( right ) ;
         break ;

      case X_SELECT:
         treadit( left ) ;
      case X_WHEN:
         treadit( mid ) ;
         break ;
   }

   return tree ;
 */
}

#ifdef TRACEMEM
# if !defined(HAVE_WINMULTITHREADING)
   int listleakedmemory=0 ;
# endif
#endif

#ifdef RXLIB
int APIENTRY dummy_main(int argc,char *argv[]);
int APIENTRY dummy_main(int argc,char *argv[])
#else
int main(int argc,char *argv[]);
int main(int argc,char *argv[])
#endif
{
   extern int isclient ;
   FILE *fptr = NULL ;
   streng *string=NULL ;
   int rccode=0, i=0, j=0, stdinput=1, state=0, rcode=0, oldi=0, trace_override=0 ;
#ifndef NDEBUG
   extern int yydebug ; 
#endif
   paramboxptr args=NULL ;
   char *arg=NULL ;
   int make_perl=0 ;
   int do_yydebug=0;
   char name[1024];
#include "multi.h"

#if defined(FLISTS) && !defined(NEW_FLISTS)
   init_hash_table() ; /* initiate the memory system */
#endif

   stddump = stderr ;

   systeminfo = creat_sysinfo( Str_cre("SYSTEM")) ;
   systeminfo->called_as = Str_cre( argv[0] ) ;

   systeminfo->currlevel0 = mainlevel = currlevel = newlevel( NULL ) ;
   systeminfo->trace_override = 0;

#if defined(HAVE_WINMULTITHREADING)
/*   if(G==&SG) */
   {
#endif
   initexpr() ;
   initfiletable() ;
   init_envir() ;
#if defined(HAVE_WINMULTITHREADING)
   }
#endif
   init_spec_vars() ;
   init_vars() ;
#if defined(HAVE_WINMULTITHREADING)
/*   if (G==&SG) */
   {
      AddFunctions();
   }
#endif

   for (i=1; i<argc; i++)
   {
      arg = argv[i] ;
      if (state==0)
      {
         if (*arg=='-') 
         {
            switch (*(++arg))
            {
               case 'i':
                  starttrace() ;
                  set_trace_char('A') ;
                  intertrace() ;
                  intertrace() ;
                  break ;

               case 'C':
                  if (*(arg+1)=='p')
                     SetupClient( arg+2 ) ;
                  else if (*(arg+1)=='i')
                     SetupInternal( arg+2 ) ;
                  break ;

               case 'p':
                  make_perl = 1 ;
                  break ;   

               case 'y':
                  do_yydebug = 1 ;
                  break ;   

               case 't':
                  queue_trace_char((char) (*(arg+1)? *(++arg) : 'A')) ;
                  trace_override = 1;
                  break ;

               case 'd':
#ifdef TRACEMEM
                  if (*(arg+1)=='m')
                     listleakedmemory = 1 ;
#endif
                  break ;
            }
         }
         else
         {
            stdinput = 0 ;
            get_external_routine(argv[i],&fptr,name,1);
            if (!fptr)
            {
               systeminfo->input_file = Str_cre(argv[i]) ;
               exiterror( ERR_PROG_UNREADABLE, 1, "Program is unreadable" )  ;
            }
            systeminfo->input_file = Str_cre(name) ;
            systeminfo->input_fp = fptr ;
            break ;
         }
      }
    }
    /* 
     * Under DJGPP setmode screws up Parse Pull and entering code interactively :-(
     */
#if defined(__EMX__) || defined(_MSC_VER) || (defined(__WATCOMC__) && !defined(__QNX__))
    setmode( fileno( stdin ), O_BINARY );
    setmode( fileno( stdout ), O_BINARY );
    setmode( fileno( stderr ), O_BINARY );
#endif

   if (stdinput)
   {
      systeminfo->input_file = Str_cre("<stdin>") ; 
      systeminfo->input_fp = NULL;
   }

   if (isclient==1) 
      RunClient() ;
   else if (isclient==2)
      return 0 ;

   oldi = ++i ;

   for (j=1;i<argc;i++)
      j += strlen(argv[i]) + 1 ;

   currlevel->args = args = Malloc(sizeof(parambox)) ;
   memset(args,0,sizeof(parambox)); /* especially ->value */
/*   
   args->value = Str_dup(systeminfo->input_file) ;
   args = args->next = Malloc(sizeof(parambox)) ;
 */
   args->next = NULL ;
   if (oldi>=argc)
      args->value = string = NULL ;
   else
   {
      args->value = string = Str_make( j ) ;
      string->len = 0 ;
   }

   for (i=oldi;i<argc;i++) 
   {
      string = Str_catstr(string,argv[i]) ;
      string->value[string->len++] = ' ' ;
   }
   if (string && string->len)
     string->len-- ;

   signal_setup() ;

   initscanner() ;
   initexternal( fptr ? fptr : stdin ) ;
#ifndef NDEBUG
   yydebug = do_yydebug ;   /* 1 == yacc-debugging */
#endif

   parseroot = NULL ;
   parse_error_flag = 0 ;
   if ((rccode=yyparse())!=0)
   {
      end_file_interpret() ;
/*      return rccode ;

   if (parse_error_flag) */
      exiterror( parse_error_flag, 0 ) ;
   }

   systeminfo->firstline = first_source_line ;
   systeminfo->lastline = last_source_line ;
   systeminfo->rootnode = parseroot ;
   end_file_interpret() ;
   if (trace_override)
      systeminfo->trace_override = 1;
   else
      systeminfo->trace_override = 0;
   parseroot = NULL ;
   tline = 0 ;

#ifndef R2PERL
#ifndef MINIMAL
#ifndef VMS
#ifndef DOS
#ifndef _MSC_VER
#ifndef __IBMC__
   if ( stdinput )
   {
      struct stat buffer ;

      /* 
       * The following line is likely to give a warning when compiled 
       * under Ultrix, this can be safely ignored, since it is just a 
       * result of Digital not defining their include files properly. 
       */
      rcode = fstat( fileno(stdin), &buffer ) ;
      if (rcode==0 && S_ISCHR(buffer.st_mode))
      { 
         printf("  \b\b") ; 
         fflush(stdout) ;
         rewind(stdin) ; 
      }
   } 
#endif /* !__IBMC__ */
#endif /* !_MSC_VER */
#endif /* !DOS */
#endif /* !VMS */
#endif /* !MINIMAL */
#endif /* !R2PERL */

   treadit( systeminfo->rootnode ) ;

#ifdef R2PERL
   if (make_perl)
   {
      preamble() ;
      translate( systeminfo->rootnode ) ;
      exit( 0 ) ;
   }
#endif

   flush_trace_chars() ;
   string = interpret( systeminfo->rootnode ) ;

   rcode = EXIT_SUCCESS ;
   if (string)
      rcode = myatol( string ) ;

#if defined(FLISTS) && defined(NEW_FLISTS)
   free_flists();
#endif

#ifdef DYNAMIC
   /*
    * Remove all external function package functions
    * and libraries. Only valid for the DYNAMIC library.
    */
   purge_library();
#endif

#ifdef TRACEMEM
   if (listleakedmemory)
      listleaked( MEMTRC_LEAKED )  ;
#endif

   killsystem( systeminfo );
   systeminfo = NULL ;

   return(rcode) ;
#include "unmulti.h"
   
}

#ifdef TRACEMEM
void mark_systeminfo()
{
   sysinfo sinfo=NULL ;
   labelbox *lptr=NULL ;
   lineboxptr llptr=NULL ;
#if !defined(HAVE_WINMULTITHREADING)
   extern sysinfo systeminfo ;
#else
# include "multi.h"
#endif

   for (sinfo=systeminfo; sinfo; sinfo=sinfo->previous)
   {
      markmemory(sinfo, TRC_SYSINFO) ;
      markmemory(sinfo->called_as, TRC_SYSINFO) ;
      markmemory(sinfo->input_file, TRC_SYSINFO) ;
      markmemory(sinfo->environment, TRC_SYSINFO) ;
      markmemory(sinfo->callstack, TRC_SYSINFO) ;

      markvariables( sinfo->currlevel0 ) ;
      marksource( sinfo->firstline ) ;
      marksubtree( sinfo->rootnode ) ;

      for (lptr=sinfo->firstlabel; lptr; lptr=lptr->next )
      {
         markmemory( lptr, TRC_SYSINFO ) ;
      }

      for (llptr=sinfo->firstline; llptr; llptr=llptr->next ) 
      {
         markmemory( llptr, TRC_SYSINFO ) ;
         markmemory( llptr->line, TRC_SYSINFO ) ;
      }
   }
#include "unmulti.h"
}
#endif


sysinfobox *creat_sysinfo( streng *envir ) 
{
   sysinfobox *sinfo=NULL ;

   sinfo = Malloc( sizeof(sysinfobox) ) ;
   sinfo->environment = envir ;
   sinfo->tracing = DEFAULT_TRACING ; 
   sinfo->interactive = DEFAULT_INT_TRACING ;
   sinfo->previous = NULL ;
   sinfo->invoked = INVO_COMMAND ;
   sinfo->called_as = NULL ;
   sinfo->input_file = NULL ;
   sinfo->input_fp = NULL ;
   sinfo->panic = NULL ;
   sinfo->hooks = 0 ;
   sinfo->firstline = NULL ;
   sinfo->firstlabel = NULL ;
   sinfo->lastlabel = NULL ;
   sinfo->lastline = NULL ;
   sinfo->callstack = Malloc(sizeof(nodeptr)*10) ;
   sinfo->result = NULL ;
   sinfo->rootnode = NULL ;
   sinfo->cstackcnt = 0 ;
   sinfo->cstackmax = 10 ;
   sinfo->serial = 0 ;
   sinfo->trace_override = 0 ;

   return sinfo ;
}

#if !defined(RXLIB)

void SetupClient( char *dummy )
{
   fprintf( stderr, "Warning: pipe-comm not compiled into interpreter\n" ) ;
}

void SetupInternal( char *dummy )
{
   fprintf (stderr, "Warning: SAA API not compiled into interpreter\n" ) ;
}
 
int hookup( int dummy )
{
   /* This should never happen, if we don't have support for SAA API, 
    * Then we should never get a system exit!
    */
   assert( 0 ) ;
   return 1 ;  /* to keep compiler happy */
}
int hookup_input( int dummy1, streng **dummy2 )
{
   /* This should never happen, if we don't have support for SAA API, 
    * Then we should never get a system exit!
    */
   assert( 0 ) ;
   return 1 ;  /* to keep compiler happy */
}
int hookup_output( int dummy1, streng *dummy2 )
{
   /* This should never happen, if we don't have support for SAA API, 
    * Then we should never get a system exit!
    */
   assert( 0 ) ;
   return 1 ;  /* to keep compiler happy */
}

void RunClient( void ) 
{
   SetupInternal( NULL ) ;
   exit( 1 ) ;
}

streng *do_an_external( streng *dummy1, paramboxptr dummy2, char dummy3, char dummy4 )
{
   SetupInternal( NULL ) ;
   exit( 1 ) ;
   return NULL;
}

streng *do_an_external_dll( void *dummy1, paramboxptr dummy2, char dummy3 )
{
   SetupInternal( NULL ) ;
   exit( 1 ) ;
   return NULL;
}


streng *SubCom( streng *dummy1, streng *dummy2, int *dummy3 )
{
   SetupInternal( NULL ) ;
   exit( 1 ) ;
   return NULL;
}

int IfcHaveFunctionExit(void)
{
 return(0);
}

#endif