/**
* @function ferite_strcasecmp
* @declaration int ferite_strcasecmp( char *left, char *right )
* @brief Do a case insensitive strcmp on the two strings.
* @param char *left
* @param char *right
*/
int ferite_strcasecmp( char *left, char *right )
{
int retv = 0;
char *left_copy, *right_copy;
FE_ENTER_FUNCTION;
left_copy = fstrdup(left);
right_copy = fstrdup(right);
ferite_lowercase( left_copy );
ferite_lowercase( right_copy );
retv = strcmp( left_copy, right_copy );
ffree_ngc( left_copy );
ffree_ngc( right_copy );
FE_LEAVE_FUNCTION( retv );
}
char *builder_get_local_dependancy_list()
{
FeriteBuffer *buf = ferite_buffer_new(FE_NoScript, 0);
FeriteString *str = NULL;
char *return_value = NULL;
char current_file[1024];
unsigned int start = 0, i = 0;
FE_ENTER_FUNCTION;
for( i = 0; i < strlen( internal_file_list ); i++ )
{
if( internal_file_list[i] == ' ' )
{
sprintf( current_file, "%s", internal_file_list + start );
if( start > 0 )
ferite_buffer_printf( FE_NoScript, buf, "%s: %s_core.c\n", current_file, current_module->name );
start = i + 1;
}
}
/* convert it to a form we like */
str = ferite_buffer_to_str( FE_NoScript, buf );
return_value = fstrdup( str->data );
ferite_str_destroy( FE_NoScript, str );
ferite_buffer_delete( FE_NoScript, buf );
FE_LEAVE_FUNCTION( return_value );
}
/*{{{ FeriteVariable *ferite_build_object( FeriteScript *script, FeriteClass *nclass) */
FeriteVariable *ferite_build_object( FeriteScript *script, FeriteClass *nclass)
{
FeriteVariable *ptr = NULL;
FE_ENTER_FUNCTION;
if( nclass != NULL )
{
FUD(("BUILDOBJECT: Creating an instance of %s\n", nclass->name ));
ptr = ferite_create_object_variable( script, nclass->name, FE_ALLOC );
if( script )
VAO(ptr) = ferite_stack_pop( script, script->objects );
if( VAO(ptr) == NULL ) {
VAO(ptr) = fmalloc( sizeof( FeriteObject ) );
FUD(( "Allocating object %p\n", VAO(ptr) ));
}
VAO(ptr)->name = fstrdup( nclass->name );
VAO(ptr)->klass = nclass;
FUD(("BUILDOBJECT: Creating a duplicate varaible hash\n"));
VAO(ptr)->variables = ferite_duplicate_object_variable_list( script, nclass );
FUD(("BUILDOBJECT: Linking function list up\n"));
VAO(ptr)->functions = nclass->object_methods;
VAO(ptr)->oid = nclass->id;
VAO(ptr)->odata = NULL;
VAO(ptr)->refcount = 1;
ferite_add_to_gc( script, VAO(ptr) );
}
FE_LEAVE_FUNCTION( ptr );
}
FeriteAMTTree *ferite_amt_compressed_dup( FeriteScript *script, FeriteAMTTree *tree, void*(*dup)(FeriteScript*,void*,void*), void *extra ) {
FeriteAMTTree *newTree = fmalloc(sizeof(FeriteAMTTree));
memset(newTree, 0, sizeof(FeriteAMTTree));
newTree->map = tree->map;
newTree->index_type = tree->index_type;
newTree->base_size = tree->base_size;
newTree->base = ferite_amt_create_base( script, newTree->base_size );
if( newTree->map ) {
int i = 0;
FeriteAMTNode *node = NULL;
for( i = 0; i < newTree->base_size; i++ ) {
if( (node = tree->base[i]) != NULL ) {
newTree->base[i] = fmalloc(sizeof(FeriteAMTNode));
memset(newTree->base[i], 0, sizeof(FeriteAMTNode));
newTree->base[i]->type = node->type;
if( IS_NODE(node) ) {
newTree->base[i]->u.value.id = node->u.value.id;
newTree->base[i]->u.value.data = (dup ? (dup)( script, node->u.value.data, extra ) : node->u.value.data);
newTree->base[i]->u.value.key = NULL;
if( node->u.value.key ) {
newTree->base[i]->u.value.key = fstrdup(node->u.value.key);
}
} else if( node->type == FeriteAMTType_Tree ) {
newTree->base[i]->u.tree = __ferite_amt_tree_dup( script, node->u.tree, dup, extra );
}
}
}
}
return newTree;
}
/**
* @function ferite_create_external_function
* @declaration FeriteFunction *ferite_create_external_function( FeriteScript *script, char *name, void *(*funcPtr)(FeriteScript *, FeriteFunction*, FeriteVariable **), char *description )
* @brief Allocate a FeriteFunction structure and set it up for use as a native function
* @param FeriteScript *script The script it is being used within
* @param char *name The name of the function to be created
* @param void *funcPtr A pointer to the native c function handling it
* @param char *description A description of the functions signiture
* @return A pointer to a FeriteFunction structure
* @description
* The description is pretty straight forward - it is simply a sequence of characters eg "oosna" They mean the following:<nl/>
* <ul>
* <li> <b>n</b> - number
* <li> <b>s</b> - string
* <li> <b>a</b> - array
* <li> <b>o</b> - object
* <li> <b>v</b> - void
* <li> <b>.</b> - variable argument list
* </ul>
* <nl/>
* This means that the function will only actually ever be called with the correct parameters.
*/
FeriteFunction *ferite_create_external_function( FeriteScript *script, char *name, void *f, char *description )
{
FeriteFunction *ptr;
int i;
FeriteVariable *new_variable = NULL;
FE_ENTER_FUNCTION;
FUD(("Creating Function: %s\n", name));
ptr = fmalloc( sizeof( FeriteFunction ) );
ptr->name = fstrdup( name );
ptr->type = FNC_IS_EXTRL;
ptr->fncPtr = (FeriteVariable*(*)(FeriteScript*,void*,FeriteObject*,FeriteFunction*,FeriteVariable**))f;
ptr->odata = NULL;
ptr->bytecode = NULL;
ptr->localvars = NULL;
ptr->signature = fmalloc( sizeof( FeriteParameterRecord* ) * FE_FUNCTION_PARAMETER_MAX_SIZE );
for( i = 0; i < FE_FUNCTION_PARAMETER_MAX_SIZE; i++ )
ptr->signature[i] = NULL;
ptr->arg_count = 0;
for( i = 0; i < (signed)strlen( description ); i++ )
{
switch( description[i] )
{
case 'a': new_variable = ferite_create_uarray_variable( script, "a", 0, FE_STATIC ); break;
case 's': new_variable = ferite_create_string_variable( script, "s", NULL, FE_STATIC ); break;
case 'n': new_variable = ferite_create_number_long_variable( script, "n", 0, FE_STATIC ); break;
case 'o': new_variable = ferite_create_object_variable( script, "o", FE_STATIC ); break;
case 'v': new_variable = ferite_create_void_variable( script, "v", FE_STATIC ); break;
case '?': new_variable = ferite_create_void_variable( script, "?", FE_STATIC ); break;
case '.': new_variable = ferite_create_void_variable( script, ".", FE_STATIC ); break;
default:
ferite_error( script, 0, "Type '%c' not allowed for function signatures (%s)\n", name );
break;
}
if( new_variable != NULL )
{
ptr->signature[ptr->arg_count] = fmalloc( sizeof( FeriteParameterRecord ) );
ptr->signature[ptr->arg_count]->variable = new_variable;
ptr->signature[ptr->arg_count]->has_default_value = FE_FALSE;
ptr->signature[ptr->arg_count]->pass_type = FE_BY_VALUE;
ptr->signature[ptr->arg_count]->name = NULL;
ptr->signature[ptr->arg_count]->is_dots = FE_FALSE;
if( description[i] == '.' )
ptr->signature[ptr->arg_count]->is_dots = FE_TRUE;
ptr->arg_count++;
}
}
ptr->native_information = NULL;
ptr->klass = NULL;
ptr->lock = NULL;
ptr->is_static = FE_TRUE;
ptr->next = NULL;
ptr->state = FE_ITEM_IS_PUBLIC;
ptr->is_alias = FE_FALSE;
ptr->length = 0;
ptr->cached = FE_FALSE;
ptr->return_type = F_VAR_VOID;
FE_LEAVE_FUNCTION( ptr );
}
/*!
* @function ferite_create_internal_function
* @declaration FeriteFunction *ferite_create_internal_function( FeriteScript *script, char *name )
* @brief Allocate a FeriteFunction structure and set it up for use as a script function
* @param FeriteScript *script The script it is being used within
* @param FeriteFunction *name The name of the function to be created
* @return A pointer to a FeriteFunction structure
* @description
* This function tends to be used only be ferite and is used purely to dump opcode data into
* to create a native function see ferite_create_external_function()
*/
FeriteFunction *ferite_create_internal_function( FeriteScript *script, char *name )
{
FeriteFunction *ptr;
int i = 0;
FE_ENTER_FUNCTION;
FUD(("Creating Function: %s\n", name));
ptr = fmalloc( sizeof( FeriteFunction ) );
ptr->name = fstrdup( name );
ptr->type = FNC_IS_INTRL;
ptr->localvars = ferite_create_stack( script, FE_FUNCTION_VARIABLE_SIZE );
ptr->bytecode = ferite_create_opcode_list( FE_FUNCTION_OPCODE_INIT_SIZE );
ptr->signature = fmalloc( sizeof( FeriteParameterRecord* ) * FE_FUNCTION_PARAMETER_MAX_SIZE );
for( i = 0; i < FE_FUNCTION_PARAMETER_MAX_SIZE; i++ )
ptr->signature[i] = NULL;
ptr->arg_count = 0;
ptr->native_information = NULL;
ptr->odata = NULL;
ptr->lock = NULL;
ptr->klass = NULL;
ptr->is_static = FE_TRUE;
ptr->state = FE_ITEM_IS_PUBLIC;
ptr->next = NULL;
ptr->is_alias = FE_FALSE;
ptr->length = 0;
ptr->cached = FE_FALSE;
ptr->return_type = F_VAR_VOID;
FE_LEAVE_FUNCTION( ptr );
}
FeriteAMTArrayEntry *__ferite_amtarray_dup_array_data( FeriteScript *script, FeriteAMTArrayEntry *entry, FeriteScript *_script )
{
FeriteAMTArrayEntry *newEntry = fmalloc(sizeof(FeriteAMTArrayEntry));
if( entry->key )
newEntry->key = fstrdup(entry->key);
newEntry->variable = ferite_duplicate_variable( script, entry->variable, NULL );
return newEntry;
}
/**
* @function ferite_get_warning_string
* @declaration char *ferite_get_warning_string( FeriteScript *script )
* @brief Get a null terminated string containing the warning log
* @param FeriteScript *script The script whose warnings are required
* @return A null terminated string, you will need to ffree the string when done to prevent memory leak
*/
char *ferite_get_warning_string( FeriteScript *script )
{
char *msg;
FE_ENTER_FUNCTION;
if( script->warning )
msg = ferite_buffer_get( script, script->warning, NULL );
else
msg = fstrdup("");
FE_LEAVE_FUNCTION( msg );
}
/**
* @function ferite_get_error_log
* @declaration char *ferite_get_error_log( FeriteScript *script )
* @brief Get a null terminated string containing the error and warning logs on a script
* @param FeriteScript *script The script to get the errror logs from
* @return A null terminated string, you will need to ffree the string when done to prevent memory leak
*/
char *ferite_get_error_log( FeriteScript *script )
{
int err_size = 0, warn_size = 0;
char *msg, *err_ptr, *warn_ptr;
FE_ENTER_FUNCTION;
if( script->error )
err_ptr = ferite_buffer_get( script, script->error, &err_size );
else
err_ptr = fstrdup("");
if( script->warning )
warn_ptr = ferite_buffer_get( script, script->warning, &warn_size );
else
warn_ptr = fstrdup("");
msg = fmalloc( err_size + warn_size + 1 );
strcpy( msg, warn_ptr );
strcat( msg, err_ptr );
ffree( err_ptr );
ffree( warn_ptr );
FE_LEAVE_FUNCTION( msg );
}
/**
* @function ferite_replace_string
* @declaration char *ferite_replace_string( char *str, char *pattern, char *data )
* @brief Replace all occurances of a pattern in a string with another
* @param char *str The string to scan
* @param char *pattern The pattern to look for
* @param char *datat The data to replace with
* @return A string that has had the replacements
* @warning It is the responsibility of the calling function to free the returned string.
*/
char *ferite_replace_string( char *str, char *pattern, char *data )
{
size_t i = 0, start = 0;
char *rstr = NULL, *tmpbuf = NULL;
FE_ENTER_FUNCTION;
if( str && pattern && data )
{
/* empty string -- nothing to replace */
if( !str[0] )
{
FE_LEAVE_FUNCTION( fstrdup(str) );
}
/* empty pattern -- nothing to replace */
if( !pattern[0] )
{
FE_LEAVE_FUNCTION( fstrdup(str) );
}
if( !data[0] ) /* empty replacement -- string won't grow */
rstr = fcalloc_ngc( strlen( str ) + 1, sizeof(char) );
else /* none of the strings can have length zero now */
rstr = fcalloc_ngc( strlen( str ) * strlen( pattern ) * strlen( data ) + 1, sizeof(char) );
FUD(("replace_str: replace \"%s\" with \"%s\"\n", pattern, data ));
while( ((i=ferite_find_string( str+start, pattern ))+1) )
{
strncat( rstr, str+start, i );
strcat( rstr, data );
start = i + start + strlen(pattern);
}
strcat( rstr, str + start );
tmpbuf = fstrdup( rstr );
ffree_ngc( rstr );
FE_LEAVE_FUNCTION( tmpbuf );
}
FE_LEAVE_FUNCTION( NULL );
}
/**
* @function ferite_rename_namespace_element
* @declaration int ferite_rename_namespace_element( FeriteScript *script, FeriteNamespace *ns, char *from, char *to )
* @brief Delete an element from the namespace
* @param FeriteScript *script The script
* @param FeriteNamespace *ns The namespace to look into
* @param char *from The name of the element to rename
* @param char *to The name to rename to
* @return FE_TRUE if an element is deleted, FE_FALSE otherwise
*/
int ferite_rename_namespace_element( FeriteScript *script, FeriteNamespace *ns, char *from, char *to )
{
FeriteNamespaceBucket *nsb = NULL;
FE_ENTER_FUNCTION;
FE_ASSERT( ns != NULL && from != NULL );
nsb = ferite_hash_get( script, ns->data_fork, from );
if( nsb != NULL )
{
ferite_hash_delete( script, ns->data_fork, from );
ferite_hash_add( script, ns->data_fork, to, nsb );
FE_LEAVE_FUNCTION(1);
}
else
{
nsb = ferite_hash_get( script, ns->code_fork, from );
if( nsb != NULL )
{
switch( nsb->type )
{
case FENS_FNC:
ffree( ((FeriteFunction*)nsb->data)->name );
((FeriteFunction*)nsb->data)->name = fstrdup(to);
break;
case FENS_CLS:
ffree( ((FeriteClass*)nsb->data)->name );
((FeriteClass*)nsb->data)->name = fstrdup(to);
break;
}
ferite_hash_delete( script, ns->code_fork, from );
ferite_hash_add( script, ns->code_fork, to, nsb );
FE_LEAVE_FUNCTION(1);
}
}
FE_LEAVE_FUNCTION(0);
}
void ferite_amtarray_add( FeriteScript *script, FeriteAMTArray *array, FeriteVariable *var, char *id, int pos )
{
FeriteAMTArrayEntry *entry = fmalloc(sizeof(FeriteAMTArrayEntry));
unsigned long index = 0;
if( pos >= 0 || pos == FE_ARRAY_ADD_AT_END ) {
index = array->upperLimit++;
} else {
index = array->lowerLimit--;
}
entry->variable = var;
entry->key = NULL;
if( id ) {
entry->key = fstrdup(id);
ferite_hamt_set( script, array->_hash, entry->key, (void*)index );
}
ferite_amt_set( script, array->_array, index, entry );
}
/**
* @function ferite_verror
* @declaration void ferite_verror( FeriteScript *script, char *errormsg, va_list *ap )
* @brief Raise an error
* @param FeriteScript *script The script
* @param int err The error number associated with the error
* @param char *errormsg The error with formating codes in it
* @param va_list *ap The list of arguments
*/
void ferite_verror( FeriteScript *script, int err, char *errormsg, va_list *ap )
{
char *real_errormsg = fstrdup(errormsg);
int length = strlen(real_errormsg);
FE_ENTER_FUNCTION;
if( real_errormsg[length - 1] == '\n' ) {
real_errormsg[length - 1] = '\0';
}
if( script == NULL )
{
vprintf(real_errormsg, *ap );
printf("\n");
ffree( real_errormsg );
FE_LEAVE_FUNCTION( NOWT );
}
if( script->error == NULL )
script->error = ferite_buffer_new( script, 0 );
ferite_buffer_add_str( script, script->error, "Error: " );
ferite_buffer_vprintf( script, script->error, real_errormsg, ap );
ferite_buffer_add_str( script, script->error, "\n" );
if( script->error_state != FE_ERROR_THROWN ) {
if( ferite_is_executing( script ) ) {
int len = 0, sub_length = strlen("Error: ");
char *ptr = ferite_buffer_get( script, script->error, &len );
char *real_ptr = ferite_replace_string( ptr, "%", "%%" );
char *msg = fmalloc(len + 1);
memcpy( msg, real_ptr + sub_length, len - sub_length );
ferite_raise_script_error( script, err, msg );
ffree( msg );
ffree( ptr );
ffree( real_ptr );
}
script->error_state = FE_ERROR_THROWN;
}
ffree( real_errormsg );
FE_LEAVE_FUNCTION( NOWT );
}
/**
* @function ferite_register_namespace
* @declaration FeriteNamespace *ferite_register_namespace( FeriteScript *script, char *name, FeriteNamespace *parent )
* @brief Create a new namespace and place it in the given namespace
* @param FeriteScript *script The script
* @param char *name The name of the new namespace
* @param FeriteNamespace *parent The namespace in which to put the new namespace
* @return The newly created namespace
*/
FeriteNamespace *ferite_register_namespace( FeriteScript *script, char *name, FeriteNamespace *parent )
{
FeriteNamespace *ns = NULL;
FE_ENTER_FUNCTION;
ns = fmalloc( sizeof( FeriteNamespace ) );
ns->name = fstrdup( name );
ns->num = FE_NAMESPACE_INIT_SIZE;
ns->code_fork_ref = fmalloc( sizeof( int ) );
*(ns->code_fork_ref) = 1;
ns->data_fork = ferite_create_hash( script, FE_NAMESPACE_INIT_SIZE );
ns->code_fork = ferite_create_hash( script, FE_NAMESPACE_INIT_SIZE );
if( parent != NULL )
{
ns->container = parent;
ferite_register_namespace_element( script, parent, name, FENS_NS, ns );
}
else
ns->container = NULL;
FE_LEAVE_FUNCTION( ns );
}
/**
* @function ferite_namespace_dup
* @declaration FeriteNamespace *ferite_namespace_dup( FeriteScript *script, FeriteNamespace *ns, FeriteNamespace *container )
* @brief Duplicate a namespace
* @param FeriteScript *script The script
* @param FeriteNamespace *ns The namespace to duplicate
* @param FeriteNamespace *container The container of the new namespace
* @return The new namespace
*/
FeriteNamespace *ferite_namespace_dup( FeriteScript *script, FeriteNamespace *ns, FeriteNamespace *container )
{
FeriteNamespace *ptr = NULL;
FE_ENTER_FUNCTION;
FE_ASSERT( ns != NULL );
ptr = fmalloc(sizeof(FeriteNamespace));
ptr->num = ns->num;
ptr->data_fork = ferite_hash_dup( script, ns->data_fork, (void *(*)(FeriteScript *,void *,void*))ferite_namespace_bucket_dup, ptr );
/* Use the same code fork reference */
ptr->code_fork = ns->code_fork;
ptr->code_fork_ref = ns->code_fork_ref;
*(ptr->code_fork_ref) += 1;
ptr->container = container;
if( ns->name != NULL )
ptr->name = fstrdup( ns->name );
else
ptr->name = NULL;
FE_LEAVE_FUNCTION(ptr);
}
void
text_x11(display_t *out, char *text, int n) {
float x, y;
char *tmp;
XWindow *win;
win = plot_window( CURRENT );
xwindow_font_load(win);
tmp = fstrdup(text, n);
tmp = encode(tmp);
get_position(&x, &y);
x = view_to_x11_x(x, win);
y = view_to_x11_y(y, win);
switch( win->font->type) {
case XFONT_TYPE_SOFTWARE:
softwaretext(out, text, n);
break;
case XFONT_TYPE_CORE:
xwindow_draw_string_core(win, tmp, x, y);
break;
case XFONT_TYPE_XFT:
xwindow_draw_string_xft(win, tmp, x, y);
break;
default:
fprintf(stderr, "SAC: Unknown X11 Font Subsystem\n");
break;
}
free(tmp);
tmp = NULL;
}
/**
* @function ferite_function_dup
* @declaration FeriteFunction *ferite_function_dup( FeriteScript *script, FeriteFunction *function, FeriteClass *container )
* @brief Duplicate a function
* @param FeriteScript *script The current script
* @param FeriteFunction *function The function to duplicated
* @param FeriteClass *container The class the function is part of [if it is part of a class]
* @return The new function
*/
FeriteFunction *ferite_function_dup( FeriteScript *script, FeriteFunction *function, FeriteClass *container )
{
FeriteFunction *ptr = NULL;
int i = 0;
FE_ENTER_FUNCTION;
if( function != NULL )
{
ptr = fmalloc( sizeof( FeriteFunction ) );
if( function->name != NULL )
ptr->name = fstrdup( function->name );
else
ptr->name = NULL;
ptr->type = function->type;
ptr->is_static = function->is_static;
ptr->arg_count = function->arg_count;
if( function->lock != NULL )
ptr->lock = aphex_mutex_recursive_create();
else
ptr->lock = NULL;
ptr->klass = container;
ptr->signature = fmalloc( sizeof( FeriteParameterRecord* ) * FE_FUNCTION_PARAMETER_MAX_SIZE );
for( i = 0; i < FE_FUNCTION_PARAMETER_MAX_SIZE; i++ )
ptr->signature[i] = NULL;
for( i = 0; i < (ptr->arg_count + 1); i++ )
{
if( function->signature[i] != NULL )
{
ptr->signature[i] = fmalloc( sizeof(FeriteParameterRecord) );
ptr->signature[i]->variable = ferite_duplicate_variable( script, function->signature[i]->variable, NULL );
ptr->signature[i]->has_default_value = function->signature[i]->has_default_value;
ptr->signature[i]->pass_type = function->signature[i]->pass_type;
}
}
if( function->native_information != NULL )
{
ptr->native_information = fmalloc(sizeof(FeriteFunctionNative));
ptr->native_information->code = fstrdup(function->native_information->code);
ptr->native_information->file = fstrdup(function->native_information->file);
ptr->native_information->line = function->native_information->line;
}
else
ptr->native_information = NULL;
switch( function->type )
{
case FNC_IS_INTRL:
ptr->localvars = ferite_duplicate_stack( script, function->localvars, (void*(*)(FeriteScript*,void*,void*))ferite_duplicate_variable, NULL );
ptr->bytecode = ferite_opcode_dup( script, function->bytecode );
break;
case FNC_IS_EXTRL:
ptr->fncPtr = function->fncPtr;
ptr->bytecode = NULL;
break;
}
if( function->next != NULL )
ptr->next = ferite_function_dup( script, function->next, container );
else
ptr->next = NULL;
ptr->state = function->state;
ptr->is_alias = function->is_alias;
}
FE_LEAVE_FUNCTION(ptr);
}
/**
* Get an enumerated header value from the current SAC file
*
* @param kname
* Name of the header field to get
* @param kvalue
* Value of heade field from the current SAC data file
* Each value represents a specific condition
* @param nerr
* Error Return Flag
* - 0 on Success
* - ERROR_UNDEFINED_HEADER_FIELD_VALUE
* - 1337
* @param kname_s
* Length of \p kname
* @param kvalue_s
* Length of \p kvalye
*
* @date 870902: Original version.
*
*/
void
getihv(char *kname,
char *kvalue,
int *nerr,
int kname_s,
int kvalue_s) {
char ktest[9];
int index, ivalue, ntest;
char *kname_c;
int callFromC = 0;
if(kname_s < 0) {
callFromC = 1;
}
kname_c = fstrdup(kname, kname_s);
kname_s = strlen(kname_c) + 1;
*nerr = 0;
/* - Convert input name to uppercase and
* check versus list of legal names. */
ntest = min( indexb( kname_c,kname_s ), SAC_HEADER_STRING_LENGTH_FILE );
strcpy( ktest, " " );
modcase( TRUE, kname_c, ntest, ktest );
index = nequal( ktest, (char*)kmlhf.kihdr,9, SAC_HEADER_ENUMS );
/* - If legal name, return current value.
* Otherwise, set error condition. */
if( index > 0 ){
ivalue = Ihdr[index];
if( ivalue == cmhdr.iundef ){
fstrncpy( kvalue, kvalue_s-1, "UNDEFINED", 9);
*nerr = ERROR_UNDEFINED_HEADER_FIELD_VALUE;
}
else{
fstrncpy( kvalue, kvalue_s-1, kmlhf.kiv[ivalue - 1],
strlen(kmlhf.kiv[ivalue - 1]) );
}
}
else{
fstrncpy( kvalue, kvalue_s-1, "ILLEGAL", 7);
*nerr = 1337;
}
/* - Create error message and write to terminal. */
if( *nerr != 0 ){
setmsg( "WARNING", *nerr );
apcmsg( kname_c,kname_s );
outmsg();
clrmsg();
}
if(callFromC) { /* C String Termination */
kvalue[ max(0,min(kvalue_s,8))] = 0;
} else { /* Fortran String Non-Termination by Spaces */
if(kvalue_s > 8) {
memset(kvalue + 8, ' ', kvalue_s - 8);
}
}
free(kname_c);
return;
}
void builder_process_closed_function( FeriteScript *script, FeriteFunction *fnc, char *parent )
{
int i, is_ptr = 0;
int decrementArgCount = 0;
char c_variable_type[64], *buf, c_variable_init[512];
FeriteStack *stk;
FeriteFunctionNative *native_info;
FILE *target;
FE_ENTER_FUNCTION;
if( fnc->next != NULL )
builder_process_closed_function( script, fnc->next, parent );
if( fnc->type == FNC_IS_INTRL ) /* we dont touch internal functions */
{
if( opt.verbose )
printf( " Function '%s' is not native code.\n", fnc->name );
FE_LEAVE_FUNCTION(NOWT);
}
target = module_current_c_file;
if( current_module->name_stack->stack_ptr == 1 )
target = current_module->misc;
ferite_stack_push( FE_NoScript, current_module->name_stack, fnc->name );
if( opt.verbose )
printf( " Writing function %s\n", parent );
stk = ferite_create_stack( NULL, 30 );
fprintf( current_module->header, "FE_NATIVE_FUNCTION( %s );\n", builder_generate_current_name(FE_TRUE,FE_TRUE) );
fprintf( current_module->core, " %s( script, %s%s, \"%s\", %s, \"",
(in_class == 1 ? "fe_create_cls_fnc" : "fe_create_ns_fnc"),
builder_generate_current_name(FE_FALSE,FE_TRUE),
(in_class == 1 ? "_class" : "_namespace"),
fnc->name,
builder_generate_current_name(FE_TRUE,FE_TRUE) );
fprintf( target, "FE_NATIVE_FUNCTION( %s )\n{\n", builder_generate_current_name(FE_TRUE,FE_TRUE) );
for( i = 0; i < fnc->arg_count; i++ )
{
if( !(fnc->signature[i]->is_dots) )
{
switch( F_VAR_TYPE(fnc->signature[i]->variable) )
{
case F_VAR_LONG:
case F_VAR_DOUBLE:
strcpy( c_variable_type, "double" );
c_variable_init[0] = '\0';
fprintf( current_module->core, "n" );
is_ptr = 0;
break;
case F_VAR_STR:
strcpy( c_variable_type, "FeriteString" );
is_ptr = 1;
break;
case F_VAR_OBJ:
strcpy( c_variable_type, "FeriteObject" );
c_variable_init[0] = '\0';
if( i < (in_class == 0 ? fnc->arg_count : fnc->arg_count - 2) )
fprintf( current_module->core, "o" );
is_ptr = 1;
break;
case F_VAR_UARRAY:
strcpy( c_variable_type, "FeriteUnifiedArray" );
c_variable_init[0] = '\0';
fprintf( current_module->core, "a" );
is_ptr = 1;
break;
case F_VAR_VOID:
strcpy( c_variable_type, "FeriteVariable" );
sprintf( c_variable_init, " = params[%d]", i );
fprintf( current_module->core, "v" );
is_ptr = 1;
break;
}
if( i < (in_class == 0 ? fnc->arg_count -1 : fnc->arg_count - 3) )
fprintf( current_module->core, "," );
fprintf( target, " %s %s%s%s;\n", c_variable_type, (is_ptr ? "*" : "" ), fnc->signature[i]->name, c_variable_init );
}
if( !fnc->signature[i]->is_dots && F_VAR_TYPE(fnc->signature[i]->variable) != F_VAR_VOID )
sprintf( c_variable_type, ", %s%s", (F_VAR_TYPE(fnc->signature[i]->variable) == F_VAR_STR ? "" : "&"), fnc->signature[i]->name );
else
sprintf( c_variable_type, ", NULL" );
ferite_stack_push( FE_NoScript, stk, fstrdup( c_variable_type ) );
}
if( !in_class )
{
fprintf( current_module->core, "\" );\n" );
}
else
{
fprintf( current_module->core, "\", %s );\n", (fnc->is_static ? "1" : "0") );
}
if( fnc->arg_count > 0 )
{
fprintf( target, "\n ferite_get_parameters( params, %d",
(decrementArgCount ? fnc->arg_count - (in_class ? 3 : 1) : fnc->arg_count) );
for( i = 1; i <= stk->stack_ptr; i++ )
{
buf = stk->stack[i];
fprintf( target, "%s", buf );
ffree( buf );
}
fprintf( target, " );\n" );
}
ferite_delete_stack( NULL, stk );
native_info = fnc->native_information;
fprintf( target, "\n { /* Main function body. */\n" );
if( (buf = strrchr( native_info->file, '/' )) != NULL )
buf++;
fprintf( target, "#line %d \"%s\"\n", native_info->line,
ferite_replace_string( (buf != NULL ? buf : native_info->file), "\\", "\\\\" ) );
fprintf( target, "%s\n }\n FE_RETURN_VOID;\n self = NULL;\n}\n\n", native_info->code );
ferite_stack_pop( FE_NoScript, current_module->name_stack );
FE_LEAVE_FUNCTION( NOWT );
}
void builder_process_open_function( FeriteScript *script, FeriteFunction *fnc, char *parent )
{
int i, is_ptr = 0;
int decrementArgCount = 0;
char c_variable_type[64], *buf = NULL, c_variable_init[512], *sig = NULL;
FeriteStack *stk = NULL;
FeriteFunctionNative *native_info = NULL;
FILE *target = NULL;
FE_ENTER_FUNCTION;
if( fnc->next != NULL )
builder_process_open_function( script, fnc->next, parent );
if( fnc->type == FNC_IS_INTRL ) /* we dont touch internal functions */
{
if( opt.verbose )
printf( " Function '%s' is not native code.\n", fnc->name );
FE_LEAVE_FUNCTION(NOWT);
}
target = module_current_c_file;
if( current_module->name_stack->stack_ptr == 1 )
target = current_module->misc;
ferite_stack_push( FE_NoScript, current_module->name_stack, fnc->name );
if( opt.verbose )
printf( " Writing function %s\n", parent );
stk = ferite_create_stack( NULL, 30 );
sig = ferite_function_generate_sig_string( script, fnc );
fprintf( current_module->header, "FE_NATIVE_FUNCTION( %s_%s );\n", builder_generate_current_name(FE_TRUE,FE_TRUE), sig );
fprintf( current_module->core, " ferite_module_register_native_function( \"%s_%s\", %s_%s );\n",
builder_generate_current_function_name(), sig,
builder_generate_current_name(FE_TRUE,FE_TRUE), sig );
fprintf( target, "FE_NATIVE_FUNCTION( %s_%s )\n{\n", builder_generate_current_name(FE_TRUE,FE_TRUE), sig );
ffree( sig );
for( i = 0; i < fnc->arg_count; i++ )
{
memset( &c_variable_init, '\0', 512 );
if( fnc->signature[i]->variable ) {
switch( F_VAR_TYPE(fnc->signature[i]->variable) )
{
case F_VAR_BOOL:
strcpy( c_variable_type, "char" );
strcpy( c_variable_init, " = FE_FALSE" );
is_ptr = 0;
break;
case F_VAR_LONG:
case F_VAR_DOUBLE:
strcpy( c_variable_type, "double" );
strcpy( c_variable_init, " = 0.0" );
is_ptr = 0;
break;
case F_VAR_STR:
strcpy( c_variable_type, "FeriteString" );
strcpy( c_variable_init, " = NULL" );
is_ptr = 1;
break;
case F_VAR_OBJ:
strcpy( c_variable_type, "FeriteObject" );
strcpy( c_variable_init, " = NULL" );
is_ptr = 1;
break;
case F_VAR_UARRAY:
strcpy( c_variable_type, "FeriteUnifiedArray" );
strcpy( c_variable_init, " = NULL" );
is_ptr = 1;
break;
case F_VAR_VOID:
strcpy( c_variable_type, "FeriteVariable" );
sprintf( c_variable_init, " = params[%d]", i );
is_ptr = 1;
break;
}
fprintf( target, " %s %s%s%s;\n", c_variable_type, (is_ptr ? "*" : "" ), fnc->signature[i]->name, c_variable_init );
}
if( !(fnc->signature[i]->is_dots) && F_VAR_TYPE(fnc->signature[i]->variable) != F_VAR_VOID )
sprintf( c_variable_type, ", &%s", fnc->signature[i]->name );
else
sprintf( c_variable_type, ", NULL" );
ferite_stack_push( FE_NoScript, stk, fstrdup( c_variable_type ) );
}
if( fnc->klass != NULL && !fnc->is_static )
{
fprintf( target, " FeriteObject *self = FE_CONTAINER_TO_OBJECT;\n" );
fprintf( target, " FeriteObject *super = FE_CONTAINER_TO_OBJECT;\n" );
}
else if( fnc->klass != NULL && fnc->is_static )
fprintf( target, " FeriteClass *self = FE_CONTAINER_TO_CLASS;\n" );
else
fprintf( target, " FeriteNamespace *self = FE_CONTAINER_TO_NS;\n" );
if( fnc->arg_count > 0 )
{
fprintf( target, "\n ferite_get_parameters( params, %d", (decrementArgCount
? fnc->arg_count - (in_class ? 3 : 1)
: fnc->arg_count) );
for( i = 1; i <= stk->stack_ptr; i++ )
{
buf = stk->stack[i];
fprintf( target, "%s", buf );
ffree( buf );
}
fprintf( target, " );\n" );
}
ferite_delete_stack( NULL, stk );
native_info = fnc->native_information;
fprintf( target, "\n { /* Main function body. */\n" );
if( (buf = strrchr( native_info->file, '/' )) != NULL )
buf++;
fprintf( target, "#line %d \"%s\"\n", native_info->line,
ferite_replace_string( (buf != NULL ? buf : native_info->file), "\\", "\\\\" ) );
fprintf( target, "%s\n }\n FE_RETURN_VOID;\n self = NULL;\n", native_info->code );
if( fnc->klass != NULL && !fnc->is_static )
fprintf( target, " super = NULL;\n" );
fprintf( target, "}\n\n" );
ferite_stack_pop( FE_NoScript, current_module->name_stack );
FE_LEAVE_FUNCTION( NOWT );
}
void builder_process_closed_class( FeriteScript *script, FeriteClass *cls, char *parent )
{
char buf[1024];
FE_ENTER_FUNCTION;
if( (char *)cls->parent != NULL ) /* we have a inheirted class */
{
if( !builder_class_in_stack( (char *)cls->parent ) ) /* it's not in the class stack */
{
FeriteNamespaceBucket *nsb = ferite_find_namespace( script, script->mainns, (char *)cls->parent, FENS_CLS );
if( nsb != NULL )
{
builder_process_class( script, nsb->data, parent );
ferite_stack_push( FE_NoScript, class_stack, fstrdup((char *)cls->parent) );
}
else
{
ferite_warning( script, "Class '%s' extends '%s' which does not exist in this module - assuming it is external\n", cls->name, (char*)cls->parent );
}
}
}
if( builder_class_in_stack( cls->name ) )
{
/* we return if we are already in the list */
FE_LEAVE_FUNCTION(NOWT);
}
ferite_stack_push( FE_NoScript, current_module->name_stack, cls->name );
sprintf( buf, "%s.c", builder_generate_current_name(FE_TRUE,FE_FALSE) );
strcat( internal_file_list, buf ); strcat( internal_file_list, " " );
if( opt.verbose )
printf( "Generating file %s for class %s\n", buf, parent );
ferite_stack_push( FE_NoScript, file_stack, module_current_c_file );
module_current_c_file = builder_fopen( buf, "w" );
fprintf( module_current_c_file,
"/* This file has been automatically generated by builder part of the ferite distribution */\n" \
"/* file: %s */\n" \
"/* class: %s */\n\n" \
"#include <ferite.h> /* we need this without a doubt */\n" \
"#include \"%s_header.h\" /* this is the module header */\n\n", buf, cls->name, current_module->name );
fprintf( current_module->core, " if( ferite_namespace_element_exists( script, %s_namespace, \"%s\" ) == NULL )\n" \
" {\n" \
" FeriteClass *%s_%s_class = ferite_register_inherited_class( script, %s_namespace, \"%s\", %s%s%s );\n",
builder_generate_current_name( FE_FALSE,FE_TRUE ),
cls->name,
builder_generate_current_name( FE_TRUE,FE_TRUE ),
cls->name,
builder_generate_current_name( FE_FALSE,FE_TRUE ),
cls->name,
( cls->parent == NULL ? "" : "\"" ),
( cls->parent == NULL ? "NULL" : (char *)cls->parent ),
( cls->parent == NULL ? "" : "\"" )
);
if( cls->parent != NULL )
{
ffree( cls->parent );
}
in_class = 1;
ferite_process_hash( script, cls->object_vars, (void (*)(FeriteScript*,void *,char*))builder_process_variable );
ferite_process_hash( script, cls->class_vars, (void (*)(FeriteScript*,void *,char*))builder_process_variable );
ferite_process_hash( script, cls->object_methods, (void (*)(FeriteScript*,void *,char*))builder_process_function );
ferite_process_hash( script, cls->class_methods, (void (*)(FeriteScript*,void *,char*))builder_process_function );
in_class = 0;
fprintf( current_module->core, " }\n\n" );
fclose( module_current_c_file );
module_current_c_file = ferite_stack_pop( FE_NoScript, file_stack );
ferite_stack_pop( FE_NoScript, current_module->name_stack );
FE_LEAVE_FUNCTION( NOWT );
}
