Data Structures
struct	prim_t
	description of a primitive More...
Defines
#define	FLAG_EX_PRINTDEPTHLIMIT 0x00010000
	extended flag for PRINTDEPTHLIMIT
#define	FLAG_EX_PRINTWIDTHLIMIT 0x00020000
	extended flag for PRINTWIDTHLIMIT
#define	FLAG_EX_FULLPRINTP 0x00040000
	extended flag for FULLPRINTP
#define	FLAG_EX_CASEIGNOREDP 0x00080000
	extended flag for CASEIGNOREDP
#define	FLAG_EX_LOGOPLATFORM 0x00100000
	extended flag for LOGOPLATFORM
#define	FLAG_EX_LOGOVERSION 0x00200000
	extended flag for LOGOVERSION
#define	FLAG_EX_LOGODIALECT 0x00400000
	extended flag for LOGODIALECT
#define	DUMP_BUF_SIZE 128
Typedefs
typedef struct prim_t	primitive_t
	description structure of a primitive
Functions
void	init_vars ()
	initializes variables
void	finit_vars ()
	finalizes the Varss module
atom_t	new_var (atom_t name, atom_t parent, int attach)
	creates a new var atom
int	need_descr2 (atom_t var)
	creates var descriptor if needed
void	delete_var (atom_t a)
	deletes var atom
void	dump_var (atom_t a, int level)
	dumps error atom
atom_t	find_var (atom_t name, atom_t parent)
	searches a variable
atom_t	find_local_runtime_var (atom_t name, int frame)
	searches a variable at runtime
atom_t	find_runtime_var (atom_t name, int frame)
	searches a variable at runtime
atom_t	find_local_var (atom_t name, atom_t parent)
	searches a local variable
atom_t	new_local_var (atom_t name, atom_t function, int quoted)
	creates a new local var
void	copy_local_vars (int frame)
	copy local vars to parent
Variables
atom_t	root
	parent of all variables
atom_t	word_to
	word containing "TO" token
atom_t	word_to_syn
	word containing a synonym of "TO" token
atom_t	word_end
	word containing "END" token
atom_t	word_run
	word containing "RUN" token
atom_t	word_make
	word containing "MAKE" token
atom_t	word_plus
	word containing "+" token
atom_t	word_toplevel
	word containing "TOPLEVEL" token
atom_t	word_system
	word containing "SYSTEM" token
atom_t	word_error
	word containing "ERROR" token
atom_t	unbound
	atom representing unbound values
atom_t	stopped
	atom representing stop values
atom_t	repeat_chain
	atom for the topmost repeat chain
atom_t	globals
	collection of global system-wide persistent variables
atom_t	printdepthlimit
	variable PRINTDEPTHLIMIT
atom_t	printwidthlimit
	variable PRINTWIDTHLIMIT
atom_t	fullprintp
	variable FULLPRINTP
atom_t	caseignoredp
	variable CASEIGNOREDP
atom_t	last_error
	last caught error (used by ERROR primitive)
atom_t	delayed_free
	atoms sheduled for delayed free
int	root_frame
	frame of root
int	backup_frame
	run-time backup of frame
atom_t	error_flag
	error flag (used by internal/external functions)
int	catch_output_flag
	1 = there was output/stop in catch
primitive_t	vars []
	array with actual properties of primitives

Define Documentation

#define FLAG_EX_PRINTDEPTHLIMIT 0x00010000

#define FLAG_EX_PRINTWIDTHLIMIT 0x00020000

#define FLAG_EX_FULLPRINTP 0x00040000

#define FLAG_EX_CASEIGNOREDP 0x00080000

#define FLAG_EX_LOGOPLATFORM 0x00100000

#define FLAG_EX_LOGOVERSION 0x00200000

#define FLAG_EX_LOGODIALECT 0x00400000

#define DUMP_BUF_SIZE 128

Typedef Documentation

typedef struct prim_t primitive_t

Function Documentation

void init_vars ( )

as local variables to the root variable. The names of primitives are taken from TR_PRIMITIVES, the properties are taken from vars[]. Two words :to and :end are created.

Initializes the variables module by creating the system root variable which is named as defined by ROOT_VAR_NAME, and globals variable defined by

