/************************************************************************/
/* $Id: //tools/src/freeware/gsstest/rtlink.c#5 $
 ************************************************************************
 *
 * Copyright (c) 1998-2000  SAP AG.  All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 *
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer. 
 *
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in
 *    the documentation and/or other materials provided with the
 *    distribution.
 *
 * 3. All advertising materials mentioning features or use of this
 *    software must display the following acknowledgment:
 *    "This product includes software developed by SAP AG"
 *
 * 4. The name "SAP AG" must not be used to endorse or promote products
 *    derived from this software without prior written permission.
 *    For written permission, please contact www.press@sap.com
 *
 * 5. Redistributions of any form whatsoever must retain the following
 *    acknowledgment:
 *    "This product includes software developed by SAP AG"
 *
 * THIS SOFTWARE IS PROVIDED BY SAP AG ``AS IS'' AND ANY EXPRESSED
 * OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 * PURPOSE ARE DISCLAIMED. SAP AG SHALL BE LIABLE FOR ANY DAMAGES
 * ARISING OUT OF THE USE OF THIS SOFTWARE ONLY IF CAUSED BY SAP AG'S
 * INTENT OR GROSS NEGLIGENCE. IN CASE SAP AG IS LIABLE UNDER THIS
 * AGREEMENT FOR DAMAGES CAUSED BY SAP AG'S GROSS NEGLIGENCE SAP AG
 * FURTHER SHALL NOT BE LIABLE FOR ANY INDIRECT, INCIDENTAL, SPECIAL,
 * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
 * OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 * OR TORT, AND SHALL NOT BE LIABLE IN EXCESS OF THE AMOUNT OF
 * DAMAGES TYPICALLY FORESEEABLE FOR SAP AG, WHICH SHALL IN NO EVENT
 * EXCEED US$ 500.000.- 
 *
 ************************************************************************/


#include "common.h"
#include <errno.h>
#include "debug.h"
#include "rtlink.h"
#include "non_ansi.h"
#include <ctype.h>

#define LIBNAME_MAX    255

#define RTL_MAXLIBS   (9 + 1)


/* MACRO to suppress "function parameter not used" compiler warnings */
#ifndef USE
#  define USE(a)   (a) = (a);
#endif


#ifdef RTLINK_APPLE_MAC

#  include <CodeFragments.h>
#  include <Gestalt.h>
#  include <OSUtils.h>
#  include <Traps.h>

   typedef struct UPPADMSTRUCT
   {
	RoutineDescriptor	*theUPP;
	struct UPPADMSTRUCT	*next;
   }	UPPADM;

#endif



struct rtl_shlib_s {
   char * libname;
   char * real_libname;
#if defined(RTLINK_APPLE_MAC)
   union {
      UPPADM	     * uppadm;
      void	     * ptr;
      size_t	       val;
   } handle;
   CFragConnectionID   connid;  /* Connection ID of CodeFragment */
#else
   union {
      void    * ptr;
      size_t	val;
   } handle;
#endif
};

#define ptr_handle     handle.ptr
#define val_handle     handle.val
#define ptr_uppadm     handle.uppadm

static struct rtl_shlib_s    rtl_shlib_adm[RTL_MAXLIBS];



#if defined(RTLINK_UNIX_DLOPEN)

   /******************************************************************/
   /*								     */
   /*	modern UNIX:    dlopen() / dlclose() / dlsym()		     */
   /*								     */
   /******************************************************************/

#  include <dlfcn.h>

#  define PLATFORM_SPECIFIC_DLOPEN(shlib)    unix_dlopen(shlib)
#  define PLATFORM_SPECIFIC_DLCLOSE(shlib)   unix_dlclose(shlib)
#  define PLATFORM_SPECIFIC_DLSYM(shlib, fname, attr, ptr)	  \
					     unix_dlsym(shlib, fname, ptr)
#ifndef DLOPEN_FLAGS
#  define DLOPEN_FLAGS (RTLD_NOW)
#endif

static int
unix_dlopen( struct rtl_shlib_s * shlib )
{
   void * ldrc;
   DEBUG_BEGIN(unix_dlopen)

   ldrc = dlopen( shlib->libname, DLOPEN_FLAGS );
   if ( ldrc==NULL ) {
      XDBG((D_ERR, "dlopen(\"%s\") FAILED:\n  \"%s\"\n",
		   shlib->libname, dlerror() ))
      return(RTLERR_LOAD_FAILED);
   }

   shlib->ptr_handle = ldrc;

   return(RTL_OK);

} /* unix_dlopen() */

/* ----- */

static int
unix_dlclose( struct rtl_shlib_s * shlib )
{
   void   * ldrc    = shlib->ptr_handle;
   DEBUG_BEGIN(unix_dlclose)

   if ( dlclose( ldrc )!= 0 ) {
      XDBG((D_ERR, "dlclose(\"%s\") FAILED:\n  \"%s\"\n",
		   shlib->libname, dlerror() ))
      return(RTLERR_UNLOAD_FAILED);
   }

   return(RTL_OK);

} /* unix_dlclose() */

/* ----- */

static int
unix_dlsym( struct rtl_shlib_s * shlib,
	    char * funcname, RTL_FUNC_ADR * pp_fptr )
{
   void  * ldrc = shlib->ptr_handle;
   DEBUG_BEGIN(unix_dlsym)

   *pp_fptr = (RTL_FUNC_ADR) dlsym(ldrc, funcname);
   if ( *pp_fptr == 0 ) {
      XDBG((D_INFO, "dlsym(\"%s\") failed:\n  \"%s\"\n",
		    funcname, dlerror() ))
      return(RTLERR_SYMBOL_FAILED);
   }

   return(RTL_OK);

} /* unix_dlsym() */


#elif defined(RTLINK_AIX_LOAD)

   /******************************************************************/
   /*								     */
   /*	AIX non-standard:    load(), unload(), nlist()		     */
   /*								     */
   /*   should work for AIX 3.2.5 and AIX 4.1.x			     */
   /*   in AIX 4.2 there is dlopen(), Wow!			     */
   /******************************************************************/

   /* This is so horribly stupid! */
   /* the calls are defined    int (*load)();          */
   /* and                      int unload( void * );   */

typedef int         (AIX_FUNC)();
typedef AIX_FUNC   * AIX_FUNC_PTR;

#include <nlist.h>

    
#  define PLATFORM_SPECIFIC_DLOPEN(shlib)    aix_load(shlib)
#  define PLATFORM_SPECIFIC_DLCLOSE(shlib)   aix_unload(shlib)
#  define PLATFORM_SPECIFIC_DLSYM(shlib, fname, attr, ptr)	  \
					     aix_nlist(shlib, fname, ptr)
static int
aix_load( struct rtl_shlib_s * shlib )
{
   AIX_FUNC_PTR ldrc;
   DEBUG_BEGIN(aix_load)

   ldrc = load( shlib->libname, 0, (char *) 0 );
   if ( ldrc==0 ) {
      XDBG((D_ERR, "load(\"%s\") FAILED:\n  \"%s\"\n",
		   shlib->libname, strerror(errno) ))
      return(RTLERR_LOAD_FAILED);
   }

   shlib->ptr_handle = (void *) ldrc;

   return(RTL_OK);

} /* aix_load() */

/* ----- */

static int
aix_unload( struct rtl_shlib_s * shlib )
{
   void  * ldrc;
   DEBUG_BEGIN(aix_unload)

   ldrc = (void *) shlib->ptr_handle;
   if ( unload( ldrc )!= 0 ) {
      XDBG((D_ERR, "unload(\"%s\") FAILED:\n  \"%s\"\n",
		   shlib->libname, strerror(errno) ))
      return(RTLERR_UNLOAD_FAILED);
   }

   return(RTL_OK);

} /* aix_unload() */

/* ----- */

