#ifndef lint
static char *RCSid = "$Id";
#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 file implements the client part of the SAA API when Regina 
 * is linked into a program using SAA API. There is one routine for 
 * each of the functions in SAA API, and the functionality is partly 
 * implemented here, and partly by calling subroutines in Regina.
 * Note that the interface to Regina is as simple as possible, so that
 * a multitude of different transport mechanisms can be used (although
 * normal linking is probably the most common.
 * 
 * The following SAA API functions is defined in this source file:
 * 
 *    RexxStart()               --- execute Rexx code
 *    RexxRegisterSubcomExe()   --- register subcommand handler
 *    RexxRegisterSubcomDll()   --- ditto (not yet implemented)
 *    RexxQuerySubcom()         --- query subcommand handler 
 *    RexxDeregisterSubcom()    --- deregister subcommand handler
 *    RexxVariablePool()        --- handle Rexx variable manipulation
 *    RexxRegisterExitExe()     --- register exit handler
 *    RexxDeregisterExit()      --- deregister exit handler
 *    RexxRegisterFunctionExe() --- register external function handler
 *    RexxQueryFunction()       --- query external function 
 *    RexxDeregisterFunction()  --- deregister external function
 * 
 * These functions are all defined in the doc for SAA API. In addition,
 * a number of calls in Regina are called, as well as a number of calls
 * are defined for use by Regina. These all start with the prefix Ifc. 
 * First the one defined in rexxsaa.c, which can be called from other 
 * parts of Regina:
 *
 *    IfcSubCmd()   --- invoke a subcommand
 *    IfcDoExit()   --- invoke a system exit handler 
 *    IfcExecFunc() --- invoke an external function handler
 *
 * Then the functions which are defined elsewhere, which can be called
 * by this source code:
 *
 *    IfcStartUp()    --- initialize Regina
 *    IfcExecScript() --- start to execute Rexx code
 *    IfcVarPool()    --- handle a variable manipulation request
 *    IfcRegFunc()    --- register an external function name
 *    IfcDelFunc()    --- deregister an external function name
 *  
 * All these routines are properly defined in the documentation for
 * Regina. Other than the functions listed, the code in this file has 
 * been isolated as far as possible, and no functions specific to 
 * Regina is used, not even for memory allocation. 
 */
 
/* 
 * We need to define these symbols in order to get the proper macros,
 * datatypes, and declaration when including rexxsaa.h.
 */
#define INCL_RXSHV
#define INCL_RXSUBCOM
#define INCL_RXFUNC
#define INCL_RXSYSEXIT 

/*
 * The rexxsaa.h header file defines the interface between this file and 
 * the client program which uses SAA API. The rxiface.h header file 
 * defines the interface between this file and Regina. 
 */
#include "rexxsaa.h"
#include "rxiface.h"

#include <limits.h>
#include <stdio.h>
#include <string.h>
#include <unistd.h>
#include <assert.h>
#include <stdlib.h>
#include <errno.h>
#include <fcntl.h>
#include <ctype.h>

/*
 * The struct EnvBox datatype holds the definition of any subcommand 
 * handler (i.e. an 'environment'). It is intended as an double-linked
 * list of entries, though performence concerns may force a change in
 * this structure later. It contains the name of the environment, and 
 * an eight byte dataarea of user defined data. The same datastructure
 * is also used for holding the symbol table of external functions. 
 *
 * This may prove a problem in the future, since the number of external
 * functions are generally much larger than the number of subcommand 
 * handlers. Thus, different datastructures may be necessary to acheive
 * maximum performance.
 */
struct EnvBox
{
   struct EnvBox *prev, *next ;    /* double linked list pointers */
   char *EnvName ;                 /* environment/function name */
   unsigned char UserData[8] ;     /* user defined data area */
   union {                           
     PFN EntryPnt ;                /* external function entry point */
     RexxSubcomHandler *SubCom ;   /* subcommand handler entry point */
   } u ;
} ;

/*
 * The Interpreting variable is set when at least one level of 
 * interpretation is currently active; i.e. at least one invokation of
 * RexxStart() is active in the call-stack. This variable is checked 
 * later, when one wants to see whether a call to retrieve data values
 * would succeed.
 */
static int Interpreting=0 ;


/*
 * The following MAP_TYPE() macro maps from the SAA API macros holding 
 * the type of an invocation (function, subroutine or command), to its
 * equivalent value in the internal interface of Regina (as defined in 
 * the file rxiface.h
 */
#define MAP_TYPE(a) ((a)==RXCOMMAND ? RX_TYPE_COMMAND : \
              (a)==RXFUNCTION ? RX_TYPE_FUNCTION : RX_TYPE_SUBROUTINE)