{
  #ifdef DEBUG_VAR
  printf("<VAR> Vars initialized\n");
  #endif //DEBUG_VAR

  // create the root variable
  atom_t name = new_word( ROOT_VAR_NAME, -1 );
  root = new_var( name, 0, 0 );
  need_descr2( root );
  SET_FLAGS( root, FLAG_FUNCTION );
  LARGS( root ) = 0;
  RARGS( root ) = 0;
  LEVEL( root ) = 0;
  PRIORITY( root ) = PRIORITY_CMD;
  DEUSE( name );

  // create the globals variable
  name = new_word( GLOBALS_VAR_NAME, -1 );
  globals = new_var( name, 0, 0 );
  SET_FLAGS( globals, FLAG_VARIABLE );
  LARGS( root ) = 0;
  RARGS( root ) = 0;
  LEVEL( root ) = 0;
  PRIORITY( root ) = PRIORITY_CMD;
  DEUSE( name );

  unbound = new_integer( 0 );
  stopped = new_integer( 1 );

  repeat_chain = new_list( new_integer(0), empty_list );
  REPCOUNT( CAR(repeat_chain) ) = -1;

  last_error = empty_list;
  delayed_free = empty_list;

  atom_t names = new_word( TR_PRIMITIVES, UNKNOWN );
  atom_t tokens = tokenize( names, TOKENIZE_DATA );

  // setting TO, END and other words
  atom_t t = tokens; 
  false_true[0] = USE(CAR(t)); t = CDR(t);
  false_true[1] = USE(CAR(t)); t = CDR(t);
  word_to       = USE(CAR(t)); t = CDR(t);
  word_to_syn   = USE(CAR(t)); t = CDR(t);
  word_end      = USE(CAR(t)); t = CDR(t);
  word_toplevel = USE(CAR(t)); t = CDR(t);
  word_system   = USE(CAR(t)); t = CDR(t);
  word_error    = USE(CAR(t)); t = CDR(t);
  //word_run -- set in the next FOR-cycle

  // create primitives
  int i;
  for( i = 0; vars[i].largs>=0; i++, t=CDR(t) )
    {
      #ifdef SAFEMODE
        assert( IS_NOT_EMPTY(t) ); // too few words in TR_PRIMITIVES
      #endif

      //printf("%d ",i); dumpln(CAR(t));
      atom_t name = CAR(t);
      if( LENGTH(name) )
      {
        atom_t var = new_var( name, globals, 1 );
        ADDRESS( var ) = (int_t)vars[i].function;
        LEVEL( var ) = 1;
        LARGS( var ) = vars[i].largs;
        RARGS( var ) = vars[i].rargs;

        if( vars[i].flags & FLAG_PRIORITY_MUL )
          PRIORITY( var ) = PRIORITY_MUL;
        else if( vars[i].flags & FLAG_PRIORITY_ADD )
          PRIORITY( var ) = PRIORITY_ADD;
        else if( vars[i].flags & FLAG_PRIORITY_LOG )
          PRIORITY( var ) = PRIORITY_LOG;
        else if( vars[i].flags & FLAG_PRIORITY_CMP )
          PRIORITY( var ) = PRIORITY_CMP;
        else if( vars[i].flags & FLAG_COMMAND )
          PRIORITY( var ) = PRIORITY_CMD;
        else
          PRIORITY( var ) = PRIORITY_FUN;

        SET_FLAGS( var, (vars[i].flags&ALL_VAR_FLAGS) | FLAG_PRIMITIVE );

        // initialize system variables to (unbound)
        if( IS_VARIABLE(var) )
          {
            if( vars[i].flags & FLAG_EX_PRINTDEPTHLIMIT ) printdepthlimit = var;
            if( vars[i].flags & FLAG_EX_PRINTWIDTHLIMIT ) printwidthlimit = var;
            if( vars[i].flags & FLAG_EX_FULLPRINTP      ) fullprintp = var;
            if( vars[i].flags & FLAG_EX_CASEIGNOREDP    ) caseignoredp = var;

            if( vars[i].flags & FLAG_EX_LOGOPLATFORM )
              VALUE(var) = new_word(LOGO_PLATFORM,-1);
            else if( vars[i].flags & FLAG_EX_LOGOVERSION )
              VALUE(var) = new_word(LOGO_VERSION,-1);
            else if( vars[i].flags & FLAG_EX_LOGODIALECT )
              VALUE(var) = new_word(LOGO_DIALECT,-1);
            else
              VALUE(var) = USE( unbound );

            VARTYPE(var) = VAR_TYPE_RUNTIME; // value is in var's atom
          }
        
        //printf("{%d",REF(word_run));      
        if( ADDRESS(var) == (int_t)rt_run  ) word_run  = USE(name);
        if( ADDRESS(var) == (int_t)rt_make ) word_make = USE(name);
        if( ADDRESS(var) == (int_t)rt_plus ) word_plus = USE(name);
        //printf("%d}\n",REF(word_run));      
      }
    }

  #ifdef SAFEMODE
    assert( IS_EMPTY(t) ); // too many words in TR_PRIMITIVES
  #endif

  DEUSE( names );
  DEUSE( tokens );
}