/* AWWWW!  this looks so bogus and slow ... */
static int
aix_nlist( struct rtl_shlib_s * shlib,
	   char * funcname, RTL_FUNC_ADR * pp_fptr )
{
   struct nlist  nl[2];
   int           status;
   DEBUG_BEGIN(aix_nlist)


   nl[0]._n._n_name  = funcname;
   nl[0].n_value     = 0;
   nl[1]._n._n_name  = (char *)0;

   status = nlist( shlib->libname, nl );
   if ( status!=0  ||  nl[0].n_value == 0 ) {
      XDBG((D_INFO, "nlist(\"%s\") failed:\n  \"%s\"\n",
		    funcname, dlerror() ))
      return(RTLERR_SYMBOL_FAILED);
   }

   *pp_fptr = (RTL_FUNC_ADR) ( ((char *)shlib->ptr_handle) + nl[0].n_value );
   
   return(RTL_OK);

} /* aix_nlist() */


#elif defined(RTLINK_HPUX_SHLOAD)

   /******************************************************************/
   /*								     */
   /*	HP-UX non-standard:    shl_load(), shl_unload(),	     */
   /*			       shl_findsym()			     */
   /*								     */
   /*   should work for HP-UX 9.x an 10.x			     */
   /******************************************************************/

#include <dl.h>

#  define PLATFORM_SPECIFIC_DLOPEN(shlib)    hpux_shl_load(shlib)
#  define PLATFORM_SPECIFIC_DLCLOSE(shlib)   hpux_shl_unload(shlib)
#  define PLATFORM_SPECIFIC_DLSYM(shlib, fname, attr, ptr)	  \
				       hpux_shl_findsym(shlib, fname, ptr)

static int
hpux_shl_load( struct rtl_shlib_s * shlib )
{
   shl_t  ldrc;
   int    flags = (BIND_IMMEDIATE|BIND_VERBOSE);
   DEBUG_BEGIN(hpux_shl_load)

   /* Workaround for serious bug in HP-UX 11.0 32-bit DYNAMIC_PATH which */
   /* makes SHLIB_PATH directories override absolute library filenames */
   if ( (shlib->libname)[0]!='/' )
      flags |= DYNAMIC_PATH;

   ldrc = shl_load( shlib->libname, flags, 0L );
   if ( ldrc==0 ) {
      XDBG((D_ERR, "shl_load(\"%s\") FAILED:\n  \"%s\"\n",
		   shlib->libname, strerror(errno) ))
      return(RTLERR_LOAD_FAILED);
   }

   shlib->ptr_handle = (void *) ldrc;

   return(RTL_OK);

} /* hpux_shl_load() */

/* ----- */

static int
hpux_shl_unload( struct rtl_shlib_s * shlib )
{
   shl_t   ldrc    = shlib->ptr_handle;
   DEBUG_BEGIN(hpux_shl_unload)

   if ( shl_unload( ldrc )!= 0 ) {
      XDBG((D_ERR, "shl_unload(\"%s\") FAILED:\n  \"%s\"\n",
		   shlib->libname, strerror(errno) ))
      return(RTLERR_UNLOAD_FAILED);
   }

   return(RTL_OK);

} /* hpux_shl_unload() */

/* ----- */

static int
hpux_shl_findsym( struct rtl_shlib_s * shlib,
		  char * funcname, RTL_FUNC_ADR * pp_fptr )
{
   shl_t   ldrc  = shlib->ptr_handle;
   void  * adr;
   DEBUG_BEGIN(hpux_shl_findsym)

   if ( shl_findsym( &ldrc, funcname, TYPE_PROCEDURE, &adr) != 0 ) {
      XDBG((D_INFO, "shl_findsym(\"%s\") failed:\n  \"%s\"\n",
		    funcname, strerror(errno) ))
      return(RTLERR_SYMBOL_FAILED);
   }

   *pp_fptr = (RTL_FUNC_ADR) adr;

   return(RTL_OK);

} /* hpux_shl_findsym() */


#elif defined(RTLINK_WINDOWS_LOADLIBRARY)

   /*******************************************************************/
   /*								      */
   /*	Microsoft Windows:    LoadLibrary(), FreeLibrary(),	      */
   /*			      GetProcAddress()			      */
   /*								      */
   /*  should work for 16-bit (Windows 3.1 and up) and 32-bit (Win32) */
   /*******************************************************************/

#  undef FAR
#  undef WINAPI
#  include <windows.h>

#  define PLATFORM_SPECIFIC_DLOPEN(shlib)    windows_loadlib(shlib)
#  define PLATFORM_SPECIFIC_DLCLOSE(shlib)   windows_freelib(shlib)
#  define PLATFORM_SPECIFIC_DLSYM(shlib, fname, attr, ptr)	  \
					windows_getproc(shlib, fname, ptr)

static void
windows_err( DWORD p_lasterr,  char * p_buf,  size_t p_buflen )
{
   DWORD    rval;
   char   * errmsg = NULL;
   char   * s;
   char     tmpmsg[128];
   Uint      i;
   DEBUG_BEGIN(windows_err)

   p_buf[0] = '\0';
   if ( p_buflen<5 )
      return;

   rval     = FormatMessage( FORMAT_MESSAGE_ALLOCATE_BUFFER
			     | FORMAT_MESSAGE_FROM_SYSTEM,
			     NULL, (DWORD) p_lasterr,
			     MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
			     (LPTSTR) &errmsg, 0, NULL );
   if ( rval==0 ) {

      sprintf(tmpmsg, "FormatMessage() failed for lasterr = 0x%08lx",
		      (unsigned long)p_lasterr);
      strncpy(p_buf, tmpmsg, p_buflen-1);
      p_buf[p_buflen-1] = '\0';

   } else {

      /* remove the stupid linebreaks from the messsage */
      for( i=0, s=errmsg ; *s!='\0' && i<(p_buflen-1) ; s++ ) {
	 if ( *s=='\r' ) { continue; }
	 if ( *s=='\n' ) {
	    p_buf[i++] = ' ';
	 } else {
	    p_buf[i++] = *s;
	 }
      }
      p_buf[i]= '\0';

      while( i>0 && p_buf[i-1]==' ' ) { i--; p_buf[i]='\0'; }

   }

   if ( errmsg!=NULL ) {
      LocalFree( (LPVOID) errmsg );
      errmsg = NULL;
   }

   return;

} /* windows_err() */

/* ---- */

static int
windows_loadlib( struct rtl_shlib_s * shlib )
{
   HINSTANCE   hInst;
   DWORD       lasterr;
   DWORD       len;
   char        tmpbuf[1024];
   char      * ptr = NULL;
   DEBUG_BEGIN(windows_loadlib)


   hInst = LoadLibrary( shlib->libname );
   if ( hInst==(HINSTANCE)0 ) {
      lasterr = GetLastError();
      windows_err( lasterr, tmpbuf, sizeof(tmpbuf)-1 );
      XDBG((D_ERR, "LoadLibrary(\"%s\") FAILED:\n"
		   "  (0x%08lx) = \"%s\"\n",
		   shlib->libname, (long)lasterr, tmpbuf ))
      return(RTLERR_LOAD_FAILED);
   }

   /******************************************************/
   /* Update the filename information for the loaded DLL */
   /* relative paths, PATH searching, and omitting the   */
   /* filename extension may still load successfully.    */
   /*                                                    */
   /* Try to find out which DLL was actually loaded and  */
   /* update the filename into our struct rtl_shlib_s    */
   /******************************************************/
   len = GetModuleFileName( (HMODULE)hInst, tmpbuf, sizeof(tmpbuf)-1 );
   if ( len>0 && len<LIBNAME_MAX ) {
      tmpbuf[len] = '\0';
      ptr = malloc( len + 1 );
      if ( ptr!=NULL ) {
	 memcpy( ptr, tmpbuf, len+1);
	 shlib->real_libname = ptr;
	 ptr = NULL;
      }
   }

   shlib->val_handle = (size_t)hInst;

   return(RTL_OK);

} /* windows_loadlib() */

/* ----- */

