regina/library.c

   1 /*
   2  *  The Regina Rexx Interpreter
   3  *  Copyright (C) 1992-1994  Anders Christensen <anders@pvv.unit.no>
   4  *
   5  *  This library is free software; you can redistribute it and/or
   6  *  modify it under the terms of the GNU Library General Public
   7  *  License as published by the Free Software Foundation; either
   8  *  version 2 of the License, or (at your option) any later version.
   9  *
  10  *  This library is distributed in the hope that it will be useful,
  11  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13  *  Library General Public License for more details.
  14  *
  15  *  You should have received a copy of the GNU Library General Public
  16  *  License along with this library; if not, write to the Free
  17  *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18  */
  19
  20 /*
  21  * Sigh, let's live dangerously. We need to remove the definition of
  22  * _POSIX_SOURCE, in order to get defined some extenstions to POSIX,
  23  * since dynamic loading is not a part of POSIX.
  24  */
  25
  26 #include "regina_c.h"
  27 #include "rexxsaa.h"
  28 #define DONT_TYPEDEF_PFN
  29
  30 #ifdef HAVE_GCI
  31 # include "gci/gci.h"
  32 #endif
  33
  34 #include "rexx.h"
  35 #include "rxiface.h"
  36 #include <assert.h>
  37 #include <string.h>
  38
  39 /*
  40  * Starting after 3.3RC1 we process both the Rexx???Exe as the Rexx???Dll
  41  * stuff here and only here. An Exe element is an element with a library of
  42  * NULL.
  43  */
  44
  45 #define EP_COUNT 133    /* should be a prime for distribution */
  46
  47 #define FUNCS   0
  48 #define EXITS   1
  49 #define SUBCOMS 2
  50
  51 typedef struct { /* lib_tsd: static variables of this module (thread-safe) */
  52    struct library *     first_library;
  53    struct library *     orphaned;
  54    struct entry_point  *ep[3][EP_COUNT]; /* FUNCS, EXITS, SUBCOMS */
  55    streng *             err_message;
  56 } lib_tsd_t; /* thread-specific but only needed by this module. see
  57               * init_library
  58               */
  59
  60 /*
  61  * init_library initializes the module.
  62  * Currently, we set up the thread specific data.
  63  * The function returns 1 on success, 0 if memory is short.
  64  */
  65 int init_library( tsd_t *TSD )
  66 {
  67    lib_tsd_t *lt;
  68
  69    if ( TSD->lib_tsd != NULL )
  70       return 1;
  71
  72    if ( ( TSD->lib_tsd = MallocTSD( sizeof( lib_tsd_t ) ) ) == NULL )
  73       return 0;
  74    lt = (lib_tsd_t *)TSD->lib_tsd;
  75    memset( lt, 0, sizeof( lib_tsd_t ) );  /* correct for all values */
  76    return 1;
  77 }
  78
  79 #ifdef DYNAMIC
  80 /*
  81  * insert_library inserts the passed library in the linked list of used
  82  * libraries unconditionally.
  83  */
  84 static void insert_library( const tsd_t *TSD, struct library *ptr )
  85 {
  86    lib_tsd_t *lt;
  87
  88    lt = (lib_tsd_t *)TSD->lib_tsd;
  89    ptr->prev = NULL;
  90    ptr->next = lt->first_library;
  91    lt->first_library = ptr;
  92    if ( ptr->next != NULL )
  93       ptr->next->prev = ptr;
  94 }
  95
  96 /*
  97  * unlink_orphaned_libs attempts to remove the address space from unused
  98  * DLLs aka shared libraries.
  99  *
 100  * We must be extremely careful. Scenario:
 101  * Load a function package, e.g. w32funcs. This lets several functions
 102  * (e.g. win32func???) and win32load and win32unload been registered.
 103  * When the call of win32unload happens, each function name gets unload and
 104  * on the last call the entire library gets released. But this happens just
 105  * when RexxDeregisterFunction(win32unload) happens! The address space doesn't
 106  * exist any longer and the call does a return to unmapped memory. Crash!
 107  *
 108  * Therefore the freeing of the library moves the unused lib to the list of
 109  * orphaned libs which are removed when it's safe to do so.
 110  *
 111  * Alternatively we have to maintain a list of used external entry points
 112  * which lock the associated libraries only (move to orphaned), others are
 113  * freed immediately. The disadvantage is the maintainance problem with
 114  * longjmp/sigjmp.
 115  *
 116  * If the flag force is set we assume a clean state which should be set only
 117  * on reforking or terminating.
 118  */
 119 static void unlink_orphaned_libs( const tsd_t *TSD, lib_tsd_t *lt, int force )
 120 {
 121    struct library *ptr;
 122
 123    if ( !lt->orphaned )
 124       return;
 125
 126    if ( !force )
 127    {
 128       /*
 129        * The system is ready to remove every lib if TSD->systeminfo->previous
 130        * is empty AND TSD->systeminfo->input_name is empty.
 131        * Otherwise we don't catch the plain main() calls or other calls I can
 132        * imagine that use the first systeminfo directly.
 133        */
 134       if ( TSD->systeminfo )
 135       {
 136          if ( TSD->systeminfo->previous || TSD->systeminfo->input_file )
 137             return;
 138       }
 139    }
 140
 141    while ( ( ptr = lt->orphaned ) != NULL )
 142    {
 143       lt->orphaned = ptr->next;
 144       if ( lt->orphaned )
 145          lt->orphaned->prev = NULL;
 146
 147       assert( ptr->used == 0 );
 148
 149       wrapper_unload( TSD, ptr->handle );
 150       assert( ptr->name );
 151       Free_stringTSD( ptr->name );
 152       FreeTSD( ptr );
 153    }
 154 }
 155
 156 /*
 157  * remove_library removes the passed library from the linked list of used
 158  * libraries unconditionally.
 159  * The library will be unloaded and the name and the passed structure will be
 160  * freed later when it's safe to do so.
 161  * See unlink_orphaned_libs.
 162  */
 163 static void remove_library( const tsd_t *TSD, struct library *ptr )
 164 {
 165    lib_tsd_t *lt;
 166
 167    assert( ptr->used == 0 );
 168
 169    lt = (lib_tsd_t *)TSD->lib_tsd;
 170    if ( ptr->next )
 171       ptr->next->prev = ptr->prev;
 172
 173    if ( ptr->prev )
 174       ptr->prev->next = ptr->next;
 175    else
 176       lt->first_library = ptr->next;
 177
 178    ptr->next = lt->orphaned;
 179    if ( lt->orphaned )
 180       lt->orphaned->prev = ptr;
 181
 182    lt->orphaned = ptr;
 183
 184    /*
 185     * Now try to remove it really.
 186     */
 187    unlink_orphaned_libs( TSD, lt, 0 );
 188 }
 189 #endif
 190
 191 /*
 192  * remove_entry removes the passed library entry from the linked list of used
 193  * library entries unconditionally.
 194  * The slot must be either FUNCS, EXITS, or SUBCOMS.
 195  * Used memory will be freed and the holding library will be removed if this
 196  * entry was the last entry used of the library.
 197  */
 198 static void remove_entry( tsd_t *TSD, struct entry_point *fptr, int slot )
 199 {
 200    lib_tsd_t *lt;
 201
 202    assert( slot >= FUNCS && slot <= SUBCOMS );
 203
 204    lt = (lib_tsd_t *)TSD->lib_tsd;
 205    if ( fptr->name )
 206       Free_stringTSD( fptr->name );
 207 #if defined(HAVE_GCI) && defined(DYNAMIC)
 208    if ( ( fptr->special.gci_info != NULL ) && ( slot == FUNCS ) )
 209       GCI_remove_structure( TSD, (GCI_treeinfo *)fptr->special.gci_info );
 210 #endif
 211    if ( fptr->next )
 212       fptr->next->prev = fptr->prev;
 213    if ( fptr->prev )
 214       fptr->prev->next = fptr->next;
 215    else
 216       lt->ep[slot][fptr->hash % EP_COUNT] = fptr->next;
 217
 218 #ifdef DYNAMIC
 219    if ( fptr->lib != NULL )
 220    {
 221       assert( fptr->lib->used > 0 );
 222       if ( --fptr->lib->used == 0 )
 223          remove_library( TSD, fptr->lib );
 224    }
 225 #endif
 226
 227    FreeTSD( fptr );
 228 }
 229
 230 /*
 231  * free_orphaned_libs disconnect from unused DLLs, see unlink_orphaned_libs.
 232  */
 233 void free_orphaned_libs( tsd_t *TSD )
 234 {
 235 #ifdef DYNAMIC
 236    lib_tsd_t *lt = (lib_tsd_t *)TSD->lib_tsd;
 237
 238    unlink_orphaned_libs( TSD, lt, 0 );
 239 #else
 240    (TSD = TSD);
 241 #endif
 242 }
 243
 244 /*
 245  * purge_library frees all used memory used by every entry point that is
 246  * registered and unloads every library.
 247  * This routine is a little bit slow.
 248  */
 249 void purge_library( tsd_t *TSD )
 250 {
 251    struct entry_point *ep, *save_ep;
 252    lib_tsd_t *lt;
 253    int i, j;
 254
 255    lt = (lib_tsd_t *)TSD->lib_tsd;
 256    if ( lt->first_library != NULL )
 257    {
 258       for ( i = FUNCS; i <= SUBCOMS; i++ )
 259       {
 260          for ( j = 0; j < EP_COUNT; j++ )
 261          {
 262             if ( ( ep = lt->ep[i][j] ) != NULL )
 263             {
 264                do {
 265                   save_ep = ep;
 266                   remove_entry( TSD, ep, i );
 267                   if ( ( ep = lt->ep[i][j] ) == save_ep )
 268                      break;
 269                } while ( ep != NULL );
 270                if ( lt->first_library == NULL )
 271                   goto fastEnd;
 272             }
 273          }
 274       }
 275    }
 276    fastEnd:
 277    assert( lt->first_library == NULL );
 278    lt->first_library = NULL;
 279 #ifdef DYNAMIC
 280    unlink_orphaned_libs( TSD, lt, 1 );
 281 #endif
 282    assert( lt->orphaned == NULL );
 283    lt->orphaned = NULL;
 284    memset( lt->ep, 0, sizeof( lt->ep ) );
 285 }
 286
 287 #ifdef DYNAMIC
 288 /*
 289  * find_library returns the internal structure associated with the passed
 290  * library name or NULL if such a library doesn't exist.
 291  */
 292 struct library *find_library( const tsd_t *TSD, const streng *name )
 293 {
 294    struct library *lptr;
 295    lib_tsd_t *lt;
 296
 297    lt = (lib_tsd_t *)TSD->lib_tsd;
 298    lptr = lt->first_library;
 299    for ( ; lptr; lptr = lptr->next )
 300    {
 301       if ( !Str_cmp( name, lptr->name ) )
 302          return lptr;
 303    }
 304
 305    return NULL;
 306 }
 307 #endif
 308
 309 /*
 310  * add_entry creates a new library entry from the passed data and inserts it
 311  * in the linked list of used entries unconditionally.
 312  * The slot must be either FUNCS, EXITS, or SUBCOMS.
 313  * rxname is the name that can be used by a REXX script.
 314  * addr is the entry point of the function/exit hook/subcom hook.
 315  * lptr is a loaded library or NULL for a call of RexxRegister???Exe.
 316  * Either gci_info or user_area may be set depending on the kind of the entry.
 317  *
 318  * The internal counter of the library isn't incremented.
 319  */
 320 static void add_entry( const tsd_t *TSD, int slot, const streng *rxname,
 321                        PFN addr,
 322                        struct library *lptr, void *gci_info,
 323                        void *user_area )
 324 {
 325    int hash0;
 326    lib_tsd_t *lt;
 327    struct entry_point *fptr;
 328
 329    assert( slot >= FUNCS && slot <= SUBCOMS );
 330    lt = (lib_tsd_t *)TSD->lib_tsd;
 331
 332    fptr = (struct entry_point *)MallocTSD( sizeof( struct entry_point ) );
 333    fptr->name = Str_upper( Str_dupstrTSD( rxname ) );
 334    fptr->hash = hashvalue( rxname->value, rxname->len );
 335    fptr->addr = addr;
 336    fptr->lib = lptr;
 337    memset( &fptr->special, 0, sizeof( fptr->special ) );
 338    if ( slot == FUNCS )
 339       fptr->special.gci_info = gci_info;
 340    else
 341    {
 342       if ( user_area != NULL )
 343          memcpy( fptr->special.user_area, user_area,
 344                  sizeof ( fptr->special.user_area ) );
 345    }
 346
 347    hash0 = fptr->hash % EP_COUNT;
 348    fptr->next = lt->ep[slot][hash0];
 349    lt->ep[slot][hash0] = fptr;
 350    fptr->prev = NULL;
 351    if ( fptr->next )
 352       fptr->next->prev = fptr;
 353 }
 354
 355 /*
 356  * find_entry_point returns NULL if no entry is found. Returns the exact entry
 357  * if both the name and the library match. Returns any entry with a fitting
 358  * name if the library doesn't match but the name exists.
 359  * library may be NULL for entries registered by RexxRegister???Exe.
 360  * The slot must be either FUNCS, EXITS, or SUBCOMS.
 361  */
 362 static struct entry_point *find_entry_point( const tsd_t *TSD,
 363                                              const streng *name,
 364                                              void *library,
 365                                              int slot )
 366 {
 367    struct entry_point *lptr;
 368    unsigned hash, hash0;
 369    lib_tsd_t *lt;
 370    struct entry_point *retval = NULL;
 371
 372    lt = (lib_tsd_t *)TSD->lib_tsd;
 373    hash = hashvalue( name->value, name->len );
 374    hash0 = hash % EP_COUNT;
 375    for ( lptr = lt->ep[slot][hash0]; lptr; lptr = lptr->next )
 376    {
 377       if ( hash == lptr->hash )
 378          if ( Str_cmp( name, lptr->name ) == 0 )
 379          {
 380             if ( lptr->lib == library )
 381                return lptr;
 382             else
 383                retval = lptr;
 384          }
 385    }
 386
 387    return retval;
 388 }
 389
 390 /*
 391  * find_first_entry_point returns NULL if no entry is found and returns the
 392  * most recent hook otherwise.
 393  * The slot must be either FUNCS, EXITS, or SUBCOMS.
 394  */
 395 static struct entry_point *find_first_entry_point( const tsd_t *TSD,
 396                                                    const streng *name,
 397                                                    int slot )
 398 {
 399    struct entry_point *lptr;
 400    unsigned hash, hash0;
 401    lib_tsd_t *lt;
 402
 403    lt = (lib_tsd_t *)TSD->lib_tsd;
 404    hash = hashvalue( name->value, name->len );
 405    hash0 = hash % EP_COUNT;
 406    for ( lptr = lt->ep[slot][hash0]; lptr; lptr = lptr->next )
 407    {
 408       if ( hash == lptr->hash )
 409          if ( Str_cmp( name, lptr->name ) == 0 )
 410             return lptr;
 411    }
 412
 413    return NULL;
 414 }
 415
 416 /*
 417  * find_all_entries returns 0 if no entry is found. Otherwise it returns the
 418  * number of all matching entries with the given name, different in the module
 419  * name only.
 420  * The slot must be either FUNCS, EXITS, or SUBCOMS.
 421  * *list will be set to a list of all available entries.
 422  *
 423  * This function is slow.
 424  */
 425 static int find_all_entries( const tsd_t *TSD, const streng *name, int slot,
 426                              struct entry_point ***list )
 427 {
 428    struct entry_point *lptr, **array;
 429    unsigned hash, hash0;
 430    lib_tsd_t *lt;
 431    int cnt;
 432
 433    lt = (lib_tsd_t *)TSD->lib_tsd;
 434    hash = hashvalue( name->value, name->len );
 435    hash0 = hash % EP_COUNT;
 436    for ( cnt = 0, lptr = lt->ep[slot][hash0]; lptr; lptr = lptr->next )
 437    {
 438       if ( hash == lptr->hash )
 439          if ( Str_cmp( name, lptr->name ) == 0 )
 440             cnt++;
 441    }
 442
 443    if ( cnt == 0 )
 444    {
 445       *list = NULL;
 446       return 0;
 447    }
 448
 449    array = (struct entry_point **)MallocTSD( cnt * sizeof( struct entry_point * ) );
 450    *list = array;
 451
 452    for ( cnt = 0, lptr = lt->ep[slot][hash0]; lptr; lptr = lptr->next )
 453    {
 454       if ( hash == lptr->hash )
 455          if ( Str_cmp( name, lptr->name ) == 0 )
 456             array[cnt++] = lptr;
 457    }
 458
 459    return cnt;
 460 }
 461
 462 /*
 463  * set_err_message replaces the current error message by a new one that will
 464  * be assembled as the concatenation of the two passed messages.
 465  * The created string will be returned by RxFuncErrMsg().
 466  */
 467 void set_err_message( const tsd_t *TSD, const char *message1,
 468                       const char *message2 )
 469 {
 470    lib_tsd_t *lt;
 471    int size;
 472
 473    lt = (lib_tsd_t *)TSD->lib_tsd;
 474    if ( lt->err_message )
 475       Free_stringTSD( lt->err_message );
 476
 477    size = strlen( message1 ) + strlen( message2 );
 478    lt->err_message = Str_makeTSD( size + 1 );
 479    if ( lt->err_message )
 480    {
 481       strcpy( lt->err_message->value, message1 );
 482       strcat( lt->err_message->value, message2 );
 483       lt->err_message->len = size;
 484    }
 485 }
 486
 487 /*
 488  * load_entry creates a new library entry from the passed data and inserts it
 489  * in the linked list of used entries.
 490  * lptr is a loaded library or NULL for a call of RexxRegister???Exe.
 491  * rxname is the name that can be used by a REXX script.
 492  * objnam will be used if lptr != NULL only and is the name of the hook
 493  * or function that is exported by the library.
 494  * entry will be used if lptr == NULL only and is the entry point of the hook
 495  * or function.
 496  * The slot must be either FUNCS, EXITS, or SUBCOMS.
 497  * Either gci_info or user_area may be set depending on the kind of the entry.
 498  *
 499  * Return codes:
 500  *    0 on success.
 501  *    1 if the function is defined already.
 502  *    1 if the hook is defined already and bound to the same library. The new
 503  *      hook is rejected.
 504  *    2 if the hook is defined already and bound to another library. The new
 505  *      hook is accepted.
 506  *    3 if objnam isn't exported by lptr.
 507  *    4 if external libraries are not supported.
 508  */
 509 static int load_entry( const tsd_t *TSD, struct library *lptr,
 510                        const streng *rxname, const streng *objnam,
 511                        PFN entry,
 512                        int slot, void *gci_info, void *user_area )
 513 {
 514    int result=0;
 515    struct entry_point *fptr;
 516
 517    assert( ( lptr != NULL ) ^ ( entry != NULL ) );
 518    assert( rxname != NULL );
 519    assert( slot >= FUNCS && slot <= SUBCOMS );
 520    /*
 521     * Check the exceptions first.
 522     */
 523    if ( ( fptr = find_entry_point( TSD, rxname, lptr, slot ) ) != NULL )
 524    {
 525       /*
 526        * EXITS and SUBCOMS may have the same callable name bound to different
 527        * modules.
 528        */
 529       if ( ( slot == FUNCS ) || ( fptr->lib == lptr ) )
 530          return 1;
 531       /*
 532        * must be a hook with the same name in a different module.
 533        */
 534       result = 2;
 535    }
 536
 537    if ( lptr )
 538    {
 539       assert( objnam != NULL );
 540 #ifdef DYNAMIC
 541       if ( ( entry = wrapper_get_addr( TSD, lptr, objnam ) ) == NULL )
 542          return 3;
 543       lptr->used++;
 544 #else
 545       return 4;
 546 #endif
 547    }
 548
 549    add_entry( TSD, slot, rxname, entry, lptr, gci_info, user_area );
 550    return result;
 551 }
 552
 553 /*
 554  * unload_entry removes a known library entry from the linked list of known
 555  * entries.
 556  *
 557  * rxname is the name that can be used by a REXX script.
 558  * module is the name of the library and may be NULL for a generic request
 559  * or is a RexxRegister???Exe registered funcion/hook shall be unloaded.
 560  * The slot must be either FUNCS, EXITS, or SUBCOMS.
 561  *
 562  * Return codes:
 563  *    0 on success.
 564  *    1 if the function/hook is not defined or a hook with this name is bound
 565  *      to different modules and the module name is not given.
 566  */
 567 static int unload_entry( tsd_t *TSD, const streng *rxname,
 568                          const streng *module, int slot )
 569 {
 570    struct entry_point *fptr, **list;
 571    struct library *lib;
 572    int cnt;
 573
 574 #ifdef DYNAMIC
 575    if ( module == NULL )
 576       lib = NULL;
 577    else
 578    {
 579       if ( ( lib = find_library( TSD, module ) ) == NULL )
 580          return 1;
 581    }
 582 #else
 583    if ( module != NULL )
 584       return 1;
 585    lib = NULL;
 586 #endif
 587
 588    fptr = find_entry_point( TSD, rxname, lib, slot );
 589    if ( fptr == NULL )
 590       return 1;
 591
 592    if ( fptr->lib == lib )
 593    {
 594       remove_entry( TSD, fptr, slot );
 595       return 0;
 596    }
 597
 598    /*
 599     * Not a properly matching function. Check for the "wildcard" library.
 600     */
 601    if ( lib != NULL )
 602       return 1;
 603
 604    /*
 605     * We need it the hard way. Check if more than one entry is registered.
 606     */
 607    cnt = find_all_entries( TSD, rxname, slot, &list );
 608    if ( cnt > 1 )
 609    {
 610       FreeTSD( list );
 611       return 1;
 612    }
 613
 614    remove_entry( TSD, *list, slot );
 615    FreeTSD( list );
 616    return 0;
 617 }
 618
 619 /*
 620  * loadrxfunc adds a new function to the set of registered entry points.
 621  *
 622  * lptr is a loaded library or NULL for a call of RexxRegisterFunctionExe.
 623  * rxname is the name that can be used by a REXX script.
 624  * objnam will be used if lptr != NULL only and is the name of the function
 625  * that is exported by the library.
 626  * entry will be used if lptr == NULL only and is the entry point of the
 627  * function.
 628  * gci_info may be set depending on whether RxFuncDefine is used.
 629  *
 630  * Returns a return code suitable for RexxRegisterFunction???.
 631  */
 632 static int loadrxfunc( const tsd_t *TSD, struct library *lptr,
 633                        const streng *rxname, const streng *objnam,
 634                        PFN entry,
 635                        void *gci_info )
 636 {
 637    int rc;
 638
 639    rc = load_entry( TSD, lptr, rxname, objnam, entry, FUNCS, gci_info, NULL );
 640    switch ( rc )
 641    {
 642       case 0:  return 0;   /* RXFUNC_OK */
 643       case 1:  return 10;  /* RXFUNC_DEFINED */
 644       case 3:  return 50;  /* RXFUNC_ENTNOTFND */
 645       case 4:  return 60;  /* RXFUNC_NOTINIT */
 646    }
 647    assert ( rc != 0 );
 648    return 10000 + rc; /* something not recognisable */
 649 }
 650
 651 /*
 652  * loadrxhook adds a new exit/subcom hook to the set of registered entry
 653  * points.
 654  *
 655  * lptr is a loaded library or NULL for a call of RexxRegister???Exe.
 656  * rxname is the name that can be used in a hook list.
 657  * objnam will be used if lptr != NULL only and is the name of the hook that
 658  * that is exported by the library.
 659  * entry will be used if lptr == NULL only and is the entry point of the hook.
 660  * user_area is the passed parameter called UserArea of the Registration.
 661  * The slot must be either EXITS or SUBCOMS.
 662  *
 663  * Returns a return code suitable for RexxRegister???.
 664  */
 665 static int loadrxhook( const tsd_t *TSD, struct library *lptr,
 666                        const streng *rxname, const streng *objnam,
 667                        PFN entry,
 668                        void *user_area, int slot )
 669 {
 670    int rc;
 671
 672    rc = load_entry( TSD, lptr, rxname, objnam, entry, slot, NULL, user_area );
 673    switch ( rc )
 674    {
 675       case 0:  return 0;     /* RX???_OK */
 676       case 1:  return 30;    /* RX???_NOTREG */
 677       case 2:  return 10;    /* RX???_DUP */
 678       case 3:  return 50;    /* RX???_LOADERR */
 679       case 4:  return 1004;  /* RX???_NOTINIT */
 680    }
 681    assert ( rc != 0 );
 682    return 10000 + rc; /* something not recognisable */
 683 }
 684
 685 /*
 686  * unloadrxhook removes a registered function entry point.
 687  *
 688  * rxname is the name that can be used by a REXX script.
 689  *
 690  * Returns a return code suitable for RexxDeregisterFunction.
 691  */
 692 static int unloadrxfunc( tsd_t *TSD, const streng *rxname )
 693 {
 694    assert( rxname != NULL );
 695
 696    if ( unload_entry( TSD, rxname, NULL, FUNCS ) == 0 )
 697       return 0;
 698    return 30; /* RXFUNC_NOTREG */
 699 }
 700
 701 /*
 702  * unloadrxhook removes a registered exit/subcom hook entry point.
 703  *
 704  * rxname is the name that can be used in a hook list.
 705  * module is the name of the module that contains the hook or NULL if either
 706  * the generic hook should be removed or if a RexxRegister???Exe-hook should
 707  * be removed. The later one has precedence.
 708  * The slot must be either EXITS or SUBCOMS.
 709  *
 710  * Returns a return code suitable for RexxDeregister???.
 711  */
 712 static int unloadrxhook( tsd_t *TSD, const streng *rxname,
 713                          const streng *module, int slot )
 714 {
 715    assert( rxname != NULL );
 716
 717    if ( unload_entry( TSD, rxname, module, slot ) == 0 )
 718       return 0;
 719    return 30; /* RX???_NOTREG */
 720 }
 721
 722 /*
 723  * rex_funcadd processes a RexxRegisterFunctionDll() or
 724  * RexxRegisterFunctionExe() request.
 725  *
 726  * rxname is the name that can be used by a REXX script.
 727  * module is the name of the library and may be NULL only a
 728  * RexxRegisterFunctionExe is processed.
 729  * objnam will be used if module != NULL only and is the name of the function
 730  * that is exported by the library.
 731  * entry will be used if module == NULL only and is the entry point of the
 732  * function.
 733  * gci_info may be set depending on whether RxFuncDefine is used.
 734  *
 735  * Returns a return code suitable for RexxRegisterFunction???.
 736  */
 737 static int rex_funcadd( const tsd_t *TSD, const streng *rxname,
 738                         const streng *module, const streng *objnam,
 739                         PFN entry,
 740                         void *gci_info )
 741 {
 742    struct library *lptr=NULL;
 743    int rc;
 744 #ifdef DYNAMIC
 745    void *handle;
 746    int newhandle = 0;
 747 #endif
 748    streng *regutil=Str_crestr( "regutil" );
 749    streng *rexxutil=Str_crestr( "rexxutil" );
 750
 751    assert( rxname != NULL );
 752
 753    if ( module != NULL )
 754    {
 755       assert( entry == NULL );
 756 #ifdef DYNAMIC
 757       if ( Str_ccmp( module, rexxutil ) == 0 )
 758       {
 759          if ( ( lptr = find_library( TSD, regutil ) ) == NULL )
 760          {
 761             newhandle = 1;
 762             handle = wrapper_load( TSD, regutil ) ;
 763             if ( handle )
 764             {
 765                lptr = (struct library *)MallocTSD( sizeof( struct library )) ;
 766                lptr->name = Str_dupstrTSD( regutil ) ;
 767                lptr->handle = handle ;
 768                lptr->used = 0l;
 769             }
 770             else
 771             {
 772                Free_stringTSD( regutil );
 773                Free_stringTSD( rexxutil );
 774                return 40; /* RXFUNC_MODNOTFND */
 775             }
 776             insert_library( TSD, lptr ) ;
 777          }
 778       }
 779       if ( lptr == NULL )
 780       {
 781          if ( ( lptr = find_library( TSD, module ) ) == NULL )
 782          {
 783             newhandle = 1;
 784             handle = wrapper_load( TSD, module ) ;
 785             if ( handle )
 786             {
 787                lptr = (struct library *)MallocTSD( sizeof( struct library )) ;
 788                lptr->name = Str_dupstrTSD( module ) ;
 789                lptr->handle = handle ;
 790                lptr->used = 0l;
 791             }
 792             else
 793             {
 794                Free_stringTSD( regutil );
 795                Free_stringTSD( rexxutil );
 796                return 40; /* RXFUNC_MODNOTFND */
 797             }
 798             insert_library( TSD, lptr ) ;
 799          }
 800       }
 801 #else
 802       Free_stringTSD( regutil );
 803       Free_stringTSD( rexxutil );
 804       return 60; /* RXFUNC_NOTINIT */
 805 #endif
 806    }
 807    else
 808    {
 809       assert( entry != NULL );
 810    }
 811    if ( ( rc = loadrxfunc( TSD, lptr, rxname, objnam, entry, gci_info ) ) != 0 )
 812    {
 813 #ifdef DYNAMIC
 814       if ( newhandle )
 815          remove_library( TSD, lptr );
 816 #endif
 817    }
 818    Free_stringTSD( regutil );
 819    Free_stringTSD( rexxutil );
 820    return rc;
 821 }
 822
 823 /*
 824  * rex_hookadd processes a RexxRegisterExitDll(), RexxRegisterExitExe(),
 825  * RexxRegisterSubcomDll(), or RexxRegisterSubcomExe() request.
 826  *
 827  * rxname is the name that can be used in a hook list.
 828  * module is the name of the library and may be NULL only a RexxRegister???Exe
 829  * is processed.
 830  * objnam will be used if module != NULL only and is the name of the hook
 831  * that is exported by the library.
 832  * entry will be used if module == NULL only and is the entry point of the
 833  * hook.
 834  * user_area is the passed parameter called UserArea of the Registration.
 835  * The slot must be either EXITS or SUBCOMS.
 836  *
 837  * Returns a return code suitable for RexxRegister???.
 838  */
 839 static int rex_hookadd( const tsd_t *TSD, const streng *rxname,
 840                         const streng *module, const streng *objnam,
 841                         PFN entry,
 842                         void *user_area, int slot )
 843 {
 844    struct library *lptr=NULL;
 845    int rc;
 846 #ifdef DYNAMIC
 847    void *handle;
 848    int newhandle = 0;
 849 #endif
 850
 851    assert( rxname != NULL );
 852
 853    if ( module != NULL )
 854    {
 855       assert( entry == NULL );
 856 #ifdef DYNAMIC
 857       if ( ( lptr = find_library( TSD, module ) ) == NULL )
 858       {
 859          newhandle = 1;
 860          handle = wrapper_load( TSD, module ) ;
 861          if ( handle )
 862          {
 863             lptr = (struct library *)MallocTSD( sizeof( struct library )) ;
 864             lptr->name = Str_dupstrTSD( module ) ;
 865             lptr->handle = handle ;
 866             lptr->used = 0l;
 867          }
 868          else
 869          {
 870             return 50; /* RX???_LOADERR */
 871          }
 872          insert_library( TSD, lptr ) ;
 873       }
 874 #else
 875       return 1004; /* RX???_NOTINIT */
 876 #endif
 877    }
 878    else
 879    {
 880       assert( entry != NULL );
 881    }
 882    rc = loadrxhook( TSD, lptr, rxname, objnam, entry, user_area, slot );
 883    if ( ( rc != 0 ) && ( rc != 10 ) )
 884    {
 885 #ifdef DYNAMIC
 886       if ( newhandle )
 887          remove_library( TSD, lptr );
 888 #endif
 889    }
 890    return rc;
 891 }
 892
 893 /*
 894  * rex_rxfuncerrmsg implements the BIF RxFuncErrMsg.
 895  */
 896 streng *rex_rxfuncerrmsg( tsd_t *TSD, cparamboxptr parms )
 897 {
 898 #ifdef DYNAMIC
 899    lib_tsd_t *lt;
 900 #endif
 901
 902    checkparam( parms, 0, 0, "RXFUNCERRMSG" );
 903
 904 #ifdef DYNAMIC
 905    lt = (lib_tsd_t *)TSD->lib_tsd;
 906    if ( lt->err_message )
 907       return Str_dupTSD( lt->err_message );
 908    else
 909       return nullstringptr();
 910 #else
 911    return Str_creTSD( "Module doesn't support dynamic linking; are you running the \"regina\" executable?" );
 912 #endif
 913 }
 914
 915 /*
 916  * rex_rxfuncquery implements the BIF RxFuncQuery.
 917  */
 918 streng *rex_rxfuncquery( tsd_t *TSD, cparamboxptr parms )
 919 {
 920 #ifdef DYNAMIC
 921    streng *name;
 922    struct entry_point *fptr;
 923 #endif
 924
 925    checkparam( parms, 1, 1, "RXFUNCQUERY" );
 926
 927 #ifdef DYNAMIC
 928    name = Str_upper( Str_dupTSD( parms->value ) );
 929    fptr = find_entry_point( TSD, name, NULL, FUNCS );
 930    Free_stringTSD( name );
 931
 932    if ( fptr )
 933       return int_to_streng( TSD, 0 );
 934    return int_to_streng( TSD, 1 );
 935 #else
 936    return int_to_streng( TSD, 1 );
 937 #endif
 938 }
 939
 940
 941 /*
 942  * rex_rxfuncadd implements the BIF RxFuncAdd.
 943  * The returned value is suitable for RexxRegisterFunctionDll.
 944  *
 945  * Parameters:
 946  *   1) name of the function to be added (in Rexx)
 947  *   2) name of object file to link in
 948  *   3) name of the function to be added (in the object file)
 949  */
 950 streng *rex_rxfuncadd( tsd_t *TSD, cparamboxptr parms )
 951 {
 952 #ifdef DYNAMIC
 953    streng *rxname;
 954    streng *module, *objnam;
 955    int rc;
 956 #endif
 957
 958    if ( TSD->restricted )
 959       exiterror( ERR_RESTRICTED, 1, "RXFUNCADD" );
 960
 961    checkparam( parms, 2, 3, "RXFUNCADD" );
 962
 963 #ifdef DYNAMIC
 964    rxname = Str_upper( Str_dupTSD( parms->value ) );
 965    objnam = parms->value;
 966    module = ( parms = parms->next )->value;
 967    if ( ( parms->next != NULL ) && ( parms->next->value != NULL ) )
 968       objnam = parms->next->value;
 969
 970    rc = rex_funcadd( TSD, rxname, module, objnam, NULL, NULL );
 971    Free_stringTSD( rxname );
 972    return int_to_streng( TSD, rc );
 973 #else
 974    return int_to_streng( TSD, 60 ); /* RXFUNC_NOTINIT */
 975 #endif
 976 }
 977
 978 #ifdef HAVE_GCI
 979 /*
 980  * rex_rxfuncdefine implements the BIF RxFuncDefine.
 981  *
 982  * parameters:
 983  *   1) name of the function to be added (in Rexx)
 984  *   2) name of object file to link in
 985  *   3) name of the function to be added (in the object file)
 986  *   4) name of a stem containing the definition of the function
 987  */
 988 streng *rex_rxfuncdefine( tsd_t *TSD, cparamboxptr parms )
 989 {
 990 #ifdef DYNAMIC
 991    streng *rxname,*module,*objnam,*def_stem;
 992    void *gci_info;
 993    int rc;
 994 #endif
 995
 996    if ( TSD->restricted )
 997       exiterror( ERR_RESTRICTED, 1, "RXFUNCDEFINE" );
 998
 999    checkparam( parms, 4, 4, "RXFUNCDEFINE" );
1000
1001 #ifdef DYNAMIC
1002    rxname = Str_upper( Str_dupTSD( parms->value ) );
1003    objnam = parms->value;
1004    module = ( parms = parms->next )->value;
1005    parms = parms->next;
1006    if ( parms->value != NULL )
1007       objnam = parms->value;
1008    def_stem = parms->next->value;
1009
1010    if ( ( rc = GCI_checkDefinition( TSD, def_stem, &gci_info ) ) != 0 )
1011    {
1012       Free_stringTSD( rxname );
1013       return int_to_streng( TSD, 1 );
1014    }
1015
1016    rc = rex_funcadd( TSD, rxname, module, objnam, NULL, gci_info );
1017    Free_stringTSD( rxname );
1018    if ( rc )
1019       GCI_remove_structure( TSD, (GCI_treeinfo *)gci_info );
1020    return int_to_streng( TSD, rc );
1021 #else
1022    return int_to_streng( TSD, 60 ); /* RXFUNC_NOTINIT */
1023 #endif
1024 }
1025
1026 /*
1027  * rex_gciprefixchar implements the BIF GciPrefixChar.
1028  *
1029  * parameters:
1030  *   1) new prefix character
1031  */
1032 streng *rex_gciprefixchar( tsd_t *TSD, cparamboxptr parms )
1033 {
1034    static const char valid[] = " !?_#$@"; /* last 3 are Regina specific */
1035    char oldval[2], newval[2];
1036    streng *value;
1037
1038    checkparam( parms, 0, 1, "GCIPREFIXCHAR" );
1039
1040    oldval[0] = TSD->gci_prefix[0];
1041    oldval[1] = TSD->gci_prefix[1];
1042    newval[1] = '\0';
1043
1044    value = parms->value;
1045    if ( value )
1046    {
1047       if ( Str_len( value ) == 0 )
1048       {
1049          newval[0] = '\0';
1050       }
1051       else if ( Str_len( value ) > 1 )
1052       {
1053          exiterror( ERR_INCORRECT_CALL, 23, "GCIPREFIXCHAR", 1, tmpstr_of( TSD, value ) );
1054       }
1055       else
1056       {
1057          newval[0] = Str_val( value )[0];
1058          if ( newval[0] )
1059          {
1060             if ( strchr( valid, (int) newval[0] ) == NULL )
1061             {
1062                exiterror( ERR_INCORRECT_CALL, 28, "GCIPREFIXCHAR", 1, valid, newval );
1063             }
1064          }
1065          if ( newval[0] == ' ' )
1066          {
1067             newval[0] = '\0';
1068          }
1069       }
1070    }
1071    else
1072    {
1073       newval[0] = oldval[0];
1074    }
1075
1076    TSD->gci_prefix[0] = newval[0];
1077    TSD->gci_prefix[1] = newval[1];
1078
1079    return Str_creTSD( oldval );
1080 }
1081 #endif
1082
1083 /*
1084  * rex_rxfuncdrop implements the BIF RxFuncDrop.
1085  * The returned value is suitable for RexxDeregisterFunction.
1086  */
1087 streng *rex_rxfuncdrop( tsd_t *TSD, cparamboxptr parms )
1088 {
1089    streng *name;
1090
1091    checkparam( parms, 1, 1, "RXFUNCDROP" );
1092    name = Str_upper( parms->value );
1093
1094    return int_to_streng( TSD, unloadrxfunc( TSD, name ) );
1095 }
1096
1097 /*
1098  * IfcRegFunc is the interface function for RexxRegisterFunctionExe and
1099  * RexxRegisterFunctionDll.
1100  * Either entry or module and objnam must be set.
1101  */
1102 int IfcRegFunc( const tsd_t *TSD, const char *rxname, const char *module,
1103                 const char *objnam,
1104                 PFN entry )
1105 {
1106    int rc;
1107    streng *ext;
1108    streng *intr=NULL;
1109    streng *lib=NULL;
1110
1111    ext = Str_upper( Str_creTSD( rxname ) );
1112    if ( module && objnam )
1113    {
1114       intr = Str_creTSD( objnam );
1115       lib = Str_creTSD( module );
1116    }
1117
1118    rc = rex_funcadd( TSD, ext, lib, intr, entry, NULL );
1119
1120    Free_stringTSD( ext );
1121    if ( intr && lib )
1122    {
1123       Free_stringTSD( intr );
1124       Free_stringTSD( lib );
1125    }
1126
1127    return rc;
1128 }
1129
1130 /*
1131  * IfcRegHook is the interface function for RexxRegisterExitExe,
1132  * RexxRegisterExitDll, RexxRegisterSubcomExe, RexxRegisterSubcomtDll.
1133  * Either entry or module and objnam must be set.
1134  */
1135 static int IfcRegHook( const tsd_t *TSD, const char *rxname,
1136                        const char *module, const char *objnam,
1137                        PFN entry,
1138                        void *user_area, int slot )
1139 {
1140    int rc;
1141    streng *ext;
1142    streng *intr=NULL;
1143    streng *lib=NULL;
1144
1145    ext = Str_upper( Str_creTSD( rxname ) );
1146    if ( module && objnam )
1147    {
1148       intr = Str_creTSD( objnam );
1149       lib = Str_creTSD( module );
1150    }
1151
1152    rc = rex_hookadd( TSD, ext, lib, intr, entry, user_area, slot );
1153
1154    Free_stringTSD( ext );
1155    if ( intr && lib )
1156    {
1157       Free_stringTSD( intr );
1158       Free_stringTSD( lib );
1159    }
1160
1161    return rc;
1162 }
1163
1164 /*
1165  * IfcRegExit is the interface function for RexxRegisterExitExe or
1166  * RexxRegisterExitDll.
1167  * Either entry or module and objnam must be set.
1168  */
1169 int IfcRegExit( const tsd_t *TSD, const char *rxname, const char *module,
1170                 const char *objnam,
1171                 PFN entry,
1172                 void *user_area )
1173 {
1174    return IfcRegHook( TSD, rxname, module, objnam, entry, user_area, EXITS );
1175 }
1176
1177 /*
1178  * IfcRegSubcom is the interface function for RexxRegisterSubcomExe or
1179  * RexxRegisterSubcomDll.
1180  * Either entry or module and objnam must be set.
1181  */
1182 int IfcRegSubcom( const tsd_t *TSD, const char *rxname, const char *module,
1183                   const char *objnam,
1184                   PFN entry,
1185                   void *user_area )
1186 {
1187    streng *env;
1188    env = Str_creTSD( rxname );
1189    set_subcomed_envir( TSD, env, 1 );
1190    Free_stringTSD( env );
1191    return IfcRegHook( TSD, rxname, module, objnam, entry, user_area, SUBCOMS );
1192 }
1193
1194 /*
1195  * IfcDelFunc is the interface function for RexxDeregisterFunction.
1196  */
1197 int IfcDelFunc( tsd_t *TSD, const char *rxname )
1198 {
1199    int rc;
1200    streng *ext;
1201
1202    ext = Str_upper( Str_creTSD( rxname ) );
1203    rc = unloadrxfunc( TSD, ext );
1204    Free_stringTSD( ext );
1205
1206    return rc;
1207 }
1208
1209 /*
1210  * IfcDelHook is the interface function for RexxDeregisterExit or
1211  * RexxDeregisterSubcom.
1212  */
1213 static int IfcDelHook( tsd_t *TSD, const char *rxname, const char *module,
1214                        int slot )
1215 {
1216    int rc;
1217    streng *ext,*mod;
1218
1219    ext = Str_upper( Str_creTSD( rxname ) );
1220    if ( module != NULL )
1221       mod = Str_creTSD( module );
1222    else
1223       mod = NULL;
1224    rc = unloadrxhook( TSD, ext, mod, slot );
1225    Free_stringTSD( ext );
1226    if ( mod != NULL )
1227       Free_stringTSD( mod );
1228
1229    return rc;
1230 }
1231
1232 /*
1233  * IfcDelExit is the interface function for RexxDeregisterExit.
1234  */
1235 int IfcDelExit( tsd_t *TSD, const char *rxname, const char *module )
1236 {
1237    return IfcDelHook( TSD, rxname, module, EXITS );
1238 }
1239
1240 /*
1241  * IfcDelSubcom is the interface function for RexxDeregisterSubcom.
1242  */
1243 int IfcDelSubcom( tsd_t *TSD, const char *rxname, const char *module )
1244 {
1245    streng *env;
1246    env = Str_creTSD( rxname );
1247    set_subcomed_envir( TSD, env, 0 );
1248    Free_stringTSD( env );
1249    return IfcDelHook( TSD, rxname, module, SUBCOMS );
1250 }
1251
1252 /*
1253  * IfcQueryFunc is the interface function for RexxQueryFunction.
1254  */
1255 int IfcQueryFunc( const tsd_t *TSD, const char *rxname )
1256 {
1257    int rc;
1258    streng *ext;
1259
1260    ext = Str_upper( Str_creTSD( rxname ) );
1261    rc = ( find_entry_point( TSD, ext, NULL, FUNCS ) != NULL ) ? 0 : 30;
1262    Free_stringTSD( ext );
1263
1264    return rc;
1265 }
1266
1267 /*
1268  * IfcQueryHook is the interface function for RexxQueryExit or RexxQuerySubcom.
1269  */
1270 static int IfcQueryHook( const tsd_t *TSD, const char *rxname,
1271                          const char *module, int slot, void *user_area )
1272 {
1273    streng *ext;
1274    struct entry_point *fptr,**list;
1275    struct library *lib;
1276    int cnt;
1277 #ifdef DYNAMIC
1278    streng *mod;
1279 #endif
1280
1281    ext = Str_upper( Str_creTSD( rxname ) );
1282    if ( module != NULL )
1283    {
1284 #ifdef DYNAMIC
1285       mod = Str_creTSD( module );
1286       lib = find_library( TSD, mod );
1287       Free_stringTSD( mod );
1288       if ( lib == NULL )
1289       {
1290          Free_stringTSD( ext );
1291          return 30; /* RX???_NOTREG */
1292       }
1293 #else
1294       return 1004; /* RX???_NOTINIT */
1295 #endif
1296    }
1297    else
1298       lib = NULL;
1299
1300    fptr = find_entry_point( TSD, ext, lib, slot );
1301
1302    if ( fptr == NULL )
1303    {
1304       Free_stringTSD( ext );
1305       return 30; /* RX???_NOTREG */
1306    }
1307
1308    if ( fptr->lib != lib )
1309    {
1310       /*
1311        * Found via wildcard mechanism, check if more than one element exists
1312        * and if a wildcard is allowed.
1313        */
1314       if ( lib != NULL )
1315       {
1316          Free_stringTSD( ext );
1317          return 30; /* RX???_NOTREG */
1318       }
1319
1320       cnt = find_all_entries( TSD, ext, slot, &list );
1321       FreeTSD( list );
1322       Free_stringTSD( ext );
1323
1324       if ( cnt > 1 )
1325          return 30; /* RX???_NOTREG */
1326    }
1327    else
1328       Free_stringTSD( ext );
1329
1330    if ( user_area != NULL )
1331       memcpy( user_area, fptr->special.user_area,
1332               sizeof ( fptr->special.user_area ) );
1333    return 0;
1334 }
1335
1336 /*
1337  * IfcQueryExit is the interface function for RexxQueryExit.
1338  */
1339 int IfcQueryExit( const tsd_t *TSD, const char *rxname, const char *module,
1340                   void *user_area )
1341 {
1342    return IfcQueryHook( TSD, rxname, module, EXITS, user_area );
1343 }
1344
1345 /*
1346  * IfcQuerySubcom is the interface function for RexxQuerySubcom.
1347  */
1348 int IfcQuerySubcom( const tsd_t *TSD, const char *rxname, const char *module,
1349                     void *user_area )
1350 {
1351    return IfcQueryHook( TSD, rxname, module, SUBCOMS, user_area );
1352 }
1353
1354 struct entry_point *loaded_lib_func( const tsd_t *TSD, const streng *name )
1355 {
1356    struct entry_point *box;
1357    streng *upp;
1358
1359    upp = Str_upper( Str_dupTSD( name ) );
1360    box = find_first_entry_point( TSD, upp, FUNCS );
1361    Free_stringTSD( upp );
1362
1363    return box;
1364 }
1365
1366 /*
1367  * exit_hook returns the most recent exit handler of the given name.
1368  * The value may be NULL if no hook is registered.
1369  */
1370 struct entry_point *exit_hook( const tsd_t *TSD, const char *env, int len )
1371 {
1372    streng *name;
1373    struct entry_point *ret;
1374
1375    name = Str_upper( Str_ncreTSD( env, len ) );
1376    ret = find_first_entry_point( TSD, name, EXITS );
1377    Free_stringTSD( name );
1378
1379    return ret;
1380 }
1381
1382 /*
1383  * subcom_hook returns the most recent subcom handler of the given name.
1384  * The value may be NULL if no hook is registered.
1385  */
1386 struct entry_point *subcom_hook( const tsd_t *TSD, const char *com, int len )
1387 {
1388    streng *name;
1389    struct entry_point *ret;
1390
1391    name = Str_upper( Str_ncreTSD( com, len ) );
1392    ret = find_first_entry_point( TSD, name, SUBCOMS );
1393    Free_stringTSD( name );
1394
1395    return ret;
1396 }