void finit_vars ( )

Finilizes the Vars module by freeing :to, :end and :root atoms. Deleting :root will recursively delete all other variables including the primitives.

Some system primitive variables like fullprintp, printwidthlimit, and printdepthlimit does not need individual finalization, because they are included in globals and finalized when globals is finalized.

{
  DEUSE( globals );
  DEUSE( root );
  DEUSE( repeat_chain );

  if( REF(last_error)>1 ) REF(last_error)=1; // patch

#ifdef SAFEMODE
  //printf( "REF(unbound)=%d\n",REF(unbound) );
  //printf( "REF(false_true[0])=%d\n",REF(false_true[0]) );
  //printf( "REF(last_error=%x)=%d\n",(int)last_error,REF(last_error) );
  //printf( "REF(word_run=%x)=%d\n",(int)word_run,REF(word_run) );
  assert( REF(unbound)==1 );
  assert( REF(stopped)==1 );
  assert( REF(word_error)==1 );
  assert( REF(word_system)==1 );
  assert( REF(word_toplevel)==1 );
  assert( REF(word_to)==1 );
  assert( REF(word_to_syn)==1 );
  assert( REF(word_end)==1 );
  assert( REF(false_true[0])==1 );
  assert( REF(false_true[1])==1 );
  assert( REF(word_run)==1 );
  assert( REF(word_make)==1 );
  assert( REF(word_plus)==1 );
  assert( REF(last_error)==1 );
#endif

  // IMPORTANT! The unbound atom is considered
  // not use-able amd deuse-able, thus its reference
  // count is always 1. Because of this DEUSE will
  // not automatically delete it, thus we delete is
  // manually and adjust statistics manually.
  DEUSE( unbound );
  DEUSE( stopped );

  #ifdef ADVANCED
  stats[ID(unbound)].deallocs++;
  stats_free++;
  stats[ID(stopped)].deallocs++;
  stats_free++;
  #endif //ADVANCED
  delete_numeric( unbound ); // special case
  delete_numeric( stopped ); // special case

  DEUSE( word_error );
  DEUSE( word_system );
  DEUSE( word_toplevel );
  DEUSE( word_to );
  DEUSE( word_to_syn );
  DEUSE( word_end );
  DEUSE( false_true[0] );
  DEUSE( false_true[1] );
  DEUSE( last_error );
  DEUSE( delayed_free );
  DEUSE( word_run );
  DEUSE( word_make );
  DEUSE( word_plus );

  #ifdef DEBUG_VAR
    printf("<VAR> Vars finalized\n");
  #endif //DEBUG_VAR
}

atom_t new_var	(	atom_t	name,
		atom_t	parent,
		int	attach
	)

Parameters:

name	word atom for the name of the variable
parent	var atom for the parent of the variable
attach	1=attach to parent, 0=do not attach

Returns:: var atom

Creates a var atom describing a variable with given name and parent. The reference count of the var is set to 1, the reference count of name is increased, the reference count of parent is not changed. The function automatically creates the first descriptor of the var atom. The second descriptor is left uninitialized - it could be later created by need_descr2() if needed.

The newly created var atom is included in the list of local variables of the parent only if attach != 0. Otherwise var has a parent, but the parent does not know about the child var.

