[OpenVMS, C] Example-C LIB$FIND_IMAGE_SYMBOL or dlopen/dlsym


PRODUCT:    HP C Version 7.2-022
            HP CRTL Version V8.3-01


OP/SYS:     OpenVMS IA64 Version 8.3-1H1


SOURCE:     Philippe Vouters
            Fontainebleau/France


HIGH QUALITY MOBILES+TABLETS:  http://android-land.fr


OVERVIEW:

This example shows how to use LIB$FIND_IMAGE_SYMBOL or dlopen/dlsym to 
dynamically solve function/procedure run-time addresses of function/procedure
residing inside shareable images. Also it shows how, with Compaq C, an 
unconstained array of functions returning longs can be declared (see vtable).
It also shows, combined with the /names=(shortened) option of the HP C compiler,
the dlsym C API name shortening ability.


*** CAUTION ***

This sample procedure has been tested using HP C Version 7.2-022, HP CRTL
Version V8.3-01 on OpenVMS IA64 Version 8.3-1H1. However, we cannot guarantee 
its effectiveness because of the possibility of error in transmitting or 
implementing it. It is meant to be used as a template for writing your own 
procedure, and may require modification for use on your system. 


PROCEDURE NOTES:

The procedure below builds B.EXE in the current directory, and the shareable
image A.EXE. The array of functions vtable is initialized with the sample
function FUNCTION_1 and the sample procedure PROCEDURE_1. These procedure and
function are later invoked by the routine sample_call_to_image_b in A's
shareable image. B.EXE is built with /DEBUG compiler and Linker's option. It
would be advised to run B and to do SHOW IMAGE under the debugger before and
after the call to LIB$FIND_IMAGE_SYMBOL. Then, still under the debugger, SET
BREAK FUNCTION_1 and trigger it with a GO. This will show that routines
residing in any image call be called.


PROCEDURE:

$!
$!        Copyright (C) 2010 by Philippe.Vouters@laposte.net
$!
$!    This program is free software: you can redistribute it and/or modify
$!    it under the terms of the GNU General Public License as published by the
$!    Free Software Foundation, either version 3 of the License, or
$!    any later version.
$!
$!    This program 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 General Public License for more details.
$!
$!    You should have received a copy of the GNU General Public License
$!    along with this program.  If not, see <http://www.gnu.org/licenses/>;.
$!
$! Optional DCL procedure parameter : "DEBUG"
$!
$ write_symbol_vectors : subroutine
$ start:
$ read/end=end_subroutine 'P1' line
$ if f$length(line) .eq. 0 then goto start
$ if f$locate("Module",line) .eq. 0 then goto start
$ write 'P2' "SYMBOL_VECTOR=(''line'=PROCEDURE)"
$ goto start
$ end_subroutine:
$ close 'P1'
$ endsubroutine
$!
$ write_transfer_vectors : subroutine
$ HT[0,7]=9
$ write 'P2' "''HT'.TITLE a_vector"
$ write 'P2' "''HT'.IDENT 'V1.0-00'"
$ write 'P2' ""
$ write 'P2' "''HT'.macro vector entry_point"
$ write 'P2' "''HT'.align quad"
$ write 'P2' "''HT'.transfer entry_point"
$ write 'P2' "''HT'.mask   entry_point"
$ write 'P2' "''HT'brw     entry_point+2"
$ write 'P2' "''HT'.endm vector"
$ write 'P2' ""
$ write 'P2' "''HT'.PSECT $$$vector,pic,exe,nowrt,rd,shr,lcl,quad"
$ write 'P2' ""
$ write 'P2' "vectors:"
$ start:
$ read/end=end_subroutine 'P1' line
$ if f$length(line) .eq. 0 then goto start
$ if f$locate("Module",line) .eq. 0 then goto start
$ write 'P2' "''HT'vector ''line'"
$ goto start
$ end_subroutine:
$ close 'P1'
$ endsubroutine
$!
$!
$! Start of DCL procedure
$!
$ inquire Answer "Use LIB$FIND_IMAGE_SYMBOL ? [Y/N]"
$ if Answer .eqs. "Y" then compilation_define = "/DEFINE=(FIND_IMAGE_SYMBOL)"
$!
$! Determine if we are running on a VAX or an ALPHA 
$!
$ IA64 = F$GETSYI("ARCH_TYPE") .Eq. 3
$ AXP = F$GETSYI("ARCH_TYPE") .Eq. 2
$ VAX = F$GETSYI("ARCH_TYPE") .Eq. 1
$!
$ create a.c
#include <stdio.h>

#if defined (__vax) || defined (FIND_IMAGE_SYMBOL)
#define A_very_long_routine_name_more_than_thirty_one_characters \
sample_call_to_image_b
#define INSIDE "sample_call_to_image_b"
#else
#define INSIDE "A_very_long_routine_name_more_than_thirty_one_characters"
#endif

long (*FUNCTION_1)();   /* Declare the (uninitialized) function */
void (*PROCEDURE_1)();  /* Declare the (uninitialized) procedure */

/* Called by IMAGE B during init to establish the function pointers */
void bind_functions (long (*vtable[])())        
{
    FUNCTION_1 = vtable[0];
    PROCEDURE_1 = (void (*)())vtable[1];
}

