// 
// Copyright (C) 2001, 2000, 1999,  Rildo Pragana, Jim Noeth, 
//               Andrew Cameron, David Essex.
// Copyright (C) 1993, 1991  Rildo Pragana.
// 
// This library is free software; you can redistribute it and/or
// modify it under the terms of the GNU Lesser General Public License
// as published by the Free Software Foundation; either version 2.1,
// or (at your option) any later version.
// 
// This library is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
// GNU Lesser General Public License for more details.
// 
// You should have received a copy of the GNU Lesser General Public
// License along with this library; see the file COPYING.LIB.  If
// not, write to the Free Software Foundation, Inc., 59 Temple Place,
// Suite 330, Boston, MA 02111-1307 USA


//
//  TinyCOBOL Run Time Library 
//  Dynamic CALL statement functions
//

#include "htcoblib.h"
#include "rterrors.h"

#ifndef PATH_MAX 
#define PATH_MAX                        1024
#endif

#define SUBR_HASHLEN                     128
#define HTCOB_PATH_PWD_STR                "."

/* max of 64 chars sub-routine names */
#define HTCOB_DYNLIBS_MAX_NAME		65

#ifdef __MINGW32__
#include "dlfcnwin32.h"
#else
#include <dlfcn.h>
#include <glob.h>
#endif // MINGW32

#ifdef __WINDOWS__
#define HTCOB_DYNLIBS_PATTERN           "*.dll"
#define HTCOB_DYNLIBS_SUFIX             ".dll"
#define HTCOB_PATH_SEP_CHAR                ';'
#define HTCOB_PATH_DELIM_STR                "\\"
#else
#define HTCOB_DYNLIBS_PATTERN           "*.so"
#define HTCOB_DYNLIBS_SUFIX             ".so"
#define HTCOB_PATH_SEP_CHAR                ':'
#define HTCOB_PATH_DELIM_STR                "/"
#endif

extern struct runelement_info *running_element; // walter 12-12-05 /* the current run element */
extern struct element_order *elementorder; // walter 12-12-05

/* store sub-routine names */
static char subrname[PATH_MAX];
static char subr_libname[PATH_MAX];

static struct resolve_handle
{
    void *handle;
    struct resolve_handle *next;
} *resolve_handles = NULL;

/* 
 this mini-symtable will register previously called subroutines
 to speed up resolving their names to pointers
 */
static struct subr_desc
{
    char name[255];
    void *(*subr)();
    struct subr_desc *next;

} subrtab[SUBR_HASHLEN];

#ifndef __MINGW32__
static char libs_pattern[] = HTCOB_DYNLIBS_PATTERN;
#endif

/*------------------------------------------------------------------------*\
 |                                                                        |
 |                          subr_hash                                     |
 |                                                                        |
 \*------------------------------------------------------------------------*/

static int
subr_hash(char *s)
{
    int val = 0, i;
    for (i = 0; s[i] != '\0'; i++)
        val += s[i];
    return (val % SUBR_HASHLEN);
}

/*------------------------------------------------------------------------*\
 |                                                                        |
 |                          savename                                      |
 |                                                                        |
 \*------------------------------------------------------------------------*/

static char *
savename(char *s)
{
    char *ap;
    if ((ap = (char *) tcob_malloc(strlen(s) + 1)) != NULL)
        strcpy(ap, s);
    return (ap);
}

/*------------------------------------------------------------------------*\
 |                                                                        |
 |                          subr_lookup                                   |
 |                                                                        |
 \*------------------------------------------------------------------------*/

static int initialized = 0;

static struct subr_desc *
subr_lookup(char *s)
{
    struct subr_desc *sd;
    if (!initialized)
    {
        memset(&subrtab[0], 0x00, sizeof (subrtab));
        initialized = 1;
        return NULL;
    }

    for (sd = &subrtab[subr_hash(s)]; sd != NULL; sd = sd->next)
        if (strcmp(s, sd->name) == 0)
            return sd;
    return NULL;
}

/*------------------------------------------------------------------------*\
 |                                                                        |
 |                          subr_install                                  |
 |                                                                        |
 \*------------------------------------------------------------------------*/

static struct subr_desc *
subr_install(char *name, void *(*subr)())
{
    int val;
    struct subr_desc *sd = subr_lookup(name);

    struct element_order *eo = NULL;
    struct element_order *eop = NULL;

    if (sd == NULL)
    {
        sd = tcob_malloc(sizeof (struct subr_desc));
        if (sd == NULL)
            return NULL;

        strcpy(sd->name, name);

        val = subr_hash(sd->name);
        sd->next = &subrtab[val];
        sd->subr = subr;
        memcpy(&subrtab[val], sd, sizeof (struct subr_desc));
        free(sd);
    }

    eo = elementorder;

    eop = eo;

    while (eo)
    { // find module name
        if (!strcmp(name, eo->module_name))
            break;
        eop = eo;
        eo = eo->next;
    }

    if (!eo)
    {
        eo = calloc(1, sizeof (struct element_order));

        if (!elementorder) // first try
            elementorder = eo;
        else
            eop->next = eo;

        eo->module_name = savename(name);
        eo->who_call = savename(running_element->name); //calloc(1, strlen(running_element->name)+1);
        eo->next = NULL;
    }

    return sd;
}