{
  #ifdef SAFEMODE
    assert( name );
    assert( IS_WORD(name)||IS_SUBWORD(name)||IS_EMPTY(name) );
    assert( !parent||IS_VARATOM(parent) );
  #endif

  atom_t a = take_from_pool( &data_pool );
  DESCR1(a) = take_from_pool( &data_pool );
  DESCR2(a) = 0;

  REF(a) = 1;
  ID(a)  = VAR_ID;

  NAME(a) = USE(name);
  FLAGS(a) = 0;
  PARENT(a) = parent; // weak link, no ref++
  VARTYPE(a) = VAR_TYPE_NORMAL;
  if( parent )
    {
      need_descr2( parent );
      if( attach ) LOCALS(parent) = new_list( a, LOCALS(parent) );
      LEVEL(a) = LEVEL(parent)+1;
      OFFSET(a) = 0;
    }
  else
    LEVEL(a) = 0;

  #ifdef DEBUG_ATOM
    printf("<ATOM>  [%08x] var="STR"\n",(int)a,STRING(name));
  #endif //DEBUG_ATOM

    #ifdef ADVANCED
    stats[ID(a)].allocs+=2;  // it's 2 because of 
    stats_free-=2;    // the 1st descriptor
    if( stats[ID(a)].max<(stats[ID(a)].allocs-stats[ID(a)].deallocs) )
      stats[ID(a)].max=(stats[ID(a)].allocs-stats[ID(a)].deallocs);
  #endif //ADVANCED


  #ifdef DEBUG_RUNTIME_ATOMS
  if( running_compiled_code )
    {
      outter( TEXT("<RUNTIME> new  "), -1 );
      dump_atom_address( a );
      dump_atom( a, 1 );
      outter( TEXT("\n"), -1 );
    }
  #endif
  #ifdef DEBUG_COMPILETIME_ATOMS
  if( compiling_code )
    {
      outter( TEXT("<COMPILETIME> new  "), -1 );
      dump_atom_address( a );
      dump_atom( a, 1 );
      outter( TEXT("\n"), -1 );
    }
  #endif

  return a;
}

int need_descr2 ( atom_t var )

Parameters:

var	var which descriptor will be created

Returns:: 1 if descriptor was created

Creates the second descriptor of a var atom if it does not exist. All the values of the new second descriptor are set to empty lists.

{
  // create descr2 if it does not exist
  if( DESCR2(var) ) return 0;
  DESCR2(var) = take_from_pool( &data_pool );

  // initialize descr2
  atom_t def = empty_list;
  def = new_list( empty_list, def ); // TREE
  def = new_list( empty_list, def ); // BODY
  def = new_list( empty_list, def ); // SOURCE
  def = new_list( empty_list, def ); // FULLSOURCE
  DEFINITIONS(var) = def;
  LOCALS(var) = empty_list;
  BINARY(var) = empty_list;

  #ifdef ADVANCED
    stats[ID(var)].allocs++;
    if( stats[ID(var)].max<(stats[ID(var)].allocs-stats[ID(var)].deallocs) )
      stats[ID(var)].max=(stats[ID(var)].allocs-stats[ID(var)].deallocs);
    stats_free--;
  #endif //ADVANCED

  return 1;
}

void delete_var ( atom_t a )

Parameters:

a	atom to delete

Deletes var atom by returning it back to the data pool. All structures pointed to by the var atom are dereferences (and most-likely) deleted.

{
  //printf(">>>DELETEVAR "); dumpln(NAME(a));
  //if( DESCR2(a) ) { printf(">>>      DEFINITIONS "); dump_atom(DEFINITIONS(a),1); printf("\n\n"); }

  // dereference value of primitive/global variables
  if( (IS_PRIMITIVE(a) || IS_GLOBAL(a) || IS_TAG(a) || IS_RUNTIME(a)) && IS_VARIABLE(a) )
    {
      //printf(">>>DELETEVARVALUE "); dumpln(VALUE(a));
      DEUSE( VALUE(a) );
    }

  //if(a==root){printf(">>>DELETEVARNAME "); dumpln(NAME(a));}
  DEUSE( NAME(a) );

  // descriptors have no reference counts
  return_to_pool( &data_pool, DESCR1(a) );
  #ifdef ADVANCED
    stats[ID(a)].deallocs++;
    stats_free++;
  #endif //ADVANCED

  if( DESCR2(a) )
    {
      //printf(">>>DELETEVARLOCALS\n");
      //printf(">>>id=%d ref=%d\n",ID(a),REF(a));
      //dumpln(LOCALS(a));
      DEUSE( LOCALS(a) );
      //no-DEUSE( BODY(a) );
      //no-DEUSE( TREE(a) );
      //printf(">>>DELETEVARBINARY\n");
      DEUSE( BINARY(a) );
      //no-DEUSE( SOURCE(a) );
      //if( a==root )
      //{
      //printf(">>>DELETEVARDEFINITIONS\n");
      //printf(">>>BODY OF ROOT ID=%d\n",ID(root));
      //dumpln(BODY(root)); printf("========\n");
      //printf(">>>ROOT FULLSOURCE="); dumpln(FULLSOURCE(a));
      //printf(">>>ROOT SOURCE="); dumpln(SOURCE(a));
      //printf(">>>ROOT BODY="); dumpln(BODY(a));
      //printf(">>>ROOT TREE="); dumpln(TREE(a));
      //}
      //printf("vvvvvvvvvvvvvvvvvvvvvvvv\n");
      DEUSE( DEFINITIONS(a) );
      //printf("^^^^^^^^^^^^^^^^^^^^^^^^\n");
      //if( a==root )
      //{
      //printf(">>>DONE\n");
      //}
      //printf(">>>DELETEVARDEFINITIONS2\n");
      return_to_pool( &data_pool, DESCR2(a) );

      #ifdef ADVANCED
        stats[ID(a)].deallocs++;
        stats_free++;
      #endif //ADVANCED
    }
  return_to_pool( &data_pool, a );
  //if(a==root) printf(">>>          DONE!\n");
}