long A_very_long_routine_name_more_than_thirty_one_characters(void)
{
    printf ("Inside %s\n", INSIDE);
    PROCEDURE_1();
    return (*FUNCTION_1)();
}
$!
$! compile with Compaq C compiler on OpenVMS V7.2 Alpha
$ if AXP .or. IA64
$ then
$    cc/debug/noopt/names=(shortened)'compilation_define' a
$ else
$    cc/debug/noopt a
$ endif
$ library/create/object a.olb
$ library/insert a.olb a.obj
$ library/list=sys$scratch:temp.tmp/names a.olb
$ if AXP .or. IA64
$ then
$     open/write f a.opt
$ else
$     open/write a_vector.mar
$ endif
$ open/read fred sys$scratch:temp.tmp
$ cont:
$ read/end=end fred line
$ if f$locate("Module",line) .eq. f$length(line) then goto cont
$ if AXP .or. IA64
$ then
$     call write_symbol_vectors fred f
$ else
$     call write_transfer_vectors fred f
$ endif
$ end:
$! close fred
$ close f
$ delete/nolog/noconfirm sys$scratch:temp.tmp;*
$ delete/nolog/noconfirm a.obj;
$ if AXP .or. IA64
$ then
$! Linker's option file for alpha or ia64
$     link/share a.olb/library/include=(a),a.opt/options
$     delete/nolog/noconfirm a.opt;
$ endif
$ if VAX
$ then
$     macro a_vector
$     link/debug/share/exe=sys$share:a.exe/map/full -
                      a.olb/library/include=(a),-
                      a_vector.obj
$     delete/nolog/noconfim a_vector.*;
$ endif
$ delete/nolog/noconfirm a.olb;
$ create b.c
#include <stdlib.h>
#include <unistd.h>
#include <string.h>
#include <stdio.h>
#include <errno.h>
#ifdef FIND_IMAGE_SYMBOL
#include <descrip.h>
#include <lib$routines.h>
#else
#include <dlfcn.h>  /* to include the dlopen, dlsym, dlclose functions */
#endif

#define MAX_PATH 256
#define ShareableName "A"

long FUNCTION_1();
void PROCEDURE_1(); 

main()
{
    long ((*vtable[])()) = { FUNCTION_1,(long (*)())PROCEDURE_1 }; /* Build
table of function addresses */
    int status;
    void (*bind_functions)();
    long (*sample_call_to_image_b)();
#ifdef FIND_IMAGE_SYMBOL
    $DESCRIPTOR (IMAGE_A_NAME_DESC,ShareableName);
    $DESCRIPTOR (RTN_NAME_DESC,"bind_functions");
    $DESCRIPTOR (SECOND_RTN_NAME_DESC,"sample_call_to_image_b");
#else
    unsigned int *A_Handle;
#endif
/* 
** Do a LIB$FIND_IMAGE_SYMBOL to locate IMAGE A's "bind_functions" routine.
**
*/
#ifdef FIND_IMAGE_SYMBOL
    status = lib$find_image_symbol( &IMAGE_A_NAME_DESC, &RTN_NAME_DESC,
                            &bind_functions,NULL);
    status = lib$find_image_symbol( &IMAGE_A_NAME_DESC, &SECOND_RTN_NAME_DESC,
                            &sample_call_to_image_b,NULL);
#else
    if ((A_Handle = dlopen(ShareableName,0)) == NULL){
         printf ("dlopen error: %s\n",dlerror());
         exit(0);
    }
    if ((bind_functions = (void (*)())dlsym(A_Handle,
                                "bind_functions")) == NULL){
         printf ("dlsym error: %s\n",dlerror());
         exit(0);
    }
#ifdef __vax
    if ((sample_call_to_image_b = (long (*)())dlsym(A_Handle,
                                "sample_call_to_image_b")) == NULL){
         printf ("dlsym error: %s\n",dlerror());
         exit(0);
    }
#else
    if ((sample_call_to_image_b = (long (*)())dlsym(A_Handle,
           "A_very_long_routine_name_more_than_thirty_one_characters")) == NULL){
         printf ("dlsym error: %s\n",dlerror());
         exit(0);
    }
#endif
#endif

    bind_functions(vtable);          /* Pass the vector table to image A  */

    /* Call FUNCTION_1 in this image via a call to a routine in image A */ 
    status = sample_call_to_image_b();
}

void PROCEDURE_1() {
return;
}

long FUNCTION_1() {
return(1);
}
$ cc/debug/noopt'compilation_define' b
$ if "''P1'" .eqs "DEBUG" then linker_option="/DEBUG"
$ link b'linker_option'
$! create a logical which points to our shareable image
$ this_proc = f$env("PROCEDURE")
$ this_dev=f$parse(this_proc,,,"DEVICE")
$ this_dir=f$parse(this_proc,,,"DIRECTORY")
$ define/user A 'this_dev''this_dir'A.EXE
$! Check with the debugger the status condition of lib$find_image_symbol
$! set a breakpoint in FUNCTION_1 and verify that it has been called.
$! define DECC$TRACE 3
$ run b
$ exit


REFERENCE(S):

 OpenVMS RTL Library (LIB$) Manual (OpenVMS V6.1)