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

#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=NULL, *olptr=NULL ;

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

   if ( systm->environment )
   {
      Free_string( systm->environment ) ;
      systm->environment = NULL;
   }

   if ( systm->called_as )
   {
      Free_string( systm->called_as ) ;
      systm->called_as = NULL;
   }

   if (systm->input_file )
   {
      Free_string( systm->input_file ) ;
      systm->input_file = NULL;
   }

   if (systm->input_fp )
   {
      fclose( systm->input_fp ) ;
      systm->input_fp = NULL;
   }

   if ( systm->rootnode)
   {
      destroytree( systm->rootnode ) ;
      systm->rootnode = NULL;
   }

   if (systm->currlevel)
     {
      removelevel( systm->currlevel ) ;
      systm->currlevel = NULL;
     }

   if (systm->firstline)
   {
      kill_lines( systm->firstline ) ;
      systm->firstline = NULL;
   }

   if (systm->panic)
   {
      Free( systm->panic ) ;
      systm->panic = NULL;
   }

   if ( systm->result)
   {
      Free_string( systm->result ) ;
      systm->result = NULL;
   }

   if (systm->callstack)
   {
      Free( systm->callstack ) ;
      systm->callstack = NULL;
   }

   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=NULL, *tmpsys=NULL ;
   extern proclevel currlevel ;
   extern sysinfobox *systeminfo ;
   extern nodeptr currentnode ;
   struct macro *mptr=NULL ;
   streng *ptr=NULL ;
   jmp_buf *jbuf=NULL ;
   

   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=NULL, *tmpsys=NULL ;
   extern proclevel currlevel ;
   extern sysinfobox *systeminfo ;
   extern nodeptr currentnode ;
   char name[1024] ;
   streng *ptr=NULL ;
   char *cptr=NULL, *eptr=NULL, *start=NULL, *stop=NULL ;
   char path[1024] ;
   FILE *fptr=NULL ;
   jmp_buf *jbuf=NULL ;
   
   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
   {
    if (memcmp("<stdin>",command->value,command->len) == 0) /* reading from stdin */
     {
      fptr = stdin;
      strcpy(name,command->value);
     }
    else
     {
      cptr = command->value ;
      eptr = cptr + command->len ;

      for (start=cptr; start<eptr && isspace(*start); start++) ;
      for (stop=eptr-1;stop>start && isspace(*stop);  stop--) ;

      memcpy( path, start, (stop-start)+1 ) ;
      *(path+(stop-start)+1) = 0x00 ;
      get_external_routine(path,&fptr,name);

      if (!fptr)
      {
         Free( jbuf ) ;
         if (RetCode)
           {
            *RetCode = -ERR_PROG_UNREADABLE;
            fprintf(stderr,"REXX: Error %d: %s: \"%s\"\n",
                ERR_ROUTINE_NOT_FOUND,errortext(ERR_ROUTINE_NOT_FOUND),name);
           }
         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, 0 )  ;
      }
      /*
       * Don't close fptr if it is stdin!
       */
      if (fptr != stdin)
         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=NULL ;

   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=NULL ;

   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=NULL ;
   struct macro *newmacro=NULL ;

   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, 0 )  ;
      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=0, hcnt=0 ;

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