static int
windows_freelib( struct rtl_shlib_s * shlib )
{
   HINSTANCE   hInst;
   DWORD       lasterr;
   char        tmpbuf[256];
   DEBUG_BEGIN(windows_freelib)

   hInst = (HINSTANCE) shlib->val_handle;
   if ( FreeLibrary( hInst )==0 ) {
      lasterr = GetLastError();
      windows_err( lasterr, tmpbuf, sizeof(tmpbuf)-1 );
      XDBG((D_ERR, "FreeLibrary(\"%s\") FAILED:\n"
		   "  (0x%08lx) = \"%s\"\n",
		   shlib->libname, (long)lasterr, tmpbuf ))
      return(RTLERR_LOAD_FAILED);
   }

   return(RTL_OK);

} /* windows_freelib() */

/* ----- */

static int
windows_getproc( struct rtl_shlib_s * shlib,
		 char * funcname, RTL_FUNC_ADR  * fptr )
{
   HINSTANCE   hInst;
   DWORD       lasterr;
   char        tmpbuf[256];
   DEBUG_BEGIN(windows_getproc)

   hInst = (HINSTANCE) shlib->val_handle;
   *fptr = (RTL_FUNC_ADR) GetProcAddress( hInst, funcname );
   if ( *fptr == 0 ) {
      lasterr = GetLastError();
      windows_err( lasterr, tmpbuf, sizeof(tmpbuf)-1 );
      XDBG((D_INFO, "GetProcAddress(\"%.128s\") failed:\n"
		    "  (0x%08lx) = \"%s\"\n",
		    shlib->libname, (long)lasterr, tmpbuf ))
      return(RTLERR_SYMBOL_FAILED);
   }

   return(RTL_OK);

} /* windows_getproc() */


#elif defined(RTLINK_APPLE_MAC)

   /*******************************************************************/
   /*								      */
   /*	Apple MacIntosh						      */
   /*	using Code Fragment Manager 				      */
   /*								      */
   /*								      */
   /*								      */
   /*******************************************************************/

#  define PLATFORM_SPECIFIC_DLOPEN(shlib)   mac_loadlib(shlib)
#  define PLATFORM_SPECIFIC_DLCLOSE(shlib)  mac_unloadlib(shlib)
#  define PLATFORM_SPECIFIC_DLSYM(shlib,fname, attr, ptr) \
					    mac_loadfunc(shlib,fname,attr,ptr)



#define sysEnvironsVersion  1           /* Version of Sysenvirons           */


/******************************************************************************
 * CtoPString()
 *
 *	converts a null-terimnated string into a pascal string.
 *	returns true if all chars of srcString fitted in destString.
 ******************************************************************************/
static Boolean
CtoPString( const char  * srcString, Str255 destString )
{
   register short	i;
   Str255		saveString;
	
   for (i = 0; (i < 256 && srcString[i] != 0); i++) {
      saveString[i + 1] = srcString[i];
   }

   saveString[0] = i;

   BlockMove(saveString, destString, saveString[0] + 1L );

   return (srcString[i] == 0);

} /* CtoPString() */


/******************************************************************************
 * TrapInstalled
 *
 *	Check whether a certain trap exists on this machine. For pre-Mac II
 *	machines, trap numbers only go up to 0x1FF.
 ******************************************************************************/
static Boolean
TrapInstalled( short theTrap )
{
   TrapType tType;
   short    numToolBoxTraps;
	
	 /* first determine the trap type		*/
				
   tType = (theTrap & 0x800) > 0 ? ToolTrap : OSTrap;
	
	 /* next find out how many traps there are	*/
				
   if (NGetTrapAddress( _InitGraf, ToolTrap) == NGetTrapAddress( 0xAA6E, ToolTrap)) {
      numToolBoxTraps = 0x200;
   } else {
      numToolBoxTraps = 0x400;
   }

	 /* check if the trap number is too big for the	*/
	 /* current trap table				*/
				
   if (tType == ToolTrap)
   {
      theTrap &= 0x7FF;
      if (theTrap >= numToolBoxTraps) {
	 theTrap = _Unimplemented;
      }
   }
	
	 /* the trap is implemented if its address is	*/
	 /* different from the unimplemented trap	*/
				
   return ( NGetTrapAddress( theTrap, tType)
	    != NGetTrapAddress(_Unimplemented, ToolTrap) );

} /* TrapInstalled() */


/******************************************************************************
 * GestaltIsPresent
 *
 *	Check whether Gestalt is present
 ******************************************************************************/

static Boolean
GestaltIsPresent(void)
{
   SysEnvRec	theWorld;		       /* System environment	*/
	
   SysEnvirons(sysEnvironsVersion, &theWorld); /* Check environment	*/

   if (theWorld.machineType<0) {
      return(false);
   } else {
      return(TrapInstalled(_Gestalt));
   }

} /* GestaltIsPresent() */


/******************************************************************************
 * CFMIsPresent
 *
 *	Check whether the Code Fragment Manager is present
 ******************************************************************************/
static Boolean
CFMIsPresent( void )
{
   if (GestaltIsPresent()) {
      long	response;
		
      return ((Gestalt(gestaltCFMAttr, &response) == noErr) &&
			(((response >> gestaltCFMPresent) & 1) != 0));
   }

   return false;

} /* CFMIsPresent() */


/* ----- */


static int
mac_loadlib( struct rtl_shlib_s  * shlib )
{
   OSErr		err;
   CFragConnectionID	connID;
   Ptr			libAddr;
   Str255		pLibName;
   Str255		errName;
   DEBUG_BEGIN(mac_loadlib)

   if ( !CFMIsPresent() ) {
      XDBG((D_ERR, "mac_loadlib(): Code Fragment Manager not present!\n"));
      return(RTLERR_LOAD_FAILED);
   }

   CtoPString(shlib->libname, pLibName);
   err = GetSharedLibrary( pLibName,

#  ifdef RTLINK_APPLE_MAC_68K
			   kMotorola68KCFragArch,
#  else
			   kPowerPCCFragArch,
#  endif
			   kPrivateCFragCopy,
			   &connID,
			   &libAddr,
			   errName );

   if ( err!=noErr ) {
      XDBG((D_ERR, "mac_loadlib(): GetSharedLibrary(%.150s) failed (%d)\n",
		   shlib->libname, (int) err ));
      return(RTLERR_LOAD_FAILED);
   }

   shlib->ptr_uppadm = NULL;
   shlib->connid     = connID;

   return(RTL_OK);

} /* mac_loadlib */

/* ----- */

static int
mac_unloadlib( struct rtl_shlib_s * shlib )
{
   OSErr      err;
   UPPADM   * uppadm;
   UPPADM   * next;
   int        connid;
   DEBUG_BEGIN(mac_unloadlib)

   if ( !CFMIsPresent() ) {
      XDBG((D_ERR, "mac_unloadlib(): Code Fragment Manager not present!\n"));
      return(RTLERR_UNLOAD_FAILED);
   }

   connid = (int)shlib->connid;
   err = CloseConnection( &(shlib->connid) );
   if ( err!=noErr ) {
      XDBG((D_ERR, "mac_unloadlib(): CloseConnection(%d) failed (%d)!\n",
		   (int)connid, (int) err));
      return(RTLERR_UNLOAD_FAILED);
   }

   for( uppadm = shlib->ptr_uppadm ; uppadm!=NULL ; uppadm = next ) {
      next = uppadm->next;
      DisposePtr( (Ptr) uppadm->theUPP );
      free( uppadm );
   }

   return(RTL_OK);

} /* mac_unloadlib() */

/* ----- */

