#ifndef lint
static char *RCSid = "$Id: macros.c,v 1.2 1993/05/10 06:04:06 anders Exp anders $";
#endif

/*
 *  The Regina Rexx Interpreter
 *  Copyright (C) 1993-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 <stdio.h>
#include <ctype.h>
#include <setjmp.h>
#include <string.h>
#include <assert.h>


struct macro {
   struct macro *prev, *next ;
   streng *name ;
   lineboxptr first, last ;
   nodeptr tree ;
   int serial ;
} *firstmacro = NULL ;
int macro_serialno = 0 ;



extern lineboxptr first_source_line, last_source_line ;

struct macro *find_macro( streng *name, int serial )  ;

extern nodeptr parseroot ;

void killsystem( sysinfo systm )
{
   labelbox *lptr, *olptr ;

   for (lptr=systm->first; lptr; lptr=olptr ) 
   {
      olptr = lptr->next ;
      Free( lptr ) ;
   }

   if ( systm->environment )
      Free_string( systm->environment ) ;

   if ( systm->called_as )
      Free_string( systm->called_as ) ;

   if (systm->input_file )
      Free_string( systm->input_file ) ;

   if ( systm->rootnode)
      destroytree( systm->rootnode ) ;

   if (systm->currlevel)
      removelevel( systm->currlevel ) ;

   if (systm->firstline)
      kill_lines( systm->firstline ) ;

   if (systm->panic)
      Free( systm->panic ) ;

   if ( systm->result)
      Free_string( systm->result ) ;

   if (systm->callstack)
      Free( systm->callstack ) ;

   Free( systm ) ;
}

int there_is_no_error ;


streng *do_instore( streng *name, paramboxptr args, streng *envir, 
               int *RetCode, int hooks, int calltype, int serial, int ctype )
{
   sysinfobox *newsystem, *tmpsys ;
   extern proclevel currlevel ;
   extern sysinfobox *systeminfo ;
   extern nodeptr currentnode ;
   struct macro *mptr ;
   streng *ptr ;
   jmp_buf *jbuf ;
   

   if (RetCode)
      *RetCode = 0 ;

   there_is_no_error = 0 ;
   jbuf = Malloc( sizeof(jmp_buf) ) ;
   if (setjmp(*jbuf))
   {
      ptr = systeminfo->result ;
      systeminfo->result = NULL ;
      if (!there_is_no_error && RetCode)
         *RetCode = -1 ;
   }
   else
   {
      currentnode = NULL ;
   
      newsystem = creat_sysinfo( Str_dup(envir)) ;
      newsystem->previous = systeminfo ;
      systeminfo->currlevel = currlevel ;

      currlevel = NULL ;   
      systeminfo = newsystem ;
      systeminfo->hooks = hooks ;
      systeminfo->panic = jbuf ;
      systeminfo->invoked = ctype ;
      systeminfo->called_as = Str_dup( name ) ;
      systeminfo->input_file = Str_dup( name ) ;
      systeminfo->currlevel = currlevel = newlevel( NULL ) ;

      currlevel->args = args ;
/*
      if (currentnode)
      {
         pushcallstack( currentnode ) ;
         must_pop = 1 ;
      }
 */ 
      mptr = find_macro( NULL, serial ) ;
      systeminfo->rootnode = mptr->tree ;
      systeminfo->firstline = mptr->first ;
      systeminfo->lastline = mptr->last ;
      if (systeminfo->hooks & HOOK_MASK(HOOK_INIT))
         hookup( HOOK_INIT ) ;

      if (systeminfo->rootnode)
         ptr = interpret( systeminfo->rootnode ) ;
      else 
         ptr = NULL ;

      if (systeminfo->hooks & HOOK_MASK(HOOK_TERMIN))
         hookup( HOOK_TERMIN ) ;
   }
/*
   if (must_pop)
      popcallstack( -1 ) ;
 */
   tmpsys = systeminfo ;
   systeminfo = systeminfo->previous ;
   currlevel = systeminfo->currlevel ;
   trace_stat = currlevel->tracestat ;

   tmpsys->currlevel->args = NULL ;
   tmpsys->rootnode = NULL ;
   tmpsys->firstline = NULL ;
   killsystem( tmpsys ) ; 

   /* Oops, we really ought to handle function-did-not-return-data */
   return (ptr) ? ptr : nullstringptr()  ;
}