/*------------------------------------------------------------------------*\
 |                                                                        |
 |                          subr_uninstall                                |
 |                                                                        |
 \*------------------------------------------------------------------------*/

static void
subr_uninstall(char *name)
{
    struct subr_desc *sd = NULL;
    struct subr_desc *ant = NULL;
    int hash;
    hash = subr_hash(name);

    for (sd = &subrtab[hash]; sd; sd = sd->next)
    {
        if (strcmp(name, sd->name) == 0)
        {
            if (!ant)
                memcpy(&subrtab[hash], sd->next, sizeof (struct subr_desc));
            else
                ant->next = sd->next;

            memset(sd,0x00, sizeof (struct subr_desc));

            return;
        }

        ant = sd;
    }
}

/*------------------------------------------------------------------------*\
 |                                                                        |
 |                          module_install                                |
 |                                                                        |
 \*------------------------------------------------------------------------*/
static void
module_install(void *module)
{
    struct resolve_handle *rh;

    rh = tcob_malloc(sizeof (struct resolve_handle));

    rh->handle = module;
    rh->next = resolve_handles;

    resolve_handles = rh;
}

/*------------------------------------------------------------------------*\
 |                                                                        |
 |                     tcob_resolve_subr_error                            |
 |                                                                        |
 \*------------------------------------------------------------------------*/

void
tcob_resolve_subr_error(void)
{
    fprintf(stderr, "*** RT Error: dynamic library call \"%s\" not found!\n",subrname);
}

/*
 *
 * tcob_resolve_in_previous_libs 
 * 
 * Try to resolve a routine handler on previous opened libs
 *
 *
 */
static void *
tcob_resolve_in_previous_libs(char *subrname)
{
    struct resolve_handle *rh;
    void *(* _dynsubr)() = NULL;

    for (rh = resolve_handles; rh != NULL; rh = rh->next)
    {

        _dynsubr = dlsym(rh->handle, subrname);
        if (_dynsubr != NULL)
        {
            subr_install(subrname, _dynsubr);
            return _dynsubr;
        }
    }
    return NULL;
}

/*
 *
 * tcob_cancel_subr
 *
 * Cancel a dynamically loaded module and uninstall it.
 *
 */
void
tcob_cancel_subr(char *name, char *running)
{
    struct element_order *eo;
    struct element_order *eop;

    eo = elementorder;
    eop = eo;

    while (eo)
    {
        if (strcmp(name, eo->module_name) != 0)
            break;

        eop = eo;
        eo = eo->next;
    }

    if (!eo)
        return;

    if (strcmp(running, eo->who_call) != 0) // you can't remove module that you did't call
        return;

    eop->next = NULL;
    if (eo->next)
        eop->next = eo->next;
    if (eo == elementorder)
    {
        free(elementorder);
        elementorder = eop->next;
    }
    else
        free(eo);

    subr_uninstall(name);
}

/*
 * tcob_find_in_lib
 *
 * Try to find a library handler on a library name
 *
 */
static void *
tcob_find_in_lib(char *rutname, char *libname)
{

    void *(* _dynsubr)() = NULL;
    void *module;

    module = dlopen(libname, RTLD_LAZY);

    if (module != NULL)
    {
        _dynsubr = dlsym(module, subrname);
        if (_dynsubr != NULL)
        {
            subr_install(rutname, _dynsubr);
            // save for speeding up next search
            module_install(module);
            // return the resolved handler
            return _dynsubr;
        }
        dlclose(module);
    }
    return NULL;
}

/*
 * tcob_resolve 
 *
 * Try to resolve the routine name
 * The paths specified by LD_LIBRARY_PATH and TCOB_LD_LIBRARY_PATH
 * 
 */