/*
 * The FillReq() function takes as parameter a pointer to a VarPool() 
 * request structure variable, and the definition of a string, and 
 * fill the content of the string into the request block. Note that the
 * third parameter is gobbled up, so it can not be used or released by 
 * the calling function afterwards. Also, there are two macros defined,
 * which gives a better access to the contents of the function
 */
#define FillReqName(a,b,c) FillReq(a,b,c,1)
#define FillReqValue(a,b,c) FillReq(a,b,c,0)

static void FillReq( PSHVBLOCK Req, ULONG Length, char *String, int type ) 
{
   RXSTRING *string ;
   ULONG *strlen ;

   string = type ? &(Req->shvname) : &(Req->shvvalue) ;
   strlen = type ? &(Req->shvnamelen) : &(Req->shvvaluelen) ;

   /* 
    * If the string is undefined, set ->strptr to NULL. It is not required
    * that the lengths parameters are set to zero, but I'll do this as 
    * nice gest to the users; someone is probably going to believe that 
    * this is how the data is returned.
    */
   if (Length == RX_NO_STRING)
   {
      string->strptr = NULL ;
      *strlen = string->strlength = 0 ;
      return ;
   }

   /* 
    * If a string was supplied, use it, else allocate sufficient space. 
    * The then part of the if will just copy the data to the user-supplied
    * return string data area, noting a truncation is one occurred. 
    */
   if (string->strptr)
   { 
      if (*strlen<Length)
      {
          Req->shvret |= RXSHV_TRUNC ;
          Length = *strlen ;
      }
      memcpy(string->strptr, String, Length ) ;
      string->strlength = Length ;
   }
   else
   {
      /*
       * The else part of the if will allocate new space for the data, and
       * fills in the data, or return a memory fault if data could not 
       * properly be allocated. 
       */
      string->strptr = malloc( Length ) ;
      if (string->strptr)
      {
         memcpy( string->strptr, String, Length ) ;
         string->strlength = Length ;
         *strlen = Length ;
      }
      else
         Req->shvret |= RXSHV_MEMFL ;
   }
}

/*
 * This function initializes the Rexx interpreter. Actually, most of the 
 * job is performed by IfcStartUp(). This module mainly performs three 
 * functions: (1) veryfy parameters, (2) prevent reinitialization, and 
 * (3) to verify that this module and the Rexx interpreter implements the
 * same version of the interface.
 * 
 * Zero is returned if no errors occurred, while non-zero return code 
 * indicates an error. 
 */
static int InitFlag=0 ;
static int StartupRexx( char *EnvName ) 
{ 
   int rc, Maj, Min ;

   if (InitFlag)
      return 1 ;

   InitFlag = 1 ;
   /* 
    * First parameter ignored, but keep it for compatibility 
    */
   rc = IfcStartUp( NULL, &Maj, &Min ) ;

   if (Maj != RXVERSION_MAJ || Min != RXVERSION_MIN) 
      return 1 ;

   return rc ;
}


/* ========================================================================
 * Here starts the section for maintaining the list of environments 
 * supported by this environment. There are several routines using 
 * the functions in this section, the routines defined here are:
 * 
 *  FindEnv()  --- retrieves a pointer to a environment box.
 * 
 * Actually, it used to be more, one to insert and one to delete. 
 * However, in order to save code, these was moved into the routines 
 * where they were called (they were used only once). The functions
 * into which the code was moved are RexxRegisterSubcomExe(), and 
 * RexxDeregisterSubcom(). To improve modularization, and to 
 * ease the introduction of a new datastructure, the code should 
 * probably be extracted and inserted in this section.
 */

/*
 * First there is the name of the pointer to the head of the list 
 * containing all the environments.
 */
static struct EnvBox *FirstEnv=NULL ;
static struct EnvBox *FirstExit=NULL ;

#define BOX_IS_ENVIR 0
#define BOX_IS_EXIT 1