static int
mac_loadfunc( struct rtl_shlib_s * shlib, char * funcname,
	      Uint32 attributes,  RTL_FUNC_ADR * fptr )
{
   OSErr	       err;
   Str255	       pFuncName;
   Ptr		       funcAddr  = 0;
   CFragSymbolClass    funcClass = 0;
   DEBUG_BEGIN(mac_loadfunc)

   if ( !CFMIsPresent() ) {
      XDBG((D_ERR, "mac_loadlib(): Code Fragment Manager not present!\n"));
      return(RTLERR_SYMBOL_FAILED);
   }

   CtoPString( funcname, pFuncName );
   err = FindSymbol( shlib->connid, pFuncName, &funcAddr, &funcClass );
   if ( err!=noErr ) {
      XDBG((V_INFO, "mac_loadlib(): FindSymbol(\"%.150s\") failed (%d)!\n",
		   funcname, (int) err ));
      return(RTLERR_SYMBOL_FAILED);
   }


#  ifdef  RTLINK_APPLE_MAC_68K

   if ( funcAddr==0 ) {

      XDBG((V_ERR, "mac_loadlib(): Strange FindSymbol(\"%.150s\") behaviour!\n",
		   funcname ));
      return(RTLERR_SYMBOL_FAILED);

   } else {

      RoutineDescriptor     funcDesc = BUILD_ROUTINE_DESCRIPTOR(0,0);
      RoutineDescriptor   * funcUPP  = NULL;
      UPPADM		  * uppadm   = NULL;

      funcDesc.routineRecords[0].procDescriptor = (ProcPtr) funcAddr;
      funcDesc.routineRecords[0].procInfo       = flags;
      funcDesc.routineRecords[0].ISA            = (kM68kISA | kCFM68kRTA);

      funcUPP = (RoutineDesciptor *) NewPtr( sizeof(RoutineDescriptor) );

      if (funcUPP!=0) {
	 *funcUPP = funcDesc;  /* copy the whole structure */

	 /* create new UPP control structure */
	 uppadm = malloc( sizeof(UPPADM) );

	 if ( uppadm==NULL ) {
	    DisposePtr( (Ptr) funcUPP );
	    XDBG((D_ERR, "mac_loadfunc(): malloc(%lu) failed!\n",
	          (unsigned long) sizeof(UPPADM) ));
	    return(RTLERR_OUT_OF_MEMORY);
	 }

	 /* chain it into the shlib control block */
	 uppadm->theUPP	   = funcUPP;
	 uppadm->next	   = shlib->ptr_uppadm;
	 shlib->ptr_uppadm = uppadm;

	 /* return the function pointer (function entry point) */
	 (*fptr)           = (RTL_FUNC_ADR) funcUPP;

      } else {

	 XDBG((D_ERR, "mac_loadfunc(): NewPtr(%lu) failed!\n",
		      (unsigned long) sizeof(RoutineDescriptor) ));
	 return(RTLERR_OUT_OF_MEMORY);

      }

   }

#  else /* MacIntosh on PowerPC */

   (*fptr) = (RTL_FUNC_ADR) funcAddr;

#  endif /* MacIntosh on PowerPC */

   return(RTL_OK);

} /* mac_loadfunc() */


#elif defined(RTLINK_OS390)

   /*******************************************************************/
   /*								      */
   /*	 IBM OS/390 Open Edition (Posix)			      */
   /*								      */
   /*								      */
   /*								      */
   /*******************************************************************/

#  include <dll.h>
#  ifdef _ENHANCED_ASCII_EXT
#    include <_Nascii.h>
#  endif

#  define PLATFORM_SPECIFIC_DLOPEN(shlib)	os390_dllload(shlib)
#  define PLATFORM_SPECIFIC_DLCLOSE(shlib)	os390_dllfree(shlib)
#  define PLATFORM_SPECIFIC_DLSYM(shlib,fname, attr, ptr)      \
						os390_dllqueryfn(shlib, fname, ptr)
static int
os390_dllload( struct rtl_shlib_s * shlib )
{
   dllhandle * ldrc;
   int         xerrno;
   DEBUG_BEGIN(os390_dllload)

   ldrc   = dllload( shlib->libname );
   xerrno = errno;
#if defined(ENHANCED_ASCII_EXT) && defined(__AE_EBCDIC_MODE )
   /* NASCII:  errno==NOEXEC  maybe system is entirely confused */
   /* about filetags and codepages.                             */
   /* extremely dirty hack: switch operating mode and retry ... */ 
   if ( ldrc==NULL && errno==ENOEXEC ) {
	__ae_thread_setmode( __AE_EBCDIC_MODE );  /* switch to EBCDIC */
	ldrc = dllload( shlib->libname );
	__ae_thread_setmode( __AE_ASCII_MODE );   /* switch back to NASCII */
	xerrno = errno;
   }
#endif
   if ( ldrc==NULL ) {
      XDBG((D_ERR, "dllload(\"%s\") FAILED:\n  \"%s\"\n",
		   shlib->libname, strerror(xerrno) ))
      return(RTLERR_LOAD_FAILED);
   }

   shlib->ptr_handle = (void *)ldrc;

   return(RTL_OK);

} /* os390_dllload() */

/* ----- */

static int
os390_dllfree( struct rtl_shlib_s * shlib )
{
   dllhandle * ldrc = (dllhandle *) (shlib->ptr_handle);
   DEBUG_BEGIN(os390_dllfree)

   if ( dllfree( ldrc )!=0 ) {
      XDBG((D_ERR, "dllfree(\"%s\") FAILED:\n  \"%s\"\n",
		   shlib->libname, strerror(errno) ))
      return(RTLERR_UNLOAD_FAILED);
   }

   return(RTL_OK);

} /* os390_dllfree() */

/* ----- */

static int
os390_dllqueryfn( struct rtl_shlib_s * shlib,
		  char * funcname,  RTL_FUNC_ADR * pp_fptr )
{
   dllhandle * ldrc = (dllhandle *) (shlib->ptr_handle);
   DEBUG_BEGIN(os390_dllqueryfn)

   *pp_fptr = (RTL_FUNC_ADR) dllqueryfn( ldrc, funcname );
   if ( *pp_fptr == 0 ) {
      XDBG((D_INFO, "dllqueryfn(\"%s\") failed:\n  \"%s\"\n",
		    funcname, strerror(errno) ))
      return(RTLERR_SYMBOL_FAILED);
   }

   return(RTL_OK);

} /* os390_dllqueryfn() */


#elif defined(RTLINK_OS400)

   /*******************************************************************/
   /*								                                  */
   /*	 IBM OS/400 ( iSeries )                     			      */
   /*								                                  */
   /*								                                  */
   /*								                                  */
   /*******************************************************************/

#include <mih/rslvsp.h> /* for rslvsp     */
#include <qleawi.h>     /* for QleGetExp  */
#include <except.h>
#include <unistd.h>
#include <sys/stat.h>
#include <pointer.h>
#include <qmhrtvm.h>


#  define PLATFORM_SPECIFIC_DLOPEN(shlib)	os400_loadlib(shlib)
#  define PLATFORM_SPECIFIC_DLCLOSE(shlib)	os400_unloadlib(shlib)
#  define PLATFORM_SPECIFIC_DLSYM(shlib,fname, attr, ptr)      \
						os400_loadfunc(shlib, fname, ptr)

#define MY_PATH_MAX	    1024
#define MAX_SYMLINK_DEPTH   50
#define MAX_LEN_LIB_MEMBER  10
#define MAX_LEN_LIB_NAME    10


#define MYERR_OK	   0
#define MYERR_BAD_ARGS    -1
#define MYERR_NO_MEM      -2
#define MYERR_ERRNO       -3
#define MYERR_PROCESSING  -4
#define MYERR_NOT_FOUND   -5


/*
 * merge_path()
 *
 */