void *
tcob_resolve(char *subrname)
{

    void *(* _dynsubr)() = NULL;
#ifndef __MINGW32__
    glob_t g;
    char **libname;
    char *ldlib = NULL, *libs1 = NULL, *libstmp = NULL;
#else
    char *libs1 = NULL, *libstmp = NULL;
#endif
    char *libs = NULL;
    struct subr_desc *sd; // walter 25-10-05
    //char *libs1 = NULL, *libstmp=NULL;

    // search in previously opened library handles

    // check if we've not seen this before
    if ((sd = subr_lookup(subrname)) != NULL)
    { // walter 25-10-05
        return (sd->subr);
    }

    // search our currently linked libraries
    // and the calling program

#ifndef __MINGW32__	
    _dynsubr = tcob_find_in_lib(subrname, NULL);
    if (_dynsubr)
    {
        return _dynsubr;
    }

    // This may be equivalent but does not seam to work on Win32
    // #else
    //      GetModuleFileName (NULL, subr_libname, sizeof (subr_libname));
    // 	_dynsubr = tcob_find_in_lib(subrname, subr_libname);
    // 	if (_dynsubr) {
    // 		return _dynsubr;
    // 	}

#endif	

    // search in previously opened library handles
    _dynsubr = tcob_resolve_in_previous_libs(subrname);
    if (_dynsubr)
    {
        return _dynsubr;
    }

    // First find a library named as the routine on all the library path
    _dynsubr = tcob_find_in_lib(subrname, subrname);
    if (_dynsubr)
    {
        return _dynsubr;
    }

    // The following search sequence is not really required on MinGW (Win32)
#ifndef __MINGW32__	

    // find rutname.so
    strcpy(subr_libname, subrname);
    strcat(subr_libname, HTCOB_DYNLIBS_SUFIX);
    _dynsubr = tcob_find_in_lib(subrname, subr_libname);
    if (_dynsubr)
    {
        return _dynsubr;
    }

    // find ./rutname.so
    strcpy(subr_libname, ".");
    strcat(subr_libname, HTCOB_PATH_DELIM_STR);
    strcat(subr_libname, subrname);
    strcat(subr_libname, HTCOB_DYNLIBS_SUFIX);
    _dynsubr = tcob_find_in_lib(subrname, subr_libname);
    if (_dynsubr)
    {
        return _dynsubr;
    }

    // find ./librutname.so
    strcpy(subr_libname, ".");
    strcat(subr_libname, HTCOB_PATH_DELIM_STR);
    strcat(subr_libname, "lib");
    strcat(subr_libname, subrname);
    strcat(subr_libname, HTCOB_DYNLIBS_SUFIX);
    _dynsubr = tcob_find_in_lib(subrname, subr_libname);
    if (_dynsubr)
    {
        return _dynsubr;
    }

#endif	

    // The following functionality is not implimented on MinGW (Win32)
#ifndef __MINGW32__	
    // Now find the modules on the current dir and on the TC library PATH
    // setup our libraries names to search (in current directory)
    g.gl_offs = 0;
    glob(libs_pattern, 0, NULL, &g);
    // add libraries found in HTCOB_LD_PATH
    libs1 = getenv(HTCOB_LD_PATH);
    if (libs1 != NULL)
    {
        libstmp = tcob_malloc(strlen(libs1) + 1);
        strcpy(libstmp, libs1);
        libs1 = libstmp;
    }
    // find all the libraryes on the HTCOB_LD_PATH
    while ((libs = libs1) != NULL)
    {
        if ((libs1 = strchr(libs, HTCOB_PATH_SEP_CHAR)) != NULL)
        {
            *libs1++ = 0;
        }
        ldlib = tcob_malloc(strlen(libs) + strlen(libs_pattern) + 2);
        strcpy(ldlib, libs);

        strcat(ldlib, HTCOB_PATH_DELIM_STR);
        strcat(ldlib, libs_pattern);

        glob(ldlib, GLOB_APPEND, NULL, &g);
        free(ldlib);
    }

    if (libstmp != NULL)
        free(libstmp);

    // loop until we find a function with the name given
    libname = g.gl_pathv;
    if (libname != NULL)
    {
        for (; *libname != NULL; libname++)
        {
            _dynsubr = tcob_find_in_lib(subrname, *libname);
            if (_dynsubr != NULL)
            {
                return _dynsubr;
            }
        }
    }
    globfree(&g);
#else	
    HANDLE findFileHandle = NULL;
    WIN32_FIND_DATA uFindFileData, *lpFindFileData;

    lpFindFileData = &uFindFileData;

    // Since the calling program is not a DLL
    // This does not work on Win32
    /*
     //
     // Search the calling program
     //
     fprintf(stderr, "dyncall debug 101 : subrname=%s, subr_libname=%s;\n", subrname, subr_libname);
     mNameLen = GetModuleFileName (NULL, subr_libname, sizeof (subr_libname));
     if (mNameLen != 0) {
     fprintf(stderr, "dyncall debug 103 : subrname=%s, subr_libname=%s;\n", subrname, subr_libname);
     mHandle = GetModuleHandle(subr_libname);
     if (mHandle != NULL) {
     fprintf(stderr, "dyncall debug 105 : subrname=%s, subr_libname=%s;\n", subrname, subr_libname);
     _dynsubr = dlsym(mHandle, subrname);
     if (_dynsubr != NULL)  {
     fprintf(stderr, "dyncall debug 107 : subrname=%s, subr_libname=%s;\n", subrname, subr_libname);
     return _dynsubr;
     }
     }
     }
     */

    //
    // Search loaded DLL's
    //
    //        fprintf(stderr, "dyncall debug 111 : subrname=%s, subr_libname=%s;\n", subrname, subr_libname);
    _dynsubr = tcob_resolve_in_previous_libs(subrname);
    if (_dynsubr)
    {
        //           fprintf(stderr, "Already loaded : subrname=%s, subr_libname=%s;\n", subrname, subr_libname);
        return _dynsubr;
    }

    //
    // Locate and search DLL's in the TCOB_LD_LIBRARY_PATH paths
    //
    libs1 = getenv(HTCOB_LD_PATH);
    if (libs1 != NULL)
    {
        libstmp = tcob_malloc(strlen(libs1) + 1);
        strcpy(libstmp, libs1);
        libs = libstmp;

        //
        // Find all DLL's in the TCOB_LD_LIBRARY_PATH	paths
        //

        // libs contains the search path
        // libs1 will point to each directory to search
        char * psc = tcob_malloc(2);
        sprintf(psc, "%c", HTCOB_PATH_SEP_CHAR);

        libs1 = strtok(libs, psc);
        while (libs1 != NULL)
        {
            strcpy(subr_libname, libs1);
            strcat(subr_libname, HTCOB_PATH_DELIM_STR);
            strcat(subr_libname, HTCOB_DYNLIBS_PATTERN);

            //				printf("Searching on [%s]\n",subr_libname);

            // get first dll from the current searched directory
            findFileHandle = FindFirstFile(subr_libname, lpFindFileData);
            if (findFileHandle != INVALID_HANDLE_VALUE)
            {
                strcpy(subr_libname, lpFindFileData->cFileName);
                _dynsubr = tcob_find_in_lib(subrname, subr_libname);
                if (_dynsubr)
                {
                    return _dynsubr;
                }

                // get second to last dll from the current searched directory
                while (FindNextFile(findFileHandle, lpFindFileData) == TRUE)
                {
                    strcpy(subr_libname, lpFindFileData->cFileName);
                    _dynsubr = tcob_find_in_lib(subrname, subr_libname);
                    if (_dynsubr)
                    {
                        return _dynsubr;
                    }
                }
            }

            // did not found yet... will search next directory on the search path
            libs1 = strtok(NULL, psc);
        }

        free(libstmp);
    }

#endif	
    return NULL;

}