/* 
 * Find a particular environment, and return a pointer to a struct
 * containing information about that environment. If it is not found,
 * a pointer to NULL is returned. 
 */
#define FindEnvir(a) FindBox(a,BOX_IS_ENVIR)
#define FindExit(a) FindBox(a,BOX_IS_EXIT) 

static struct EnvBox *FindBox( char *Env, int type )
{
   struct EnvBox *bptr = ((type==BOX_IS_ENVIR) ? FirstEnv : FirstExit) ;

   assert( Env ) ;
   for (; bptr; bptr=bptr->next)
      if (!strcmp(bptr->EnvName,Env))
         return bptr ;

   return NULL ;
}

#define AddEnvir(a,b,c) AddBox(a,b,c,BOX_IS_ENVIR)
#define AddExit(a,b,c) AddBox(a,b,c,BOX_IS_EXIT)

static struct EnvBox *AddBox( char *EnvName, void *UserArea,
			      PFN EntryPoint, int type )
{
   struct EnvBox *NewBox ;
   struct EnvBox **first ;
   int EnvLen ;

   first = (type==BOX_IS_ENVIR) ? &FirstEnv : &FirstExit ;
   NewBox = malloc( sizeof( struct EnvBox )) ;
   if (!NewBox)
      return NULL ; 

   EnvLen = strlen( EnvName ) ;
   NewBox->EnvName = malloc( EnvLen+1 ) ;
   if (!NewBox->EnvName)
   {
      free( NewBox ) ;
      return NULL ;
   }

   NewBox->prev = NULL ;
   NewBox->next = (*first) ;
   if (*first)
      (*first)->prev = NewBox ;
   (*first) = NewBox ;

   strcpy( NewBox->EnvName, EnvName ) ;
   NewBox->u.EntryPnt = EntryPoint ;
   if (UserArea)
      memcpy( NewBox->UserData, UserArea, 8 ) ;
   else
      memset( NewBox->UserData, 0x00, 8 ) ;

   return NewBox ;
 }


#define RemoveExit(a) RemoveBox(a,BOX_IS_EXIT)
#define RemoveEnvir(a) RemoveBox(a,BOX_IS_ENVIR)

static int RemoveBox( char *EnvName, int type )
{
   struct EnvBox *OldBox ;
   struct EnvBox **First ;
   
   OldBox = FindBox( EnvName, type ) ;
   if (OldBox)
   {
      First = (type==BOX_IS_ENVIR) ? &FirstEnv : &FirstExit ;
      if (OldBox->prev)
         OldBox->prev->next = OldBox->next ;
      if (OldBox->next)
         OldBox->next->prev = OldBox->prev ;
      if ((*First)==OldBox)
         (*First) = OldBox->prev ;
      
      free( OldBox->EnvName ) ;
      free( OldBox ) ;
      return 0 ;
   }
   return 1 ;
}



int IfcSubCmd( int EnvLen, char *EnvStr, int CmdLen, char *CmdStr,
               int *RetLen, char **RetStr ) 
{
   RXSTRING Cmd, Ret ;
   char result[DEFAULT_RETSTRING_LENGTH], *OldResult ;
   USHORT Flags ;
   int Length ;
   char *EnvNam, *Command ;
   struct EnvBox *Envir ;
   int rvalue, RCode ;

   EnvNam = EnvStr ;
   Length = CmdLen ;
   Command = CmdStr ;
            
   Envir = FindEnvir( EnvNam ) ;
   if (Envir)
   {
      MAKERXSTRING( Cmd, Command, Length ) ;
      MAKERXSTRING( Ret, result, DEFAULT_RETSTRING_LENGTH ) ;
      OldResult = result ;

      rvalue = (*(Envir->u.SubCom))( &Cmd, &Flags, &Ret ) ;
 
      if (Flags==RXSUBCOM_OK)
         RCode = RXFLAG_OK ;
      else if (Flags==RXSUBCOM_ERROR)
         RCode = RXFLAG_ERROR ;
      else if (Flags==RXSUBCOM_FAILURE)
         RCode = RXFLAG_FAILURE ;
      else
         assert( 0 ) ;
   }
   else
   {
      RCode = RXFLAG_FAILURE ;
      Ret.strlength = 0 ;
   }

   if (Ret.strlength)
   {
      *RetLen = Ret.strlength ; 
      *RetStr = Ret.strptr ;
   }
   else 
   {
      *RetLen = 1 ;
      *RetStr = "0" ;
   }

   if (Ret.strlength && OldResult != Ret.strptr)
      free( Ret.strptr ) ; 

   return RCode ;
}