static int
merge_path( char * p_path, size_t p_path_max, char * p_file )
{
    char      cwd[MY_PATH_MAX];
    char    * src = p_file;
    char    * nsrc;
    char    * ptr;
    size_t    plen;  /* current length of p_path */
    size_t    nlen;  /* length of new path element */
    int       rc;

    if ( p_file==NULL || p_path==0 )
	return(MYERR_BAD_ARGS);

    if ( *p_file == '/' ) {
	/* supplied p_file is an absolute pathname, replace p_path altogether */
	p_file++;
	if ( p_path_max<2 )
	    return(MYERR_NO_MEM);
	strcpy(p_path, "/");

    } else {

	if ( *p_path=='\0' ) {
	    /* empty p_path was supplied -- look up current directory */
	    ptr = getcwd(cwd, sizeof(cwd)-1);
	    if ( ptr==NULL )
		return(MYERR_ERRNO);
	    cwd[sizeof(cwd)-1] = 0;
	    plen = strlen(cwd);
	    if ( plen >= p_path_max )
		return(MYERR_NO_MEM);
	    strncpy(p_path, cwd, p_path_max);
	}
    }

    plen = strlen(p_path);
    while ( plen>1 && p_path[plen-1]=='/' ) {
	plen--;
	p_path[plen] = '\0';
    }
    
    for ( src=p_file ; (nsrc=strchr(src, '/'))!=NULL ; src = nsrc+1 ) {
	if ( nsrc-src==1 && 0==strncmp(src, "./", 2) ) {

	    continue;

	} else if ( nsrc-src==2 && 0==strncmp(src, "../", 3) ) {
	    ptr = strrchr(p_path, '/');
	    if (ptr!=NULL && ptr!=p_path) {
		/* chop off last directory */
		*ptr = '\0';
		plen = ptr - p_path;
	    }
	} else {
	    nlen = nsrc - src;
	    if ( plen + 1 + nlen + 1 >p_path_max ) /* old-len + '/' + add-len + '\0' */
		return(-1);
	    plen += sprintf( &(p_path[plen]), "%s%.*s",
		             (plen>1) ? "/" : "",
		             (int) nlen, src );
	}
    }

    nlen = strlen(src);
    if ( plen + 1 + nlen + 1 >p_path_max ) /* old-len + '/' + add-len + '\0' */
	return(MYERR_NO_MEM);

    plen += sprintf( &(p_path[plen]), "%s%.*s",
    	             (plen>1) ? "/" : "",
	             (int) nlen, src );

    return(MYERR_OK);

} /* merge_path() */



/*
 * resolve_ifs_link()
 *
 */
static int
resolve_ifs_link( char * p_namein, char *p_nameout, size_t p_nameout_max )
{
    char            curname[MY_PATH_MAX];
    char            lnkname[MY_PATH_MAX];
    char          * next;
    char          * ptr;
    unsigned char   uc;
    struct  stat    stb;
    int             rc;
    int             i;
    int             lcount;

    if ( p_nameout_max==0 )
	return(MYERR_BAD_ARGS);

    (*p_nameout) = '\0';

    curname[0] = '\0';
    
    for ( next=p_namein,lcount=0 ; lcount<MAX_SYMLINK_DEPTH ; lcount++ ) {
	rc = merge_path(curname, sizeof(curname), next );
	if ( rc!=0 )
	    return(rc);

	rc = lstat( curname, &stb );
	if ( rc!=0 )
	    return(MYERR_ERRNO);
    
	if ( S_ISNATIVE(stb.st_mode) ) {
	    /* Finished -- we found a link into QSYS.LIB ... */
	    if ( strlen(curname) >= p_nameout_max )
		return(MYERR_NO_MEM);
	    /* convert Filename into all-uppercase */
	    for ( i=0 ; i<p_nameout_max ; i++ ) {
		uc = (unsigned char)curname[i];
		p_nameout[i] = (islower(uc)) ? (char)toupper(uc) : (char)uc;
	    }
	    p_nameout[i] = '\0';
	    return(MYERR_OK);
	}

	if ( S_ISLNK(stb.st_mode) ) {
	    rc = readlink( curname, lnkname, sizeof(lnkname)-1 );
	    if ( rc<=0 )
		return(MYERR_ERRNO);
	    lnkname[rc] = 0;
	    next = lnkname;
	    /* chop filename off the end of curname, leave only path */
	    ptr  = strrchr(curname, '/');
	    if ( ptr==NULL ) {
		/* shouldn't happen here, but for completeness */
		curname[0] = '\0';
	    } else {
		if ( ptr>curname ) {
		    *ptr = '\0';
		}
	    }
	} else {
	    break;
	}
    }

    return(MYERR_PROCESSING);

} /* resolve_ifs_link() */



/*
 * find_srvpgm()
 *
 */
static int
find_srvpgm( char * p_fname, char pp_libname[MAX_LEN_LIB_NAME+1], char pp_objname[MAX_LEN_LIB_MEMBER+1] )
{
    char           fullname[MY_PATH_MAX];
    char         * libstart;
    char         * objstart;
    char         * ptr;
    size_t         len;
    struct stat    stb;
    int            rc;

    memset( pp_libname, 0, sizeof(pp_libname));
    memset( pp_objname, 0, sizeof(pp_objname));

    rc = stat( p_fname, &stb );
    if ( rc!=0 ) {
	return(MYERR_ERRNO);
    } else {
	if ( S_ISNATIVE(stb.st_mode)
	     && 0==strncmp( stb.st_objtype, "*SRVPGM", 7) ) {
	    /* this file does in fact refer to a OS/400 shared library */
	    /* aka "Service Program" (type *SRVPGM)                    */
	    /* therefore lets try to translate the IFS filename into   */
	    /* the native library / object by chasing down the full    */
	    /* filename of the file (expanding symlinks) which will be */
	    /* something like "/QSYS/<libname>.LIB/<objname>.SRVPGM"   */
	    rc = resolve_ifs_link(p_fname, fullname, sizeof(fullname));
	    if ( rc==MYERR_OK ) {
		if ( 0==strncmp(fullname, "/QSYS.LIB/", 10) ) {
		    libstart = &(fullname[10]);
		    objstart = strchr(libstart, '/');
		    if ( objstart!=NULL ) {
			len = objstart - libstart;
			ptr = memchr(libstart, '.', len);
			if ( ptr==NULL || 0!=strncmp(ptr,".LIB", 4) )
			    return(MYERR_PROCESSING);
			len = ptr - libstart;
			strncpy(pp_libname, libstart, MAX_LEN_LIB_NAME);
			if (len<MAX_LEN_LIB_NAME+1)
			    memset( &(pp_libname[len]), 0, (MAX_LEN_LIB_NAME+1)-len);

			objstart++;
			ptr = strchr(objstart, '.');
			if (ptr==NULL || 0!=strncmp(ptr,".SRVPGM", 7) )
			    return(MYERR_PROCESSING);
			len = ptr - objstart;
			strncpy(pp_objname, objstart, MAX_LEN_LIB_MEMBER);
			if (len<MAX_LEN_LIB_MEMBER+1)
			    memset( &(pp_objname[len]), 0, (MAX_LEN_LIB_MEMBER+1)-len);

			return(MYERR_OK);
		    }
		}
	    }
	}
    }

    return(MYERR_NOT_FOUND);

} /* find_srvpgm() */


static char   os400_msgbuf[1024];
static char * default_prefix  = "    ==> \"";
static char * default_postfix = "\"\n";

