call.c File Reference

#include "config.h"
#include "defaults.h"
#include <stdio.h>
#include <stdlib.h>
#include <stddef.h>
#include <stdarg.h>
#include <string.h>
#include <ctype.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <ltdl.h>
#include "libcob.h"
#include "coblocal.h"
#include "system.def"

Include dependency graph for call.c:

Go to the source code of this file.

Data Structures
struct	call_hash
struct	struct_handle
struct	system_table

Macros
#define	_GNU_SOURCE   1
#define	COB_LIB_EXPIMP
#define	COB_MAX_COBCALL_PARMS   16
#define	CALL_BUFF_SIZE   256U
#define	CALL_BUFF_MAX   (CALL_BUFF_SIZE - 1U)
#define	HASH_SIZE   131U
#define	COB_SYSTEM_GEN(x, y, z)   { x, {(void *(*)(void *))z} },

Functions
static void	set_resolve_error (const char *msg, const char *entry)
static void	cob_set_library_path (const char *path)
static void	do_cancel_module (struct call_hash *p, struct call_hash **base_hash, struct call_hash *prev)
static void *	cob_get_buff (const size_t buffsize)
static void	cache_dynload (const char *path, lt_dlhandle handle)
static size_t	cache_preload (const char *path)
static COB_INLINE unsigned int	hash (const unsigned char *s)
static void	insert (const char *name, void *func, lt_dlhandle handle, cob_module *module, const char *path, const unsigned int nocanc)
static void *	lookup (const char *name)
static void *	cob_resolve_internal (const char *name, const char *dirent, const int fold_case)
static const char *	cob_chk_dirp (const char *name)
static char *	cob_chk_call_path (const char *name, char **dirent)
const char *	cob_resolve_error (void)
void	cob_call_error (void)
void	cob_set_cancel (cob_module *m)
void *	cob_resolve (const char *name)
void *	cob_resolve_cobol (const char *name, const int fold_case, const int errind)
void *	cob_resolve_func (const char *name)
void *	cob_call_field (const cob_field *f, const struct cob_call_struct *cs, const unsigned int errind, const int fold_case)
void	cob_cancel (const char *name)
void	cob_cancel_field (const cob_field *f, const struct cob_call_struct *cs)
int	cob_call (const char *name, const int argc, void **argv)
int	cob_func (const char *name, const int argc, void **argv)
void *	cob_savenv (struct cobjmp_buf *jbuf)
void *	cob_savenv2 (struct cobjmp_buf *jbuf, const int jsize)
void	cob_longjmp (struct cobjmp_buf *jbuf)
void	cob_exit_call (void)
void	cob_init_call (cob_global *lptr, cob_settings *sptr)

Variables
static struct call_hash **	call_table
static struct struct_handle *	base_preload_ptr
static struct struct_handle *	base_dynload_ptr
static cob_global *	cobglobptr
static cob_settings *	cobsetptr
static char **	resolve_path
static char *	resolve_error
static char *	resolve_alloc
static char *	resolve_error_buff
static void *	call_buffer
static char *	call_filename_buff
static char *	call_entry_buff
static unsigned char *	call_entry2_buff
static lt_dlhandle	mainhandle
static size_t	call_lastsize
static size_t	resolve_size
static unsigned int	cob_jmp_primed
static const struct system_table	system_tab []
static const unsigned char	hexval [] = "0123456789ABCDEF"
static unsigned char	valid_char [256]
static const unsigned char	pvalid_char []

Macro Definition Documentation

#define _GNU_SOURCE   1

Definition at line 26 of file call.c.

#define CALL_BUFF_MAX   (CALL_BUFF_SIZE - 1U)

Definition at line 120 of file call.c.

Referenced by set_resolve_error().

#define CALL_BUFF_SIZE   256U

Definition at line 119 of file call.c.

Referenced by cob_init_call().

#define COB_LIB_EXPIMP

Definition at line 113 of file call.c.

#define COB_MAX_COBCALL_PARMS   16

Definition at line 118 of file call.c.

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

Definition at line 183 of file call.c.

#define HASH_SIZE   131U

Definition at line 122 of file call.c.

Referenced by cob_exit_call(), cob_init_call(), and hash().

Function Documentation

static void cache_dynload ( const char *  path, lt_dlhandle  handle  )

static

Definition at line 431 of file call.c.

References base_dynload_ptr, cob_malloc(), cob_strdup(), struct_handle::handle, struct_handle::next, and struct_handle::path.

Referenced by cob_resolve_internal().

