OpenCOBOL 1.1pre-rel
Data Structures | Defines | Functions | Variables
call.c File Reference
#include "config.h"
#include "defaults.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include <unistd.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <dlfcn.h>
#include "call.h"
#include "common.h"
#include "coblocal.h"
#include "fileio.h"
#include "system.def"
Include dependency graph for call.c:

Go to the source code of this file.

Data Structures

struct  struct_handle
struct  call_hash
struct  system_table

Defines

#define __USE_GNU   1
#define lt_dlopen(x)   dlopen(x, RTLD_LAZY | RTLD_GLOBAL)
#define lt_dlsym(x, y)   dlsym(x, y)
#define lt_dlclose(x)   dlclose(x)
#define lt_dlerror()   dlerror()
#define lt_dlhandle   void *
#define PATHSEPC   ':'
#define PATHSEPS   ":"
#define COB_MAX_COBCALL_PARMS   16
#define CALL_BUFF_SIZE   256
#define CALL_FILEBUFF_SIZE   2048
#define HASH_SIZE   131
#define COB_SYSTEM_GEN(x, y, z)   { x, (void *)z },

Functions

static void *COB_NOINLINE cob_strdup (const void *stptr)
static void cob_set_library_path (const char *path)
static void * cob_get_buff (const size_t buffsize)
static void cache_handle (lt_dlhandle libhandle)
static COB_INLINE size_t hash (const unsigned char *s)
static void insert (const char *name, void *func, void *cancel)
static void * lookup (const char *name)
const char * cob_resolve_error (void)
void cob_call_error (void)
void cob_set_cancel (const char *name, void *entry, void *cancel)
void * cob_resolve (const char *name)
void * cob_resolve_1 (const char *name)
void * cob_call_resolve (const cob_field *f)
void * cob_call_resolve_1 (const cob_field *f)
void cobcancel (const char *name)
void cob_field_cancel (const cob_field *f)
void cob_init_call (void)
int cobcall (const char *name, const int argc, void **argv)
int cobfunc (const char *name, const int argc, void **argv)
void * cobsavenv (struct cobjmp_buf *jbuf)
void * cobsavenv2 (struct cobjmp_buf *jbuf, const int jsize)
void coblongjmp (struct cobjmp_buf *jbuf)

Variables

static char ** resolve_path = NULL
static char * resolve_error = NULL
static char * resolve_error_buff = NULL
static lt_dlhandle mainhandle = NULL
static size_t name_convert = 0
static size_t resolve_size = 0
static size_t cobjmp_primed = 0
static void * call_buffer
static char * call_filename_buff
static char * call_entry_buff
static unsigned char * call_entry2_buff
static size_t call_lastsize
static struct struct_handlepre_handle = NULL
static struct call_hash ** call_table = NULL
static struct system_table system_tab []

Define Documentation

#define __USE_GNU   1

Definition at line 44 of file call.c.

#define CALL_BUFF_SIZE   256

Definition at line 100 of file call.c.

#define CALL_FILEBUFF_SIZE   2048

Definition at line 101 of file call.c.

#define COB_MAX_COBCALL_PARMS   16

Definition at line 99 of file call.c.

#define COB_SYSTEM_GEN (   x,
  y,
 
)    { x, (void *)z },

Definition at line 152 of file call.c.

#define HASH_SIZE   131

Definition at line 130 of file call.c.

#define lt_dlclose (   x)    dlclose(x)

Definition at line 48 of file call.c.

#define lt_dlerror ( )    dlerror()

Definition at line 49 of file call.c.

#define lt_dlhandle   void *

Definition at line 50 of file call.c.

#define lt_dlopen (   x)    dlopen(x, RTLD_LAZY | RTLD_GLOBAL)

Definition at line 46 of file call.c.

#define lt_dlsym (   x,
 
)    dlsym(x, y)

Definition at line 47 of file call.c.

#define PATHSEPC   ':'

Definition at line 95 of file call.c.

#define PATHSEPS   ":"

Definition at line 96 of file call.c.


Function Documentation

static void cache_handle ( lt_dlhandle  libhandle) [static]

Definition at line 213 of file call.c.

{
        struct struct_handle    *newhandle;

        newhandle = cob_malloc (sizeof (struct struct_handle));
        newhandle->preload_handle = libhandle;
        newhandle->next = pre_handle;
        pre_handle = newhandle;
}

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_call_error ( void  )

Definition at line 286 of file call.c.

