Re: Functions using variable values (shell archive)

Here is the promised source code for whoever is interested. ------- Cut Here ------- #!/bin/sh # This is a shell archive (produced by GNU sharutils 4.2). # To extract the files from this archive, save it to some FILE, remove # everything before the `!/bin/sh' line above, then type `sh FILE'. # # Existing files will *not* be overwritten unless `-c' is specified. # # This shar contains: # length mode name # ------ ---------- ------------------------------------------ # 5776 -rw-rw-r-- call.c # 678 -rw-rw-r-- call.h # 1044 -rw-rw-r-- callChk.4gl # 706 -rw-rw-r-- error.c # 138 -rw-rw-r-- error.h # 2443 -rw-rw-r-- makefile # 34 -rw-rw-r-- makefile.depend # 443 -rw-rw-r-- makefile.prj # 5887 -rw-rw-r-- symtab.c # save_IFS="${IFS}" IFS="${IFS}:" gettext_dir=FAILED locale_dir=FAILED first_param="$1" for dir in $PATH do if test "$gettext_dir" = FAILED && test -f $dir/gettext \\ && ($dir/gettext --version >/dev/null 2>&1) then set `$dir/gettext --version 2>&1` if test "$3" = GNU then gettext_dir=$dir fi fi if test "$locale_dir" = FAILED && test -f $dir/shar \\ && ($dir/shar --print-text-domain-dir >/dev/null 2>&1) then locale_dir=`$dir/shar --print-text-domain-dir` fi done IFS="$save_IFS" if test "$locale_dir" = FAILED || test "$gettext_dir" = FAILED then echo=echo else TEXTDOMAINDIR=$locale_dir export TEXTDOMAINDIR TEXTDOMAIN=sharutils export TEXTDOMAIN echo="$gettext_dir/gettext -s" fi touch -am 1231235999 $$.touch >/dev/null 2>&1 if test ! -f 1231235999 && test -f $$.touch; then shar_touch=touch else shar_touch=: echo $echo 'WARNING: not restoring timestamps. Consider getting and' $echo "installing GNU \\`touch', distributed in GNU File Utilities..." echo fi rm -f 1231235999 $$.touch # if mkdir _sh03210; then $echo 'x -' 'creating lock directory' else $echo 'failed to create lock directory' exit 1 fi # ============= call.c ============== if test -f 'call.c' && test "$first_param" != -c; then $echo 'x -' SKIPPING 'call.c' '(file already exists)' else $echo 'x -' extracting 'call.c' '(text)' sed 's/^X//' << 'SHAR_EOF' > 'call.c' && /* X Dynamic Calling Interface for 4GL programs. X X Written by Emil Sarkissian X Copyright( c ) 1997, Svilosa Co. */ X #include <memory.h> #include <stdio.h> #include "error.h" #include "call.h" #include <string.h> #include <ctype.h> X /* default cache */ X long searchDefaultCache(); struct DynamicCache *DefaultCache = 0; X /* default 4gl function type */ X typedef (*TFglFunc)(); X /* X LET IdFunc = GetFuncId( FuncName ) */ X int getfuncid ( arg ) int arg; { X char funcName[ MAXFUNCNAME ]; X char fgeName[ 255 ]; X long funcAdr; X int i; X X popvchar( funcName, MAXFUNCNAME ); X X i=0; X while( funcName[i] ) X { X funcName[i] = tolower( funcName[i] ); X i++; X } X X if( (funcAdr = searchDefaultCache( funcName )) == -1 ) X { X pushint( 0 ); X arg_val(1); X popvchar( fgeName, 254 ); X X if( (funcAdr = getFuncAdr( fgeName, funcName )) == -1 ) X SysError("function name not found", M_CALL ); X } X retlong( funcAdr ); X return 1; } X /* X Search default cache for a certain function. Return -1 if X address not found. */ X long searchDefaultCache( funcName ) char *funcName; { X int i; X long address; X X if( !DefaultCache ) X return -1; X X for( i = 0;i<DefaultCache->numFuncs;i++ ) X if( (strcmp( funcName, DefaultCache->funcDefs[i].name ) == 0)) X if( DefaultCache->funcDefs[i].value ) X { X return DefaultCache->funcDefs[i].value; X } X else X return -1; X X return -1; } X /* X --------- Cache Functions ----------- X X Caches can be created for a certain file and a number of functions. X One cache can be used as the default cache. When a function address X is required, the default cache is searched first. If it is not found X there, the current executable file will be searched and then, if X the function is not found, an error will be generated. X */ X /* X LET IdCache = NewCache( FileName ) X X Creates a new cache for the current file name. X Returns the cache handle ( address ). */ X int newcache( arg ) int arg; { X int i; X struct DynamicCache *cache; X X cache = (struct DynamicCache*)malloc( sizeof( struct DynamicCache ) ); X X if( !cache ) X SysError("unable to allocate dynamic cache",M_CALL ); X X popvchar( cache->fileName, 254 ); X X cache->numFuncs = 0; X X for( i = 0;i<MAXFUNCS;i++ ) X { X cache->funcDefs[i].value = 0; X cache->funcDefs[i].name[0] = 0; X } X X pushlong( (long)cache ); X return 1; } X /* X CALL AddCacheFunc( FuncName, CacheId ) */ X #define CF_NAME cache->funcDefs[cache->numFuncs].name X int addcachefunc( arg ) int arg; { X struct DynamicCache *cache; X int i; X X poplong( (long*)&cache ); X popvchar( CF_NAME, MAXFUNCNAME ); X X for( i=0;i<strlen( CF_NAME );i++ ) X CF_NAME[i] = tolower( CF_NAME[i] ); X X cache->numFuncs++; X return 0; } X /* X X CALL LoadCache( CacheId ) X X Loads the entire cache up from its associated executable file. X */ X int loadcache( arg ) int arg; { X struct DynamicCache *cache; X X poplong( (long*)&cache ); X X createCache( cache ); X X return 0; } X /* X CALL DestroyCache( CacheId ) X X Destroys the cache, and removes it from the default position if it X is the default cache as well. */ X int destroycache( arg ) int arg; { X struct DynamicCache *cache; X X poplong( (long*)&cache ); X X if( DefaultCache == cache ) X DefaultCache = 0; X X if( cache ) X free( cache ); X X return 0; } X /* X CALL SetDefaultCache( CacheId ) X X Set the default cache. */ X int setdefaultcache( arg ) int arg; { X poplong( (long*)&DefaultCache ); } X /* X CALL ExecFuncId( ..., Id ) X X The point of having several ExecFuncIds is that the 4GL compiler X checks all function calls within a certain module and makes sure X that the same function is always called with the same number of X params, thus the following will be wrong: X X CALL ExecFuncId( Param1, Param2, FuncId1 ) # OK X X ... X X # later in the same sourse file X X CALL ExecFuncId( Param1, FuncId2 ) # Error - function ExecFuncId called X