{
    struct struct_handle    *dynptr;

    for (dynptr = base_dynload_ptr; dynptr; dynptr = dynptr->next) {
        if (!strcmp (path, dynptr->path)) {
            if (!dynptr->handle) {
                dynptr->handle = handle;
                return;
            }
        }
    }
    dynptr = cob_malloc (sizeof (struct struct_handle));
    dynptr->path = cob_strdup (path);
    dynptr->handle = handle;
    dynptr->next = base_dynload_ptr;
    base_dynload_ptr = dynptr;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static size_t cache_preload ( const char *  path )

static

Definition at line 451 of file call.c.

References base_preload_ptr, cob_malloc(), __cob_settings::cob_preload_str, cob_strcat(), cob_strdup(), struct_handle::handle, struct_handle::next, NULL, struct_handle::path, PATHSEP_STR, and R_OK.

Referenced by cob_init_call().

{
    struct struct_handle    *preptr;
    lt_dlhandle     libhandle;

#if defined(_WIN32) || defined(__CYGWIN__)
    struct struct_handle    *last_elem;
    last_elem = NULL;
#endif

    /* Check for duplicate */
    for (preptr = base_preload_ptr; preptr; preptr = preptr->next) {
        if (!strcmp (path, preptr->path)) {
            return 1;
        }
#if defined(_WIN32) || defined(__CYGWIN__)
        /* Save last element of preload list */
        if (!preptr->next) last_elem = preptr;
#endif
    }

    if (access (path, R_OK) != 0) {
        return 0;
    }

    libhandle = lt_dlopen (path);
    if (!libhandle) {
        return 0;
    }

    preptr = cob_malloc (sizeof (struct struct_handle));
    preptr->path = cob_strdup (path);
    preptr->handle = libhandle;

#if defined(_WIN32) || defined(__CYGWIN__)
    /*
     * Observation: dlopen (POSIX) and lt_dlopen (UNIX) are overloading
     * symbols with equal name. So if we load two libraries with equal
     * named symbols, the last one wins and is loaded.
     * LoadLibrary (Win32) ignores any equal named symbol
     * if another library with this symbol was already loaded.
     *
     * In Windows (including MinGW/CYGWIN) we need to load modules
     * in the same order as we save them to COB_PRE_LOAD due to issues
     * if we have got two modules with equal entry points.
     */
    if(last_elem) {
        last_elem->next = preptr;
    }
    else {
        preptr->next = NULL;
        base_preload_ptr = preptr;
    }
#else
    preptr->next = base_preload_ptr;
    base_preload_ptr = preptr;
#endif


    if(!cobsetptr->cob_preload_str) {
        cobsetptr->cob_preload_str = cob_strdup(path);
    }
    else {
        cobsetptr->cob_preload_str = cob_strcat((char*) PATHSEP_STR, cobsetptr->cob_preload_str);
        cobsetptr->cob_preload_str = cob_strcat((char*) path, cobsetptr->cob_preload_str);
    }

    return 1;
}

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 1080 of file call.c.

References _, __cob_global::cob_call_params, cob_fatal_error(), COB_FERROR_INITIALIZED, cob_free(), cob_malloc(), COB_MAX_FIELD_PARAMS, cob_resolve_cobol(), cob_runtime_error(), cob_stop_run(), cob_call_union::funcint, cob_call_union::funcvoid, and unlikely.

Referenced by cob_func().

{
    void            **pargv;
    cob_call_union      unifunc;
    int         i;

    if (unlikely(!cobglobptr)) {
        cob_fatal_error (COB_FERROR_INITIALIZED);
    }
    if (argc < 0 || argc > COB_MAX_FIELD_PARAMS) {
        cob_runtime_error (_("Invalid number of arguments to '%s'"), "cob_call");
        cob_stop_run (1);
    }
    if (unlikely(!name)) {
        cob_runtime_error (_("NULL parameter passed to '%s'"), "cob_call");
        cob_stop_run (1);
    }
    unifunc.funcvoid = cob_resolve_cobol (name, 0, 1);
    pargv = cob_malloc (COB_MAX_FIELD_PARAMS * sizeof(void *));
    /* Set number of parameters */
    cobglobptr->cob_call_params = argc;
    for (i = 0; i < argc; ++i) {
        pargv[i] = argv[i];
    }
#if COB_MAX_FIELD_PARAMS == 16 || \
    COB_MAX_FIELD_PARAMS == 36 || \
    COB_MAX_FIELD_PARAMS == 56 || \
    COB_MAX_FIELD_PARAMS == 76 || \
    COB_MAX_FIELD_PARAMS == 96
#else
#error  "Invalid COB_MAX_FIELD_PARAMS value"
#endif
    i =  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]
#if COB_MAX_FIELD_PARAMS > 16
                ,pargv[16], pargv[17], pargv[18], pargv[19]
                ,pargv[20], pargv[21], pargv[22], pargv[23]
                ,pargv[24], pargv[25], pargv[26], pargv[27]
                ,pargv[28], pargv[29], pargv[30], pargv[31]
                ,pargv[32], pargv[33], pargv[34], pargv[35]
#if COB_MAX_FIELD_PARAMS > 36
                ,pargv[36], pargv[37], pargv[38], pargv[39]
                ,pargv[40], pargv[41], pargv[42], pargv[43]
                ,pargv[44], pargv[45], pargv[46], pargv[47]
                ,pargv[48], pargv[49], pargv[50], pargv[51]
                ,pargv[52], pargv[53], pargv[54], pargv[55]
#if COB_MAX_FIELD_PARAMS > 56
                ,pargv[56], pargv[57], pargv[58], pargv[59]
                ,pargv[60], pargv[61], pargv[62], pargv[63]
                ,pargv[64], pargv[65], pargv[66], pargv[67]
                ,pargv[68], pargv[69], pargv[70], pargv[71]
                ,pargv[72], pargv[73], pargv[74], pargv[75]
#if COB_MAX_FIELD_PARAMS > 76
                ,pargv[76], pargv[77], pargv[78], pargv[79]
                ,pargv[80], pargv[81], pargv[82], pargv[83]
                ,pargv[84], pargv[85], pargv[86], pargv[87]
                ,pargv[88], pargv[89], pargv[90], pargv[91]
                ,pargv[92], pargv[93], pargv[94], pargv[95]
#endif
#endif
#endif
#endif
                );
    cob_free (pargv);
    return i;
}

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_call_error

(

void

)

Definition at line 878 of file call.c.

References cob_resolve_error(), cob_runtime_error(), and cob_stop_run().

Referenced by cob_call_field(), cob_resolve_cobol(), and main().