static char * 
translate_sysmessage( char p_sysmsg[7], char * p_prefix, char * p_postfix )
{
    Qmh_Rtvm_RTVM0100_t  * rtvm0100;
    char		 * msg       = NULL;
    char		 * msg_end   = NULL;
    size_t		   msg_len;
    size_t		   len;
    size_t		   restlen;
    Qus_EC_t	           ErrorCode;

    DEBUG_BEGIN(translate_sysmessage)

    memset( &ErrorCode, 0, sizeof(ErrorCode) );
    ErrorCode.Bytes_Provided = sizeof(ErrorCode);

    rtvm0100 = (Qmh_Rtvm_RTVM0100_t *) &(os400_msgbuf[0]);
    memset( rtvm0100, 0, sizeof(*rtvm0100) );
    rtvm0100->Bytes_Available	       = sizeof(os400_msgbuf)-1;
    rtvm0100->Bytes_Return	       = 0;

    os400_msgbuf[0] =  '\0';

    if ( p_sysmsg[0]!='\0' ) {

	QMHRTVM(  rtvm0100,
		  rtvm0100->Bytes_Available,
		  "RTVM0100",
		  p_sysmsg,
		  "QCPFMSG   *LIBL     ", /* "                    " MAY WORK ?! */
		  "",
		  0,
		  "*YES      ",
		  "*NO       ",
		 &ErrorCode );

	if ( ErrorCode.Bytes_Available==0 ) {
	    ((char *)rtvm0100)[rtvm0100->Bytes_Return] = '\0';

	    msg      = (char *)rtvm0100 + sizeof(*rtvm0100);
	    msg_end  = msg + rtvm0100->Length_Message_Returned;
	    *msg_end = '\0';
	    msg_len  = msg_end - msg;

	    os400_msgbuf[sizeof(os400_msgbuf)-1] = 0;

	} else {
	    /* OUCH -- QMHRTVM() failed! */
	    XDBG((D_ERR, "QMHRTVM() failed, MessageID = %.7s\n",
			 ErrorCode.Exception_Id ));
	    sprintf(os400_msgbuf, "Lookup QMHRTVM(MessageID %.7s) failed with MessageID %.7s!\n",
		    p_sysmsg, ErrorCode.Exception_Id);
	    msg     = os400_msgbuf;
	    msg_len = strlen(msg);
	}

	len = (p_prefix==0) ? 0 : strlen(p_prefix);
	restlen = msg_len + len;
	if (restlen >= sizeof(os400_msgbuf) )
	    msg_len = sizeof(os400_msgbuf)-len-1;

	if ( msg_len>0 )
	    memmove( &(os400_msgbuf[len]), msg, msg_len );

	if ( len>0 )
	    strncpy( os400_msgbuf, p_prefix, len );

	len = (p_postfix==NULL) ? 0 : strlen(p_postfix);
	if (len>0 && len + restlen < sizeof(os400_msgbuf) )
	    strcpy( &(os400_msgbuf[restlen]), p_postfix );
	os400_msgbuf[restlen+len] = '\0';
	os400_msgbuf[sizeof(os400_msgbuf)-1] = '\0';

    }

    return(os400_msgbuf);

} /* translate_sysmessage() */



/*
 * os400_loadlib()
 *
 */
static int
os400_loadlib( struct rtl_shlib_s * shlib )
{
	    char		  * asterisk;
	    char		  * dot;
	    char		  * sep;
	    char		  * psrvpgm;
	    char		  * plib;
	    char		  * sysmsg;
	    char		  * syscall = "?";
	    unsigned char           uc;
    static  _INTRPT_Hndlr_Parms_T   ca;
	    Qus_EC_t		    ErrorCode;
	    _SYSPTR		    sysP;
	    int			    i;
	    int			    len;
	    int			    ActivationMark = 0;
	    int			    rc;
	    char		    namecpy[MY_PATH_MAX];
	    char		    srvpgm[MAX_LEN_LIB_MEMBER+1];
	    char		    lib[MAX_LEN_LIB_NAME+1];

    DEBUG_BEGIN(os400_loadlib)

    memset( &ErrorCode, 0, sizeof(ErrorCode) );
    memset( &ca, 0, sizeof ( ca ) );
    ErrorCode.Bytes_Provided = sizeof(ErrorCode);

    /* copy supplied input name into namecpy and convert to all-uppercase */
    len = strlen(shlib->libname);
    for ( i=0 ; i<len ; i++ ) {
	uc = (unsigned char)shlib->libname[i];
	namecpy[i] = (char)((islower(uc)) ? toupper(uc) : uc );
    }
    namecpy[len] = 0;

    /* default LIB is "*LIBL", which means to search current library list */
    psrvpgm = namecpy;
    plib    = "*LIBL";

    dot      = strrchr(namecpy,'.');
    asterisk = strrchr(namecpy,'*');

    if ( asterisk==NULL
	 && ( namecpy[0]=='/'
	      || namecpy[0]=='.'
	      || (dot!=NULL && 0==strcmp(dot, ".DLL"))
	      || (dot!=NULL && 0==strcmp(dot, ".SRVPGM")) ) ) {

	rc = find_srvpgm( namecpy, lib, srvpgm );
	if ( rc!=MYERR_OK ) {
	    if ( rc==MYERR_ERRNO ) {
		XDBG((D_ERR, "Error accessing file \"%.255s\": %s\n",
			     namecpy, strerror(errno) ))
	    } else {
		XDBG((D_ERR, "Error (%d) resolving filename \"%.255s\"\n",
			     rc, namecpy))
	    }
	    	 
	    return(RTLERR_LOAD_FAILED);
	}

    } else {

	sep = strchr( namecpy, '/' );
	if ( NULL!=sep ) {
	    /* explicit library provided as "LIBNAME/PROGNAME" */
	    *sep    = '\0';
	    plib    = namecpy;
	    psrvpgm = sep+1;
	}

	asterisk = strchr( psrvpgm, '*' );
	if ( NULL!=asterisk && strcmp(asterisk,"*SRVPGM")==0 ) {
	    *asterisk = 0;
	}

	strncpy( lib, plib, MAX_LEN_LIB_MEMBER );
	lib[MAX_LEN_LIB_NAME] = 0;

	strncpy( srvpgm, psrvpgm, MAX_LEN_LIB_MEMBER );
	srvpgm[MAX_LEN_LIB_MEMBER] = 0;
    }
    		
    /* Install Exception Handler */
	
    syscall = "rslvsp";

    #pragma exception_handler (EXCP_HND, ca, 0, _C2_MH_ESCAPE | _C2_MH_FUNCTION_CHECK, _CTLA_HANDLE)
				
    /* Resolve System Object ( Serviceprogram ) -- this may cause an Exception */

    sysP = rslvsp ( WLI_SRVPGM, srvpgm, lib, _AUTH_EXECUTE );
		
    /* Call the QleActBndPgm API to activate the service program */
	
    syscall = "QleActBndPgm";
    QleActBndPgm ( &sysP, 
                   &ActivationMark, 
                    NULL, 
                    (int *)0, 
                   &ErrorCode );
		
    if ( ErrorCode.Bytes_Available > 0 ) {
	sysmsg = translate_sysmessage( ErrorCode.Exception_Id, default_prefix, default_postfix );
        XDBG((D_ERR, "QleActBndPgm (srvpgm=\"%s\", lib=\"%s\") FAILED: %s\n%s",
		     srvpgm, lib, ErrorCode.Exception_Id, sysmsg ))
        return(RTLERR_LOAD_FAILED);
    }

    shlib->val_handle = (size_t)ActivationMark;

EXCP_HND:
    #pragma disable_handler
		
    if ( ca.Msg_Id [0] != 0 ) {
	sysmsg = translate_sysmessage( ca.Msg_Id, default_prefix, default_postfix );
        XDBG((D_ERR, "%s(srvpgm=\"%s\", lib=\"%s\")\n    caught machine exception %.7s\n%s",
		     syscall, srvpgm, lib, ca.Msg_Id, sysmsg ))
        return(RTLERR_LOAD_FAILED);
    }

    return(RTL_OK);

} /* os400_loadlib() */



/*
 * os400_unloadlib()
 *
 */
static int
os400_unloadlib( struct rtl_shlib_s * shlib )
{
    DEBUG_BEGIN(os400_unloadlib)

    /* NOT IMPLEMENTED/AVAILABLE on iSeries */
    XDBG((D_INFO, "os400_unloadlib() is a NOOP on OS/400 iSeries ...\n"))

    return(RTL_OK);

} /* os400_unloadlib() */ 



/*
 * os400_loadfunc()
 *
 */