/*
static struct EnvBox *FindExit( char *Env ) {
   struct EnvBox *bptr ;

   assert( Env ) ;
   for (bptr=FirstExit; bptr; bptr=bptr->next)
      if (!strcmp(bptr->EnvName,Env))
         return bptr ;

   return NULL ; }
*/

struct ExitHandlers {
   RexxExitHandler *(Handlers[RXNOOFEXITS]) ;
   struct ExitHandlers *prev ; } *CurrentHandlers=NULL ;



int IfcDoExit( int Code, int *RLength, char **RString ) 
{
   EXIT ParBox ;
   int rc, SubCode, MainCode ;

   switch (Code)
   {
      case RX_EXIT_STDERR:
      case RX_EXIT_STDOUT:
         ParBox.siosay.rxsio_string.strlength = *RLength ;
         ParBox.siosay.rxsio_string.strptr = *RString ;
         SubCode = (Code==RX_EXIT_STDOUT) ? RXSIOSAY : RXSIOTRC ;
         MainCode = RXSIO ;
         break ;

      case RX_EXIT_TRCIN:
         ParBox.siodtr.rxsiodtr_retc.strlength = 0 ;
         ParBox.siodtr.rxsiodtr_retc.strptr = NULL ;
         SubCode = RXSIODTR ;
         MainCode = RXSIO ;
         break ;

      case RX_EXIT_PULL:
         ParBox.siotrd.rxsiotrd_retc.strlength = 0 ;
         ParBox.siotrd.rxsiotrd_retc.strptr = NULL ;
         SubCode = RXSIOTRD ;
         MainCode = RXSIO ;
         break ;

      case RX_EXIT_INIT:
         MainCode = RXINI ;
         SubCode = RXINIEXT ;
         break ;
 
      default:
         assert( 0 ) ;
         /* fallthrough; to avoid compiler warnings */

      case RX_EXIT_TERMIN:
         MainCode = RXTER ;
         SubCode = RXTEREXT ;
         break ;
   }

   assert( CurrentHandlers->Handlers[MainCode] ) ;
   rc = (*(CurrentHandlers->Handlers[MainCode]))(MainCode, SubCode, &ParBox);
   assert( rc==RXEXIT_HANDLED || rc==RXEXIT_NOT_HANDLED ||
           rc==RXEXIT_RAISE_ERROR ) ;

   switch (Code)
   {
     case RX_EXIT_STDERR:
     case RX_EXIT_STDOUT:
     case RX_EXIT_INIT:
     case RX_EXIT_TERMIN:
         break ;

     case RX_EXIT_TRCIN:
         *RLength = ParBox.siodtr.rxsiodtr_retc.strlength ;
         *RString = ParBox.siodtr.rxsiodtr_retc.strptr ;
         break ;

     case RX_EXIT_PULL:
         *RLength = ParBox.siotrd.rxsiotrd_retc.strlength ;
         *RString = ParBox.siotrd.rxsiotrd_retc.strptr ;
         break ;

      default:
         assert( 0 ) ; 
   }

   if (rc==RXEXIT_HANDLED)
      rc = RX_HOOK_NOPE ;
   else if (rc==RXEXIT_NOT_HANDLED)
      rc = RX_HOOK_GO_ON ;
   else if (rc==RXEXIT_RAISE_ERROR)
      rc = RX_HOOK_ERROR ;

   if (RString && !(*RString))
      *RLength = RX_NO_STRING ;

   return rc ;
}



/* ================================================================ */
/* ================ in order to start Rexx scripts ================ */