streng *execute_external( streng *command, paramboxptr args, streng *envir,
                          int *RetCode, int hooks, int ctype ) 
{
   sysinfobox *newsystem, *tmpsys ;
   extern proclevel currlevel ;
   extern sysinfobox *systeminfo ;
   extern nodeptr currentnode ;
   char *name ;
   streng *ptr ;
   int ss ;
   char *cptr, *eptr, *start, *stop ;
   char path[1024] ;
   FILE *volatile fptr ;
   jmp_buf *jbuf ;
   

   if (RetCode)
      *RetCode = 0 ;

   fptr = NULL ;
   jbuf = Malloc( sizeof(jmp_buf) ) ;
   there_is_no_error = 0 ;

   if (setjmp(*jbuf))
   {
      ptr = systeminfo->result ;
      systeminfo->result = NULL ;
      if (!there_is_no_error && RetCode)
         *RetCode = -1 ;
   }
   else
   {
      cptr = command->value ;
      eptr = cptr + command->len ;

      for (start=cptr; isspace(*start) && start<eptr; start++) ;
      for (stop=start; !isspace(*stop) && stop<eptr; stop++) ;

      strcpy( path, "/local/lib/rexx/" ) ;
      memcpy( path+(ss=strlen(path)), start, stop-start ) ;
      *(path+ss+(stop-start)) = 0x00 ;

      fptr = fopen( name=path+ss, "rb" ) ;
      if (!fptr)
         fptr = fopen( name=path, "rb" ) ;

      if (!fptr)
      {
         Free( jbuf ) ;
         return NULL ;
      }

      initexternal( fptr ) ;
 
      currentnode = NULL ;
   
      newsystem = creat_sysinfo( Str_dup(envir)) ;
      newsystem->previous = systeminfo ;
      systeminfo->currlevel = currlevel ;

      currlevel = NULL ;   
      systeminfo = newsystem ;
      systeminfo->hooks = hooks ;
      systeminfo->invoked = ctype ;
      systeminfo->panic = jbuf ;
      systeminfo->called_as = Str_dup( command ) ;
      systeminfo->input_file = Str_cre( name ) ;
      systeminfo->currlevel = currlevel = newlevel( NULL ) ;

      currlevel->args = args ;
/*
      if (currentnode)
      {
         pushcallstack( currentnode ) ;
         must_pop = 1 ; 
      }
 */
      parseroot = NULL ;
      if (!yyparse()) 
      {
         systeminfo->rootnode = parseroot ;
         parseroot = NULL ;
         systeminfo->firstline = first_source_line ;
         systeminfo->lastline = last_source_line ;
         treadit( systeminfo->rootnode ) ;
         if (systeminfo->hooks & HOOK_MASK(HOOK_INIT))
            hookup( HOOK_INIT ) ;

         ptr = interpret( systeminfo->rootnode ) ;
         if (systeminfo->hooks & HOOK_MASK(HOOK_TERMIN))
            hookup( HOOK_TERMIN ) ;
      }
      else 
      {
         ptr = NULL ;
         exiterror( ERR_YACC_SYNTAX ) ;
      }
   }

   fclose(fptr) ;
/*
   if (must_pop)
      popcallstack( -1 ) ;
 */
   tmpsys = systeminfo ;
   systeminfo = systeminfo->previous ;
   currlevel = systeminfo->currlevel ;
   trace_stat = currlevel->tracestat ;

   tmpsys->currlevel->args = NULL ;
   killsystem( tmpsys ) ; 

   /* Oops, we really ought to handle function-did-not-return-data */
   return (ptr) ? ptr : nullstringptr()  ;
}



struct macro *find_macro( streng *name, int serial ) 
{
   struct macro *mptr ;

   assert( name || serial ) ;  
   for (mptr=firstmacro; mptr; mptr=mptr->prev) 
   {
      if ((!name || !Str_cmp(name, mptr->name)) && 
                                 (!serial || serial==mptr->serial))
          return mptr ;
   }
   return NULL ;
}




void kill_macro( streng *name, int serial ) 
{
   struct macro *mptr ;

   mptr = find_macro( name, serial ) ;
   if (mptr)
   {
      kill_lines( mptr->first ) ;
      destroytree( mptr->tree ) ;
      if (mptr->name)
         Free_string( mptr->name ) ;
      if (mptr->prev)
         mptr->prev->next = mptr->next ;

      if (mptr->next)
         mptr->next->prev = mptr->prev ;
      else
         firstmacro = mptr->prev ;
   }
}


int enter_macro( streng *source, streng *name ) 
{
   treenode *newtree ;
   struct macro *newmacro ;

   initmacro( source ) ;
   parseroot = NULL ;
   if (!yyparse()) 
   {
      newtree = parseroot ;
      parseroot = NULL ;
      treadit( newtree ) ;
      newmacro = Malloc( sizeof( struct macro )) ;
      newmacro->next = NULL ;
      newmacro->first = first_source_line ;
      newmacro->last = last_source_line ;
      newmacro->tree = newtree ;
      newmacro->serial = ++macro_serialno ;
      newmacro->name = name ;
      newmacro->prev = firstmacro ;
      if (firstmacro)
         newmacro->prev->next = newmacro ;
      firstmacro = newmacro ;
      return newmacro->serial ;
   }
   else 
   {
      exiterror( ERR_YACC_SYNTAX ) ;
      return 0 ;
   }
}



/*
 * Takes as input a pointer to a parameter structure, and counts the 
 * number of parameters in it, and return that value. The counting 
 * can be performed in two different manners, either soft or hard. 
 * Soft means that "trailing" ommitted parameters are ignored, hard
 * means that all parameters are counted. (When counting hard, all 
 * routines stared from Rexx has at least one parameter: the one that
 * was ommitted. However, when started from C by SAA API, functions 
 * can be started with zero parameters.)
 */
int count_params( paramboxptr ptr, int soft )
{
   int scnt, hcnt ;

   assert( PARAM_TYPE_SOFT && !PARAM_TYPE_HARD ) ;

   for (hcnt=scnt=0; ptr; ptr=ptr->next, hcnt++) 
      if (soft && ptr->value)
         scnt = hcnt ;
      
   return ((soft) ? scnt : hcnt ) ;
  
}


/* 
 * Takes a pointer to an argument structure as input, together with an
 * integer. Returns the parameter numbered by the number, or NULL if
 * either that parameter is omitted or otherwise non-existing. 
 */
streng *get_parameter( paramboxptr ptr, int number ) 
{
   assert( number>0 ) ;
   for (; ptr && --number; ptr=ptr->next) ;

   return ((ptr && ptr->value) ? ptr->value : NULL ) ;
}

