2 * Generic Call Interface for Rexx
3 * Copyright © 2003-2004, Florian Große-Coosmann
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.
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.
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.
19 * ----------------------------------------------------------------------------
21 * This file contains the code to use Regina's internal structures.
30 #include "../rxiface.h"
38 * streng_of returns a new streng with the same content as str has.
39 * NULL is allowed for str and will result in a NULL return value.
40 * The non-existing string is allowed for for str and will result in an empty
43 static streng
*streng_of( const tsd_t
*TSD
, const GCI_str
*str
)
47 if ( GCI_ccontent( str
) == NULL
)
48 return nullstringptr();
49 return Str_ncreTSD( GCI_ccontent( str
), GCI_strlen( str
) );
53 * Returns the translated function code from GCI_result to the code that
54 * Regina shall return to the caller.
55 * This function set the textual representation of an error code to that value
56 * that will be accessed by RxFuncErrMsg() and sets the variable GCI_RC to
59 * dispo is either NULL (or the content is NULL) or contains the position of
60 * the error within the structure. dispo's content will be deallocated.
62 static int GCIcode2ReginaFuncCode( tsd_t
*TSD
,
67 GCI_str description
, fullinfo
, *fi
= NULL
, *out
;
68 volatile char *tmpDispo
, *tmpFull
= NULL
, *tmpBest
;
71 GCI_strOfCharBuffer(GCI_RC
);
73 GCI_strcats( &str_GCI_RC
, "GCI_RC" );
74 GCI_describe( &description
, rc
);
76 if ( ( dispo
!= NULL
) && ( GCI_content( dispo
) == NULL
) )
79 if ( ( dispo
!= NULL
) && ( rc
!= GCI_OK
) )
81 if ( GCI_stralloc( TSD
, &fullinfo
, GCI_strlen( dispo
) +
82 GCI_strlen( &description
) +
86 GCI_strcpy( fi
, &description
);
87 GCI_strcats( fi
, ": " );
88 GCI_strcat( fi
, dispo
);
92 out
= ( fi
!= NULL
) ? fi
: &description
;
93 GCI_writeRexx( TSD
, &str_GCI_RC
, out
, 0 );
95 if ( ( rc
== GCI_OK
) && !forceError
)
98 GCI_strfree( TSD
, dispo
);
100 GCI_strfree( TSD
, fi
);
104 h
= streng_of( TSD
, &description
);
105 tmpDispo
= tmpstr_of( TSD
, h
);
110 h
= streng_of( TSD
, fi
);
111 tmpFull
= tmpstr_of( TSD
, h
);
116 GCI_strfree( TSD
, dispo
);
118 GCI_strfree( TSD
, fi
);
121 * We have two temporary strings describing the error condition.
122 * All stuff we have to deallocate is deallocated. Let's go.
124 tmpBest
= ( tmpFull
!= NULL
) ? tmpFull
: tmpDispo
;
125 set_err_message( TSD
, (char *) tmpBest
, "" );
130 exiterror( ERR_STORAGE_EXHAUSTED
, 0 );
133 exiterror( ERR_INCORRECT_CALL
, 980, ( tmpDispo
) ? ": " : "", ( tmpDispo
) ? tmpDispo
: "" );
135 case GCI_NumberRange
:
136 exiterror( ERR_INCORRECT_CALL
, 981, ( tmpDispo
) ? ": " : "", ( tmpDispo
) ? tmpDispo
: "" );
138 case GCI_StringRange
:
139 exiterror( ERR_INCORRECT_CALL
, 982, ( tmpDispo
) ? ": " : "", ( tmpDispo
) ? tmpDispo
: "" );
141 case GCI_UnsupportedType
:
143 return 71; /* RXFUNC_BADTYPE + 1 */
144 exiterror( ERR_INCORRECT_CALL
, 983, ( tmpDispo
) ? ": " : "", ( tmpDispo
) ? tmpDispo
: "" );
146 case GCI_UnsupportedNumber
:
147 exiterror( ERR_INCORRECT_CALL
, 984, ( tmpDispo
) ? ": " : "", ( tmpDispo
) ? tmpDispo
: "" );
149 case GCI_BufferTooSmall
:
150 exiterror( ERR_INCORRECT_CALL
, 985, ( tmpDispo
) ? ": " : "", ( tmpDispo
) ? tmpDispo
: "" );
152 case GCI_MissingName
:
153 exiterror( ERR_INCORRECT_CALL
, 986, ( tmpDispo
) ? ": " : "", ( tmpDispo
) ? tmpDispo
: "" );
155 case GCI_MissingValue
:
156 exiterror( ERR_INCORRECT_CALL
, 987, ( tmpDispo
) ? ": " : "", ( tmpDispo
) ? tmpDispo
: "" );
158 case GCI_IllegalName
:
159 exiterror( ERR_INCORRECT_CALL
, 988, ( tmpDispo
) ? ": " : "", ( tmpDispo
) ? tmpDispo
: "" );
162 exiterror( ERR_INCORRECT_CALL
, 989, ( tmpDispo
) ? ": " : "", ( tmpDispo
) ? tmpDispo
: "" );
165 exiterror( ERR_INCORRECT_CALL
, 990, ( tmpDispo
) ? ": " : "", ( tmpDispo
) ? tmpDispo
: "" );
167 case GCI_SyntaxError
:
168 exiterror( ERR_INCORRECT_CALL
, 991, ( tmpDispo
) ? ": " : "", ( tmpDispo
) ? tmpDispo
: "" );
170 case GCI_ArgStackOverflow
:
171 exiterror( ERR_INCORRECT_CALL
, 992, ( tmpDispo
) ? ": " : "", ( tmpDispo
) ? tmpDispo
: "" );
173 case GCI_NestingOverflow
:
174 exiterror( ERR_INCORRECT_CALL
, 993, ( tmpDispo
) ? ": " : "", ( tmpDispo
) ? tmpDispo
: "" );
179 exiterror( ERR_INTERPRETER_FAILURE
, 1, __FILE__
, __LINE__
, tmpBest
);
180 return 0; /* Keep the compiler happy */
184 * GCI_migrateStreng converts a streng into a GCI_str. No further memory
185 * allocation is done and it is STRONGLY forbidden to use GCI_strfree.
186 * The return value shall be used for further operations.
188 static const GCI_str
*GCI_migrateStreng( GCI_str
*str
,
189 const streng
*string
)
191 if ( Str_len( string
) == RX_NO_STRING
)
193 str
->used
= str
->max
= 0;
196 else if ( ( str
->val
= (char *) Str_val( string
) ) == NULL
)
197 str
->used
= str
->max
= 0;
199 str
->used
= str
->max
= (int) Str_len( string
);
205 * GCI_migrateRxString converts a RXSTRING into a GCI_str. No further memory
206 * allocation is done and it is STRONGLY forbidden to use GCI_strfree.
207 * The return value shall be used for further operations.
209 static const GCI_str
*GCI_migrateRxString( GCI_str
*str
,
210 const RXSTRING
*string
)
212 if ( !RXVALIDSTRING( *string
) && !RXZEROLENSTRING( *string
) )
215 str
->used
= str
->max
= 0;
219 str
->val
= (char *) RXSTRPTR( *string
);
220 str
->used
= str
->max
= (int) RXSTRLEN( *string
);
226 * assignedRxString builds a RXSTRING of a GCI_str. The RXSTRING is set
227 * in the usual manner and a terminating zero is appended without notification
228 * of the target. NULL-strings are converted to empty strings.
229 * Returns 1 on error, 0 on success.
231 static int assignRxString( void *hidden
,
237 if ( RXNULLSTRING( *dest
) || ( RXSTRLEN( *dest
) < (ULONG
) src
->used
+1 ) )
239 if ( ( h
= (char *) IfcAllocateMemory( (ULONG
) (src
->used
+1) ) ) == NULL
)
243 h
= RXSTRPTR( *dest
);
245 memcpy( h
, src
->val
, src
->used
);
246 h
[(int) (src
->used
)] = '\0';
247 MAKERXSTRING( *dest
, h
, (ULONG
) src
->used
);
252 * readRexx works as a merged version of the function GCI_readRexx and
253 * GCI_readNewRexx below. The difference is the flag allocate. If this is
254 * set, the function works aas GCI_readNewRexx, otherwise is works like
257 static GCI_result
readRexx( void *hidden
,
265 tsd_t
*TSD
= (tsd_t
*) hidden
;
272 Lengths
[0] = GCI_strlen( name
);
273 Strings
[0] = (char *) GCI_ccontent( name
);
275 if ( !signalOnNovalue
)
276 set_ignore_novalue( (const tsd_t
*) hidden
);
277 retval
= IfcVarPool( (tsd_t
*) hidden
,
278 ( symbolicAccess
) ? RX_GETSVAR
: RX_GETVAR
,
282 if ( !signalOnNovalue
)
283 clear_ignore_novalue( (const tsd_t
*) hidden
);
293 case RX_CODE_NOVALUE
:
299 case RX_CODE_INVNAME
:
300 return GCI_IllegalName
;
304 FreeTSD( Strings
[1] );
305 return GCI_RexxError
;
307 if ( Lengths
[1] == RX_NO_STRING
)
308 return GCI_RexxError
;
311 * We must copy the value's content (Strings[1]/Lengths[1]) and we must
312 * destroy the value if "allocated" is set.
316 if ( ( rc
= GCI_stralloc( hidden
, target
, Lengths
[1] ) ) != GCI_OK
)
319 FreeTSD( Strings
[1] );
323 else if ( Lengths
[1] > GCI_strmax( target
) )
326 FreeTSD( Strings
[1] );
328 return GCI_BufferTooSmall
;
331 memcpy( GCI_content( target
), Strings
[1], Lengths
[1] );
333 FreeTSD( Strings
[1] );
334 GCI_strsetlen( target
, Lengths
[1] );
338 /*****************************************************************************
339 *****************************************************************************
340 ** GLOBAL FUNCTIONS *********************************************************
341 *****************************************************************************
342 *****************************************************************************/
345 * GCI_readRexx reads the content of one variable of name "name" into the
346 * "target". The size or the content-holding string of target isn't changed,
347 * the caller must provide a sufficient space.
349 * symbolicAccess shall be set if normal access is expected. If this variable
350 * is 0, the variable's name is treated as "tail-expanded" and any further
351 * interpretation of the name isn't done by the interpreter.
353 * signalOnNovalue shall be set if this function shall throw a NOVALUE
354 * condition if the variable isn't set. This function may or may not be
355 * able to do so. If not, the return value is set to GCI_MissingValue.
357 * *novalue is set either to 1 for a return of a variable's default value or
358 * to 0 if the variable has an assigned value. novalue may be NULL.
361 * GCI_OK: Everything is fine.
362 * GCI_MissingValue: signalOnNovalue is set and this function doesn't
363 * support to fire a NOVALUE condition.
364 * GCI_BufferTooSmall: The "target" buffer is too small to hold the result.
365 * GCI_IllegalName: "name" is illegal in terms of Rexx. Especially on
366 * non-"symbolicAccess" the caller must provide uppercased
367 * stem names if a stem is used.
368 * GCI_RexxError: An unexpected other error is returned by the
371 GCI_result
GCI_readRexx( void *hidden
,
378 return readRexx( hidden
,
388 * GCI_readNewRexx reads the content of one variable of name "name" into the
389 * "target". The content of the target is overwritten regardless of its
392 * symbolicAccess shall be set if normal access is expected. If this variable
393 * is 0, the variable's name is treated as "tail-expanded" and any further
394 * interpretation of the name isn't done by the interpreter.
396 * signalOnNovalue shall be set if this function shall throw a NOVALUE
397 * condition if the variable isn't set. This function may or may not be
398 * able to do so. If not, the return value is set to GCI_MissingValue.
400 * *novalue is set either to 1 for a return of a variable's default value or
401 * to 0 if the variable has an assigned value. novalue may be NULL.
404 * GCI_OK: Everything is fine.
405 * GCI_NoMemory: Can't allocate enough memory for the return value.
406 * GCI_MissingValue: signalOnNovalue is set and this function doesn't
407 * support to fire a NOVALUE condition.
408 * GCI_IllegalName: "name" is illegal in terms of Rexx. Especially on
409 * non-"symbolicAccess" the caller must provide uppercased
410 * stem names if a stem is used.
411 * GCI_RexxError: An unexpected other error is returned by the
414 GCI_result
GCI_readNewRexx( void *hidden
,
421 return readRexx( hidden
,
431 * GCI_writeRexx sets the content of one variable of name "name" to the content
434 * symbolicAccess shall be set if normal access is expected. If this variable
435 * is 0, the variable's name is treated as "tail-expanded" and any further
436 * interpretation of the name isn't done by the interpreter.
439 * GCI_OK: Everything is fine.
440 * GCI_NoMemory: Can't allocate enough memory for the return value.
441 * GCI_MissingValue: signalOnNovalue is set and this function doesn't
442 * support to fire a NOVALUE condition.
443 * GCI_IllegalName: "name" is illegal in terms of Rexx. Especially on
444 * non-"symbolicAccess" the caller must provide uppercased
445 * stem names if a stem is used.
446 * GCI_RexxError: An unexpected other error is returned by the
449 GCI_result
GCI_writeRexx( void *hidden
,
451 const GCI_str
*value
,
459 Lengths
[0] = GCI_strlen( name
);
460 Strings
[0] = (char *) GCI_ccontent( name
);
461 if ( GCI_ccontent( value
) == NULL
)
463 Lengths
[1] = RX_NO_STRING
;
468 Lengths
[1] = GCI_strlen( value
);
469 Strings
[1] = (char *) GCI_ccontent( value
);
472 retval
= IfcVarPool( (tsd_t
*) hidden
,
473 ( symbolicAccess
) ? RX_SETSVAR
: RX_SETVAR
,
481 case RX_CODE_NOVALUE
:
484 case RX_CODE_INVNAME
:
485 return GCI_IllegalName
;
488 return GCI_RexxError
;
495 * GCI_checkDefinition parses and checks the content of a stem according to
496 * the GCI definition stem's syntax.
498 * The arguments to GCI_checkDefinition are stem_name for the stem's name and
499 * tree for the position where the parsed tree shall be copied to.
501 * The return will be that one as for RxFuncDefine. A SYNTAX error is thrown
503 * The value of RxFuncErrMsg() and of GCI_RC is set to a description in case
506 int GCI_checkDefinition( tsd_t
*TSD
,
507 const streng
*stem_name
,
511 GCI_str stem
, disposition
;
515 memset( &disposition
, 0, sizeof( disposition
) );
516 memset( &t
, 0, sizeof( t
) );
517 if ( ( rc
= GCI_ParseTree( TSD
,
518 GCI_migrateStreng( &stem
, stem_name
),
521 TSD
->gci_prefix
) ) != GCI_OK
)
522 return GCIcode2ReginaFuncCode( TSD
, rc
, &disposition
, 0 );
524 *tree
= MallocTSD( sizeof( GCI_treeinfo
) );
525 *((GCI_treeinfo
*) *tree
) = t
;
530 * GCI_RegisterDefinedFunction will return GCI_OK here. It is a stub.
532 GCI_result
GCI_RegisterDefinedFunction( void *hidden
,
533 const GCI_str
*internal
,
534 const GCI_str
*library
,
535 const GCI_str
*external
,
536 const GCI_treeinfo
*ti
)
539 (internal
= internal
);
541 (external
= external
);
547 * GCI_remove_structure deallocates the GCI_treeinfo structure and all
550 void GCI_remove_structure( void *hidden
,
551 GCI_treeinfo
*gci_info
)
553 GCI_treeinfo
*ti
= gci_info
;
557 if ( ti
->nodes
!= NULL
)
558 GCI_free( hidden
, ti
->nodes
);
559 GCI_free( hidden
, ti
);
564 * GCI_Dispatcher is the entry point of all GCI registered functions by the
567 * The function's arguments and return value depend on its usage from case
570 int GCI_Dispatcher( tsd_t
*TSD
,
574 const PRXSTRING params
,
578 GCI_str disposition
, direct_retval
;
579 GCI_str args
[GCI_REXX_ARGS
];
583 * This trivial test should come first to be sure not to access nonexisting
584 * memory. parseTree has fixed this number.
586 if ( Params
> GCI_REXX_ARGS
)
587 GCIcode2ReginaFuncCode( TSD
, GCI_InternalError
, NULL
, 1 );
589 memset( args
, 0, sizeof( args
) );
590 for ( i
= 0; i
< Params
; i
++ )
591 GCI_migrateRxString( &args
[i
], ¶ms
[i
] );
593 memset( &disposition
, 0, sizeof( disposition
) );
594 memset( &direct_retval
, 0, sizeof( direct_retval
) );
596 rc
= GCI_execute( TSD
,
598 (const GCI_treeinfo
*) treeinfo
,
607 GCI_strfree( TSD
, &direct_retval
); /* not really needed hopefully */
608 GCIcode2ReginaFuncCode( TSD
, rc
, &disposition
, 1 );
611 retval
= assignRxString( TSD
, retstr
, &direct_retval
);
612 GCI_strfree( TSD
, &direct_retval
);
615 exiterror( ERR_STORAGE_EXHAUSTED
, 0 );