void dump_var	(	atom_t	a,
		int	level
	)

Parameters:

a	atom to dump
level	dump level

Dumps var atom through the current outter function.

{
#ifdef ADVANCED
  #define DUMP_BUF_SIZE 128
  char_t buf[DUMP_BUF_SIZE];
  int n;
  int i;

  if( OPTION_USER_VARIABLES && IS_PRIMITIVE(a) ) return;

  // print required number of spaces
  for( i=0; i<level; i++ ) outter( TEXT("   "), 3 );

  // print type, name and additional info
  if( IS_PRIMITIVE(a) ) outter( TEXT("PRIM"), -1 );
  if( IS_VARIABLE(a) )  outter( TEXT("VAR"), -1 );
  if( IS_FUNCTION(a) )  outter( TEXT("FUN"), -1 );
  if( IS_COMMAND(a) )   outter( TEXT("CMD"), -1 );

  if( IS_FUNCTION(a)||IS_COMMAND(a) )
    {
      n = SPRINTF( buf, DUMP_BUF_SIZE, TEXT("[%d"), LARGS(a) );
      outter( buf, n );
      n = SPRINTF( buf, DUMP_BUF_SIZE, TEXT(":%d]"), RARGS(a) );
      outter( buf, n );
    }

  outter( TEXT(" "), 1 );
  outter( STRING(NAME(a)), LENGTH(NAME(a)) );
  //if( !IS_PRIMITIVE(a) && (IS_FUNCTION(a)||IS_COMMAND(a)) )
  //{
  //  outter( TEXT("="), 1 );
  //  dump( TREE(a) );
  //}

  if( IS_VARIABLE(a) && a!=root && a!=globals )
    if( IS_RUNTIME(a) )
      {
        outter( TEXT(" = "), 3 );
        dump_atom( VALUE(a), 1 );
      }

  outter( TEXT("\n"), 1 );

  if( DESCR2(a) )
    {
      atom_t locals = LOCALS(a);
      for( ; IS_NOT_EMPTY(locals); locals=CDR(locals) )
        dump_atom( CAR(locals), level+1 );
    }

  #undef DUMP_BUF_SIZE

#endif //ADVANCED
}

atom_t find_var	(	atom_t	name,
		atom_t	parent
	)

Parameters:

name	word atom containing the searched name
parent	var atom where to start the search

Returns:: found var atom or NULL if not found

Note:: search is syntax-scope based

Searches a variable named name starting from variable parent. If not found found the search continues with the parent of parent, then with its grandparent, and so on untill the root is reached. If still not found search continues within the globals variable.

This search schema can find only variables known at the time of compilation. Also, the search is strictly syntax-scope based.

{
#ifdef SAFEMODE
  assert( IS_WORD(name) || IS_SUBWORD(name) );
  assert( parent );
  assert( IS_VARATOM(parent) );
#endif

  #ifdef DEBUG_FIND_VAR
    printf("<FINDVAR> Search "); dumpln(name);
    printf("<FINDVAR> Current var tree "); dumpln(root);
  #endif

  // scan parent and its parents
  atom_t a;
  for( ; parent; parent=PARENT(parent) )
    {
      #ifdef DEBUG_FIND_VAR
        printf("<FINDVAR> Search it in parent "); dumpln(NAME(parent));
      #endif
      a = find_local_var( name, parent );
      #ifdef DEBUG_FIND_VAR
        if( a ) { printf("<FINDVAR> Found in "); dumpln(NAME(parent)); }
      #endif
      if( a ) return a;
    }

  #ifdef DEBUG_FIND_VAR
    printf("<FINDVAR> Search it in parent "); dumpln(NAME(globals));
  #endif
  a = find_local_var( name, globals );
  #ifdef DEBUG_FIND_VAR
    if( a ) { printf("<FINDVAR> Found in "); dumpln(NAME(globals)); }
  #endif
  if( a ) return a;

  #ifdef DEBUG_FIND_VAR
    printf("<FINDVAR> Not found\n");
  #endif
  return NULL; // not found
}