/*------------------------------------------------------------------------*\
 |                                                                        |
 |                         tcob_resolve_subr                              |
 |                                                                        |
 \*------------------------------------------------------------------------*/

void *
tcob_resolve_subr(struct fld_desc *f, char *s, int stacklen)
{

    char *p;

    // get our subroutine name to call
    strncpy(subrname, s, f->len);
    subrname[f->len] = 0;

    // remove trailing spaces
    p = subrname;
    while (*p)
    {
        if (*p == ' ')
            *p = '\0';
        if (*p == '-')
            *p = '_';
        p++;
    }

    // An non-zero stack length implies an WINAPI call convention
    if (stacklen != 0)
    {
        sprintf(subr_libname, "%s@%d", subrname, stacklen - 1);
        strcpy(subrname, subr_libname);
    }

#ifndef __MINGW32__	
    if (strlen(subrname) > HTCOB_DYNLIBS_MAX_NAME)
    {
        fprintf(
                stderr,
                "*** RT Error: Maximun of length of %d characters in sub-routine name ('%s') execced.\n",
                HTCOB_DYNLIBS_MAX_NAME, subrname);
        return NULL;
    }
#endif	

    // FIXME: check for invalid characters
    // change - by _ on sub name
    //	p=subrname;
    //	while(*p){
    //            if (*p=='-') *p='_';
    //	      p++;
    //	}

    return tcob_resolve(subrname);
}

int
tcob_call_loadlib(struct fld_desc *f, char *s)
{
    int r = 0;
    char *p;
    void *module;

    strncpy(subrname, s, f->len);
    subrname[f->len] = '\0';

    // remove traling spaces and add NULL delimiter
    p = subrname; // walter
    while (*p)
    {
        if (*p == ' ')
            *p = '\0';
        p++;
    }

    // open the library
    module = dlopen(subr_libname, RTLD_LAZY);
    if (module != NULL)
    {
        // save handle to improve search sequence for next search
        module_install(module);
        r = 1;
    }

    return r;
}

/* end of dyncall.c */