static int
os400_loadfunc( struct rtl_shlib_s * shlib,
		char * funcname,  RTL_FUNC_ADR * pp_fptr )
{
	    void      * __ptr128    _export	    = 0;
	    Qus_EC_t		    ErrorCode;
    static  _INTRPT_Hndlr_Parms_T   ca;
            char		  * sysmsg;
	    int			    exportType	    = 0;
	    int			    export_id	    = 0;
	    int			    export_name_len = 0;
	    int			    ActivationMark;
    
    DEBUG_BEGIN(os400_loadfunc)

    memset ( &ca, 0, sizeof ( ca ) );
    ErrorCode.Bytes_Provided = sizeof(Qus_EC_t);

    #pragma exception_handler (EXCP_HND, ca, 0, _C2_MH_ESCAPE | _C2_MH_FUNCTION_CHECK, _CTLA_HANDLE)

    ActivationMark =  (int)shlib->val_handle;


    _export = QleGetExp( &ActivationMark,
			 &export_id,
			 &export_name_len,
			  funcname,
			  (void * __ptr128 * __ptr128)(&_export),
			 &exportType,
			 &ErrorCode );
	
    if ( ErrorCode.Bytes_Available > 0 ) {
	sysmsg = translate_sysmessage( ErrorCode.Exception_Id, default_prefix, default_postfix );
        XDBG((D_ERR, "QleGetExp(\"%.255s\") FAILED: %s\n%s",
		     funcname, ErrorCode.Exception_Id, sysmsg ))
        return(RTLERR_SYMBOL_FAILED);
    }

    if ( _export==0 ||
	 ( exportType!=QLE_EX_PROC && exportType!=QLE_EX_DATA ) ) { 
	char  * msg = "\n    Reason unknown";

	if ( exportType == QLE_EX_NOT_FOUND ) {
            msg = "\n    Symbol/Export not found";
        } else if ( exportType == QLE_EX_NO_ACCESS ) {
            msg = "\n    Symbol/Export is not accessible";
	}
	XDBG((D_INFO, "QleGetExp(\"%.255s\") FAILED%s\n",
		     funcname, msg ))
	return(RTLERR_SYMBOL_FAILED);
    }

EXCP_HND:
    #pragma disable_handler

    if ( ca.Msg_Id [0] != 0 )
    {
	sysmsg = translate_sysmessage( ca.Msg_Id, default_prefix, default_postfix );
	XDBG((D_ERR, "QleGetExp(\"%.255s\")\n    caught machine exception %.7s\n%s",
		     funcname, ca.Msg_Id, sysmsg ))
        return(RTLERR_SYMBOL_FAILED);
    }
	
    *pp_fptr = (RTL_FUNC_ADR) _export;

    return(RTL_OK);

} /* os400_loadfunc() */


#elif defined(RTLINK_OS2)

   /*******************************************************************/
   /*								      */
   /*	 x86-PC running OS/2	  				      */
   /*								      */
   /*	 INCOMPLETE and UNTESTED				      */
   /*								      */
   /*******************************************************************/

#  define INCL_DOS
#  define INCL_DOSERRORS
#  include <os2.h>

#  define PLATFORM_SPECIFIC_DLOPEN(shlib)	os2_loadlib(shlib)
#  define PLATFORM_SPECIFIC_DLCLOSE(shlib)	os2_unloadlib(shlib)
#  define PLATFORM_SPECIFIC_DLSYM(shlib,fname,attr,ptr)	 \
						os2_funcname(shlib, fname, ptr)

static int
os2_loadlib( struct rtl_shlib_s * shlib )
{
   APIRET   rc;
   HMODULE  hmod;

   rc = DosQueryModuleHandle( shlib->libname, &hmod );
   if ( rc==ERROR_MOD_NOT_FOUND ) {
      /* DLL not found in Memory, so try to load it */

      rc = DosLoadModule( NULL, 0L, shlib->libname, &hmod );
      if ( rc!=0 ) {
	 /* FAILURE: the DLL wasn't found or couldn't be loaded! */
	 /* MISSING: how do I read out the error code on OS/2 ?? */
	 return(RTLERROR_LOAD_FAILED);
      }
      /* success, the DLL was loaded */
      shlib->ptr_handle = (void *) hmod;

   }

   return(RTL_OK);

}/* os2_loadlib() */


static int
os2_unloadlib( struct rtl_shlib_s * shlib )
{
   APIRET   rc;
   HMODULE  hmod;

   hmod = (HMODULE) (shlib->ptr_handle);
   rc = DosFreeModule( hmod );
   if ( rc!=0 ) {
      /* FAILURE during unloading of DLL */
      /* MISSING: how do I read out the error code on OS/2 ?? */
      return(RTLERR_UNLOAD);
   }

   return(RTL_OK);

} /* os2_unloadlib() */


static int
os2_funcname( struct rtl_shlib_s * shlib, char * funcname, RTL_FUNC_ADR * fptr )
{
   APIRET    rc;
   HMODULE   hmod;

   hmod = (HMODULE) (shlib->ptr_handle);

   rc = DosQueryProcAddr( hmod, 0L, (PSZ)funcname, (PFN *)fptr );
   if ( rc!=0 ) {
      /* FAILURE: resolving of address for funcname "funcname" failed! */
      *fptr = (RTL_FUNC_ADR *) 0;
      return(RTLERR_SYMBOL_FAILED);
   }

   return(RTL_OK);

} /* os2_funcname() */


#else

#  error  Implementation for RUNTIME LOADING of shared libaries missing!!

#endif




/*
 * rtl_load_library()
 */
int
rtl_load_library( char * p_libname,  RTL_HANDLE  * pp_handle )
{
   char     * ptr    = NULL;
   size_t     namelen;
   int        slot   = RTL_INVALID_HANDLE;
   int	      rc     = 0;
   DEBUG_BEGIN(rtl_load_library)


   XDBG((D_ARG, "\t\t&libname        = ptr:%p,\n"
		"\t\t&handle         = ptr:%p )\n",
		p_libname, pp_handle ))
   XDBG((D_STRING, "libname", p_libname ))

   if ( pp_handle==NULL )
      ERROR_RETURN_RC(RTLERR_INVALID_VALUE);

   (*pp_handle) = RTL_INVALID_HANDLE;

   if ( p_libname==NULL || p_libname[0]=='\0' )
      ERROR_RETURN_RC(RTLERR_INVALID_VALUE);

   /* determine length of filename for shared library */
   namelen = Strnlen(p_libname, (size_t)LIBNAME_MAX);
   if ( namelen>=(size_t)LIBNAME_MAX )
      ERROR_RETURN_RC(RTLERR_NAME_TOO_LONG);

   /* find empty slot in our table */
   for( slot=RTL_INVALID_HANDLE+1 ; slot<RTL_MAXLIBS ; slot++ ) {
      if ( rtl_shlib_adm[slot].libname==NULL ) { break; }
   }

   if ( slot>=RTL_MAXLIBS ) 
      ERROR_RETURN_RC(RTLERR_TABLE_FULL);

   /* clean slot entry ... safety */
   memset( &(rtl_shlib_adm[slot]), 0, sizeof(rtl_shlib_adm[0]) );

   /* allocate buffer for filename of shared library */
   ptr = (char *) malloc( namelen + 1 );
   if ( ptr==NULL )
      ERROR_RETURN_RC(RTLERR_OUT_OF_MEMORY);

   memcpy(ptr, p_libname, namelen);
   ptr[namelen]		       = '\0';
   rtl_shlib_adm[slot].libname = ptr;

   /* try to actually open&load the shared library now */
   rc = PLATFORM_SPECIFIC_DLOPEN( &(rtl_shlib_adm[slot]) );

   if ( rc==0 ) {

      /* success! */
      (*pp_handle) = (RTL_HANDLE)slot;

      XDBG((D_RET, "loading of slot #%u, (ptr_handle= %p)\n"
		   "\tshared library \"%.150s\" succeded\n",
		   (unsigned int)slot, rtl_shlib_adm[slot].ptr_handle, ptr))
   } else {

      /* failure of PLATFORM_SPECIFIC_DLOPEN() */
      (*pp_handle) = RTL_INVALID_HANDLE;

      rtl_shlib_adm[slot].libname    = NULL;
      rtl_shlib_adm[slot].ptr_handle = NULL;
error:
      if ( ptr!=NULL ) { free( ptr );   ptr = NULL; }
      if ( rtl_shlib_adm[slot].real_libname!=NULL ) {
	 free(rtl_shlib_adm[slot].real_libname);
	 rtl_shlib_adm[slot].real_libname = NULL;
      }

      XDBG((D_RET, "loading of shared\n"
		   "\tlibrary \"%.150s\" failed (%s)\n",
		   p_libname, rtl_error_name(rc) ))
   }

   return(rc);

} /* rtl_load_library() */