atom_t find_local_runtime_var	(	atom_t	name,
		int	frame
	)

Parameters:

name	word atom containing the searched name
frame	starting frame for the search

Returns:: found var atom or NULL if not found

Searches a variable named name in the the given stack frame. Search is done in the list of variables created at run-time.

If the variable is not found in the runtimers, then search continues with compile-time vars.

{
  atom_t parent;
  atom_t var;

  #ifdef SAFEMODE
    assert( IS_WORD(name) || IS_SUBWORD(name) );
  #endif

  #ifdef DEBUG_FIND_RUNTIME_VAR
    printf("<FIND_LOCAL_RUNTIME_VAR> Search "); dumpln(name);
  #endif

  // first scan variables created at run-time
  parent = *(atom_t*)(frame+BASE_OFFSET_LOCALS);
  var = find_local_var( name, parent );
  #ifdef DEBUG_FIND_RUNTIME_VAR
    if( var ) { printf("<FIND_LOCAL_RUNTIME_VAR> Found runtimer "); dumpln(NAME(var)); }
  #endif
  if( var ) return var;

  // then scan variables created at compile-time
  parent = *(atom_t*)(frame+BASE_OFFSET_PARENT);
  var = find_local_var( name, parent );
  #ifdef DEBUG_FIND_RUNTIME_VAR
    if( var ) { printf("<FIND_LOCAL_RUNTIME_VAR> Found local "); dumpln(NAME(var)); }
  #endif
  if( var ) return var;

  #ifdef DEBUG_FIND_RUNTIME_VAR
    printf("<FIND_LOCAL_RUNTIME_VAR> Not found\n");
  #endif
  return NULL; // not found
}

atom_t find_runtime_var	(	atom_t	name,
		int	frame
	)

Parameters:

name	word atom containing the searched name
frame	starting frame for the search

Returns:: found var atom or NULL if not found

Note:: search is syntax-scope based

Searches a variable named name starting from the given stack frame. Search is done in the list of variables created at run-time.

If the variable is not found in the runtimers, then search continues with compile-time vars.

If still not found, the search moves to the parent frame.

If not found in all frames up to the root, then scan the globals var.

{
  atom_t parent;
  atom_t var;

  #ifdef SAFEMODE
    assert( IS_WORD(name) || IS_SUBWORD(name) );
  #endif

  #ifdef DEBUG_FIND_RUNTIME_VAR
    printf("<FIND_RUNTIME_VAR> Search "); dumpln(name);
  #endif

  // scan parent and its parents
  while( frame )
    {
      // first scan variables created at run-time
      parent = *(atom_t*)(frame+BASE_OFFSET_LOCALS);
      var = find_local_var( name, parent );
      #ifdef DEBUG_FIND_RUNTIME_VAR
        if( var ) { printf("<FIND_RUNTIME_VAR> Found runtimer "); dumpln(NAME(var)); }
      #endif
      if( var ) return var;

      // then scan variables created at compile-time
      parent = *(atom_t*)(frame+BASE_OFFSET_PARENT);
      var = find_local_var( name, parent );
      #ifdef DEBUG_FIND_RUNTIME_VAR
        if( var ) { printf("<FIND_RUNTIME_VAR> Found local "); dumpln(NAME(var)); }
      #endif
      if( var ) return var;

      // exit the loop if we reached the root variable
      if( parent==root ) break;

      // go to upper frame
      frame = *((int*)(frame));
    }

  // the variable is not found, thus now
  // scan the global variables
  var = find_local_var( name, globals );
  #ifdef DEBUG_FIND_RUNTIME_VAR
     if( var ) { printf("<FIND_RUNTIME_VAR> Found global "); dumpln(NAME(var)); }
  #endif
  if( var ) return var;


  #ifdef DEBUG_FIND_RUNTIME_VAR
    printf("<FIND_RUNTIME_VAR> Not found\n");
  #endif
  return NULL; // not found
}

atom_t find_local_var	(	atom_t	name,
		atom_t	parent
	)

Parameters:

name	word atom containing the searched name
parent	var atom where to start the search

Returns:: found var atom or NULL if not found

Note:: search is syntax-scope based