LONG RexxStart(
   LONG		ArgCount,
   PRXSTRING 	ArgList,
   PSZ		ProgramName,
   PRXSTRING	Instore,
   PSZ		EnvName,
   LONG		CallType,
   PRXSYSEXIT	Exits,
   PLONG	ReturnCode,
   PRXSTRING	Result ) 
{
   int cnt, RLength ;
   char *RString ;
   int ParLengths[32] ;
   char *ParStrings[32] ;   int ExitFlags ;
   int EnvNamLen ;
   char *EnvNamStr ;
   char *WherePtr ;
   int WhereCode, WhereLen, rc ;
   struct ExitHandlers *Handlers ;
   RexxExitHandler *handler ;
   struct EnvBox *EnvPtr ;
   LONG ResValue ;
   int drop_ipret=0 ;
   
   if (Instore)
   {
      if (Instore[1].strptr && Instore[1].strlength < sizeof(int))
         return RX_START_BADP ;
   }

   if (CallType!=RXCOMMAND && CallType!=RXFUNCTION && CallType!=RXSUBROUTINE)
      return RX_START_BADP ;

   if (CallType==RXCOMMAND && ArgCount>1)
      return RX_START_TOOMANYP ;

   if (!InitFlag)
      StartupRexx( EnvName ) ;

   if (Interpreting==0)
      drop_ipret = Interpreting = 1 ;

   for (cnt=0; cnt<ArgCount; cnt++)
   {
      ParLengths[cnt] = ArgList[cnt].strlength ;
      ParStrings[cnt] = ArgList[cnt].strptr ;
      if (ParStrings[cnt]==NULL)
         ParLengths[cnt] = RX_NO_STRING ;
   }

   Handlers = malloc( sizeof( struct ExitHandlers )) ;
   Handlers->prev = CurrentHandlers ;
   CurrentHandlers = Handlers ;
   for (cnt=0; cnt<RXNOOFEXITS; cnt++)
      CurrentHandlers->Handlers[cnt] = NULL ;

   ExitFlags = 0x00000000 ;
   for (cnt=0; Exits && Exits->sysexit_code!=RXENDLST; Exits++ )
   {
      EnvPtr = FindExit( Exits->sysexit_name ) ;
      if (!EnvPtr)
         continue ;

      /* Sigh ... Definition requires some strange casting */
      handler = (RexxExitHandler*)(EnvPtr->u.EntryPnt) ;
      switch (Exits->sysexit_code)
      {
          case RXSIO:
             ExitFlags |= (1<<RX_EXIT_STDOUT) | (1<<RX_EXIT_STDERR) |
                          (1<<RX_EXIT_TRCIN) | (1<<RX_EXIT_PULL) ;
             CurrentHandlers->Handlers[RXSIO] = handler ;
             break ;

          case RXINI:
             ExitFlags |= (1<<RX_EXIT_INIT) ;
             CurrentHandlers->Handlers[RXINI] = handler ;
             break ;
  
          case RXTER:
             ExitFlags |= (1<<RX_EXIT_TERMIN) ;
             CurrentHandlers->Handlers[RXTER] = handler ;
             break ;

          default:
             assert( 0 ) ;
      }
   }

  

   if (EnvName)
   {
      EnvNamLen = strlen(EnvName) ;
      EnvNamStr = EnvName ;
   }
   else
   {
      EnvNamLen = RX_NO_STRING ;
      EnvNamStr = NULL ;
   }

   WherePtr = NULL ;
   WhereLen = 0 ;
   if (Instore && Instore[1].strptr)
   {
      WhereCode = RX_TYPE_INSTORE ;
      WherePtr = Instore[1].strptr ;
      WhereLen = sizeof(int) ;
   }
   else if (Instore && Instore[0].strptr)
   {
      WhereCode = RX_TYPE_SOURCE ;
      WherePtr = Instore[0].strptr ;
      WhereLen = Instore[0].strlength ;
   }
   else if (Instore)
      WhereCode = RX_TYPE_MACRO ;
   else
      WhereCode = RX_TYPE_EXTERNAL ;

   rc = IfcExecScript( strlen(ProgramName), ProgramName, 
	  ArgCount, ParLengths, ParStrings, MAP_TYPE(CallType),
	  ExitFlags, EnvNamLen, EnvNamStr,
		  WhereCode, WherePtr, WhereLen, &RLength, &RString ) ;

   Handlers = CurrentHandlers ;
   CurrentHandlers = Handlers->prev ;
   free( Handlers ) ;

   if (RLength!=RX_NO_STRING)
      ResValue = atoi( RString ) ;
   else
      ResValue = 0 ;

   if (ReturnCode)
      *ReturnCode = ResValue ;


   if (Result)
   {
      if (!Result->strptr || Result->strlength>=RLength+1)
      {
         Result->strlength = RLength ;
         Result->strptr = RString ;
      }
      else
      {
         Result->strlength = RLength ;
         memcpy( Result->strptr, RString, RLength+1 ) ;
         free( RString ) ;
      }
   }

   if (drop_ipret)
      Interpreting = 0 ;

   return rc ;
}