/*
 * rtl_library_name()
 *
 * On most platforms, a flat filename without path may work
 * without the file being present in the current directory.
 * In such cases it would really be interesting to know which
 * library was actually used.  Not all platforms allow to
 * retrieve this information -- M$ Windows does.
 */
int
rtl_library_name( RTL_HANDLE      p_handle,
		  char         ** pp_libname )
{
   int     rc = 0;
   DEBUG_BEGIN(rtl_library_name)


   XDBG((D_ARG, "\t\t handle         = ptr:%p,\n"
		"\t\t&libname        = ptr:%p )\n",
		p_handle, pp_libname ))

   if ( pp_libname==NULL )
      ERROR_RETURN_RC(RTLERR_INVALID_HANDLE);

   (*pp_libname) = 0;

   if ( p_handle<=RTL_INVALID_HANDLE  ||  p_handle>=RTL_MAXLIBS )
      ERROR_RETURN_RC(RTLERR_INVALID_HANDLE);

   if ( rtl_shlib_adm[p_handle].libname==NULL )
      ERROR_RETURN_RC(RTLERR_EMPTY_SLOT);

   if ( rtl_shlib_adm[p_handle].real_libname!=NULL ) {
      (*pp_libname) = rtl_shlib_adm[p_handle].real_libname;
   } else {
      (*pp_libname) = rtl_shlib_adm[p_handle].libname;
   }

error:
   return(rc);

} /* rtl_library_name() */



/*
 * rtl_unload_library()
 */
int
rtl_unload_library( RTL_HANDLE   * pp_handle )
{
   int     rc    = 0;
   int     slot;
   DEBUG_BEGIN(rtl_unload_library)


   XDBG((D_ARG, "\t\t&handle         = ptr:%p )\n", pp_handle ))

   if ( pp_handle==NULL
	||  (*pp_handle)<=RTL_INVALID_HANDLE  ||  (*pp_handle)>=RTL_MAXLIBS )
      ERROR_RETURN_RC(RTLERR_INVALID_HANDLE);

   slot = (*pp_handle);
   if ( rtl_shlib_adm[slot].libname==NULL )
      ERROR_RETURN_RC(RTLERR_EMPTY_SLOT);

   rc = PLATFORM_SPECIFIC_DLCLOSE( &(rtl_shlib_adm[slot]) );

   if ( rc==0 ) {

      XDBG((D_RET, "unloading of slot #%u, (ptr_handle= %p)\n"
		   "\tshared library \"%.150s\" succeded\n",
		   (unsigned int)slot, rtl_shlib_adm[slot].ptr_handle,
		   rtl_shlib_adm[slot].libname ))

      if ( rtl_shlib_adm[slot].libname!=NULL ) {
	 free( rtl_shlib_adm[slot].libname );
      }
      rtl_shlib_adm[slot].libname      = NULL;

      if ( rtl_shlib_adm[slot].real_libname!=NULL ) {
	 free( rtl_shlib_adm[slot].real_libname );
      }
      rtl_shlib_adm[slot].real_libname = NULL;

      rtl_shlib_adm[slot].ptr_handle   = NULL;

      (*pp_handle)                     = RTL_INVALID_HANDLE;

   } else {

      XDBG((D_RET, "unloading of shared\n"
		   "\t library \"%.150s\" failed (%s)\n",
		   rtl_shlib_adm[slot].libname, rtl_error_name(rc) ))
error:
      ; /* a label needs a statement -- at least an empty one */ 
   }

   return(rc);

} /* rtl_unload_library() */



/*
 * rtl_load_function()
 */
int
rtl_load_function( RTL_HANDLE     p_handle,       char	        * p_prefix,
		   char         * p_funcname,
	           Uint32         p_attributes,   RTL_FUNC_ADR  * pp_fptr )
{
   int     rc = 0;
   size_t  len;
   char    funcname[128];
   DEBUG_BEGIN(rtl_load_function)


   XDBG((D_ARG, "\t\t handle         = %d,\n"
	        "\t\t&prefix         = ptr:%p,\n"
		"\t\t&funcname       = ptr:%p,\n"
		"\t\t attributes     = %d,\n"
		"\t\t&funcptr        = ptr:%p )\n",
		(int)p_handle, p_prefix, p_funcname,
		(int)p_attributes, pp_fptr ))

   XDBG((D_STRING, "prefix",   p_prefix))
   XDBG((D_STRING, "funcname", p_funcname))

   if ( pp_fptr==NULL )
      ERROR_RETURN_RC(RTLERR_INVALID_HANDLE);

   (*pp_fptr) = (RTL_FUNC_ADR)0;

   if ( p_handle<=RTL_INVALID_HANDLE  ||  p_handle>=RTL_MAXLIBS )
      ERROR_RETURN_RC(RTLERR_INVALID_HANDLE);

   if ( rtl_shlib_adm[p_handle].libname==NULL )
      ERROR_RETURN_RC(RTLERR_EMPTY_SLOT);

   if ( p_funcname==NULL )
      ERROR_RETURN_RC(RTLERR_INVALID_VALUE);

   if ( Strmaxcpy(funcname, p_prefix, (sizeof(funcname)-1))==NULL )
      ERROR_RETURN_RC(RTLERR_INVALID_HANDLE);

   len = strlen(funcname);
   if ( Strmaxcpy(&funcname[len], p_funcname, (sizeof(funcname)-len))==NULL )
      ERROR_RETURN_RC(RTLERR_INVALID_VALUE);

   rc = PLATFORM_SPECIFIC_DLSYM( &(rtl_shlib_adm[p_handle]),
				 funcname, p_attributes, pp_fptr );

   if ( rc==0 ) {
      DEBUG_EXEC(int  len = (int)(28u - strlen(funcname));)
      DEBUG_EXEC(if (len<=0) { len=1; } )

      XDBG((D_RET, "of \"%s\"%.*s:= ptr:%p\n",
		   funcname, (int)len, "", (void *) *pp_fptr ))

   } else {

      XDBG((D_RET, "of \"%s\" FAILED\n"
		      "\tfor shared library \"%s\"\n",
		      funcname, rtl_shlib_adm[p_handle].libname ))
error:
      (*pp_fptr) = (RTL_FUNC_ADR)0;
   }

   return(rc);

} /* rtl_load_func() */



/*
 * rtl_error_name()
 */
char *
rtl_error_name( int p_rc )
{
   switch( p_rc ) {
      case RTL_OK:			return("RTL_OK");
      case RTLERR_LOAD_FAILED:		return("RTLERR_LOAD_FAILED");
      case RTLERR_UNLOAD_FAILED:	return("RTLERR_UNLOAD_FAILED");
      case RTLERR_SYMBOL_FAILED:	return("RTLERR_SYMBOL_FAILED");
      case RTLERR_TABLE_FULL:		return("RTLERR_TABLE_FULL");
      case RTLERR_INVALID_HANDLE:	return("RTLERR_INVALID_HANDLE");
      case RTLERR_INVALID_VALUE:	return("RTLERR_INVALID_VALUE");
      case RTLERR_NAME_TOO_LONG:	return("RTLERR_NAME_TOO_LONG");
      case RTLERR_OUT_OF_MEMORY:	return("RTLERR_OUT_OF_MEMORY");
      default:				break;
   }

   return("not an RTLERR value");

} /* rtl_error_name() */

