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