/* ============================================================= */
/* subcom handler subsystem */

ULONG RexxRegisterSubcomExe( 
   PSZ EnvName,
   PFN EntryPoint,
   PUCHAR UserArea )
{
   /* 
    * Perform sanity check on the parameters; UserArea may be NULL 
    */
   if (!EnvName || !EntryPoint)
      return RXSUBCOM_BADTYPE ;

   if (FindEnvir( EnvName ))
      return RXSUBCOM_NOTREG ;

   if (!AddEnvir( EnvName, UserArea, EntryPoint ))
      return RXSUBCOM_NOEMEM ;

   return RXSUBCOM_OK ;      
}


ULONG RexxRegisterSubcomDll(
   PSZ EnvName,
   PSZ ModuleName,
   PFN EntryPoint,
   PUCHAR UserArea,
   ULONG DropAuth ) 
{
   /* not yet functional */
   return RXSUBCOM_NOTREG ;
}


ULONG RexxQuerySubcom(
   PSZ EnvName,
   PSZ ModuleName,
/* PUSHORT Flag, */   /* Who knows what this is used for ... */
   PUCHAR UserWord )
{
   int ret ;
   struct EnvBox *eptr ;

   if (!EnvName)
      return RXSUBCOM_BADTYPE ;

   if (ModuleName)
      return RXSUBCOM_BADTYPE ;   /* not yet functional */

   eptr = FindEnvir( EnvName ) ;
   if (eptr)
   {
      ret = RXSUBCOM_OK ;
      if (UserWord)
         memcpy( UserWord, eptr->UserData, 8 ) ;
   }
   else
      ret = RXSUBCOM_NOTREG ;

   return ret ;
}
   
ULONG RexxDeregisterSubcom( 
   PSZ EnvName,
   PSZ ModuleName )
{
   if (!EnvName)
      return RXSUBCOM_BADTYPE ;

   if (ModuleName)
      return RXSUBCOM_BADTYPE ;  /* not yet functional */

   if (RemoveEnvir( EnvName ))
      return RXSUBCOM_NOTREG ;

   return RXSUBCOM_OK ;
}



/* ============================================================ */
/* Variable subsystem */