Searches a variable named name starting from variable parent. If found returns the var atom, otherwise returns NULL. The search scans only the variables parent. It does not scan its parents.

This search schema can find only variables known at the time of compilation. Also, the search is strictly syntax-scope based.

If the parent is a list atom, then just scan its elements (as if this is the LOCALS field of a var)

{
#ifdef SAFEMODE
  assert( IS_WORD(name) || IS_SUBWORD(name) );
  assert( parent );
  assert( IS_VARATOM(parent) || IS_LIST(parent) );
#endif

  atom_t a;

  if( IS_LIST(parent) )
    {
      a = parent;
    }
  else
    {
      if( !DESCR2(parent) ) return NULL;
      a = LOCALS(parent);
      if( !a ) return NULL;
    }

  // scan all elements in the LOCALS
  for( ; IS_NOT_EMPTY(a); a=CDR(a) )
    if( same_words(name,NAME(CAR(a))) )
      {
        return CAR(a); // found
      }

  return NULL; // not found
}

atom_t new_local_var	(	atom_t	name,
		atom_t	function,
		int	quoted
	)

Parameters:

name	word atom for the name of the variable
function	var atom for the parent of the variable
quoted	shows whether the name is quoted

Returns:: var or error atom

Creates a local variable in a function. The input name contains the name of the local variable together with the : or " character (if quoted!=0). If such local variable does not exist in the function, then it is created and returned to the caller. Otherwise an error atom of ERROR_DUPLICATE_INPUT error is returned.

{
  #ifdef SAFE_MODE
  assert( IS_VAR(function) );
  assert( IS_ANY_WORD(name) );
  if( quoted )
    {
      assert( LENGTH(name)>1 );
      assert( *STRING(name)==TEXT(':') || *STRING(name)==TEXT('"') );
    }
  #endif

  atom_t real_name;
  if( quoted )
    real_name = new_subword( name, STRING(name)+1, LENGTH(name)-1 );
  else
    real_name = USE( name );

  if( find_local_var(real_name,function) )
    {
      //printf("THERE IS "); dump(real_name); printf(" IN FUNC "); dumpln(function);
      DEUSE( real_name );
      return new_error( ERROR_DUPLICATE_INPUT, name );
    }

  //printf("CREATED "); dump(real_name); printf(" IN FUNC "); dumpln(function);
  atom_t a = new_var( real_name, function, 1 );
  DEUSE( real_name );
  return a;
}

atom_t copy_local_vars ( int frame )

Parameters:

frame current frame pointer

Returns:: same atom as input

This function is called from the generated code. It copies all local variables of the current frame into the dynamic parent (i.e. caller).

Copying variables consideres these cases:

No Flag Type Action --- --------- ---- ------ 1. primitive * not copied 2. * tag not copied 3. variable normal 4. variable runtime 5. variable else not copied 7. func/cmd normal 8. func/cmd runtime 9. func/cmd external 10. func/cmd internal