{
    cob_runtime_error ("%s", cob_resolve_error ());
    cob_stop_run (1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

void* cob_call_field	(	const cob_field *	f,
		const struct cob_call_struct *	cs,
		const unsigned int	errind,
		const int	fold_case
	)

Definition at line 957 of file call.c.

References cob_call_error(), cob_chk_call_path(), cob_call_struct::cob_cstr_call, cob_call_struct::cob_cstr_name, COB_EC_PROGRAM_NOT_FOUND, cob_fatal_error(), COB_FERROR_INITIALIZED, cob_field_to_string(), cob_free(), cob_get_buff(), cob_resolve_internal(), cob_set_exception(), cob_call_union::funcvoid, NULL, cob_field::size, system_table::syst_call, system_table::syst_name, and unlikely.

{
    void                *p;
    const struct cob_call_struct    *s;
    const struct system_table   *psyst;
    char                *buff;
    char                *entry;
    char                *dirent;

    if (unlikely(!cobglobptr)) {
        cob_fatal_error (COB_FERROR_INITIALIZED);
    }

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

    entry = cob_chk_call_path (buff, &dirent);

    /* Check if system routine */
    for (psyst = system_tab; psyst->syst_name; ++psyst) {
        if (!strcmp (entry, psyst->syst_name)) {
            if (dirent) {
                cob_free (dirent);
            }
            return psyst->syst_call.funcvoid;
        }
    }


    /* Check if contained program */
    for (s = cs; s && s->cob_cstr_name; s++) {
        if (!strcmp (entry, s->cob_cstr_name)) {
            if (dirent) {
                cob_free (dirent);
            }
            return s->cob_cstr_call.funcvoid;
        }
    }

    p = cob_resolve_internal (entry, dirent, fold_case);
    if (dirent) {
        cob_free (dirent);
    }
    if (unlikely(!p)) {
        if (errind) {
            cob_call_error ();
        } else {
            cob_set_exception (COB_EC_PROGRAM_NOT_FOUND);
            return NULL;
        }
    }
    return p;
}

Here is the call graph for this function:

void cob_cancel

(

const char *

name

)

Definition at line 1013 of file call.c.

References _, call_table, cob_chk_dirp(), cob_fatal_error(), COB_FERROR_INITIALIZED, cob_runtime_error(), cob_stop_run(), do_cancel_module(), hash(), call_hash::name, call_hash::next, NULL, and unlikely.

Referenced by cob_cancel_field(), and cob_func().

{
    const char      *entry;
    struct call_hash    *p;
    struct call_hash    **q;
    struct call_hash    *r;

    if (unlikely(!cobglobptr)) {
        cob_fatal_error (COB_FERROR_INITIALIZED);
    }
    if (unlikely(!name)) {
        cob_runtime_error (_("NULL parameter passed to '%s'"), "cob_cancel");
        cob_stop_run (1);
    }
    entry = cob_chk_dirp (name);

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_cancel_field	(	const cob_field *	f,
		const struct cob_call_struct *	cs
	)

Definition at line 1047 of file call.c.

References cob_cancel(), cob_chk_dirp(), cob_call_struct::cob_cstr_cancel, cob_call_struct::cob_cstr_name, cob_fatal_error(), COB_FERROR_INITIALIZED, cob_field_to_string(), cob_get_buff(), cob_call_union::funcint, cob_call_union::funcvoid, call_hash::name, NULL, cob_field::size, and unlikely.

{
    char                *name;
    const char          *entry;
    const struct cob_call_struct    *s;
    
    int (*cancel_func)(const int, void *, void *, void *, void *);

    if (unlikely(!cobglobptr)) {
        cob_fatal_error (COB_FERROR_INITIALIZED);
    }
    if (!f || f->size == 0) {
        return;
    }
    name = cob_get_buff (f->size + 1);
    cob_field_to_string (f, name, f->size);
    entry = cob_chk_dirp (name);

    /* Check if contained program */
    for (s = cs; s && s->cob_cstr_name; s++) {
        if (!strcmp (entry, s->cob_cstr_name)) {
            if (s->cob_cstr_cancel.funcvoid) {
                cancel_func = s->cob_cstr_cancel.funcint;
                (void)cancel_func (-1, NULL, NULL, NULL,
                           NULL);
            }
            return;
        }
    }
    cob_cancel (entry);
}

Here is the call graph for this function:

static char* cob_chk_call_path ( const char *  name, char **  dirent  )

static

Definition at line 825 of file call.c.

References cob_strdup(), and NULL.

Referenced by cob_call_field(), cob_resolve(), and cob_resolve_cobol().

{
    char    *p;
    char    *q;
    size_t  size1;
    size_t  size2;

    *dirent = NULL;
    q = NULL;
    size2 = 0;
    for (p = (char *)name, size1 = 0; *p; p++, size1++) {
        if (*p == '/' || *p == '\\') {
            q = p + 1;
            size2 = size1 + 1;
        }
    }
    if (q) {
        p = cob_strdup (name);
        p[size2] = 0;
        *dirent = p;
        for (; *p; p++) {
#ifdef  _WIN32
            if (*p == '/') {
                *p = '\\';
            }
#else
            if (*p == '\\') {
                *p = '/';
            }
#endif
        }
        return q;
    }
    return (char *)name;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static const char* cob_chk_dirp ( const char *  name )

static

Definition at line 807 of file call.c.

References NULL.

Referenced by cob_cancel(), and cob_cancel_field().

{
    const char  *p;
    const char  *q;

    q = NULL;
    for (p = name; *p; p++) {
        if (*p == '/' || *p == '\\') {
            q = p + 1;
        }
    }
    if (q) {
        return q;
    }
    return name;
}

Here is the caller graph for this function:

void cob_exit_call

(

void

)

Definition at line 1204 of file call.c.

References call_table, cob_free(), struct_handle::handle, HASH_SIZE, call_hash::name, call_hash::next, struct_handle::next, NULL, call_hash::path, and struct_handle::path.

Referenced by cob_terminate_routines().

{
    struct call_hash    *p;
    struct call_hash    *q;
    struct struct_handle    *h;
    struct struct_handle    *j;

#ifndef COB_ALT_HASH
    size_t          i;
#endif

    if (call_filename_buff) {
        cob_free (call_filename_buff);
        call_filename_buff = NULL;
    }
    if (call_entry_buff) {
        cob_free (call_entry_buff);
        call_entry_buff = NULL;
    }
    if (call_entry2_buff) {
        cob_free (call_entry2_buff);
        call_entry2_buff = NULL;
    }
    if (call_buffer) {
        cob_free (call_buffer);
        call_buffer = NULL;
    }
    if (resolve_error_buff) {
        cob_free (resolve_error_buff);
        resolve_error_buff = NULL;
    }
    if (resolve_alloc) {
        cob_free (resolve_alloc);
        resolve_alloc = NULL;
    }
    if (resolve_path) {
        cob_free (resolve_path);
        resolve_path = NULL;
    }

#ifndef COB_ALT_HASH
    if (call_table) {
        for (i = 0; i < HASH_SIZE; ++i) {
            p = call_table[i];
#else
            p = call_table;
#endif
            for (; p;) {
                q = p;
                p = p->next;
                if (q->name) {
                    cob_free ((void *)q->name);
                }
                if (q->path) {
                    cob_free ((void *)q->path);
                }
                cob_free (q);
            }
#ifndef COB_ALT_HASH
        }
        if (call_table) {
            cob_free (call_table);
        }
        call_table = NULL;
    }
#endif

    for (h = base_preload_ptr; h;) {
        j = h;
        if (h->path) {
            cob_free ((void *)h->path);
        }
        if (h->handle) {
            lt_dlclose (h->handle);
        }
        h = h->next;
        cob_free (j);
    }
    base_preload_ptr = NULL;
    for (h = base_dynload_ptr; h;) {
        j = h;
        if (h->path) {
            cob_free ((void *)h->path);
        }
        if (h->handle) {
            lt_dlclose (h->handle);
        }
        h = h->next;
        cob_free (j);
    }
    base_dynload_ptr = NULL;

#if !defined(_WIN32) && !defined(USE_LIBDL)
    lt_dlexit ();
#if 0   /* RXWRXW - ltdl leak */
    /* Weird - ltdl leaks mainhandle - This appears to work but .. */
    cob_free (mainhandle);
#endif
#endif

}

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 1150 of file call.c.

References cob_call(), and cob_cancel().

{
    int ret;

    ret = cob_call (name, argc, argv);
    cob_cancel (name);
    return ret;
}

Here is the call graph for this function:

static void* cob_get_buff ( const size_t  buffsize )

static

Definition at line 420 of file call.c.

References call_buffer, cob_fast_malloc(), and cob_free().

Referenced by cob_call_field(), and cob_cancel_field().

{
    if (buffsize > call_lastsize) {
        call_lastsize = buffsize;
        cob_free (call_buffer);
        call_buffer = cob_fast_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	(	cob_global *	lptr,
		cob_settings *	sptr
	)

Definition at line 1307 of file call.c.

References cache_preload(), CALL_BUFF_SIZE, cob_fast_malloc(), cob_free(), COB_LIBRARY_PATH, __cob_settings::cob_library_path, cob_malloc(), COB_MEDIUM_BUFF, COB_MEDIUM_MAX, COB_MODULE_EXT, COB_NORMAL_BUFF, __cob_settings::cob_preload_str, cob_set_library_path(), COB_SMALL_BUFF, cob_strdup(), HASH_SIZE, NULL, PATHSEP_CHAR, PATHSEP_STR, resolve_size, and SLASH_CHAR.

Referenced by cob_init().

{
    char                *buff;
    char                *s;
    char                *p;
    size_t              i;
#ifndef HAVE_DESIGNATED_INITS
    const unsigned char     *pv;
#endif
#ifdef  __OS400__
    char                *t;
#endif

    cobglobptr = lptr;
    cobsetptr = sptr;

    base_preload_ptr = NULL;
    base_dynload_ptr = NULL;
    resolve_path = NULL;
    resolve_alloc = NULL;
    resolve_error = NULL;
    resolve_error_buff = NULL;
    mainhandle = NULL;
    call_buffer = NULL;
    call_filename_buff = NULL;
    call_entry_buff = NULL;
    call_entry2_buff = NULL;
    call_table = NULL;
    call_lastsize = 0;
    resolve_size = 0;
    cob_jmp_primed = 0;

#ifndef HAVE_DESIGNATED_INITS
    memset (valid_char, 0, sizeof(valid_char));
    for (pv = pvalid_char; *pv; ++pv) {
        valid_char[*pv] = 1;
    }
#endif

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

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

    call_filename_buff = cob_malloc ((size_t)COB_NORMAL_BUFF);
    call_entry_buff = cob_malloc ((size_t)COB_SMALL_BUFF);

    buff = cob_fast_malloc ((size_t)COB_MEDIUM_BUFF);
    if (cobsetptr->cob_library_path == NULL
     || strcmp(cobsetptr->cob_library_path, ".") == 0) {
        if (strcmp(COB_LIBRARY_PATH, ".") == 0) {
            snprintf (buff, (size_t)COB_MEDIUM_MAX, ".");
        } else {
            snprintf (buff, (size_t)COB_MEDIUM_MAX, ".%c%s",
                  PATHSEP_CHAR, COB_LIBRARY_PATH);
        }
    } else {
        if (strcmp(COB_LIBRARY_PATH, ".") == 0) {
            snprintf (buff, (size_t)COB_MEDIUM_MAX, "%s%c.",
                  cobsetptr->cob_library_path, PATHSEP_CHAR);
        } else {
            snprintf (buff, (size_t)COB_MEDIUM_MAX, "%s%c.%c%s",
                  cobsetptr->cob_library_path, PATHSEP_CHAR, PATHSEP_CHAR, COB_LIBRARY_PATH);
        }
    }
    cob_set_library_path (buff);

    lt_dlinit ();

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

    if (cobsetptr->cob_preload_str != NULL) {

        p = cob_strdup (cobsetptr->cob_preload_str);
        s = strtok (p, PATHSEP_STR);
        for (; s; s = strtok (NULL, PATHSEP_STR)) {
#ifdef __OS400__
            for (t = s; *t; ++t) {
                *t = toupper (*t);
            }
            cache_preload (t);
#else
            for (i = 0; i < resolve_size; ++i) {
                buff[COB_MEDIUM_MAX] = 0;
                snprintf (buff, (size_t)COB_MEDIUM_MAX,
                      "%s%c%s.%s",
                      resolve_path[i], SLASH_CHAR, s, COB_MODULE_EXT);
                if (cache_preload (buff)) {
                    break;
                }
            }
            /* If not found, try just using the name */
            if (i == resolve_size) {
                (void)cache_preload (s);
            }
#endif
        }
        cob_free (p);
    }
    cob_free (buff);
    call_buffer = cob_fast_malloc ((size_t)CALL_BUFF_SIZE);
    call_lastsize = CALL_BUFF_SIZE;
}

Here is the call graph for this function:

Here is the caller graph for this function:

void cob_longjmp

(

struct cobjmp_buf *

jbuf

)

Definition at line 1186 of file call.c.

References _, cobjmp_buf::cbj_jmp_buf, cob_fatal_error(), COB_FERROR_INITIALIZED, cob_runtime_error(), cob_stop_run(), and unlikely.

{
    if (unlikely(!cobglobptr)) {
        cob_fatal_error (COB_FERROR_INITIALIZED);
    }
    if (unlikely(!jbuf)) {
        cob_runtime_error (_("NULL parameter passed to '%s'"), "cob_longjmp");
        cob_stop_run (1);
    }
    if (!cob_jmp_primed) {
        cob_runtime_error (_("Call to 'cob_longjmp' with no prior 'cob_setjmp'"));
        cob_stop_run (1);
    }
    cob_jmp_primed = 0;
    longjmp (jbuf->cbj_jmp_buf, 1);
}

Here is the call graph for this function:

void* cob_resolve

(

const char *

name

)

Definition at line 908 of file call.c.

References cob_chk_call_path(), cob_free(), and cob_resolve_internal().

Referenced by main().

{
    void    *p;
    char    *entry;
    char    *dirent;

    entry = cob_chk_call_path (name, &dirent);
    p = cob_resolve_internal (entry, dirent, 0);
    if (dirent) {
        cob_free (dirent);
    }
    return p;
}

Here is the call graph for this function:

Here is the caller graph for this function:

void* cob_resolve_cobol	(	const char *	name,
		const int	fold_case,
		const int	errind
	)

Definition at line 923 of file call.c.

References cob_call_error(), cob_chk_call_path(), COB_EC_PROGRAM_NOT_FOUND, cob_free(), cob_resolve_internal(), cob_set_exception(), and unlikely.

Referenced by cob_call(), cobxref_(), and GCic_().

{
    void    *p;
    char    *entry;
    char    *dirent;

    entry = cob_chk_call_path (name, &dirent);
    p = cob_resolve_internal (entry, dirent, fold_case);
    if (dirent) {
        cob_free (dirent);
    }
    if (unlikely(!p)) {
        if (errind) {
            cob_call_error ();
        }
        cob_set_exception (COB_EC_PROGRAM_NOT_FOUND);
    }
    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 864 of file call.c.

References _, NULL, and resolve_error.

Referenced by cob_call_error().

{
    const char  *p;

    if (!resolve_error) {
        p = _("Indeterminable error in resolve of COBOL CALL");
    } else {
        p = resolve_error;
        resolve_error = NULL;
    }
    return p;
}

Here is the caller graph for this function:

void* cob_resolve_func

(

const char *

name

)

Definition at line 944 of file call.c.

References _, cob_resolve_internal(), cob_runtime_error(), cob_stop_run(), NULL, and unlikely.

{
    void    *p;

    p = cob_resolve_internal (name, NULL, 0);
    if (unlikely(!p)) {
        cob_runtime_error (_("User FUNCTION '%s' not found"), name);
        cob_stop_run (1);
    }
    return p;
}

Here is the call graph for this function:

static void* cob_resolve_internal ( const char *  name, const char *  dirent, const int  fold_case  )

static

Definition at line 599 of file call.c.

References _, cache_dynload(), call_entry2_buff, call_entry_buff, cob_fatal_error(), COB_FERROR_INITIALIZED, COB_FOLD_LOWER, COB_FOLD_UPPER, cob_malloc(), COB_MODULE_EXT, COB_NORMAL_MAX, cob_set_exception(), COB_SMALL_BUFF, cob_u8_t, call_hash::func, struct_handle::handle, insert(), likely, lookup(), __cob_settings::name_convert, struct_handle::next, NULL, struct_handle::path, R_OK, resolve_size, set_resolve_error(), SLASH_CHAR, and unlikely.

Referenced by cob_call_field(), cob_resolve(), cob_resolve_cobol(), and cob_resolve_func().

{
    unsigned char       *p;
    const unsigned char *s;
    void            *func;
    struct struct_handle    *preptr;
    lt_dlhandle     handle;
    size_t          i;

    if (unlikely(!cobglobptr)) {
        cob_fatal_error (COB_FERROR_INITIALIZED);
    }
    cob_set_exception (0);

    /* Search the cache */
    func = lookup (name);
    if (func) {
        return func;
    }

    /* Encode program name */
    p = (unsigned char *)call_entry_buff;
    s = (const unsigned char *)name;
    if (unlikely(*s <= (unsigned char)'9' && *s >= (unsigned char)'0')) {
        *p++ = (unsigned char)'_';
    }
    for (; *s; ++s) {
        if (likely(valid_char[*s])) {
            *p++ = *s;
        } else {
            *p++ = (unsigned char)'_';
            if (*s == (unsigned char)'-') {
                *p++ = (unsigned char)'_';
            } else {
                *p++ = hexval[*s / 16U];
                *p++ = hexval[*s % 16U];
            }
        }
    }
    *p = 0;

    /* Check case folding */
    switch (fold_case) {
    case COB_FOLD_UPPER:
        for (p = (unsigned char *)call_entry_buff; *p; p++) {
            if (islower (*p)) {
                *p = (cob_u8_t)toupper (*p);
            }
        }
        break;
    case COB_FOLD_LOWER:
        for (p = (unsigned char *)call_entry_buff; *p; p++) {
            if (isupper (*p)) {
                *p = (cob_u8_t)tolower (*p);
            }
        }
        break;
    default:
        break;
    }

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

    /* Search preloaded modules */
    for (preptr = base_preload_ptr; preptr; preptr = preptr->next) {
        func = lt_dlsym (preptr->handle, call_entry_buff);
        if (func != NULL) {
            insert (name, func, preptr->handle, NULL, preptr->path, 1);
            resolve_error = NULL;
            return func;
        }
    }

    /* Search dynamic modules */
    for (preptr = base_dynload_ptr; preptr; preptr = preptr->next) {
        if (!preptr->handle) {
            continue;
        }
        func = lt_dlsym (preptr->handle, call_entry_buff);
        if (func != NULL) {
            insert (name, func, preptr->handle,
                NULL, preptr->path, 1);
            resolve_error = NULL;
            return func;
        }
    }

#if 0   /* RXWRXW RTLD */
#if defined(USE_LIBDL) && defined (RTLD_DEFAULT)
    func = lt_dlsym (RTLD_DEFAULT, call_entry_buff);
    if (func != NULL) {
        insert (name, func, NULL, NULL, NULL, 1);
        resolve_error = NULL;
        return func;
    }
#endif
#endif

    s = (const unsigned char *)name;

    /* Check if name needs conversion */
    if (unlikely(cobsetptr->name_convert != 0)) {
        if (!call_entry2_buff) {
            call_entry2_buff = cob_malloc ((size_t)COB_SMALL_BUFF);
        }
        p = call_entry2_buff;
        for (; *s; ++s, ++p) {
            if (cobsetptr->name_convert == 1 && isupper (*s)) {
                *p = (cob_u8_t) tolower (*s);
            } else if (cobsetptr->name_convert == 2 && islower (*s)) {
                *p = (cob_u8_t) toupper (*s);
            } else {
                *p = *s;
            }
        }
        *p = 0;
        s = (const unsigned char *)call_entry2_buff;
    }

    /* Search external modules */
#ifdef  __OS400__
    strcpy (call_filename_buff, s);
    for(p = call_filename_buff; *p; ++p) {
        *p = (cob_u8_t)toupper(*p);
    }
    handle = lt_dlopen (call_filename_buff);
    if (handle != NULL) {
        /* Candidate for future calls */
        cache_dynload (call_filename_buff, handle);
        func = lt_dlsym (handle, call_entry_buff);
        if (func != NULL) {
            insert (name, func, handle, NULL, call_filename_buff, 0);
            resolve_error = NULL;
            return func;
        }
    }
#else
    if (dirent) {
        snprintf (call_filename_buff, (size_t)COB_NORMAL_MAX,
              "%s%s.%s", dirent, (char *)s, COB_MODULE_EXT);
        call_filename_buff[COB_NORMAL_MAX] = 0;
        if (access (call_filename_buff, R_OK) != 0) {
            set_resolve_error (_("Cannot find module"), name);
            return NULL;
        }
        handle = lt_dlopen (call_filename_buff);
        if (handle != NULL) {
            /* Candidate for future calls */
            cache_dynload (call_filename_buff, handle);
            func = lt_dlsym (handle, call_entry_buff);
            if (func != NULL) {
                insert (name, func, handle, NULL,
                    call_filename_buff, 0);
                resolve_error = NULL;
                return func;
            }
        }
        set_resolve_error (_("Cannot find entry point"),
                   (const char *)s);
        return NULL;
    }
    for (i = 0; i < resolve_size; ++i) {
        call_filename_buff[COB_NORMAL_MAX] = 0;
        if (resolve_path[i] == NULL) {
            snprintf (call_filename_buff, (size_t)COB_NORMAL_MAX,
                  "%s.%s", (char *)s, COB_MODULE_EXT);
        } else {
            snprintf (call_filename_buff, (size_t)COB_NORMAL_MAX,
                  "%s%c%s.%s", resolve_path[i],
                  SLASH_CHAR,
                  (char *)s,
                  COB_MODULE_EXT);
        }
        call_filename_buff[COB_NORMAL_MAX] = 0;
        if (access (call_filename_buff, R_OK) == 0) {
            handle = lt_dlopen (call_filename_buff);
            if (handle != NULL) {
                /* Candidate for future calls */
                cache_dynload (call_filename_buff, handle);
                func = lt_dlsym (handle, call_entry_buff);
                if (func != NULL) {
                    insert (name, func, handle, NULL,
                        call_filename_buff, 0);
                    resolve_error = NULL;
                    return func;
                }
            }
            set_resolve_error (_("Cannot find entry point"),
                       (const char *)s);
            return NULL;
        }
    }
#endif

    set_resolve_error (_("Cannot find module"), name);
    return NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

void* cob_savenv

(

struct cobjmp_buf *

jbuf

)

Definition at line 1160 of file call.c.

References _, cobjmp_buf::cbj_jmp_buf, cob_fatal_error(), COB_FERROR_INITIALIZED, cob_runtime_error(), cob_stop_run(), and unlikely.

Referenced by cob_savenv2().

{
    if (unlikely(!cobglobptr)) {
        cob_fatal_error (COB_FERROR_INITIALIZED);
    }
    if (unlikely(!jbuf)) {
        cob_runtime_error (_("NULL parameter passed to '%s'"), "cob_savenv");
        cob_stop_run (1);
    }
    if (cob_jmp_primed) {
        cob_runtime_error (_("Multiple call to 'cob_setjmp'"));
        cob_stop_run (1);
    }
    cob_jmp_primed = 1;
    return jbuf->cbj_jmp_buf;
}

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 1178 of file call.c.

References cob_savenv(), and COB_UNUSED.

{
    COB_UNUSED (jsize);

    return cob_savenv (jbuf);
}

Here is the call graph for this function:

void cob_set_cancel

(

cob_module *

m

)

Definition at line 885 of file call.c.

References call_table, cob_call_union::funcvoid, hash(), insert(), call_hash::module, __cob_module::module_entry, __cob_module::module_name, __cob_module::module_path, call_hash::name, call_hash::next, NULL, and call_hash::path.

Referenced by CHECKSRC_(), cobxref_(), GCic_(), get__reserved__lists_(), and LISTING_().

{
    struct call_hash    *p;

#ifdef  COB_ALT_HASH
    p = call_table;
#else
    p = call_table[hash ((const unsigned char *)(m->module_name))];
#endif
    for (; p; p = p->next) {
        if (strcmp (m->module_name, p->name) == 0) {
            p->module = m;
            /* Set path in program module structure */
            if (p->path && m->module_path && !*(m->module_path)) {
                *(m->module_path) = p->path;
            }
            return;
        }
    }
    insert (m->module_name, m->module_entry.funcvoid, NULL, m, NULL, 1);
}

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 279 of file call.c.

References cob_free(), cob_malloc(), NULL, PATHSEP_CHAR, PATHSEP_STR, resolve_alloc, and resolve_size.

Referenced by cob_init_call().

{
    char        *p;
    char        *pstr;
    size_t      i;
    size_t      size;
    struct stat st;

    int         flag;

    /* Clear the previous path */
    if (resolve_path) {
        cob_free (resolve_path);
        cob_free (resolve_alloc);
    }

    /* Count the number of separators */
    i = 1;
    size = 0;
    for (p = (char *)path; *p; p++, size++) {
        if (*p == PATHSEP_CHAR) {
            i++;
        }
    }

    /* Build path array */
    size++;
    resolve_alloc = cob_malloc (size);
    pstr = resolve_alloc;
    for (p = (char *)path; *p; p++, pstr++) {
#ifdef  _WIN32
        if (*p == (unsigned char)'/') {
            *pstr = (unsigned char)'\\';
            continue;
        }
#else
        if (*p == (unsigned char)'\\') {
            *pstr = (unsigned char)'/';
            continue;
        }
#endif
        *pstr = *p;
    }

    resolve_path = cob_malloc (sizeof (char *) * i);
    resolve_size = 0;
    pstr = resolve_alloc;
    for (; ; ) {
        p = strtok (pstr, PATHSEP_STR);
        if (!p) {
            break;
        }
        pstr = NULL;
        if (stat (p, &st) || !(S_ISDIR (st.st_mode))) {
            continue;
        }

        /*
         * look if we already have this path
         */
        flag = 0;
        for (i = 0; i < resolve_size; i++) {
            if(strcmp(resolve_path[i], p) == 0) {
                flag = 1;
                break;
            }
        }

        if (!flag) {
            resolve_path[resolve_size++] = p;
        }
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void do_cancel_module ( struct call_hash *  p, struct call_hash **  base_hash, struct call_hash *  prev  )

static

Definition at line 354 of file call.c.

References base_dynload_ptr, cob_free(), __cob_settings::cob_physical_cancel, __cob_module::flag_no_phys_canc, cob_call_union::funcint, cob_call_union::funcvoid, call_hash::handle, struct_handle::handle, call_hash::module, __cob_module::module_active, __cob_module::module_cancel, __cob_module::module_ref_count, call_hash::name, call_hash::next, struct_handle::next, call_hash::no_phys_cancel, NULL, and call_hash::path.

Referenced by cob_cancel().

{
    struct struct_handle    *dynptr;
    int (*cancel_func)(const int, void *, void *, void *, void *);
    int nocancel;
    nocancel = 0;

    if (!p->module) {
        return;
    }
    if (!p->module->module_cancel.funcvoid) {
        return;
    }
    if (p->module->flag_no_phys_canc) {
        nocancel = 1;
    }
    /* This should be impossible */
    if (p->module->module_active) {
        nocancel = 1;
    }
    if (p->module->module_ref_count &&
        *(p->module->module_ref_count)) {
        nocancel = 1;
    }
    cancel_func = p->module->module_cancel.funcint;
    (void)cancel_func (-1, NULL, NULL, NULL, NULL);
    p->module = NULL;

    if (nocancel) {
        return;
    }
    if (!cobsetptr->cob_physical_cancel) {
        return;
    }
    if (p->no_phys_cancel) {
        return;
    }
    if (!p->handle) {
        return;
    }

    lt_dlclose (p->handle);

    dynptr = base_dynload_ptr;
    for (; dynptr; dynptr = dynptr->next) {
        if (dynptr->handle == p->handle) {
            dynptr->handle = NULL;
        }
    }

    if (!prev) {
        *base_hash = p->next;
    } else {
        prev->next = p->next;
    }
    if (p->name) {
        cob_free ((void *)(p->name));
    }
    if (p->path) {
        cob_free ((void *)(p->path));
    }
    cob_free (p);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static COB_INLINE unsigned int hash ( const unsigned char *  s )

static

Definition at line 523 of file call.c.

References HASH_SIZE.

Referenced by cob_cancel(), cob_set_cancel(), insert(), and lookup().

{
    unsigned int    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, lt_dlhandle  handle, cob_module *  module, const char *  path, const unsigned int  nocanc  )

static

Definition at line 535 of file call.c.

References call_table, cob_free(), cob_malloc(), COB_NORMAL_BUFF, cob_strdup(), call_hash::func, call_hash::handle, hash(), module, call_hash::module, call_hash::name, call_hash::next, call_hash::no_phys_cancel, NULL, and call_hash::path.

Referenced by cob_resolve_internal(), and cob_set_cancel().

{
    struct call_hash    *p;
#ifndef COB_ALT_HASH
    unsigned int        val;
#endif

    p = cob_malloc (sizeof (struct call_hash));
    p->name = cob_strdup (name);
    p->func = func;
    p->handle = handle;
    p->module = module;
    if (path) {
#ifdef  _WIN32
        /* Malloced path or NULL */
        p->path = _fullpath (NULL, path, 1);
#elif   defined(HAVE_CANONICALIZE_FILE_NAME)
        /* Malloced path or NULL */
        p->path = canonicalize_file_name (path);
#elif   defined(HAVE_REALPATH)
        char    *s;

        s = cob_malloc ((size_t)COB_NORMAL_BUFF);
        if (realpath (path, s) != NULL) {
            p->path = cob_strdup (s);
        }
        cob_free (s);
#endif
        if (!p->path) {
            p->path = cob_strdup (path);
        }
    }
    p->no_phys_cancel = nocanc;
#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 581 of file call.c.

References call_table, call_hash::func, hash(), call_hash::name, call_hash::next, and NULL.

Referenced by cob_resolve_internal().

{
    struct call_hash    *p;

#ifdef  COB_ALT_HASH
    p = call_table;
#else
    p = call_table[hash ((const unsigned char *)name)];
#endif
    for (; p; p = p->next) {
        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:

static void set_resolve_error ( const char *  msg, const char *  entry  )

static

Definition at line 269 of file call.c.

References CALL_BUFF_MAX, COB_EC_PROGRAM_NOT_FOUND, cob_set_exception(), and resolve_error_buff.

Referenced by cob_resolve_internal().

{
    resolve_error_buff[CALL_BUFF_MAX] = 0;
    snprintf (resolve_error_buff, (size_t)CALL_BUFF_MAX,
          "%s '%s'", msg, entry);
    resolve_error = resolve_error_buff;
    cob_set_exception (COB_EC_PROGRAM_NOT_FOUND);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Variable Documentation

struct struct_handle* base_dynload_ptr

static

Definition at line 159 of file call.c.

Referenced by cache_dynload(), and do_cancel_module().

struct struct_handle* base_preload_ptr

static

Definition at line 158 of file call.c.

Referenced by cache_preload().

void* call_buffer

static

Definition at line 168 of file call.c.

Referenced by cob_get_buff().

unsigned char* call_entry2_buff

static

Definition at line 171 of file call.c.

Referenced by cob_resolve_internal().

char* call_entry_buff

static

Definition at line 170 of file call.c.

Referenced by cob_resolve_internal().

char* call_filename_buff

static

Definition at line 169 of file call.c.

size_t call_lastsize

static

Definition at line 175 of file call.c.

struct call_hash** call_table

static

Definition at line 155 of file call.c.

Referenced by cob_cancel(), cob_exit_call(), cob_set_cancel(), insert(), and lookup().

unsigned int cob_jmp_primed

static

Definition at line 177 of file call.c.

cob_global* cobglobptr

static

Definition at line 161 of file call.c.

cob_settings* cobsetptr

static

Definition at line 162 of file call.c.

const unsigned char hexval[] = "0123456789ABCDEF"

static

Definition at line 192 of file call.c.

lt_dlhandle mainhandle

static

Definition at line 173 of file call.c.

const unsigned char pvalid_char[]

static

Initial value:

=
    "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz"

Definition at line 262 of file call.c.

char* resolve_alloc

static

Definition at line 166 of file call.c.

Referenced by cob_set_library_path().

char* resolve_error

static

Definition at line 165 of file call.c.

Referenced by cob_resolve_error().

char* resolve_error_buff

static

Definition at line 167 of file call.c.

Referenced by set_resolve_error().

char** resolve_path

static

Definition at line 164 of file call.c.

size_t resolve_size

static

Definition at line 176 of file call.c.

Referenced by cob_init_call(), cob_resolve_internal(), and cob_set_library_path().

const struct system_table system_tab[]

static

Definition at line 186 of file call.c.

unsigned char valid_char[256]

static

Definition at line 261 of file call.c.