ULONG RexxVariablePool( 
   PSHVBLOCK RequestBlockList )
{
   int Code, RetCode ;
   int Lengths[2] ;
   int rc ;
   char *Strings[2] ;
   PSHVBLOCK Req=RequestBlockList ;

   RetCode = 0 ;
   if (Interpreting==0)
      return RXSHV_NOAVL ;

   /* Probably unneeded, but it won't do any harm */
   if (!InitFlag)
      StartupRexx( "none" ) ;

   for (;Req;Req=Req->shvnext)
   {
      switch (Req->shvcode)
      {
         case RXSHV_SYDRO:
         case RXSHV_SYSET:
         {
            Lengths[0] = Req->shvname.strlength ;
            Strings[0] = Req->shvname.strptr ;
            if (Req->shvcode==RXSHV_SYSET)
            {
               Lengths[1] = Req->shvvalue.strlength ;
               Strings[1] = Req->shvvalue.strptr ;
            }
            else
               Lengths[1] = RX_NO_STRING ;

            Code = IfcVarPool( RX_SETSVAR, Lengths, Strings ) ;

            Req->shvret = RXSHV_OK ;
            if (Code==RX_CODE_NOVALUE)
               Req->shvret |= RXSHV_NEWV ;
            else if (Code==RX_CODE_INVNAME)
               Req->shvret |= RXSHV_BADN ;
            else if (Code!=RXSHV_OK)
               assert( 0 ) ;
            break ;
         }
         case RXSHV_SYFET:
         {
            Lengths[0] = Req->shvname.strlength ;
            Strings[0] = Req->shvname.strptr ;
            Code = IfcVarPool( RX_GETSVAR, Lengths, Strings ) ;

            Req->shvret = RXSHV_OK ;
            if (Code==RX_CODE_NOVALUE)
               Req->shvret |= RXSHV_NEWV ;
            else if (Code==RX_CODE_INVNAME)
               Req->shvret |= RXSHV_BADN ;
            else if (Code!=RXSHV_OK)
               assert( 0 ) ;

            FillReqValue( Req, Lengths[1], Strings[1] ) ;
            break ;
         }

         case RXSHV_PRIV:
         {
            Req->shvret = RXSHV_OK ;
            if (Req->shvname.strlength==4 && Req->shvname.strptr &&
                !strncmp(Req->shvname.strptr, "PARM", 4 ))
            {
	       rc = IfcVarPool( RX_CODE_PARAMS, Lengths, Strings ) ;
               FillReqValue( Req, Lengths[0], Strings[0] ) ;
            }

            else if (Req->shvname.strlength>=5 && Req->shvname.strptr &&
                !strncmp(Req->shvname.strptr, "PARM.", 5 ))
            {
               Lengths[0] = Req->shvname.strlength - 5 ;
               Strings[0] = Req->shvname.strptr + 5 ;
               
               rc = IfcVarPool( RX_CODE_PARAM, Lengths, Strings ) ;
               if (rc == RX_CODE_OK)
                  FillReqValue( Req, Lengths[1], Strings[1] ) ;
               else
                  Req->shvret |= RXSHV_BADN ;
            }

            else 
            {
               int Code ;
               if (Req->shvname.strptr)
               {
                  if (Req->shvname.strlength==7 &&
                         !memcmp(Req->shvname.strptr, "QUENAME", 7))
                  {
                     Code = RX_CODE_QUEUE ;
                  }
                  else if (Req->shvname.strlength==7 &&
                         !memcmp(Req->shvname.strptr, "VERSION", 7))
                  {
                     Code = RX_CODE_VERSION ;
                  }
                  else if (Req->shvname.strlength==6 &&
                         !memcmp(Req->shvname.strptr, "SOURCE", 6))
                  {
                     Code = RX_CODE_SOURCE ;
                  }
                  else
                     Req->shvret |= RXSHV_BADN ;

                  if (!Req->shvret | RXSHV_BADN)
                  {
                     rc=IfcVarPool(Code, Lengths, Strings ) ;
                     FillReqValue( Req, Lengths[0], Strings[0] ) ;
                  }
               }
               else
                  Req->shvret |= RXSHV_BADN ;
            }
            break ;
         }
     
         case RXSHV_NEXTV:
         {
            int Items ;

            Req->shvret = RXSHV_OK ;
            Items = IfcVarPool( RX_NEXTVAR, Lengths, Strings ) ;	    
            assert( Items==0 || Items==2 ) ;

            if (Items==2)
            {
               FillReqValue( Req, Lengths[1], Strings[1] ) ;
               FillReqName( Req, Lengths[0], Strings[0] ) ;
            }
            else
               Req->shvret |= RXSHV_LVAR ;

            break ;
         }

         default:
            Req->shvret = RXSHV_BADF ;
      }

      RetCode |= ( Req->shvret & 0x007f ) ;
   }

   return RetCode ;
}



/* ================================================================ */
/* system exit handler subsystem */

ULONG RexxRegisterExitExe( 
   PSZ EnvName,
   PFN EntryPoint, 
   PUCHAR UserArea )
{
   int EnvLen ;
   /* 
    * Perform sanity check on the parameters; UserArea may be NULL 
    */
   if (!EnvName || !EntryPoint)
      return RXEXIT_BADTYPE ;

   EnvLen = strlen( EnvName ) ;
   if (EnvLen>MAXENVNAMELEN)
      return RXEXIT_NOTREG ;

   if (FindExit( EnvName))
      return RXEXIT_NOTREG ;

   if (!AddExit( EnvName, UserArea, EntryPoint ))
      return RXEXIT_NOEMEM ;

   return RXEXIT_OK ;      
}


int RexxDeregisterExit( 
   PSZ EnvName,
   PSZ ModuleName )
{
   if (!EnvName)
      return RXEXIT_BADTYPE ;

   if (ModuleName)
      return RXEXIT_BADTYPE ;

   if (RemoveExit(EnvName)) 
      return RXEXIT_NOTREG ;

   return RXEXIT_OK ;
}


/* ================================================================= */
/* What is this .... ? */

   
void DosFreeMem( void *ptr ) 
{
/*
   SendNumber( RX_DROP_INSTORE ) ;
   SendNumber( *((int*)(ptr)) ) ;
   WaitForNumber() ;
 */
}


/* =================================================================== */

