/* * expState.c * $Id: expState.c,v 4.21 2007/07/04 20:51:11 bkorb Exp $ * * Time-stamp: "2007-07-04 11:19:46 bkorb" * Last Committed: $Date: 2007/07/04 20:51:11 $ * * This module implements expression functions that * query and get state information from AutoGen data. * * This file is part of AutoGen. * AutoGen copyright (c) 1992-2007 by Bruce Korb - all rights reserved * * AutoGen is free software: you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by the * Free Software Foundation, either version 3 of the License, or * (at your option) any later version. * * AutoGen is distributed in the hope that it will be useful, but * WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * See the GNU General Public License for more details. * * You should have received a copy of the GNU General Public License along * with this program. If not, see . */ #ifdef SCM_HAVE_T_UINT64 typedef uint64_t ver_type_t; # define VER_UNIT_SHIFT 16ULL # if ((SCM_MAJOR_VERSION * 100) + SCM_MINOR_VERSION) >= 108 # define SCM_FROM(v) scm_from_uint64(v) # else # define SCM_FROM(v) gh_ulong2scm((unsigned long)v) # endif #else typedef uint32_t ver_type_t; # define VER_UNIT_SHIFT 8 # ifdef HAVE_SCM_FROM_UINT32 # define SCM_FROM(v) scm_from_uint32(v) # else # define SCM_FROM(v) gh_ulong2scm((unsigned long)v) # endif #endif /* = = = START-STATIC-FORWARD = = = */ /* static forward declarations maintained by :mkfwd */ static int entry_length( char* pzName ); static int count_entries( char* pzName ); static SCM find_entry_value( SCM op, SCM obj, SCM test ); static ver_type_t str2int_ver( char* pz ); /* = = = END-STATIC-FORWARD = = = */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * EXPRESSION EVALUATION SUPPORT ROUTINES * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ static int entry_length( char* pzName ) { tDefEntry** papDefs = findEntryList( pzName ); int res = 0; if (papDefs == NULL) return 0; for (;;) { tDefEntry* pDE = *(papDefs++); if (pDE == NULL) break; if (pDE->valType == VALTYP_TEXT) res += strlen( pDE->val.pzText ); else res++; } return res; } static int count_entries( char* pzName ) { tDefEntry** papDefs = findEntryList( pzName ); int res = 0; if (papDefs == NULL) return 0; for (;;) { tDefEntry* pDE = *(papDefs++); if (pDE == NULL) break; res++; } return res; } static SCM find_entry_value( SCM op, SCM obj, SCM test ) { ag_bool isIndexed; tDefEntry* pE; tSCC zFailed[] = "failed\n"; tSCC zSucc[] = "SUCCESS\n"; char* pzField; char* pzName = ag_scm2zchars( obj, "find name" ); if (OPT_VALUE_TRACE >= TRACE_EXPRESSIONS) fprintf( pfTrace, " in \"%s\" -- ", pzName ); pzField = strchr( pzName, '.' ); if (pzField != NULL) *(pzField++) = NUL; pE = findDefEntry( pzName, &isIndexed ); /* * No such entry? return FALSE */ if (pE == NULL) { if (OPT_VALUE_TRACE >= TRACE_EXPRESSIONS) fputs( zFailed, pfTrace ); return SCM_BOOL_F; } /* * No subfield? Check the values */ if (pzField == NULL) { SCM result; SCM field; if (pE->valType != VALTYP_TEXT) { if (OPT_VALUE_TRACE >= TRACE_EXPRESSIONS) fputs( zFailed, pfTrace ); return SCM_BOOL_F; /* Cannot match string -- not a text value */ } field = AG_SCM_STR02SCM( pE->val.pzText ); result = gh_call2( op, field, test ); if (! isIndexed) while (result == SCM_BOOL_F) { pE = pE->pTwin; if (pE == NULL) break; field = AG_SCM_STR02SCM( pE->val.pzText ); result = gh_call2( op, field, test ); } if (OPT_VALUE_TRACE >= TRACE_EXPRESSIONS) fputs( (result == SCM_BOOL_T) ? zSucc : zFailed, pfTrace ); return result; } /* * a subfield for a text macro? return FALSE */ if (pE->valType == VALTYP_TEXT) { if (OPT_VALUE_TRACE >= TRACE_EXPRESSIONS) fputs( zFailed, pfTrace ); return SCM_BOOL_F; } /* * Search the members for what we want. */ pzField[-1] = '.'; { SCM field = AG_SCM_STR02SCM( pzField ); SCM result; tDefCtx ctx = currDefCtx; currDefCtx.pPrev = &ctx; currDefCtx.pDefs = pE->val.pDefEntry; result = find_entry_value( op, field, test ); if (! isIndexed) while (result == SCM_BOOL_F) { pE = pE->pTwin; if (pE == NULL) break; currDefCtx.pDefs = pE->val.pDefEntry; result = find_entry_value( op, field, test ); } currDefCtx = ctx; return result; } } /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * EXPRESSION ROUTINES * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /*=gfunc base_name * * what: base output name * * doc: Returns a string containing the base name of the output file(s). * Generally, this is also the base name of the definitions file. =*/ SCM ag_scm_base_name( void ) { return AG_SCM_STR02SCM( (char*)(void*)OPT_ARG( BASE_NAME )); } /*=gfunc version_compare * * what: compare two version numbers * general_use: * * exparg: op, comparison operator * exparg: v1, first version * exparg: v2, compared-to version * * doc: Converts v1 and v2 strings into 64 bit values and returns the * result of running 'op' on those values. It assumes that the version * is a 1 to 4 part dot-separated series of numbers. Suffixes like, * "5pre4" or "5-pre4" will be interpreted as two numbers. The first * number ("5" in this case) will be decremented and the number after * the "pre" will be added to 0xC000. (Unless your platform is unable * to support 64 bit integer arithmetic. Then it will be added to 0xC0.) * Consequently, these yield true: * @example * (version-compare > "5.8.5" "5.8.5-pre4") * (version-compare > "5.8.5-pre10" "5.8.5-pre4") * @end example =*/ static ver_type_t str2int_ver( char* pz ) { char* pzStr = pz; ver_type_t val = 0; int ix = 4; while (--ix >= 0) { unsigned int v; val <<= VER_UNIT_SHIFT; while (isspace(*pz)) pz++; next_number: if (! isdigit(*pz)) break; v = (unsigned int)strtoul(pz, &pz, 0) & ((1 << VER_UNIT_SHIFT) - 1); if (pz == NULL) break; val += v; if (*pz == '-') pz++; switch (*pz) { case 'p': if ((pz[1] == 'r') && (pz[2] == 'e')) { pz += 3; val = (val << 2) - 1; val <<= (VER_UNIT_SHIFT - 2); if (--ix < 0) goto leave_str2int_ver; goto next_number; } /* FALLTHROUGH */ default: goto leave_str2int_ver; case '.': if (! isdigit( *(++pz) )) goto leave_str2int_ver; break; } } leave_str2int_ver: ; while (--ix >= 0) val <<= VER_UNIT_SHIFT; if (OPT_VALUE_TRACE >= TRACE_EXPRESSIONS) fprintf( pfTrace, "0x%016llX <<== '%s'\n", (long long)val, pzStr ); return val; } SCM ag_scm_version_compare( SCM op, SCM v1, SCM v2 ) { tSCC zVer[] = "version str"; ver_type_t val1 = str2int_ver( ag_scm2zchars( v1, zVer )); ver_type_t val2 = str2int_ver( ag_scm2zchars( v2, zVer )); v1 = SCM_FROM(val1); v2 = SCM_FROM(val2); return scm_apply( op, v1, scm_cons(v2, scm_listofnull)); } /*=gfunc chdir * * what: Change current directory * * exparg: dir, new directory name * * doc: Sets the current directory for AutoGen. Shell commands will run * from this directory as well. This is a wrapper around the Guile * native function. It returns its directory name argument and * fails the program on failure. =*/ SCM ag_scm_chdir( SCM dir ) { tSCC zChdirDir[] = "chdir directory"; scm_chdir( dir ); /* * We're still here, so we have a valid argument. */ if (pCurDir != NULL) free( pCurDir ); { char* pz = ag_scm2zchars( dir, zChdirDir ); pCurDir = malloc( AG_SCM_STRLEN( dir ) + 1 ); strcpy( (char*)pCurDir, pz ); } return dir; } /*=gfunc count * * what: definition count * * exparg: ag-name, name of AutoGen value * * doc: Count the number of entries for a definition. * The input argument must be a string containing the name * of the AutoGen values to be counted. If there is no * value associated with the name, the result is an SCM * immediate integer value of zero. =*/ SCM ag_scm_count( SCM obj ) { int ent_len = count_entries( ag_scm2zchars( obj, "ag object" )); return AG_SCM_INT2SCM( ent_len ); } /*=gfunc def_file * * what: definitions file name * * doc: Get the name of the definitions file. * Returns the name of the source file containing the AutoGen * definitions. =*/ SCM ag_scm_def_file( void ) { return AG_SCM_STR02SCM( (char*)(void*)pBaseCtx->pzCtxFname ); } /*=gfunc exist_p * * what: test for value name * * exparg: ag-name, name of AutoGen value * * doc: return SCM_BOOL_T iff a specified name has an AutoGen value. * The name may include indexes and/or member names. * All but the last member name must be an aggregate definition. * For example: * @example * (exist? "foo[3].bar.baz") * @end example * will yield true if all of the following is true: * @* * There is a member value of either group or string type * named @code{baz} for some group value @code{bar} that * is a member of the @code{foo} group with index @code{3}. * There may be multiple entries of @code{bar} within * @code{foo}, only one needs to contain a value for @code{baz}. =*/ SCM ag_scm_exist_p( SCM obj ) { ag_bool x; SCM res; if (findDefEntry( ag_scm2zchars( obj, "ag object" ), &x ) == NULL) res = SCM_BOOL_F; else res = SCM_BOOL_T; return res; } /*=gfunc ag_function_p * * what: test for function * * exparg: ag-name, name of AutoGen macro * * doc: return SCM_BOOL_T if a specified name is a user-defined AutoGen * macro, otherwise return SCM_BOOL_F. =*/ SCM ag_scm_ag_function_p( SCM obj ) { SCM res; if (findTemplate( ag_scm2zchars( obj, "ag user macro" )) == NULL) res = SCM_BOOL_F; else res = SCM_BOOL_T; return res; } /*=gfunc match_value_p * * what: test for matching value * * exparg: op, boolean result operator * exparg: ag-name, name of AutoGen value * exparg: test-str, string to test against * * doc: This function answers the question, "Is there an AutoGen value named * @code{ag-name} with a value that matches the pattern @code{test-str} * using the match function @code{op}?" Return SCM_BOOL_T iff at least * one occurrence of the specified name has such a value. The operator * can be any function that takes two string arguments and yields a * boolean. It is expected that you will use one of the string matching * functions provided by AutoGen. * @* * The value name must follow the same rules as the * @code{ag-name} argument for @code{exist?} (@pxref{SCM exist?}). =*/ SCM ag_scm_match_value_p( SCM op, SCM obj, SCM test ) { if ( (! AG_SCM_IS_PROC( op )) || (! AG_SCM_STRING_P( obj )) ) return SCM_UNDEFINED; if (OPT_VALUE_TRACE >= TRACE_EXPRESSIONS) fprintf( pfTrace, "searching for `%s'", ag_scm2zchars( test, "test value" )); return find_entry_value( op, obj, test ); } /*=gfunc get * * what: get named value * * exparg: ag-name, name of AutoGen value * exparg: alt-val, value if not present, optional * * doc: * Get the first string value associated with the name. * It will either return the associated string value (if * the name resolves), the alternate value (if one is provided), * or else the empty string. =*/ SCM ag_scm_get( SCM agName, SCM altVal ) { tDefEntry* pE; ag_bool x; if (! AG_SCM_STRING_P( agName )) pE = NULL; else pE = findDefEntry( ag_scm2zchars( agName, "ag value" ), &x ); if ((pE == NULL) || (pE->valType != VALTYP_TEXT)) { if (AG_SCM_STRING_P( altVal )) return altVal; return AG_SCM_STR02SCM(zNil); } return AG_SCM_STR02SCM( pE->val.pzText ); } /*=gfunc high_lim * * what: get highest value index * * exparg: ag-name, name of AutoGen value * * doc: * * Returns the highest index associated with an array of definitions. * This is generally, but not necessarily, one less than the * @code{count} value. (The indexes may be specified, rendering a * non-zero based or sparse array of values.) * * This is very useful for specifying the size of a zero-based array * of values where not all values are present. For example: * * @example * tMyStruct myVals[ [+ (+ 1 (high-lim "my-val-list")) +] ]; * @end example =*/ SCM ag_scm_high_lim( SCM obj ) { tDefEntry* pE; ag_bool isIndexed; pE = findDefEntry( ag_scm2zchars( obj, "ag value" ), &isIndexed ); /* * IF we did not find the entry we are looking for * THEN return zero * ELSE search the twin list for the high entry */ if (pE == NULL) return AG_SCM_INT2SCM( 0 ); if (isIndexed) return AG_SCM_INT2SCM( (int)pE->index ); if (pE->pEndTwin != NULL) pE = pE->pEndTwin; return AG_SCM_INT2SCM( (int)pE->index ); } /*=gfunc len * * what: get count of values * * exparg: ag-name, name of AutoGen value * * doc: If the named object is a group definition, then "len" is * the same as "count". Otherwise, if it is one or more text * definitions, then it is the sum of their string lengths. * If it is a single text definition, then it is equivalent to * @code{(string-length (get "ag-name"))}. =*/ SCM ag_scm_len( SCM obj ) { int len = entry_length( ag_scm2zchars( obj, "ag value" )); return AG_SCM_INT2SCM( len ); } /*=gfunc low_lim * * what: get lowest value index * * exparg: ag-name, name of AutoGen value * * doc: Returns the lowest index associated with an array of definitions. =*/ SCM ag_scm_low_lim( SCM obj ) { tDefEntry* pE; ag_bool x; pE = findDefEntry( ag_scm2zchars( obj, "ag value" ), &x ); /* * IF we did not find the entry we are looking for * THEN return zero * ELSE we have the low index. */ if (pE == NULL) return AG_SCM_INT2SCM( 0 ); return AG_SCM_INT2SCM( (int)pE->index ); } /*=gfunc set_option * * what: Set a command line option * * exparg: opt, AutoGen option name + its argument * * doc: The text argument must be an option name followed by any needed * option argument. Returns SCM_UNDEFINED. =*/ SCM ag_scm_set_option( SCM opt ) { optionLoadLine( &autogenOptions, ag_scm2zchars( opt, "opt + arg" )); return SCM_UNDEFINED; } /*=gfunc suffix * * what: get the current suffix * * doc: * Returns the current active suffix (@pxref{pseudo macro}). =*/ SCM ag_scm_suffix( void ) { return AG_SCM_STR02SCM( (char*)pzCurSfx ); } /*=gfunc tpl_file * * what: get the template file name * * exparg: full_path, include full path to file, optonal * * doc: Returns the name of the current template file. * If @code{#t} is passed in as an argument, then the template * file is hunted for in the template search path. Otherwise, * just the unadorned name. =*/ SCM ag_scm_tpl_file( SCM full ) { if (AG_SCM_BOOL_P( full ) && SCM_NFALSEP( full )) { tSCC* sfx[] = { "tpl", NULL }; char z[AG_PATH_MAX]; if (SUCCESSFUL( findFile( pzTemplFileName, z, sfx, NULL ))) return AG_SCM_STR02SCM( z ); } return AG_SCM_STR02SCM( (char*)(void*)pzTemplFileName ); } /*=gfunc tpl_file_line * * what: get the template file+line number * * exparg: msg-fmt, formatting for line message, optional * * doc: * * Returns the file and line number of the current template macro using * either the default format, "from %s line %d", or else the format you * supply. For example, if you want to insert a "C" language file-line * directive, you would supply the format "# %2$d \"%1$s\"", but that * is also already supplied with the scheme variable * @xref{SCM c-file-line-fmt}. You may use it thus: * @example * (tpl-file-line c-file-line-fmt) * @end example * * It is also safe to use the formatting string, "%2$d". AutoGen uses * an argument vector version of printf: @xref{snprintfv}. =*/ SCM ag_scm_tpl_file_line( SCM fmt ) { char zScribble[ 1024 ]; tSCC zFmt[] = "from %s line %d"; tCC* pzFmt = zFmt; char* pz; if (AG_SCM_STRING_P( fmt )) pzFmt = ag_scm2zchars( fmt, "file/line format" ); { size_t maxlen = strlen( pCurTemplate->pzTplFile ) + strlen( pzFmt ) + 4 * sizeof( int ); if (maxlen >= sizeof( zScribble )) pz = (char*)AGALOC( maxlen, "file-line buffer" ); else pz = zScribble; } { void* args[2]; args[0] = (void*)pCurTemplate->pzTplFile; args[1] = (void*)(long)pCurMacro->lineNo; sprintfv( pz, pzFmt, (snv_constpointer*)args ); } { SCM res = AG_SCM_STR02SCM( pz ); if (pz != zScribble) AGFREE( (void*)pz ); return res; } } /*=gfunc def_file_line * * what: get a definition file+line number * * exparg: ag-name, name of AutoGen value * exparg: msg-fmt, formatting for line message, optional * * doc: * * Returns the file and line number of a AutoGen defined value, using * either the default format, "from %s line %d", or else the format you * supply. For example, if you want to insert a "C" language file-line * directive, you would supply the format "# %2$d \"%1$s\"", but that * is also already supplied with the scheme variable * @xref{SCM c-file-line-fmt}. You may use it thus: * * @example * (def-file-line "ag-def-name" c-file-line-fmt) * @end example * * It is also safe to use the formatting string, "%2$d". AutoGen uses * an argument vector version of printf: @xref{snprintfv}. =*/ SCM ag_scm_def_file_line( SCM obj, SCM fmt ) { tSCC zFmt[] = "from %s line %d"; tCC* pzFmt = zFmt; char zScribble[ 1024 ]; char* pzScrib = zScribble; tDefEntry* pE; ag_bool x; pE = findDefEntry( ag_scm2zchars( obj, "ag value" ), &x ); /* * IF we did not find the entry we are looking for * THEN return UNDEFINED */ if (pE == NULL) return SCM_UNDEFINED; if (AG_SCM_STRING_P( fmt )) pzFmt = ag_scm2zchars( fmt, "file/line format" ); { size_t maxlen = strlen( pE->pzSrcFile ) + strlen( pzFmt ) + 4 * sizeof( int ); if (maxlen >= sizeof( zScribble )) pzScrib = (char*)AGALOC( maxlen, "file-line buffer" ); } { void* args[2]; args[0] = (void*)pE->pzSrcFile; args[1] = (void*)(long)pE->srcLineNum; sprintfv( pzScrib, pzFmt, (snv_constpointer*)args ); } { SCM res = AG_SCM_STR02SCM( pzScrib ); if (pzScrib != zScribble) AGFREE( (void*)pzScrib ); return res; } } /* * Local Variables: * mode: C * c-file-style: "stroustrup" * indent-tabs-mode: nil * End: * end of agen5/expState.c */