{
  // get frame and var atom of the callee
  int callee_frame = frame;
  atom_t callee = *(atom_t*)(callee_frame+BASE_OFFSET_PARENT);
  
  // get frame and var atom of the caller
  int caller_frame = *(int*)(callee_frame+BASE_OFFSET_DYNAMIC);
  atom_t caller = *(atom_t*)(caller_frame+BASE_OFFSET_PARENT);;
    
  //printf( "}->callee = "); dumpln(NAME(callee));
  //printf( "}->caller = "); dumpln(NAME(caller));
  
//#define FLAG_VARIABLE    0x0002
//#define FLAG_FUNCTION    0x0004
//#define FLAG_COMMAND    0x0008

//#define VAR_TYPE_NORMAL    0x00  ///< variable value is in stack
//#define VAR_TYPE_RUNTIME  0x01  ///< variable value is in the variable

  // Copies pure variable var from the callee to the caller.
  // If the variable exists in the caller, only its value
  // is transfered. If the variable does not exist, then
  // it is created as a runtime variable in the caller.
  // If to_atom is null, then there is no target variable
  void copy_var( atom_t from_var, atom_t to_var )
  {
    if( !to_var )
    {
      if( caller==root )
      {
        to_var = new_var( NAME(from_var), globals, 1 ); 
      }
      else
      {
        to_var = new_var( NAME(from_var), caller, 0 ); 
        atom_t* localsp = (atom_t*) (caller_frame + BASE_OFFSET_LOCALS);
        *localsp = new_list( to_var, *localsp ); // attach to other runtimers
      }
      VARTYPE( to_var ) = VAR_TYPE_RUNTIME;
      VALUE( to_var ) = USE( unbound );
    }
    
    //printf("copy "); dump_atom(NAME(PARENT(from_var)),1);
    //printf("."); dump_atom(NAME(from_var),1);
    //printf(" -> "); dump_atom(NAME(PARENT(to_var)),1);
    //printf("."); dump_atom(NAME(to_var),1);
    
    //printf("\n-->from_var=<|"); dump_atom((to_var),1);
    //printf("|>\n-->to_var=<|"); dump_atom((to_var),1);
    //printf("|>\n");
    
    // Continue with copying
    atom_t value;
      
    // get the value from the source variable variable
    SET_FLAGS( to_var, FLAG_VARIABLE );
    if( IS_NORMAL(from_var) )
    {  // CASE 3: value is in the current stack 
      value = *(atom_t*)((char*)callee_frame+OFFSET(from_var));
    }
    else
    {  // CASE 4: value pointed by var's atom
      value = VALUE( from_var );
    }
      
    // put the value in the target variable
    if( IS_NORMAL(to_var) )
    {
      //printf("normal var\n");
      atom_t* varptr = (atom_t*) ((char*)caller_frame + OFFSET( to_var ));
      //printf(" old="); dump_atom(*varptr,1);
      DEUSE( *varptr );
      *varptr = USE( value );
    }
    else
    {
      //printf("runtime var %x %x\n",(unsigned int)to_var,(unsigned int)VALUE(to_var));
      //printf(" old="); dump_atom(VALUE(to_var),1);
      DEUSE( VALUE(to_var) );
      VALUE( to_var ) = USE(value);
    }
  
    //printf(" new="); dump_atom(value,1);
    //printf("\n");
  } //copy_var()

  // Copies function/command var from the callee to the caller.
  // If to_atom is null, then there is no target variable
  void copy_func( atom_t from_var, atom_t to_var )
  {
    // if target does not exist - attach the var to the target parent
    // decrease the level of all static locals and recompile
    if( !to_var )
    {
        to_var = USE( from_var );
        LOCALS( caller ) = new_list( to_var, LOCALS( caller ) );
    }
    else
    {
      // if definitions are incompatible (different number of
      // local parameters) then exit without copying
      if (LARGS( from_var ) != LARGS( to_var ) || RARGS( from_var ) != RARGS( to_var ))
      {
        return;
      }
      
      FLAGS( to_var ) = FLAGS( from_var );
      VARTYPE( to_var ) = VARTYPE( from_var );
      PRIORITY( to_var ) = PRIORITY( from_var );
      ADDRESS( to_var ) = ADDRESS( from_var );

      DEUSE( LOCALS( to_var ) );
      LOCALS( to_var ) = USE( LOCALS( from_var ) );

      DEUSE( DEFINITIONS( to_var ) );
      DEFINITIONS( to_var ) = USE( DEFINITIONS( from_var ) );

      DEUSE( BINARY( to_var ) );
      BINARY( to_var ) = USE( BINARY( from_var ) );
    }
  }

  void copy_var_or_func( atom_t from_var )
  {
    // primitives cannot be copied
    if( IS_PRIMITIVE(from_var) ) return;
    
    // not notmals and not runtimes cannot be copies
    if( !IS_NORMAL(from_var) && !IS_RUNTIME(from_var) ) return;

    // search the destination variable
    atom_t to_var = find_local_runtime_var( NAME(from_var), caller_frame );
    
    // destination var must be non-primitive and (normal or runtime)
    if( to_var )
    {
      if( IS_PRIMITIVE(to_var) ) return;
      if( !IS_NORMAL(to_var) && !IS_RUNTIME(to_var) ) return;
    }
    
    // if variable or function/command then copy the var
    if( IS_VARIABLE( from_var ) ) copy_var( from_var, to_var );
    if( IS_FUNCTION( from_var ) || IS_COMMAND( from_var ) ) copy_func( from_var, to_var );

    return;
  }
  
  atom_t vars;
  
  // first scan variables created at run-time
  vars = *(atom_t*)(callee_frame+BASE_OFFSET_LOCALS);
  for( ; IS_NOT_EMPTY(vars); vars=CDR(vars) ) copy_var_or_func( CAR(vars) );

  // then scan variables created at compile-time
  vars = LOCALS(callee);
  for( ; IS_NOT_EMPTY(vars); vars=CDR(vars) ) copy_var_or_func( CAR(vars) );
}