/*
 * This section contains the support for the external functions 
 */

struct funcbox {
   struct funcbox *next, *prev ;
   PSZ name ;
   RexxFunctionHandler *entry ;
} *firstfunc=NULL ;

static struct funcbox *findfunc( char *name )
{
   struct funcbox *fptr ;

   for (fptr=firstfunc; fptr; fptr=fptr->prev) 
      if (!strcmp(name, fptr->name))
         return fptr ;

   return NULL ;
}

static int delfunc( char *name )
{
   struct funcbox *old ;
  
   old = findfunc( name ) ;
   if (!old)
      return RXFUNC_NOTREG ;

   free( old->name ) ;
   if (old==firstfunc)
      firstfunc = old->prev ;
   else 
      old->next->prev = old->prev ;

   if (old->prev)
      old->prev->next = old->next ;

   free( old ) ;
   return RXFUNC_OK ;
}

static int addfunc( PSZ name, RexxFunctionHandler *EntryPoint ) 
{
   struct funcbox *new ;

   if (findfunc( name ))
      return RXFUNC_DEFINED ;

   new = malloc( sizeof(struct funcbox )) ;
   if (!new)
      return RXFUNC_NOMEM ;

   new->name = malloc( strlen( name )+1 ) ;
   if (!new->name)
   {
      free( new ) ;
      return RXFUNC_NOMEM ;
   }

   strcpy( new->name, name ) ;
   new->entry = EntryPoint ;

   new->next = NULL ;
   new->prev = firstfunc ;
   if (firstfunc)
      firstfunc->next = new ;
   firstfunc = new ;

   return RXFUNC_OK ;
}

ULONG RexxRegisterFunctionExe( PSZ Name, PFN EntryPoint )
{
   int code ;

   code = addfunc( Name, (RexxFunctionHandler*)EntryPoint ) ;
   if (code)
      return code ;

   if (!InitFlag)
      StartupRexx( "none" ) ;

   code = IfcRegFunc( Name ) ;
   assert( code==RX_CODE_OK ) ;

   return RXFUNC_OK ;
}

ULONG RexxQueryFunction( PSZ Name )
{
   return (findfunc(Name)) ? RXFUNC_OK : RXFUNC_NOTREG ;
}


ULONG RexxDeregisterFunction( PSZ Name ) 
{
   int code ;

   if (!InitFlag)
      StartupRexx( "none" ) ;

   code = IfcDelFunc( Name ) ;
   assert( code==RX_CODE_OK ) ;

   return delfunc( Name ) ;
}


int IfcExecFunc( PSZ Name, int Params, int *Lengths, char *Strings[],
		 int *RetLength, char **RetString, int *RC )
{
   static char foo='x' ;
   struct funcbox *fptr ;
   int i, length ;
   static char *killme=NULL ;
   RXSTRING *params ;
   RXSTRING retstr ;
   char retdata[256] ;

   assert( Name ) ;
   assert( Params >= 0 ) ;

   if (killme)
   {
      free( killme ) ;
      killme = NULL ;
   }

   params = malloc( sizeof(RXSTRING)*Params ) ;
   for (i=0; i<Params; i++)
   {
      length = Lengths[i] ;
      if (length==RX_NO_STRING)
      {
         params[i].strptr = NULL ;
         params[i].strlength = 0 ;
      }
      else if (length==0)
      {
         params[i].strptr = &foo ;
         params[i].strlength = 0 ;
      }
      else
      {
         assert( length>0 ) ;
         params[i].strptr = Strings[i] ;
         params[i].strlength = length ;
      }
   }

   if (!(fptr=findfunc( Name )))
      return RX_CODE_NOSUCH ;

   retstr.strptr = retdata ;
   retstr.strlength = 256 ;
   *RC = (*(fptr->entry))( Name, Params, params, "default", &retstr ) ;

/* for (i=0; i<Params; i++)
      if (params[i].strptr && params[i].strlength)
         free( params[i].strptr ) ;
*/
   free( params ) ;

   if (!(*RC) && retstr.strptr)
   {
      *RetLength = retstr.strlength ;
      *RetString = retstr.strptr ;
   }
   else
      *RetLength = RX_NO_STRING ;
							
   if (retstr.strptr && retstr.strptr != retdata)
      killme = retstr.strptr ;

   return RX_CODE_OK ;
}