{
        const char      *s;

        s = cob_resolve_error ();
        if (!s) {
                s = "Unknown error";
        }
        cob_runtime_error ("%s", s);
        cob_stop_run (1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

void* cob_call_resolve ( const cob_field f)

Definition at line 454 of file call.c.

{
        char    *buff;

        buff = cob_get_buff (f->size + 1);
        cob_field_to_string (f, buff);
        return cob_resolve (buff);
}

Here is the call graph for this function:

Here is the caller graph for this function:

void* cob_call_resolve_1 ( const cob_field f)

Definition at line 464 of file call.c.

{
        void    *p;

        p = cob_call_resolve (f);
        if (unlikely(!p)) {
                cob_call_error ();
        }
        return p;
}

Here is the call graph for this function:

void cob_field_cancel ( const cob_field f)

Definition at line 504 of file call.c.

{
        char    *name;

        name = cob_get_buff (f->size + 1);
        cob_field_to_string (f, name);
        cobcancel (name);
}

Here is the call graph for this function:

static void* cob_get_buff ( const size_t  buffsize) [static]

Definition at line 201 of file call.c.

{
        if (buffsize > call_lastsize) {
                call_lastsize = buffsize;
                free (call_buffer);
                call_buffer = cob_malloc (buffsize);
        }
        return call_buffer;
}

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_init_call ( void  )

Definition at line 514 of file call.c.

{
        char                            *buff;
        char                            *s;
        char                            *p;
        const struct system_table       *psyst;
#if     defined (_WIN32) || !defined (RTLD_DEFAULT)
        lt_dlhandle                     libhandle;
#endif
        size_t                          i;
        struct stat                     st;

#ifndef USE_LIBDL
        lt_dlinit ();
#endif

        /* big enough for anything from libdl/libltdl */
        resolve_error_buff = cob_malloc (CALL_BUFF_SIZE);

#ifndef COB_ALT_HASH
        call_table = cob_malloc (sizeof (struct call_hash *) * HASH_SIZE);
#endif

        call_filename_buff = cob_malloc (CALL_FILEBUFF_SIZE);
        call_entry_buff = cob_malloc (COB_SMALL_BUFF);
        call_entry2_buff = cob_malloc (COB_SMALL_BUFF);
        s = getenv ("COB_LOAD_CASE");
        if (s != NULL) {
                if (strcasecmp (s, "LOWER") == 0) {
                        name_convert = 1;
                } else if (strcasecmp (s, "UPPER") == 0) {
                        name_convert = 2;
                }
        }

        buff = cob_malloc (COB_MEDIUM_BUFF);
        s = getenv ("COB_LIBRARY_PATH");
        if (s == NULL) {
                snprintf (buff, COB_MEDIUM_MAX, ".%s%s",
                          PATHSEPS, COB_LIBRARY_PATH);
        } else {
                snprintf (buff, COB_MEDIUM_MAX, "%s%s.%s%s",
                          s, PATHSEPS, PATHSEPS, COB_LIBRARY_PATH);
        }
        cob_set_library_path (buff);

#ifndef COB_BORKED_DLOPEN
        mainhandle = lt_dlopen (NULL);
#endif

        s = getenv ("COB_PRE_LOAD");
        if (s != NULL) {
                p = cob_strdup (s);
                s = strtok (p, PATHSEPS);
                for (; s; s = strtok (NULL, PATHSEPS)) {
                        for (i = 0; i < resolve_size; ++i) {
                                buff[COB_MEDIUM_MAX] = 0;
                                snprintf (buff, COB_MEDIUM_MAX, "%s/%s.%s",
                                          resolve_path[i], s, COB_MODULE_EXT);
                                if (stat (buff, &st) == 0) {
#if     defined (_WIN32) || !defined (RTLD_DEFAULT)
                                        if ((libhandle = lt_dlopen (buff)) != NULL) {
                                                cache_handle (libhandle);
#else
                                        if (lt_dlopen (buff) != NULL) {
#endif
                                                break;
                                        }
                                }
                        }
                }
                free (p);
        }
        free (buff);
        call_buffer = cob_malloc (CALL_BUFF_SIZE);
        call_lastsize = CALL_BUFF_SIZE;
        for (psyst = (struct system_table *)&system_tab[0]; psyst->syst_name; ++psyst) {
                insert (psyst->syst_name, psyst->syst_call, NULL);
        }
}

Here is the call graph for this function:

void* cob_resolve ( const char *  name)

Definition at line 317 of file call.c.

{
        unsigned char           *p;
        const unsigned char     *s;
        void                    *func;
#if     defined (_WIN32) || !defined (RTLD_DEFAULT)
        struct struct_handle    *chkhandle;
#endif
        lt_dlhandle             handle;
        size_t                  i;
        struct stat             st;

/* Checked in generated code
        if (!cob_initialized) {
                fputs ("cob_init() must be called before cob_resolve()", stderr);
                cob_stop_run (1);
        }
*/

        /* search the cache */
        cob_exception_code = 0;
        func = lookup (name);
        if (func) {
                return func;
        }

        /* encode program name */
        p = (unsigned char *)call_entry_buff;
        s = (const unsigned char *)name;
        if (unlikely(isdigit (*s))) {
                p += sprintf ((char *)p, "_%02X", *s++);
        }
        for (; *s; ++s) {
                if (likely(isalnum (*s) || *s == '_')) {
                        *p++ = *s;
                } else if (*s == '-') {
                        *p++ = '_';
                        *p++ = '_';
                } else {
                        p += sprintf ((char *)p, "_%02X", *s);
                }
        }
        *p = 0;

        /* search the main program */
        if (mainhandle != NULL && (func = lt_dlsym (mainhandle, call_entry_buff)) != NULL) {
                insert (name, func, NULL);
                resolve_error = NULL;
                return func;
        }

        /* Search preloaded modules */
#if     defined (_WIN32) || !defined (RTLD_DEFAULT)
        for (chkhandle = pre_handle; chkhandle; chkhandle = chkhandle->next) {
                if ((func = lt_dlsym (chkhandle->preload_handle, call_entry_buff)) != NULL) {
                        insert (name, func, NULL);
                        resolve_error = NULL;
                        return func;
                }
        }
#endif
#if     defined(USE_LIBDL) && defined (RTLD_DEFAULT)
        if ((func = lt_dlsym (RTLD_DEFAULT, call_entry_buff)) != NULL) {
                insert (name, func, NULL);
                resolve_error = NULL;
                return func;
        }
#endif

        s = (const unsigned char *)name;
        if (unlikely(name_convert != 0)) {
                s = (const unsigned char *)name;
                p = call_entry2_buff;
                for (; *s; ++s) {
                        if (name_convert == 1 && isupper (*s)) {
                                *p++ = tolower (*s);
                        } else if (name_convert == 2 && islower (*s)) {
                                *p++ = toupper (*s);
                        } else {
                                *p++ = *s;
                        }
                }
                *p = 0;
                s = (const unsigned char *)call_entry2_buff;
        }

        /* search external modules */
        for (i = 0; i < resolve_size; ++i) {
                call_filename_buff[CALL_FILEBUFF_SIZE - 1] = 0;
                if (resolve_path[i] == NULL) {
                        snprintf (call_filename_buff, CALL_FILEBUFF_SIZE - 1,
                                  "%s.%s", s, COB_MODULE_EXT);
                } else {
                        snprintf (call_filename_buff, CALL_FILEBUFF_SIZE - 1,
                                  "%s/%s.%s", resolve_path[i], s, COB_MODULE_EXT);
                }
                if (stat (call_filename_buff, &st) == 0) {
                        if ((handle = lt_dlopen (call_filename_buff)) != NULL) {
#if     defined (_WIN32) || !defined (RTLD_DEFAULT)
                                /* Candidate for future calls */
                                cache_handle (handle);
#endif
                                if ((func = lt_dlsym (handle, call_entry_buff)) != NULL) {
                                        insert (name, func, NULL);
                                        resolve_error = NULL;
                                        return func;
                                }
                        }
                        resolve_error_buff[CALL_BUFF_SIZE - 1] = 0;
                        strncpy (resolve_error_buff, lt_dlerror (),
                                 CALL_BUFF_SIZE - 1);
                        resolve_error = resolve_error_buff;
                        cob_set_exception (COB_EC_PROGRAM_NOT_FOUND);
                        return NULL;
                }
        }
        resolve_error_buff[CALL_BUFF_SIZE - 1] = 0;
        snprintf (resolve_error_buff, CALL_BUFF_SIZE - 1,
                  "Cannot find module '%s'", name);
        resolve_error = resolve_error_buff;
        cob_set_exception (COB_EC_PROGRAM_NOT_FOUND);
        return NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

void* cob_resolve_1 ( const char *  name)

Definition at line 442 of file call.c.

{
        void    *p;

        p = cob_resolve (name);
        if (unlikely(!p)) {
                cob_call_error ();
        }
        return p;
}

Here is the call graph for this function:

Here is the caller graph for this function:

const char* cob_resolve_error ( void  )

Definition at line 277 of file call.c.

{
        const char      *p = resolve_error;

        resolve_error = NULL;
        return p;
}

Here is the caller graph for this function:

void cob_set_cancel ( const char *  name,
void *  entry,
void *  cancel 
)

Definition at line 299 of file call.c.

{
        struct call_hash        *p;

#ifdef  COB_ALT_HASH
        for (p = call_table; p; p = p->next) {
#else
        for (p = call_table[hash ((const unsigned char *)name)]; p; p = p->next) {
#endif
                if (strcmp (name, p->name) == 0) {
                        p->cancel = cancel;
                        return;
                }
        }
        insert (name, entry, cancel);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void cob_set_library_path ( const char *  path) [static]

Definition at line 174 of file call.c.

{
        char            *p;
        size_t          i;

        /* clear the previous path */
        if (resolve_path) {
                free (resolve_path[0]);
                free (resolve_path);
        }

        /* count the number of separators */
        resolve_size = 1;
        for (p = strchr (path, PATHSEPC); p; p = strchr (p + 1, PATHSEPC)) {
                resolve_size++;
        }

        /* build path array */
        p = cob_strdup (path);
        resolve_path = cob_malloc (sizeof (char *) * resolve_size);
        resolve_path[0] = strtok (p, PATHSEPS);
        for (i = 1; i < resolve_size; ++i) {
                resolve_path[i] = strtok (NULL, PATHSEPS);
        }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void* COB_NOINLINE cob_strdup ( const void *  stptr) [static]

Definition at line 162 of file call.c.

{
        void    *mptr;
        size_t  len;

        len = strlen (stptr) + 1;
        mptr = cob_malloc (len);
        memcpy (mptr, stptr, len);
        return mptr;
}

Here is the call graph for this function:

Here is the caller graph for this function:

int cobcall ( const char *  name,
const int  argc,
void **  argv 
)

Definition at line 596 of file call.c.

{
        int     i;
        union {
                void    *(*funcptr)();
                int     (*funcint)();
                void    *func_void;
        } unifunc;
        void    *pargv[16];

        if (unlikely(!cob_initialized)) {
                cob_runtime_error ("'cobcall' - Runtime has not been initialized");
                cob_stop_run (1);
        }
        if (argc < 0 || argc > 16) {
                cob_runtime_error ("Invalid number of arguments to 'cobcall'");
                cob_stop_run (1);
        }
        if (unlikely(!name)) {
                cob_runtime_error ("NULL name parameter passed to 'cobcall'");
                cob_stop_run (1);
        }
        unifunc.func_void = cob_resolve_1 (name);
        memset (pargv, 0, sizeof(pargv));
        /* Set number of parameters */
        cob_call_params = argc;
        for (i = 0; i < argc; ++i) {
                pargv[i] = argv[i];
        }
        return unifunc.funcint (pargv[0], pargv[1], pargv[2], pargv[3],
                                pargv[4], pargv[5], pargv[6], pargv[7],
                                pargv[8], pargv[9], pargv[10], pargv[11],
                                pargv[12], pargv[13], pargv[14], pargv[15]);
}

Here is the call graph for this function:

Here is the caller graph for this function:

void cobcancel ( const char *  name)

Definition at line 476 of file call.c.

{
        struct call_hash        *p;
        union {
                int     (*cancel_func)(int, ...);
                void    *cancel_void;
        } unicanc;

        if (unlikely(!name)) {
                cob_runtime_error ("NULL name parameter passed to 'cobcancel'");
                cob_stop_run (1);
        }
#ifdef  COB_ALT_HASH
        for (p = call_table; p; p = p->next) {
#else
        for (p = call_table[hash ((const unsigned char *)name)]; p; p = p->next) {
#endif
                if (strcmp (name, p->name) == 0) {
                        if (p->cancel && !p->flag_is_active) {
                                unicanc.cancel_void = p->cancel;
                                unicanc.cancel_func (-1, NULL, NULL, NULL, NULL,
                                                     NULL, NULL, NULL, NULL);
                        }
                }
        }
}

Here is the call graph for this function:

Here is the caller graph for this function:

int cobfunc ( const char *  name,
const int  argc,
void **  argv 
)

Definition at line 632 of file call.c.

{
        int     ret;

        if (unlikely(!cob_initialized)) {
                cob_runtime_error ("'cobfunc' - Runtime has not been initialized");
                cob_stop_run (1);
        }
        ret = cobcall (name, argc, argv);
        cobcancel (name);
        return ret;
}

Here is the call graph for this function:

void coblongjmp ( struct cobjmp_buf jbuf)

Definition at line 671 of file call.c.

{
        if (unlikely(!jbuf)) {
                cob_runtime_error ("NULL name parameter passed to 'coblongjmp'");
                cob_stop_run (1);
        }
        if (!cobjmp_primed) {
                cob_runtime_error ("Call to 'coblongjmp' with no prior 'cobsetjmp'");
                cob_stop_run (1);
        }
        cobjmp_primed = 0;
        longjmp (jbuf->cbj_jmp_buf, 1);
}

Here is the call graph for this function:

void* cobsavenv ( struct cobjmp_buf jbuf)

Definition at line 646 of file call.c.

{
        if (unlikely(!jbuf)) {
                cob_runtime_error ("NULL name parameter passed to 'cobsavenv'");
                cob_stop_run (1);
        }
        if (cobjmp_primed) {
                cob_runtime_error ("Multiple call to 'cobsetjmp'");
                cob_stop_run (1);
        }
        cobjmp_primed = 1;
        return jbuf->cbj_jmp_buf;
}

Here is the call graph for this function:

Here is the caller graph for this function:

void* cobsavenv2 ( struct cobjmp_buf jbuf,
const int  jsize 
)

Definition at line 661 of file call.c.

{
        int     jtemp;

        /* Shut up compiler */
        jtemp = jsize;
        return cobsavenv (jbuf);
}

Here is the call graph for this function:

static COB_INLINE size_t hash ( const unsigned char *  s) [static]

Definition at line 226 of file call.c.

{
        size_t          val = 0;

        while (*s) {
                val += *s++;
        }
        return val % HASH_SIZE;
}

Here is the caller graph for this function:

static void insert ( const char *  name,
void *  func,
void *  cancel 
) [static]

Definition at line 238 of file call.c.

{
        struct call_hash        *p;
#ifndef COB_ALT_HASH
        size_t                  val;
#endif

        p = cob_malloc (sizeof (struct call_hash));
        p->name = cob_strdup (name);
        p->func = func;
        p->cancel = cancel;
#ifdef  COB_ALT_HASH
        p->next = call_table;
        call_table = p;
#else
        val = hash ((const unsigned char *)name);
        p->next = call_table[val];
        call_table[val] = p;
#endif
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void* lookup ( const char *  name) [static]

Definition at line 260 of file call.c.

{
        struct call_hash        *p;

#ifdef  COB_ALT_HASH
        for (p = call_table; p; p = p->next) {
#else
        for (p = call_table[hash ((const unsigned char *)name)]; p; p = p->next) {
#endif
                if (strcmp (name, p->name) == 0) {
                        return p->func;
                }
        }
        return NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:


Variable Documentation

void* call_buffer [static]

Definition at line 112 of file call.c.

unsigned char* call_entry2_buff [static]

Definition at line 115 of file call.c.

char* call_entry_buff [static]

Definition at line 114 of file call.c.

char* call_filename_buff [static]

Definition at line 113 of file call.c.

size_t call_lastsize [static]

Definition at line 116 of file call.c.

struct call_hash** call_table = NULL [static]

Definition at line 143 of file call.c.

size_t cobjmp_primed = 0 [static]

Definition at line 111 of file call.c.

lt_dlhandle mainhandle = NULL [static]

Definition at line 108 of file call.c.

size_t name_convert = 0 [static]

Definition at line 109 of file call.c.

struct struct_handle* pre_handle = NULL [static]

Definition at line 123 of file call.c.

char* resolve_error = NULL [static]

Definition at line 106 of file call.c.

char* resolve_error_buff = NULL [static]

Definition at line 107 of file call.c.

char** resolve_path = NULL [static]

Definition at line 105 of file call.c.

size_t resolve_size = 0 [static]

Definition at line 110 of file call.c.

struct system_table system_tab[] [static]

Definition at line 153 of file call.c.

 All Data Structures Files Functions Variables Typedefs Enumerations Enumerator Defines