regina/rexxsaa.c

   1 #ifndef lint
   2 static char *RCSid = "$Id$";
   3 #endif
   4 /*
   5  *  The Regina Rexx Interpreter
   6  *  Copyright (C) 1993-1994  Anders Christensen <anders@pvv.unit.no>
   7  *
   8  *  This library is free software; you can redistribute it and/or
   9  *  modify it under the terms of the GNU Library General Public
  10  *  License as published by the Free Software Foundation; either
  11  *  version 2 of the License, or (at your option) any later version.
  12  *
  13  *  This library is distributed in the hope that it will be useful,
  14  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  15  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16  *  Library General Public License for more details.
  17  *
  18  *  You should have received a copy of the GNU Library General Public
  19  *  License along with this library; if not, write to the Free
  20  *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21  */
  22
  23 /*
  24  * This file implements the client part of the SAA API when Regina
  25  * is linked into a program using SAA API. There is one routine for
  26  * each of the functions in SAA API, and the functionality is partly
  27  * implemented here, and partly by calling subroutines in Regina.
  28  * Note that the interface to Regina is as simple as possible, so that
  29  * a multitude of different transport mechanisms can be used (although
  30  * normal linking is probably the most common.
  31  *
  32  * The following SAA API functions is defined in this source file:
  33  *
  34  *    RexxStart()               --- execute Rexx code
  35  *    RexxRegisterSubcomExe()   --- register subcommand handler
  36  *    RexxRegisterSubcomDll()   --- ditto (not yet implemented)
  37  *    RexxQuerySubcom()         --- query subcommand handler
  38  *    RexxDeregisterSubcom()    --- deregister subcommand handler
  39  *    RexxVariablePool()        --- handle Rexx variable manipulation
  40  *    RexxRegisterExitExe()     --- register exit handler
  41  *    RexxRegisterExitDll()     --- ditto (not yet implemented)
  42  *    RexxDeregisterExit()      --- deregister exit handler
  43  *    RexxQueryExit()           --- query exit handler
  44  *    RexxRegisterFunctionExe() --- register external function handler
  45  *    RexxRegisterFunctionDll() --- ditto (from dynamic library)
  46  *    RexxQueryFunction()       --- query external function
  47  *    RexxDeregisterFunction()  --- deregister external function
  48  *    RexxSetHalt()             --- set Halt and Trace
  49  *    RexxCreateQueue()         --- create named queued
  50  *    RexxDeleteQueue()         --- delete named queued
  51  *    RexxQueryQueue()          --- query named queued
  52  *    RexxAddQueue()            --- add line to named queued
  53  *    RexxPullQueue()           --- pull line from named queued
  54  *    RexxAddMacro()            --- add a macro to macrospace
  55  *    RexxClearMacroSpace()     --- remove all macros from macrospace
  56  *    RexxDropMacro()           --- remove macro from macrospace
  57  *    RexxLoadMacroSpace()      --- load macrospace macros from file
  58  *    RexxQueryMacro()          --- find a macro's search order
  59  *    RexxReorderMacro()        --- change the search order for a macro
  60  *    RexxSaveMacroSpace()      --- save macrospace to file
  61  *    RexxFreeMemory()          --- free memory allocated by Rexx API
  62  *    RexxAllocateMemory()      --- allocate memory to be freed by Rexx API
  63  *
  64  * These functions are all defined in the doc for SAA API. In addition,
  65  * a number of calls in Regina are called, as well as a number of calls
  66  * are defined for use by Regina. These all start with the prefix Ifc.
  67  * First the one defined in rexxsaa.c, which can be called from other
  68  * parts of Regina:
  69  *
  70  *    IfcSubCmd()               --- invoke a subcommand
  71  *    IfcDoExit()               --- invoke a system exit handler
  72  *    IfcExecFunc()             --- invoke an external function handler
  73  *    IfcExecFuncDll()          --- invoke an external function handler in a DLL
  74  *
  75  * Then the functions which are defined elsewhere, which can be called
  76  * by this source code:
  77  *
  78  *    IfcExecScript()           --- start to execute Rexx code
  79  *    IfcVarPool()              --- handle a variable manipulation request
  80  *    IfcRegFunc()              --- register an external function name
  81  *    IfcDelFunc()              --- deregister an external function name
  82  *    IfcQueryFunc()            --- queries an external function name
  83  *    IfcAllocateMemory()       --- allocate memory for API user
  84  *    IfcFreeMemory()           --- free memory from API user
  85  *    IfcDeleteQueue()          --- delete queue
  86  *    IfcAddQueue()             --- add a line to the queue
  87  *    IfcPullQueue()            --- pull a line off the queue
  88  *
  89  * All these routines are properly defined in the documentation for
  90  * Regina. Other than the functions listed, the code in this file has
  91  * been isolated as far as possible, and no functions specific to
  92  * Regina is used, not even for memory allocation.
  93  */
  94
  95 /*
  96  * We need to define these symbols in order to get the proper macros,
  97  * datatypes, and declaration when including rexxsaa.h.
  98  */
  99 #define INCL_RXSHV
 100 #define INCL_RXSUBCOM
 101 #define INCL_RXFUNC
 102 #define INCL_RXSYSEXIT
 103 #define INCL_RXARI
 104 #define INCL_RXQUEUE
 105
 106
 107 #ifdef HAVE_CONFIG_H
 108 # include "config.h"
 109 #endif
 110 /*
 111  * The rexxsaa.h header file defines the interface between this file and
 112  * the client program which uses SAA API. The rxiface.h header file
 113  * defines the interface between this file and Regina.
 114  */
 115 #include "configur.h"
 116 /*
 117  * The following #define __REGINA_INTERNAL stops an error with MingW32
 118  *
 119  */
 120 #define __REGINA_INTERNAL
 121 #include "rexxsaa.h"
 122 #include "defs.h"
 123 #define DONT_TYPEDEF_PFN
 124 #ifndef RXLIB
 125 #define RXLIB
 126 #endif
 127 #include "rexx.h"
 128 #include "rxiface.h"
 129 #include "extstack.h"
 130
 131 #include <limits.h>
 132 #include <stdio.h>
 133 #include <string.h>
 134 #ifdef HAVE_UNISTD_H
 135 # include <unistd.h>
 136 #endif
 137 #ifdef HAVE_ASSERT_H
 138 # include <assert.h>
 139 #endif
 140 #include <stdlib.h>
 141 #include <errno.h>
 142 #include <fcntl.h>
 143 #include <ctype.h>
 144 #include <setjmp.h>
 145
 146 #if defined(__EPOC32__) || defined(__WINS__)
 147 # ifdef APIRET
 148 #  undef APIRET
 149 # endif
 150 # define APIRET unsigned long
 151 # ifdef APIENTRY
 152 #  undef APIENTRY
 153 # endif
 154 #else
 155 # define EXPORT_C
 156 #endif
 157
 158 struct funcbox2 {
 159    struct funcbox2 *next, *prev ;
 160    PSZ name ;
 161    RexxFunctionHandler *entry ;
 162    unsigned hash ;
 163 };
 164
 165 /* The following value allows called programs to call "free" to the return
 166  * parameters without destroying our stack.
 167  */
 168 #define ILLEGAL_USE_SIZE (8 * sizeof(void *))
 169
 170 typedef struct { /* rex_tsd: static variables of this module (thread-safe) */
 171    struct funcbox2 *    saafuncs[133];
 172    struct ExitHandlers *CurrentHandlers ;
 173    struct EnvBox *      FirstEnv ;
 174    struct EnvBox *      FirstExit ;
 175 } rex_tsd_t; /* thread-specific but only needed by this module. see
 176               * init_rexxsaa
 177               */
 178
 179 #define EXT_FUNCS_COUNT (sizeof(rt->saafuncs) / sizeof(rt->saafuncs[0]))
 180
 181 /*
 182  * The struct EnvBox datatype holds the definition of any subcommand
 183  * handler (i.e. an 'environment'). It is intended as an double-linked
 184  * list of entries, though performence concerns may force a change in
 185  * this structure later. It contains the name of the environment, and
 186  * an eight byte dataarea of user defined data. The same datastructure
 187  * is also used for holding the symbol table of external functions.
 188  *
 189  * This may prove a problem in the future, since the number of external
 190  * functions are generally much larger than the number of subcommand
 191  * handlers. Thus, different datastructures may be necessary to acheive
 192  * maximum performance.
 193  */
 194 struct EnvBox
 195 {
 196    struct EnvBox *prev, *next ;    /* double linked list pointers */
 197    char *EnvName ;                 /* environment/function name */
 198    unsigned hash ;                 /* hash value of the EnvName */
 199    unsigned char UserData[8] ;     /* user defined data area */
 200    union {
 201      PFN EntryPnt ;                /* external function entry point */
 202      RexxSubcomHandler *SubCom ;   /* subcommand handler entry point */
 203    } u ;
 204 } ;
 205
 206 struct ExitHandlers
 207 {
 208    RexxExitHandler *(Handlers[RXNOOFEXITS]) ; /* for RexxRegisterExitExe */
 209    struct ExitHandlers *prev ;
 210 } ;
 211
 212
 213
 214 /*
 215  * The following MAP_TYPE() macro maps from the SAA API macros holding
 216  * the type of an invocation (function, subroutine or command), to its
 217  * equivalent value in the internal interface of Regina (as defined in
 218  * the file rxiface.h
 219  */
 220 #define MAP_TYPE(a) ((a)==RXCOMMAND ? RX_TYPE_COMMAND : \
 221               (a)==RXFUNCTION ? RX_TYPE_FUNCTION : RX_TYPE_SUBROUTINE)
 222
 223
 224 /* init_rexxsaa initializes the module.
 225  * Currently, we set up the thread specific data.
 226  * The function returns 1 on success, 0 if memory is short.
 227  */
 228 int init_rexxsaa( tsd_t *TSD )
 229 {
 230    rex_tsd_t *rt;
 231
 232    if (TSD->rex_tsd != NULL)
 233       return(1);
 234
 235    if ((rt = TSD->rex_tsd = MallocTSD(sizeof(rex_tsd_t))) == NULL)
 236       return(0);
 237    memset(rt,0,sizeof(rex_tsd_t));  /* correct for all values */
 238    return(1);
 239 }
 240
 241 /* deinit_rexxsaa deinitializes the module and frees used memory blocks not
 242  * allocated by the Malloc-Interface. There isn't anything to do currently.
 243  */
 244 void deinit_rexxsaa( tsd_t *TSD )
 245 {
 246 }
 247
 248
 249 /* StartupInterface initializes the Rexx system once per thread. Values like
 250  * like __regina_get_tsd()->systeminfo are set. The true purpose of this
 251  * function is to create an environment which allows the run of the
 252  * interpreter. This is exactly the case when systeminfo exists. The last
 253  * systeminfo is hopefully never deleted but that won't do any harm if we
 254  * reinitialize the Rexx environment.
 255  *
 256  * There is a three-stage step to let a Rexx program run:
 257  * 1) Initialize the runtime system and programming environment. This is
 258  *    done by __regina_get_tsd() done in GLOBAL_ENTRY_POINT().
 259  *    After this call you may use Malloc() and friends: basic things.
 260  * 2) Initialize the Rexx system. This is done by
 261  *    __regina_faked_main() here or directly by any other caller of
 262  *    __regina_faked_main() or main():
 263  *    You are then allowed to access variables from the variable pool, load
 264  *    a Rexx program or just call a Rexx API function.
 265  *    Hint: The detection of this step is done as follows:.
 266  *    Rexx_system_is_running = (__regina_get_tsd()->systeminfo != NULL);
 267  *    or a similar compare.
 268  * 3) Load the Rexx program in memory.
 269  *    Although you don't know, what program is currently loaded, you can
 270  *    check if a program is loaded (and running) by checking:
 271  *    Program_running = (__regina_get_tsd()->systeminfo->tree.root != NULL);
 272  *    This step is done in RexxStart or by main()/__regina_faked_main() when
 273  *    called as a program.
 274  * Never use __regina_get_tsd() when it is not needed, of course.
 275  * This function should be called as GLOBAL_ENTRY_POINT() at the very
 276  * start of the interpreter but after GLOBAL_ENTRY_POINT.
 277  */
 278 static void StartupInterface(tsd_t *TSD)
 279 {
 280    /* The following value won't change and is const */
 281    static char *args[] = { "regina", "-Ci,foo", NULL } ;
 282
 283    if (TSD->systeminfo != NULL)
 284       return;
 285
 286    __regina_faked_main( 2, args ) ;
 287 }
 288
 289
 290 /*
 291  * FillReq prepares a String with a given Length to be exported to an
 292  * external application.
 293  * The FillReq() function takes as parameter a pointer to a VarPool()
 294  * request structure variable, and the definition of a string, and
 295  * fill the content of the string into the request block. Note that the
 296  * third parameter is gobbled up, so it can not be used or released by
 297  * the calling function afterwards. Also, there are two macros defined,
 298  * which gives a better access to the contents of the function
 299  */
 300 #define FillReqName(a,b,c) FillReq(a,b,c,1)
 301 #define FillReqValue(a,b,c) FillReq(a,b,c,0)
 302
 303 static void FillReq( PSHVBLOCK Req, ULONG Length, const char *String, int type )
 304 {
 305    RXSTRING *string=NULL ;
 306    ULONG *strlen=NULL ;
 307    ULONG SaveLength=0;
 308
 309    string = type ? &(Req->shvname) : &(Req->shvvalue) ;
 310    strlen = type ? &(Req->shvnamelen) : &(Req->shvvaluelen) ;
 311
 312    /*
 313     * If the string is undefined, set ->strptr to NULL. It is not required
 314     * that the lengths parameters are set to zero, but I'll do this as
 315     * nice gest to the users; someone is probably going to believe that
 316     * this is how the data is returned.
 317     */
 318    if (Length == RX_NO_STRING)
 319    {
 320       string->strptr = NULL ;
 321       *strlen = string->strlength = 0 ;
 322       return ;
 323    }
 324
 325    /*
 326     * If a string was supplied, use it, else allocate sufficient space.
 327     * The then part of the if will just copy the data to the user-supplied
 328     * return string data area, noting a truncation is one occurred.
 329     */
 330    if (string->strptr)
 331    {
 332       if (*strlen<Length)
 333       {
 334           Req->shvret |= RXSHV_TRUNC ;
 335           SaveLength = Length;
 336           Length = *strlen ;
 337           *strlen = SaveLength;
 338       }
 339       else
 340          *strlen = Length ;
 341       memcpy(string->strptr, String, Length ) ;
 342       string->strlength = Length ;
 343    }
 344    else
 345    {
 346       /*
 347        * The else part of the if will allocate new space for the data, and
 348        * fills in the data, or return a memory fault if data could not
 349        * properly be allocated.
 350        * MH - 6-Feb-97
 351        * Some mallocs do not allow for a size of 0, so simply set the
 352        * return length to 0 and don't attempt to do the malloc.
 353        */
 354       if (Length)
 355       {
 356          string->strptr = (char *)IfcAllocateMemory( Length ) ;
 357          if (string->strptr)
 358          {
 359             memcpy( string->strptr, String, Length ) ;
 360             string->strlength = Length ;
 361             *strlen = Length ;
 362          }
 363          else
 364             Req->shvret |= RXSHV_MEMFL ;
 365       }
 366       else
 367       {
 368        /* allocate at least 1 byte */
 369        string->strptr = (char *)IfcAllocateMemory( 1 ) ;
 370        if (string->strptr)
 371        {
 372           /* no copy needed                    */
 373           string->strlength = Length ;
 374           *strlen = Length ;
 375        }
 376        else
 377           Req->shvret |= RXSHV_MEMFL ;
 378       }
 379    }
 380 }
 381
 382 /* ========================================================================
 383  * Here starts the section for maintaining the list of environments
 384  * supported by this environment. There are several routines using
 385  * the functions in this section, the routines defined here are:
 386  *
 387  *  FindEnv()  --- retrieves a pointer to a environment box.
 388  *
 389  * Actually, it used to be more, one to insert and one to delete.
 390  * However, in order to save code, these was moved into the routines
 391  * where they were called (they were used only once). The functions
 392  * into which the code was moved are RexxRegisterSubcomExe(), and
 393  * RexxDeregisterSubcom(). To improve modularization, and to
 394  * ease the introduction of a new datastructure, the code should
 395  * probably be extracted and inserted in this section.
 396  */
 397
 398
 399 #define BOX_IS_ENVIR 0
 400 #define BOX_IS_EXIT 1
 401
 402 /*
 403  * Find a particular environment, and return a pointer to a struct
 404  * containing information about that environment. If it is not found,
 405  * a pointer to NULL is returned.
 406  */
 407 #define FindEnvir(a,b) FindBox(TSD,a,b,BOX_IS_ENVIR)
 408 #define FindExit(a,b) FindBox(TSD,a,b,BOX_IS_EXIT)
 409
 410 static struct EnvBox *FindBox( const tsd_t *TSD, const char *Env, int EnvLen, int type )
 411 {
 412    struct EnvBox *bptr;
 413    rex_tsd_t *rt;
 414    unsigned h;
 415
 416    rt = TSD->rex_tsd;
 417    bptr = ((type==BOX_IS_ENVIR) ? rt->FirstEnv : rt->FirstExit) ;
 418    assert( Env ) ;
 419    h = hashvalue(Env, EnvLen);
 420    for (; bptr; bptr=bptr->next)
 421    {
 422       if (h != bptr->hash)
 423          continue;
 424       if (memcmp(bptr->EnvName,Env,EnvLen) == 0)
 425          return bptr ;
 426    }
 427
 428    return NULL ;
 429 }
 430
 431 #define AddEnvir(a,b,c,d) AddBox(TSD,a,b,c,d,BOX_IS_ENVIR)
 432 #define AddExit(a,b,c,d) AddBox(TSD,a,b,c,d,BOX_IS_EXIT)
 433
 434 static struct EnvBox *AddBox( const tsd_t *TSD, const char *EnvName, int EnvLen,
 435                               const void *UserArea, PFN EntryPoint, int type )
 436 {
 437    struct EnvBox *NewBox ;
 438    struct EnvBox **first ;
 439    rex_tsd_t *rt;
 440
 441    rt = TSD->rex_tsd;
 442    first = (type==BOX_IS_ENVIR) ? &rt->FirstEnv : &rt->FirstExit ;
 443    NewBox = MallocTSD( sizeof( struct EnvBox ) ) ; /* This is not exported */
 444    if (!NewBox)
 445       return NULL ;
 446
 447    NewBox->EnvName = MallocTSD( EnvLen+1 ) ; /* This is not exported */
 448    if (!NewBox->EnvName)
 449    {
 450       FreeTSD( NewBox ) ;
 451       return NULL ;
 452    }
 453
 454    NewBox->prev = NULL ;
 455    NewBox->next = (*first) ;
 456    if (*first)
 457       (*first)->prev = NewBox ;
 458    (*first) = NewBox ;
 459
 460    memcpy( NewBox->EnvName, EnvName , EnvLen ) ;
 461    NewBox->EnvName[EnvLen] = '\0';
 462    NewBox->hash = hashvalue(EnvName, EnvLen);
 463    NewBox->u.EntryPnt = EntryPoint ;
 464    if (UserArea)
 465       memcpy( NewBox->UserData, UserArea, 8 ) ;
 466    else
 467       memset( NewBox->UserData, 0x00, 8 ) ;
 468
 469    return NewBox ;
 470  }
 471
 472
 473 #define RemoveExit(a,b) RemoveBox(TSD,a,b,BOX_IS_EXIT)
 474 #define RemoveEnvir(a,b) RemoveBox(TSD,a,b,BOX_IS_ENVIR)
 475
 476 static int RemoveBox( const tsd_t *TSD, const char *EnvName, int EnvLen, int type )
 477 {
 478    struct EnvBox *OldBox ;
 479    struct EnvBox **First ;
 480    rex_tsd_t *rt;
 481
 482    rt = TSD->rex_tsd;
 483    OldBox = FindBox( TSD, EnvName, EnvLen, type ) ;
 484    if (OldBox)
 485    {
 486       First = (type==BOX_IS_ENVIR) ? &rt->FirstEnv : &rt->FirstExit ;
 487       if (OldBox->prev)
 488          OldBox->prev->next = OldBox->next ;
 489       if (OldBox->next)
 490          OldBox->next->prev = OldBox->prev ;
 491       if ((*First)==OldBox)
 492          (*First) = OldBox->prev ;
 493
 494       FreeTSD( OldBox->EnvName ) ;
 495       FreeTSD( OldBox ) ;
 496       return 0 ;
 497    }
 498    return 1 ;
 499 }
 500
 501 /* RetLen and RetStr should point to {0,NULL}. They will be filled with
 502  * freshly allocated values. A return value will always exist.
 503  */
 504 int IfcSubCmd( const tsd_t *TSD, int EnvLen, const char *EnvStr,
 505                int CmdLen, const char *CmdStr,
 506                int *RetLen, char **RetStr )
 507 {
 508    RXSTRING Cmd, Ret ;
 509    char *OldResult= NULL ;
 510    USHORT Flags=0 ;
 511    char *Command ;
 512    char *EnvNam;
 513    struct EnvBox *Envir=NULL ;
 514    int rvalue=0, RCode=0, rc=RXEXIT_NOT_HANDLED ;
 515    char subcmd_result[ILLEGAL_USE_SIZE+RXAUTOBUFLEN] ;
 516    RXCMDHST_PARM cmdhst;
 517    PUCHAR parm=NULL;
 518    rex_tsd_t *rt;
 519
 520    rt = TSD->rex_tsd;
 521
 522    Command = MallocTSD( CmdLen + 1);
 523    memcpy(Command,CmdStr,CmdLen);
 524    Command[CmdLen] = '\0';
 525    memset( subcmd_result, 0, sizeof( subcmd_result ) ) ;
 526    MAKERXSTRING( Cmd, Command, CmdLen ) ;
 527    MAKERXSTRING( Ret, subcmd_result + ILLEGAL_USE_SIZE, RXAUTOBUFLEN) ;
 528    OldResult = subcmd_result + ILLEGAL_USE_SIZE;
 529    /*
 530     * Terminate the command string with nul character
 531     */
 532    if ( rt->CurrentHandlers && rt->CurrentHandlers->Handlers[RXCMD] )
 533    {
 534       EnvNam = MallocTSD( EnvLen + 1 ) ;
 535       memcpy(EnvNam, EnvStr, EnvLen ) ;
 536       EnvNam[EnvLen] = '\0';
 537       cmdhst.rxcmd_flags.rxfcfail = 0;
 538       cmdhst.rxcmd_flags.rxfcerr = 0;
 539       cmdhst.rxcmd_command = Cmd ;
 540       cmdhst.rxcmd_address = EnvNam ;
 541       cmdhst.rxcmd_addressl = (USHORT) EnvLen ;
 542       cmdhst.rxcmd_retc = Ret;
 543       cmdhst.rxcmd_dll = NULL;
 544       cmdhst.rxcmd_dll_len = 0;
 545       parm = (PUCHAR)&cmdhst;
 546       rc = (*(rt->CurrentHandlers->Handlers[RXCMD]))(RXCMD, RXCMDHST, parm);
 547       assert( rc==RXEXIT_HANDLED || rc==RXEXIT_NOT_HANDLED ||
 548               rc==RXEXIT_RAISE_ERROR ) ;
 549       if (cmdhst.rxcmd_flags.rxfcerr)
 550          RCode = RXFLAG_ERROR ;
 551       else if (cmdhst.rxcmd_flags.rxfcfail)
 552          RCode = RXFLAG_FAILURE ;
 553       else
 554          RCode = RXFLAG_OK;
 555       Ret = cmdhst.rxcmd_retc;
 556       FreeTSD( EnvNam ) ;
 557    }
 558    if (rc == RXEXIT_NOT_HANDLED)
 559    {
 560       Envir = FindEnvir( EnvStr , EnvLen ) ;
 561       if (Envir)
 562       {
 563          MAKERXSTRING( Cmd, Command, CmdLen ) ;
 564          if (Ret.strlength && OldResult != Ret.strptr) /* Ignore return values*/
 565             IfcFreeMemory( Ret.strptr ) ;
 566          MAKERXSTRING( Ret, subcmd_result + ILLEGAL_USE_SIZE, RXAUTOBUFLEN) ;
 567          OldResult = subcmd_result + ILLEGAL_USE_SIZE ;
 568          rvalue = (*(Envir->u.SubCom))( &Cmd, &Flags, &Ret ) ;
 569          if (Flags==RXSUBCOM_OK)
 570             RCode = RXFLAG_OK ;
 571          else if (Flags==RXSUBCOM_ERROR)
 572             RCode = RXFLAG_ERROR ;
 573          else if (Flags==RXSUBCOM_FAILURE)
 574             RCode = RXFLAG_FAILURE ;
 575          else
 576             exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" )  ;
 577       }
 578       else
 579       {
 580          RCode = RXFLAG_NOTREG ;
 581          Ret.strlength = 0 ;
 582       }
 583    }
 584
 585    if (Ret.strlength)
 586    {
 587       *RetLen = Ret.strlength ;
 588       *RetStr = MallocTSD( Ret.strlength ) ;
 589       memcpy( *RetStr, Ret.strptr, Ret.strlength ) ;
 590    }
 591    else
 592    {
 593       *RetLen = 1 ;
 594       *RetStr = MallocTSD( 1 ) ;
 595       (*RetStr)[0] = '0' ;
 596    }
 597
 598    if (Ret.strlength && OldResult != Ret.strptr)
 599       IfcFreeMemory( Ret.strptr ) ;
 600
 601    FreeTSD(Command);
 602    return RCode ;
 603 }
 604
 605 /* IfcDoExit calls an exit handler with one of the following codes set in Code.
 606  * The arguments may either be input or output or nothing but not both.
 607  * Parameter      INIT TERMIN PULL TRCIN STDOUT STDERR GETENV PUTENV
 608  * ---------------------------------------------------------------------------------------
 609  * InputLength    NULL NULL   set  set   NULL   NULL   set    NULL
 610  * InputString    NULL NULL   set  set   NULL   NULL   set    NULL
 611  * OutputLength1  0    0      0    0     set    set    set    set
 612  * OutputString1  NULL NULL   NULL NULL  set    set    set    set
 613  * OutputLength2  0    0      0    0     0      0      0      set
 614  * OutputString2  NULL NULL   NULL NULL  NULL   NULL   NULL   set
 615  *
 616  * Notes:
 617  * 1) An output string should always be a fresh copy. Although it is not
 618  *    allowed the user program may destroy the contents.
 619  *    For this reason OutputString is not declared as const.
 620  *    OutputString should be 0-terminated (0 not counted in OutputLength).
 621  * 2) An input string is normally NOT required. Just provide a position
 622  *    where to place the input to. Example:
 623  *    char *in = NULL;
 624  *    int inlen = 0;
 625  *    IfcDoExit(?,?,0,NULL,0,NULL,&inlen,&in);
 626  *    If the caller of this function provides a valid input string it is
 627  *    ignored on exit. This function always returns back a freshly allocated
 628  *    string in InputString (an empty string in case of errors).
 629  */
 630 int IfcDoExit( const tsd_t *TSD, int Code,
 631                int OutputLength1, char *OutputString1,
 632                int OutputLength2, char *OutputString2,
 633                int *InputLength, char **InputString )
 634 {
 635    int rc=0;
 636    LONG SubCode=0, MainCode=0 ;
 637    ULONG retlen=0;
 638    char *retstr=NULL;
 639    RXSIOSAY_PARM siosay;
 640    RXSIOTRD_PARM siotrd;
 641    RXSIODTR_PARM siodtr;
 642    RXENVSET_PARM envset;
 643    RXENVGET_PARM envget;
 644    PEXIT parm=NULL;
 645    rex_tsd_t *rt;
 646
 647    rt = TSD->rex_tsd;
 648
 649    MAKERXSTRING( siodtr.rxsiodtr_retc, NULL, 0) ; /* Make compiler happy */
 650    MAKERXSTRING( siotrd.rxsiotrd_retc, NULL, 0) ; /* Make compiler happy */
 651    MAKERXSTRING( envget.rxenv_value, NULL, 0) ; /* Make compiler happy */
 652
 653    switch (Code)
 654    {
 655       case RX_EXIT_STDERR:
 656       case RX_EXIT_STDOUT:
 657          assert(InputLength == NULL &&
 658                 InputString == NULL &&
 659                 OutputLength2 == 0 &&
 660                 OutputString2 == NULL &&
 661                 OutputLength2 == 0 &&
 662                 OutputString2 == NULL);
 663          siosay.rxsio_string.strptr = OutputString1 ;
 664          siosay.rxsio_string.strlength = OutputLength1 ;
 665          parm = (PEXIT)&siosay;
 666          SubCode = (Code==RX_EXIT_STDOUT) ? RXSIOSAY : RXSIOTRC ;
 667          MainCode = RXSIO ;
 668
 669          break ;
 670
 671       case RX_EXIT_TRCIN:
 672          assert(OutputLength1 == 0 &&
 673                 OutputString1 == NULL &&
 674                 InputLength != NULL &&
 675                 InputString != NULL &&
 676                 OutputLength2 == 0 &&
 677                 OutputString2 == NULL);
 678          siodtr.rxsiodtr_retc.strlength = *InputLength ;
 679          siodtr.rxsiodtr_retc.strptr = *InputString ;
 680          parm = (PEXIT)&siodtr;
 681          SubCode = RXSIODTR ;
 682          MainCode = RXSIO ;
 683          break ;
 684
 685       case RX_EXIT_PULL:
 686          assert(OutputLength1 == 0 &&
 687                 OutputString1 == NULL &&
 688                 InputLength != NULL &&
 689                 InputString != NULL &&
 690                 OutputLength2 == 0 &&
 691                 OutputString2 == NULL);
 692          siotrd.rxsiotrd_retc.strlength = *InputLength ;
 693          siotrd.rxsiotrd_retc.strptr = *InputString ;
 694          parm = (PEXIT)&siotrd;
 695          SubCode = RXSIOTRD ;
 696          MainCode = RXSIO ;
 697          break ;
 698
 699       case RX_EXIT_INIT:
 700          assert(OutputLength1 == 0 &&
 701                 OutputString1 == NULL &&
 702                 InputLength == NULL &&
 703                 InputString == NULL &&
 704                 OutputLength2 == 0 &&
 705                 OutputString2 == NULL);
 706          MainCode = RXINI ;
 707          SubCode = RXINIEXT ;
 708          break ;
 709
 710       case RX_EXIT_TERMIN:
 711          assert(OutputLength1 == 0 &&
 712                 OutputString1 == NULL &&
 713                 InputLength == NULL &&
 714                 InputString == NULL &&
 715                 OutputLength2 == 0 &&
 716                 OutputString2 == NULL);
 717          MainCode = RXTER ;
 718          SubCode = RXTEREXT ;
 719          break ;
 720
 721       case RX_EXIT_SETENV:
 722          assert(InputLength == NULL &&
 723                 InputString == NULL &&
 724                 OutputLength2 != 0 &&
 725                 OutputString2 != NULL &&
 726                 OutputLength2 != 0 &&
 727                 OutputString2 != NULL);
 728          envset.rxenv_name.strptr = OutputString1 ;
 729          envset.rxenv_name.strlength = OutputLength1 ;
 730          envset.rxenv_value.strptr = OutputString2 ;
 731          envset.rxenv_value.strlength = OutputLength2 ;
 732          parm = (PEXIT)&envset;
 733          MainCode = RXENV ;
 734          SubCode = RXENVSET ;
 735
 736          break ;
 737
 738       case RX_EXIT_GETENV:
 739          assert(OutputLength1 != 0 &&
 740                 OutputString1 != NULL &&
 741                 InputLength != NULL &&
 742                 InputString != NULL &&
 743                 OutputLength2 == 0 &&
 744                 OutputString2 == NULL);
 745          envget.rxenv_value.strlength = *InputLength ;
 746          envget.rxenv_value.strptr = *InputString ;
 747          envget.rxenv_name.strptr = OutputString1 ;
 748          envget.rxenv_name.strlength = OutputLength1 ;
 749          parm = (PEXIT)&envget;
 750          SubCode = RXENVGET ;
 751          MainCode = RXENV ;
 752          break ;
 753
 754       default:
 755          exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" )  ;
 756          break;
 757    }
 758
 759    assert( rt->CurrentHandlers->Handlers[MainCode] ) ;
 760
 761    rc = (*(rt->CurrentHandlers->Handlers[MainCode]))(MainCode, SubCode, parm);
 762    assert( rc==RXEXIT_HANDLED || rc==RXEXIT_NOT_HANDLED ||
 763            rc==RXEXIT_RAISE_ERROR ) ;
 764
 765    switch (Code)
 766    {
 767       case RX_EXIT_STDERR:
 768       case RX_EXIT_STDOUT:
 769       case RX_EXIT_INIT:
 770       case RX_EXIT_TERMIN:
 771       case RX_EXIT_SETENV:
 772          break ;
 773
 774      case RX_EXIT_TRCIN:
 775          retlen = siodtr.rxsiodtr_retc.strlength ;
 776          retstr = siodtr.rxsiodtr_retc.strptr ;
 777          break ;
 778
 779      case RX_EXIT_PULL:
 780          retlen = siotrd.rxsiotrd_retc.strlength ;
 781          retstr = siotrd.rxsiotrd_retc.strptr ;
 782          break ;
 783
 784      case RX_EXIT_GETENV:
 785          retlen = envget.rxenv_value.strlength ;
 786          retstr = envget.rxenv_value.strptr ;
 787          break ;
 788
 789       default:
 790          exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" )  ;
 791    }
 792
 793    if (rc==RXEXIT_HANDLED)
 794       rc = RX_HOOK_NOPE ;
 795    else if (rc==RXEXIT_NOT_HANDLED)
 796       rc = RX_HOOK_GO_ON ;
 797    else if (rc==RXEXIT_RAISE_ERROR)
 798       rc = RX_HOOK_ERROR ;
 799
 800    if (InputLength != NULL) /* retlen and retstr forms a return string. */
 801    {
 802       if ((retlen == 0) || (retstr == NULL))
 803       {
 804          retlen = 0;
 805          retstr = "";
 806       }
 807
 808       /* Make a fresh copy, the user may change the value very fast. */
 809       *InputString = MallocTSD( (retlen < 1) ? 1 : retlen );
 810       memcpy(*InputString, retstr, retlen);
 811       *InputLength = retlen;
 812    }
 813
 814    return rc ;
 815 }
 816
 817 /* ================================================================ */
 818 /* ================ general purpose API functions ================= */
 819
 820 /* You are not allowed to use TSD or __regina_get_tsd() here! */
 821 EXPORT_C APIRET APIENTRY RexxFreeMemory(PVOID MemoryBlock )
 822 {
 823    if (!MemoryBlock)
 824       return(RXFUNC_BADTYPE);
 825
 826    return IfcFreeMemory( MemoryBlock );
 827 }
 828
 829 /* You are not allowed to use TSD or __regina_get_tsd() here! */
 830 EXPORT_C PVOID APIENTRY RexxAllocateMemory(ULONG size )
 831 {
 832    return IfcAllocateMemory( size );
 833 }
 834
 835 /* ================================================================ */
 836 /* ================ in order to start Rexx scripts ================ */
 837
 838 EXPORT_C APIRET APIENTRY RexxStart(LONG       ArgCount,
 839                           PRXSTRING  ArgList,
 840                           PCSZ       ProgName,
 841                           PRXSTRING  Instore,
 842                           PCSZ       EnvName,
 843                           LONG       CallType,
 844                           PRXSYSEXIT Exits,
 845                           PSHORT     ReturnCode,
 846                           PRXSTRING  Result )
 847 {
 848    int cnt=0, RLength=0 ;
 849    char *RString=NULL ;
 850    int ParLengths[32] ;
 851    const char *ParStrings[32] ;
 852    int ExitFlags=0 ;
 853    int EnvNamLen=0 ;
 854    const char *EnvNamStr ;
 855    int WhereCode=0, rc=0 ;
 856    const char *SourcePtr ;
 857    const void *TinPtr ;
 858    unsigned long SourceLen, TinLen ;
 859    struct ExitHandlers *Handlers=NULL ;
 860    RexxExitHandler *handler=NULL ;
 861    struct EnvBox *EnvPtr=NULL ;
 862    LONG ResValue=0L ;
 863    unsigned long instore_length = 0;
 864    void *instore_buf = NULL;
 865    PCSZ ProgramName=ProgName;
 866    tsd_t *TSD;
 867    rex_tsd_t *rt;
 868    int restricted = 0;
 869
 870    TSD = GLOBAL_ENTRY_POINT();
 871    rt = TSD->rex_tsd;
 872    StartupInterface(TSD);
 873
 874    if ((ArgCount < 0) || ((ArgCount > 0) && (ArgList == NULL)))
 875       return(RXFUNC_BADTYPE);
 876    if (!ProgName)
 877       return(RXFUNC_BADTYPE);
 878    /*
 879     * Check if running in restricted mode first.
 880     */
 881    if ( CallType & RXRESTRICTED )
 882    {
 883       restricted = 1;
 884       CallType -= RXRESTRICTED;
 885    }
 886    if ((CallType != RXCOMMAND) &&
 887        (CallType != RXSUBROUTINE) &&
 888        (CallType != RXFUNCTION))
 889       return(RXFUNC_BADTYPE);
 890    if ((CallType == RXCOMMAND) && (ArgCount > 1))
 891       return(RX_START_TOOMANYP);
 892    if (ArgCount > sizeof(ParLengths) / sizeof(ParLengths[0]) )
 893       return(RX_START_TOOMANYP);
 894
 895    if (Instore)
 896    {
 897 /* MH 2602     if (Instore[1].strptr && Instore[1].strlength < sizeof(int)) */
 898       if (Instore[1].strptr && Instore[1].strlength < 1)
 899          return RX_START_BADP ;
 900    }
 901
 902    if (ArgCount > sizeof(ParLengths) / sizeof(ParLengths[0]) )
 903       ArgCount = sizeof(ParLengths) / sizeof(ParLengths[0]) ;
 904    for (cnt=0; cnt<ArgCount; cnt++)
 905    {
 906       ParLengths[cnt] = ArgList[cnt].strlength ;
 907       ParStrings[cnt] = ArgList[cnt].strptr ;
 908       if (ParStrings[cnt]==NULL)
 909          ParLengths[cnt] = RX_NO_STRING ;
 910    }
 911
 912    Handlers = TSD->MTMalloc( TSD, sizeof( struct ExitHandlers )) ;
 913    Handlers->prev = rt->CurrentHandlers ;
 914    rt->CurrentHandlers = Handlers ;
 915    for (cnt=0; cnt<RXNOOFEXITS; cnt++)
 916       rt->CurrentHandlers->Handlers[cnt] = NULL ;
 917
 918    ExitFlags = 0x00000000 ;
 919    for (cnt=0; Exits && Exits->sysexit_code!=RXENDLST; Exits++ )
 920    {
 921       if ( Exits->sysexit_name == NULL
 922       ||   strlen( Exits->sysexit_name ) == 0 )
 923          return(RX_START_BADP);
 924
 925       EnvPtr = FindExit( Exits->sysexit_name , strlen(Exits->sysexit_name) ) ;
 926       if (!EnvPtr)
 927          continue ;
 928
 929       /* Sigh ... Definition requires some strange casting */
 930       handler = (RexxExitHandler*)(EnvPtr->u.EntryPnt) ;
 931       switch (Exits->sysexit_code)
 932       {
 933          case RXSIO:
 934             ExitFlags |= (1<<RX_EXIT_STDOUT) | (1<<RX_EXIT_STDERR) |
 935                          (1<<RX_EXIT_TRCIN) | (1<<RX_EXIT_PULL) ;
 936             rt->CurrentHandlers->Handlers[RXSIO] = handler ;
 937             break ;
 938
 939          case RXINI:
 940             ExitFlags |= (1<<RX_EXIT_INIT) ;
 941             rt->CurrentHandlers->Handlers[RXINI] = handler ;
 942             break ;
 943
 944          case RXTER:
 945             ExitFlags |= (1<<RX_EXIT_TERMIN) ;
 946             rt->CurrentHandlers->Handlers[RXTER] = handler ;
 947             break ;
 948
 949          case RXCMD:
 950             ExitFlags |= (1<<RX_EXIT_SUBCOM) ;
 951             rt->CurrentHandlers->Handlers[RXCMD] = handler ;
 952             break ;
 953
 954          case RXFNC:
 955             ExitFlags |= (1<<RX_EXIT_FUNC) ;
 956             rt->CurrentHandlers->Handlers[RXFNC] = handler ;
 957             break ;
 958
 959          case RXENV:
 960             ExitFlags |= (1<<RX_EXIT_GETENV) | (1<<RX_EXIT_SETENV) ;
 961             rt->CurrentHandlers->Handlers[RXENV] = handler ;
 962             break ;
 963
 964          default:
 965             return(RX_START_BADP);
 966       }
 967    }
 968
 969    if (EnvName)
 970    {
 971       EnvNamLen = strlen(EnvName) ;
 972       EnvNamStr = EnvName ;
 973    }
 974    else
 975    {
 976       EnvNamLen = RX_NO_STRING ;
 977       EnvNamStr = NULL ;
 978    }
 979
 980    SourcePtr = NULL ;
 981    SourceLen = 0 ;
 982    TinPtr = NULL ;
 983    TinLen = 0 ;
 984    if (Instore && Instore[1].strptr)
 985    {
 986       WhereCode = RX_TYPE_INSTORE ;
 987       TinPtr = Instore[1].strptr ;
 988       TinLen = Instore[1].strlength ;
 989       SourcePtr = Instore[0].strptr ;
 990       SourceLen = Instore[0].strlength ;
 991    }
 992    else if (Instore && Instore[0].strptr)
 993    {
 994       WhereCode = RX_TYPE_SOURCE ;
 995       SourcePtr = Instore[0].strptr ;
 996       SourceLen = Instore[0].strlength ;
 997    }
 998    else if (Instore)
 999       WhereCode = RX_TYPE_MACRO ;
1000    else
1001       WhereCode = RX_TYPE_EXTERNAL ;
1002    starttrace(TSD) ;
1003
1004    rc = IfcExecScript( strlen(ProgramName), ProgramName,
1005           ArgCount, ParLengths, (const char **) ParStrings, MAP_TYPE(CallType),
1006           ExitFlags, EnvNamLen, EnvNamStr,  WhereCode, restricted,
1007           SourcePtr, SourceLen, TinPtr, TinLen,
1008           &RLength, &RString, &instore_buf, &instore_length) ;
1009    Handlers = rt->CurrentHandlers ;
1010    rt->CurrentHandlers = Handlers->prev ;
1011    TSD->MTFree( TSD, Handlers ) ;
1012
1013    if (WhereCode == RX_TYPE_SOURCE)
1014    {
1015       Instore[1].strptr = instore_buf;
1016       Instore[1].strlength = instore_length;
1017    }
1018
1019    if (RLength!=RX_NO_STRING)
1020       ResValue = atoi( RString ) ;
1021    else
1022       ResValue = 0 ;
1023
1024    if (ReturnCode)
1025       *ReturnCode = (SHORT) ResValue ;   /* FGC */
1026
1027    if (Result)
1028    {
1029       if (!Result->strptr || (int)Result->strlength>=RLength+1)
1030       {
1031          Result->strlength = RLength ;
1032          Result->strptr = RString ;
1033       }
1034       else
1035       {
1036          Result->strlength = RLength ;
1037          memcpy( Result->strptr, RString, RLength+1 ) ;
1038          IfcFreeMemory( RString ) ;
1039       }
1040    }
1041    else if (RString)
1042       IfcFreeMemory( RString ) ;
1043
1044    /*
1045     * Remove any internal queues and any connection to
1046     * rxstack
1047     */
1048    purge_stacks( TSD );
1049    /*
1050     * Close all open files and reset Regina's internal file table
1051     */
1052    purge_filetable( TSD );
1053
1054    /*
1055     * Free internal memory allocations
1056     */
1057 #if defined(FLISTS) && defined(SINGLE_THREADED)
1058    purge_flists( TSD );
1059 #endif
1060
1061    return rc ;
1062 }
1063
1064
1065
1066 /* ============================================================= */
1067 /* subcom handler subsystem */
1068
1069 EXPORT_C APIRET APIENTRY RexxRegisterSubcomExe(PCSZ EnvName,
1070                                       PFN EntryPoint,
1071                                       PUCHAR UserArea )
1072 {
1073    int EnvLen=0 ;
1074    tsd_t *TSD;
1075
1076    TSD = GLOBAL_ENTRY_POINT();
1077    StartupInterface(TSD);
1078
1079    /*
1080     * Perform sanity check on the parameters; UserArea may be NULL
1081     */
1082    if (!EnvName || !EntryPoint)
1083       return RXSUBCOM_BADTYPE ;
1084
1085    EnvLen = strlen( EnvName ) ;
1086    if (EnvLen>MAXENVNAMELEN)
1087       return RXSUBCOM_NOTREG ;
1088
1089    if (FindEnvir( EnvName, EnvLen ))
1090       return RXSUBCOM_NOTREG ;
1091
1092    if (!AddEnvir( EnvName, strlen(EnvName) , UserArea, EntryPoint ))
1093       return RXSUBCOM_NOEMEM ;
1094
1095    return RXSUBCOM_OK ;
1096 }
1097
1098
1099 EXPORT_C APIRET APIENTRY RexxRegisterSubcomDll(PCSZ EnvName,
1100                                       PCSZ ModuleName,
1101                                       PCSZ ProcedureName,
1102                                       PUCHAR UserArea,
1103                                       ULONG DropAuth )
1104 {
1105    tsd_t *TSD;
1106
1107    TSD = GLOBAL_ENTRY_POINT();
1108    StartupInterface(TSD);
1109
1110    if (!EnvName || !ModuleName || !ProcedureName)
1111       return(RXSUBCOM_BADTYPE);
1112
1113    /* not yet functional */
1114    return RXSUBCOM_NOTREG ;
1115 }
1116
1117
1118 EXPORT_C APIRET APIENTRY RexxQuerySubcom(PCSZ EnvName,
1119                                 PCSZ ModuleName,
1120                                 PUSHORT Flag, /* Who knows what this is used for ... */
1121                                 PUCHAR UserWord )
1122 {
1123    int ret=0 ;
1124    struct EnvBox *eptr=NULL ;
1125    tsd_t *TSD;
1126
1127    TSD = GLOBAL_ENTRY_POINT();
1128    StartupInterface(TSD);
1129
1130    if (!EnvName || !Flag)
1131       return(RXFUNC_BADTYPE);
1132
1133    /* ModuleName is not yet functional */
1134
1135    eptr = FindEnvir( EnvName , strlen(EnvName) ) ;
1136    if (eptr)
1137    {
1138       ret = RXSUBCOM_OK ;
1139       if (UserWord)
1140          memcpy( UserWord, eptr->UserData, 8 ) ;
1141    }
1142    else
1143       ret = RXSUBCOM_NOTREG ;
1144
1145    *Flag = 0;               /* what else to give it ? */
1146
1147    return ret ;
1148 }
1149
1150 EXPORT_C APIRET APIENTRY RexxDeregisterSubcom(PCSZ EnvName,
1151                                      PCSZ ModuleName )
1152 {
1153    tsd_t *TSD;
1154
1155    TSD = GLOBAL_ENTRY_POINT();
1156    StartupInterface(TSD);
1157
1158    if (!EnvName)
1159       return(RXSUBCOM_BADTYPE);
1160
1161    /* ModuleName is not yet functional */
1162
1163    if (RemoveEnvir( EnvName , strlen(EnvName) ))
1164       return RXSUBCOM_NOTREG ;
1165
1166    return RXSUBCOM_OK ;
1167 }
1168
1169
1170
1171 /* ============================================================ */
1172 /* Variable subsystem */
1173 /* JH 20-10-99 */  /* To make Direct setting of stems Direct and not Symbolic. */
1174 /****************************************************************************
1175  *
1176  *  JH 13/12/1999 (Original code changes on 20/10/1999)
1177  *
1178  *  BUG022            To make Direct setting of stems Direct and not Symbolic.
1179  *   - Added checks for the direct variable functions RX_GETVAR and RX_SETVAR.
1180  *     In the switch that determines what to do, based on the value passed in
1181  *     shvcode, symbolics still fall through to the code that is under the
1182  *     direct labels, but it sets a variable to denote that symbolic processing
1183  *     is to take place.  The direct section only sets this variable if it has
1184  *     not been set before.
1185  *   - Added new variable IVPcode (IfcVariablePool) that will contain the code
1186  *     used to call IfcVariablePool(), instead of hard coding the parameter,
1187  *
1188  *  NB that this routine lumps the Drop's and Set's together, before calling
1189  *    IfcVarPool().  At some point it might be better to pass the shvcode
1190  *    value, rather than translating it and later performing additional
1191  *    checks to split it back out.
1192  *
1193  ****************************************************************************/
1194 EXPORT_C APIRET APIENTRY RexxVariablePool(PSHVBLOCK RequestBlockList )
1195 {
1196    int Code=0, RetCode=0, IVPcode;
1197    int Lengths[2] ;
1198    int rc=0 ;
1199    char *Strings[2] ;
1200    PSHVBLOCK Req=RequestBlockList ;
1201    tsd_t *TSD;
1202    rex_tsd_t *rt;
1203
1204    TSD = GLOBAL_ENTRY_POINT();
1205    rt = TSD->rex_tsd;
1206    StartupInterface(TSD);
1207
1208    if (!RequestBlockList) /* FGC: I assume we must have at least one param */
1209       return(RXFUNC_BADTYPE);
1210
1211    if (TSD->systeminfo->tree.root==NULL) /* Doesn't the interpreter run? */
1212       return RXSHV_NOAVL ;
1213
1214    RetCode = 0 ;
1215
1216    for (;Req;Req=Req->shvnext)
1217    {
1218       IVPcode = 0; /* Needed for a correct IVPcode on a second request */
1219       switch (Req->shvcode)
1220       {
1221          case RXSHV_SYDRO:
1222          case RXSHV_SYSET:
1223            IVPcode = RX_SETSVAR;                        /* JH 20-10-99 */
1224          case RXSHV_DROPV:                              /* MH 26-12-95 */
1225          case RXSHV_SET:                                /* MH 26-12-95 */
1226          {
1227             IVPcode = IVPcode ? IVPcode : RX_SETVAR;    /* JH 20-10-99 */
1228             Lengths[0] = Req->shvname.strlength ;
1229             Strings[0] = Req->shvname.strptr ;
1230             if (Req->shvcode==RXSHV_SYSET               /* MH 26-12-95 */
1231             ||  Req->shvcode==RXSHV_SET)                /* MH 26-12-95 */
1232             {
1233                Lengths[1] = Req->shvvalue.strlength ;
1234                Strings[1] = Req->shvvalue.strptr ;
1235             }
1236             else
1237                Lengths[1] = RX_NO_STRING ;
1238
1239             Code = IfcVarPool( TSD, IVPcode, Lengths, Strings ) ; /* JH 20-10-99 */
1240
1241             Req->shvret = RXSHV_OK ;
1242             if (Code==RX_CODE_NOVALUE)
1243                Req->shvret |= RXSHV_NEWV ;
1244             else if (Code==RX_CODE_INVNAME)
1245                Req->shvret |= RXSHV_BADN ;
1246             else if (Code!=RXSHV_OK)
1247                exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" )  ;
1248             TSD->var_indicator=0;
1249             break ;
1250          }
1251          case RXSHV_SYFET:
1252            IVPcode = RX_GETSVAR;                        /* JH 20-10-99 */
1253          case RXSHV_FETCH:                              /* MH 26-12-95 */
1254          {
1255             IVPcode = IVPcode ? IVPcode : RX_GETVAR;    /* JH 20-10-99 */
1256             Lengths[0] = Req->shvname.strlength ;
1257             Strings[0] = Req->shvname.strptr ;
1258             /* FIXME, FGC: This two lines are unnecessary
1259             Lengths[1] = Req->shvvalue.strlength ;
1260             Strings[1] = Req->shvvalue.strptr ; */
1261             Code = IfcVarPool( TSD, IVPcode, Lengths, Strings ) ; /* JH 20-10-99 */
1262
1263             Req->shvret = RXSHV_OK ;
1264             if (Code==RX_CODE_NOVALUE)
1265                Req->shvret |= RXSHV_NEWV ;
1266             else if (Code==RX_CODE_INVNAME)
1267                Req->shvret |= RXSHV_BADN ;
1268             else if (Code!=RXSHV_OK)
1269                exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" )  ;
1270             FillReqValue( Req, Lengths[1], Strings[1] ) ;
1271             TSD->var_indicator=0;
1272             break ;
1273          }
1274
1275          case RXSHV_PRIV:
1276          {
1277             Req->shvret = RXSHV_OK ;
1278             if (Req->shvname.strlength==4 && Req->shvname.strptr &&
1279                 !strncmp(Req->shvname.strptr, "PARM", 4 ))
1280             {
1281                rc = IfcVarPool( TSD, RX_CODE_PARAMS, Lengths, Strings ) ;
1282                FillReqValue( Req, Lengths[0], Strings[0] ) ;
1283             }
1284
1285             else if (Req->shvname.strlength>=5 && Req->shvname.strptr &&
1286                 !strncmp(Req->shvname.strptr, "PARM.", 5 ))
1287             {
1288                Lengths[0] = Req->shvname.strlength - 5 ;
1289                Strings[0] = Req->shvname.strptr + 5 ;
1290
1291                rc = IfcVarPool( TSD, RX_CODE_PARAM, Lengths, Strings ) ;
1292                if (rc == RX_CODE_OK)
1293                   FillReqValue( Req, Lengths[1], Strings[1] ) ;
1294                else
1295                   Req->shvret |= RXSHV_BADN ;
1296             }
1297
1298             else
1299             {
1300                int Code=0 ;
1301                if (Req->shvname.strptr)
1302                {
1303                   if (Req->shvname.strlength==7 &&
1304                          !memcmp(Req->shvname.strptr, "QUENAME", 7))
1305                   {
1306                      Code = RX_CODE_QUEUE ;
1307                   }
1308                   else if (Req->shvname.strlength==7 &&
1309                          !memcmp(Req->shvname.strptr, "VERSION", 7))
1310                   {
1311                      Code = RX_CODE_VERSION ;
1312                   }
1313                   else if (Req->shvname.strlength==6 &&
1314                          !memcmp(Req->shvname.strptr, "SOURCE", 6))
1315                   {
1316                      Code = RX_CODE_SOURCE ;
1317                   }
1318                   else
1319                      Req->shvret |= RXSHV_BADN ;
1320
1321                   if (!Req->shvret | RXSHV_BADN)
1322                   {
1323                      rc=IfcVarPool( TSD, Code, Lengths, Strings ) ;
1324                      FillReqValue( Req, Lengths[0], Strings[0] ) ;
1325                   }
1326                }
1327                else
1328                   Req->shvret |= RXSHV_BADN ;
1329             }
1330             break ;
1331          }
1332
1333          case RXSHV_NEXTV:
1334          {
1335             int Items ;
1336
1337             Req->shvret = RXSHV_OK ;
1338             Items = IfcVarPool( TSD, RX_NEXTVAR, Lengths, Strings ) ;
1339             assert( Items==0 || Items==2 ) ;
1340
1341             if (Items==2)
1342             {
1343                FillReqValue( Req, Lengths[1], Strings[1] ) ;
1344                FillReqName( Req, Lengths[0], Strings[0] ) ;
1345             }
1346             else
1347                Req->shvret |= RXSHV_LVAR ;
1348
1349             break ;
1350          }
1351
1352          default:
1353             Req->shvret = RXSHV_BADF ;
1354       }
1355
1356       RetCode |= ( Req->shvret & 0x007f ) ;
1357    }
1358
1359    return RetCode ;
1360 }
1361
1362
1363
1364 /* ================================================================ */
1365 /* system exit handler subsystem */
1366
1367 EXPORT_C APIRET APIENTRY RexxRegisterExitExe(PCSZ EnvName,
1368                                     PFN EntryPoint,
1369                                     PUCHAR UserArea )
1370 {
1371    int EnvLen=0 ;
1372    tsd_t *TSD;
1373
1374    TSD = GLOBAL_ENTRY_POINT();
1375    StartupInterface(TSD);
1376
1377    if (!EnvName || !EntryPoint)
1378       return RXEXIT_BADTYPE ;
1379
1380    EnvLen = strlen( EnvName ) ;
1381    if (EnvLen>MAXENVNAMELEN)
1382       return RXEXIT_NOTREG ;
1383
1384    if (FindExit( EnvName, EnvLen ))
1385       return RXEXIT_NOTREG ;
1386
1387    if (!AddExit( EnvName, EnvLen, UserArea, EntryPoint ))
1388       return RXEXIT_NOEMEM ;
1389
1390    return RXEXIT_OK ;
1391 }
1392
1393 EXPORT_C APIRET APIENTRY RexxRegisterExitDll(PCSZ EnvName,
1394                                     PCSZ ModuleName,
1395                                     PCSZ ProcedureName,
1396                                     PUCHAR UserArea,
1397                                     ULONG DropAuth )
1398 {
1399    tsd_t *TSD;
1400
1401    TSD = GLOBAL_ENTRY_POINT();
1402    StartupInterface(TSD);
1403
1404    if (!EnvName || !ModuleName || !ProcedureName)
1405       return(RXFUNC_BADTYPE);
1406    /* not yet functional */
1407    return RXEXIT_NOTREG ;
1408 }
1409
1410
1411 EXPORT_C APIRET APIENTRY RexxDeregisterExit(PCSZ EnvName,
1412                                    PCSZ ModuleName )
1413 {
1414    tsd_t *TSD;
1415
1416    TSD = GLOBAL_ENTRY_POINT();
1417    StartupInterface(TSD);
1418
1419    if (!EnvName)
1420       return(RXFUNC_BADTYPE);
1421
1422    /* Ignore ModuleName, it may be NULL in case of an Exe-handler */
1423
1424    if (RemoveExit(EnvName, strlen(EnvName) ))
1425       return RXEXIT_NOTREG ;
1426
1427    return RXEXIT_OK ;
1428 }
1429
1430 EXPORT_C APIRET APIENTRY RexxQueryExit(PCSZ EnvName,
1431                               PCSZ ModuleName,
1432                               PUSHORT Flag,
1433                               PUCHAR UserArea)
1434 {
1435    tsd_t *TSD;
1436    struct EnvBox *EnvPtr=NULL ;
1437    ULONG rc=0;
1438
1439    TSD = GLOBAL_ENTRY_POINT();
1440    StartupInterface(TSD);
1441
1442    if (!EnvName || !Flag)
1443       return(RXEXIT_BADTYPE);
1444
1445    EnvPtr = FindExit( EnvName, strlen( EnvName ) ) ;
1446    if ( EnvPtr == NULL )
1447    {
1448       *Flag = RXEXIT_NOTREG;
1449       rc = RXEXIT_NOTREG;
1450    }
1451    else
1452    {
1453       *Flag = RXEXIT_OK;
1454       rc = RXEXIT_OK;
1455       if ( UserArea )
1456          memcpy( UserArea, EnvPtr->UserData, 8 ) ;
1457    }
1458    return( rc );
1459 }
1460
1461 /* =================================================================== */
1462
1463 /*
1464  * This section contains the support for the external functions
1465    */
1466
1467 static struct funcbox2 *findfunc( const tsd_t *TSD, const char *name )
1468 {
1469    struct funcbox2 *fptr=NULL ;
1470    int hashbox ;
1471    rex_tsd_t *rt;
1472    unsigned hash;
1473
1474    rt = TSD->rex_tsd;
1475    hash = hashvalue( name, -1 ) ;
1476    hashbox = hash % EXT_FUNCS_COUNT ;
1477    for (fptr=rt->saafuncs[hashbox]; fptr; fptr=fptr->prev)
1478       if (fptr->hash == hash)
1479          if (!strcmp(name, fptr->name))
1480             return fptr ;
1481
1482    return NULL ;
1483 }
1484
1485 static int delfunc2( const tsd_t *TSD, const char *name )
1486 {
1487    struct funcbox2 *old=NULL ;
1488    int hashbox ;
1489    rex_tsd_t *rt;
1490
1491    rt = TSD->rex_tsd;
1492    old = findfunc( TSD, name ) ;
1493    if (!old)
1494       return RXFUNC_NOTREG ;
1495
1496    hashbox = hashvalue( name, -1 ) % EXT_FUNCS_COUNT ;
1497    FreeTSD( old->name ) ;
1498    if (old==rt->saafuncs[hashbox])
1499       rt->saafuncs[hashbox] = old->prev ;
1500    else
1501       old->next->prev = old->prev ;
1502
1503    if (old->prev)
1504       old->prev->next = old->next ;
1505
1506    FreeTSD( old ) ;
1507    return RXFUNC_OK ;
1508 }
1509
1510 static int addfunc2( const tsd_t *TSD, const char *name, RexxFunctionHandler *EntryPoint )
1511 {
1512    struct funcbox2 *new=NULL ;
1513    int hashbox, hash ;
1514    rex_tsd_t *rt;
1515
1516    rt = TSD->rex_tsd;
1517
1518    if (findfunc( TSD, name ))
1519       return RXFUNC_DEFINED ;
1520
1521    new = MallocTSD( sizeof(struct funcbox2) ) ;
1522    if (!new)
1523       return RXFUNC_NOMEM ;
1524
1525    new->name = MallocTSD( strlen( name )+1 ) ;
1526    if (!new->name)
1527    {
1528       FreeTSD( new ) ;
1529       return RXFUNC_NOMEM ;
1530    }
1531
1532    strcpy( new->name, name ) ;
1533    hash = hashvalue( new->name, -1 ) ;
1534    hashbox = hash % EXT_FUNCS_COUNT ;
1535
1536    new->entry = EntryPoint ;
1537    new->next = NULL ;
1538    new->hash = hash ;
1539    new->prev = rt->saafuncs[hashbox] ;
1540    if (rt->saafuncs[hashbox])
1541       rt->saafuncs[hashbox]->next = new ;
1542    rt->saafuncs[hashbox] = new ;
1543
1544    return RXFUNC_OK ;
1545 }
1546
1547
1548 EXPORT_C APIRET APIENTRY RexxRegisterFunctionExe( PCSZ Name,
1549                                          PFN EntryPoint )
1550 {
1551    int code;
1552    int i;
1553    char *upper_name;
1554    tsd_t *TSD;
1555
1556    TSD = GLOBAL_ENTRY_POINT();
1557    StartupInterface(TSD);
1558
1559    if (!Name || !EntryPoint)
1560       return(RXFUNC_BADTYPE);
1561    assert( Name );
1562    if ((upper_name = MallocTSD( strlen(Name)+1) ) == NULL)
1563       return(RXFUNC_NOMEM);
1564    strcpy(upper_name,Name);
1565    for (i=0;i<(int) strlen(upper_name);i++)
1566      *(upper_name+i) = (char) toupper(*(upper_name+i));
1567    code = addfunc2( TSD, upper_name, (RexxFunctionHandler*)EntryPoint ) ;
1568    FreeTSD( upper_name );
1569    if (code)
1570       return code ;
1571
1572    code = IfcRegFunc( TSD, Name ) ;
1573    switch (code) {
1574       case RX_CODE_OK:    code = RXFUNC_OK;    break;
1575       case RX_CODE_NOMEM: code = RXFUNC_NOMEM; break;
1576       default: code = -1;
1577    }
1578    assert( code==RXFUNC_OK ) ; /* A simple "if (code!=RXFUNC_OK)delfunc2()"
1579                                 * might be better!
1580                                 */
1581
1582    return RXFUNC_OK ;
1583 }
1584
1585 EXPORT_C APIRET APIENTRY RexxRegisterFunctionDll( PCSZ ExternalName,
1586                                          PCSZ LibraryName,
1587                                          PCSZ InternalName )
1588 {
1589    tsd_t *TSD;
1590
1591    TSD = GLOBAL_ENTRY_POINT();
1592    StartupInterface(TSD);
1593
1594    if (!ExternalName || !LibraryName || !InternalName)
1595       return(RXFUNC_BADTYPE);
1596    return ((ULONG)IfcRegDllFunc(TSD,ExternalName,LibraryName,InternalName));
1597 }
1598
1599 EXPORT_C APIRET APIENTRY RexxQueryFunction( PCSZ Name )
1600 {
1601    tsd_t *TSD;
1602
1603    TSD = GLOBAL_ENTRY_POINT();
1604    StartupInterface(TSD);
1605
1606    if (!Name)
1607       return(RXFUNC_BADTYPE);
1608    return ( IfcQueryFunc( TSD, Name ) ) ? RXFUNC_NOTREG : RXFUNC_OK ;
1609 }
1610
1611
1612 EXPORT_C APIRET APIENTRY RexxDeregisterFunction( PCSZ Name )
1613 {
1614    int rc;
1615    tsd_t *TSD;
1616
1617    TSD = GLOBAL_ENTRY_POINT();
1618    StartupInterface(TSD);
1619    if (!Name)
1620       return(RXFUNC_BADTYPE);
1621    if ((rc = delfunc2(TSD, Name)) != RXFUNC_OK)
1622       return rc;
1623    return (IfcDelFunc(TSD, Name)) ? RXFUNC_NOTREG : RXFUNC_OK ;
1624 }
1625
1626 /* The caller of IfcFunctionExit should call this function with fresh copies of
1627  * Name and params to be bullet-proof. The called function MAY
1628  * change the values although this is illegal.
1629  */
1630 static int IfcFunctionExit(const tsd_t *TSD,
1631                            PSZ Name,
1632                            int Params,
1633                            RXSTRING *params,
1634                            PCSZ queuename,
1635                            PRXSTRING Retstr,
1636                            int *RCode,
1637                            char called)
1638 {
1639    int rc=0 ;
1640    RXFNCCAL_PARM fnccal;
1641    PUCHAR parm=NULL;
1642    char *qname;
1643    size_t len;
1644    rex_tsd_t *rt;
1645
1646    rt = TSD->rex_tsd;
1647
1648    if ( rt->CurrentHandlers && rt->CurrentHandlers->Handlers[RXFNC] )
1649    {
1650       len = strlen( queuename ) ;
1651       qname = MallocTSD( len + 1 ) ;
1652       memcpy( qname, queuename, len + 1 ) ;
1653       fnccal.rxfnc_flags.rxfferr = 0;
1654       fnccal.rxfnc_flags.rxffnfnd = 0;
1655       fnccal.rxfnc_flags.rxffsub = (called) ? 1 : 0;
1656       fnccal.rxfnc_name = (unsigned char *)Name;
1657       fnccal.rxfnc_namel = (USHORT) strlen(Name);
1658       fnccal.rxfnc_que = qname;
1659       fnccal.rxfnc_quel = (USHORT) len;
1660       fnccal.rxfnc_argc = (USHORT) Params;
1661       fnccal.rxfnc_argv = params;
1662       fnccal.rxfnc_retc = *Retstr;
1663       parm = (PUCHAR)&fnccal;
1664       rc = (*(rt->CurrentHandlers->Handlers[RXFNC]))(RXFNC, RXFNCCAL, parm);
1665       assert( rc==RXEXIT_HANDLED || rc==RXEXIT_NOT_HANDLED ||
1666               rc==RXEXIT_RAISE_ERROR ) ;
1667       if (rc == RXEXIT_HANDLED)
1668       {
1669          if (fnccal.rxfnc_flags.rxfferr)
1670             *RCode = RXFLAG_ERROR ;
1671          else if (fnccal.rxfnc_flags.rxffnfnd)
1672             *RCode = RXFLAG_FAILURE ;
1673          else
1674             *RCode = RXFLAG_OK;
1675       }
1676       *Retstr = fnccal.rxfnc_retc;
1677       return(rc);
1678    }
1679    else
1680    {
1681       return (RXEXIT_NOT_HANDLED);
1682    }
1683 }
1684
1685 /* The caller of IfcExecFunc should call this function with fresh copies of
1686  * Name, Length and Strings to be bullet-proof. The called function MAY
1687  * change the values although this is illegal.
1688  * RetLength and RetString should point to {0,NULL}. They will be filled with
1689  * freshly allocated values if there are some.
1690  */
1691 int IfcExecFunc( const tsd_t *TSD, PFN Func, char *Name, int Params,
1692                  int *Lengths, char **Strings,
1693                  int *RetLength, char **RetString,
1694                  int *RC, char exitonly, char called )
1695 {
1696    struct funcbox2 *fptr=NULL ;
1697    int i=0, length=0, rc=0, RCode=0 ;
1698    RXSTRING *params, retstr ;
1699    rex_tsd_t *rt;
1700    char execfunc_result[ILLEGAL_USE_SIZE+RXAUTOBUFLEN] ;
1701
1702    rt = TSD->rex_tsd;
1703    assert( Name ) ;
1704    assert( Params >= 0 ) ;
1705
1706    params = MallocTSD( sizeof(RXSTRING)*Params ) ;
1707    for (i=0; i<Params; i++)
1708    {
1709       length = Lengths[i] ;
1710       if (length==RX_NO_STRING)
1711       {
1712          params[i].strptr = NULL ;
1713          params[i].strlength = 0 ;
1714       }
1715       else
1716       {
1717          params[i].strptr = Strings[i] ;
1718          params[i].strlength = length ;
1719       }
1720    }
1721
1722    memset( execfunc_result, 0, sizeof( execfunc_result ) ) ;
1723    retstr.strptr = execfunc_result + ILLEGAL_USE_SIZE ;
1724    retstr.strlength = RXAUTOBUFLEN;        /* MH 26-12-95 */
1725
1726    rc = IfcFunctionExit( TSD, Name, Params, params, "default",
1727                          &retstr, &RCode, called );
1728    switch(rc)
1729    {
1730       case RXEXIT_NOT_HANDLED:
1731          if (exitonly)
1732          {
1733            *RC = ERR_ROUTINE_NOT_FOUND;
1734          }
1735          else
1736          {
1737             /* Func or fptr->entry will inherit a possible return value in
1738              * retstr. This might be a problem, expect suspicious results
1739              * if the called functions are not error free.
1740              */
1741             if (Func == NULL)
1742             {
1743                if ((fptr=findfunc( TSD, Name )) == NULL)
1744                {
1745                   FreeTSD( params );
1746                   return RX_CODE_NOSUCH ;
1747                }
1748                rc = (*(fptr->entry))( Name, Params, params, "default", &retstr ) ;
1749             }
1750             else
1751                rc = (*(Func))( Name, Params, params, "default", &retstr ) ;
1752
1753             if (rc)
1754                *RC = ERR_INCORRECT_CALL;
1755             else
1756                *RC = 0;
1757          }
1758          break;
1759       case RXEXIT_HANDLED:
1760          if (RCode == RXFLAG_ERROR)
1761             *RC = ERR_INCORRECT_CALL;
1762          else if (RCode == RXFLAG_FAILURE)
1763             *RC = ERR_ROUTINE_NOT_FOUND;
1764          else
1765             *RC = 0;
1766          break;
1767       case RXEXIT_RAISE_ERROR:
1768          *RC = ERR_SYSTEM_FAILURE;
1769          break;
1770    }
1771
1772    FreeTSD( params ) ;
1773
1774    if (!(*RC) && retstr.strptr)
1775    {
1776       *RetString = MallocTSD( (retstr.strlength < 1) ? 1 : retstr.strlength ) ;
1777       memcpy( *RetString, retstr.strptr, retstr.strlength ) ;
1778       *RetLength = retstr.strlength ;
1779    }
1780    else
1781       *RetLength = RX_NO_STRING ;
1782
1783    if (retstr.strptr && retstr.strptr != execfunc_result + ILLEGAL_USE_SIZE)
1784       IfcFreeMemory( retstr.strptr ) ;
1785
1786    return RX_CODE_OK ;
1787 }
1788
1789 int IfcHaveFunctionExit(const tsd_t *TSD)
1790 {
1791    rex_tsd_t *rt;
1792
1793    rt = TSD->rex_tsd;
1794    if ( rt->CurrentHandlers && rt->CurrentHandlers->Handlers[RXFNC] )
1795       return 1;
1796    else
1797       return 0;
1798 }
1799
1800 /* ============================================================= */
1801 /* Asynchronous Rexx API interface */
1802
1803 EXPORT_C APIRET APIENTRY RexxSetHalt(LONG dummyProcess,
1804                             LONG dummyThread )
1805 {
1806    tsd_t *TSD;
1807
1808    TSD = GLOBAL_ENTRY_POINT();
1809    StartupInterface(TSD);
1810    /*
1811     * Perform sanity check on the parameters; is process id me ?
1812     */
1813    set_rexx_halt();
1814    return RXARI_OK ;
1815 }
1816
1817 /* ============================================================= */
1818 /* Named queue interface */
1819
1820 EXPORT_C APIRET APIENTRY RexxCreateQueue( PSZ Buffer,
1821                                  ULONG BuffLen,
1822                                  PSZ RequestedName,
1823                                  ULONG* DupFlag)
1824 {
1825    int code;
1826    tsd_t *TSD;
1827
1828    TSD = GLOBAL_ENTRY_POINT();
1829    StartupInterface(TSD);
1830
1831    TSD->called_from_saa = 1;
1832    code = IfcCreateQueue( TSD, RequestedName, (RequestedName) ? strlen( RequestedName): 0, Buffer, DupFlag, BuffLen );
1833    TSD->called_from_saa = 0;
1834    return code;
1835 }
1836
1837 EXPORT_C APIRET APIENTRY RexxDeleteQueue( PSZ QueueName )
1838 {
1839    int code;
1840    tsd_t *TSD;
1841
1842    TSD = GLOBAL_ENTRY_POINT();
1843    StartupInterface(TSD);
1844
1845    TSD->called_from_saa = 1;
1846    if (!QueueName || !strlen(QueueName))
1847       code = RXQUEUE_BADQNAME;
1848    else
1849       code = IfcDeleteQueue( TSD, QueueName, strlen( QueueName ) );
1850    TSD->called_from_saa = 0;
1851    return code;
1852 }
1853
1854 EXPORT_C APIRET APIENTRY RexxQueryQueue( PSZ QueueName,
1855                                 ULONG* Count)
1856 {
1857    int code;
1858    tsd_t *TSD;
1859
1860    TSD = GLOBAL_ENTRY_POINT();
1861    StartupInterface(TSD);
1862
1863    TSD->called_from_saa = 1;
1864    if (!QueueName || !strlen(QueueName))
1865       code = RXQUEUE_BADQNAME;
1866    else
1867       code = IfcQueryQueue( TSD, QueueName, strlen( QueueName ), Count );
1868    TSD->called_from_saa = 0;
1869    return code;
1870 }
1871
1872 EXPORT_C APIRET APIENTRY RexxAddQueue( PSZ QueueName,
1873                               PRXSTRING EntryData,
1874                               ULONG AddFlag)
1875 {
1876    int code;
1877    tsd_t *TSD;
1878
1879    TSD = GLOBAL_ENTRY_POINT();
1880    StartupInterface(TSD);
1881
1882    TSD->called_from_saa = 1;
1883    if (!QueueName || !strlen(QueueName))
1884       code = RXQUEUE_BADQNAME;
1885    else
1886       code = IfcAddQueue( TSD, QueueName, strlen( QueueName), EntryData->strptr, EntryData->strlength, AddFlag==RXQUEUE_LIFO );
1887    TSD->called_from_saa = 0;
1888    return code;
1889 }
1890
1891 EXPORT_C APIRET APIENTRY RexxPullQueue( PSZ QueueName,
1892                                PRXSTRING DataBuf,
1893                                PDATETIME TimeStamp,
1894                                ULONG WaitFlag)
1895 {
1896    int code;
1897    tsd_t *TSD;
1898    int buflen;
1899    char *buf;
1900
1901    TSD = GLOBAL_ENTRY_POINT();
1902    StartupInterface(TSD);
1903
1904    if ( WaitFlag != RXQUEUE_WAIT && WaitFlag != RXQUEUE_NOWAIT )
1905       return RXQUEUE_BADWAITFLAG;
1906
1907    DataBuf = NULL;
1908    TSD->called_from_saa = 1;
1909    if (!QueueName || !strlen(QueueName))
1910       code = RXQUEUE_BADQNAME;
1911    else
1912    {
1913       code = IfcPullQueue( TSD, QueueName, strlen( QueueName), &buf, &buflen, WaitFlag==RXQUEUE_WAIT );
1914       if ( code == 0 )
1915       {
1916          if ( buf == NULL )
1917          {
1918             /*
1919              * Queue is empty
1920              */
1921             code = RXQUEUE_EMPTY;
1922          }
1923          else
1924          {
1925             DataBuf->strlength = buflen ;
1926             DataBuf->strptr=(char *)IfcAllocateMemory(buflen+1);
1927             if ( DataBuf->strptr )
1928             {
1929                memcpy(DataBuf->strptr,(void *) buf,buflen);
1930                *(DataBuf->strptr+(buflen)) = '\0';
1931             }
1932             else
1933                code = RXQUEUE_MEMFAIL ;
1934          }
1935       }
1936    }
1937    TSD->called_from_saa = 0;
1938    return code;
1939 }
1940
1941 /* ============================================================= */
1942 /* MacroSpace Rexx API interface */
1943
1944 EXPORT_C APIRET APIENTRY RexxAddMacro( PSZ FuncName,
1945                               PSZ SourceFile,
1946                               ULONG Position )
1947 {
1948    return 0;
1949 }
1950
1951 EXPORT_C APIRET APIENTRY RexxDropMacro( PSZ FuncName)
1952 {
1953    return 0;
1954 }
1955
1956 EXPORT_C APIRET APIENTRY RexxSaveMacroSpace( ULONG FuncCount,
1957                                     PSZ * FuncNames,
1958                                     PSZ MacroLibFile)
1959 {
1960    return 0;
1961 }
1962
1963 EXPORT_C APIRET APIENTRY RexxLoadMacroSpace( ULONG FuncCount,
1964                                     PSZ * FuncNames,
1965                                     PSZ MacroLibFile)
1966 {
1967    return 0;
1968 }
1969
1970 EXPORT_C APIRET APIENTRY RexxQueryMacro( PSZ FuncName,
1971                                 PUSHORT Position )
1972 {
1973    return 0;
1974 }
1975
1976 EXPORT_C APIRET APIENTRY RexxReorderMacro( PSZ FuncName,
1977                                   ULONG Position )
1978 {
1979    return 0;
1980 }
1981
1982 EXPORT_C APIRET APIENTRY RexxClearMacroSpace( VOID )
1983 {
1984    return 0;
1985 }
1986
1987 /* ============================================================= */
1988 /* Regina extensions */
1989 /* see rexxsaa.h for a description */
1990 EXPORT_C APIRET APIENTRY ReginaVersion( PRXSTRING VersionString )
1991 {
1992    char low[3];
1993    unsigned len;
1994    tsd_t *TSD;
1995
1996    TSD = GLOBAL_ENTRY_POINT();
1997    StartupInterface(TSD);
1998
1999    if (!VersionString)
2000       goto fastexit;
2001
2002    if (VersionString->strlength == 0)
2003    {
2004       if ((VersionString->strptr =
2005                       IfcAllocateMemory(sizeof(PARSE_VERSION_STRING))) == NULL)
2006          goto fastexit;
2007        VersionString->strlength = sizeof(PARSE_VERSION_STRING);
2008    }
2009
2010    if ((len = VersionString->strlength) > sizeof(PARSE_VERSION_STRING))
2011       len = sizeof(PARSE_VERSION_STRING);
2012    memcpy(VersionString->strptr,PARSE_VERSION_STRING,len);
2013
2014    /* sizeof includes the terminating 0. Subtract it if we should. */
2015    if (len > sizeof(PARSE_VERSION_STRING) - 1)
2016       len = sizeof(PARSE_VERSION_STRING) - 1;
2017    VersionString->strlength = len;
2018
2019 fastexit:
2020    low[0] = REGINA_VERSION_MINOR[0];
2021    if (low[0] == '0') /* atoi may have problems with leading zeros (octal) */
2022    {
2023       low[0] = REGINA_VERSION_MINOR[1];
2024       low[1] = '\0';
2025    }
2026    else
2027       low[1] = REGINA_VERSION_MINOR[1];
2028    low[2] = '\0';
2029    return( (atoi(REGINA_VERSION_MAJOR) << 8) | atoi(low) ) ;
2030 }