Lhogho  0.0.028
 All Data Structures Files Functions Variables Typedefs Macros Pages
vars.c File Reference

Go to the source code of this file.

Data Structures

struct  prim_t
 description of a primitive More...
 

Macros

#define FLAG_EX_PRINTDEPTHLIMIT   0x00010000
 extended flag for PRINTDEPTHLIMIT More...
 
#define FLAG_EX_PRINTWIDTHLIMIT   0x00020000
 extended flag for PRINTWIDTHLIMIT More...
 
#define FLAG_EX_FULLPRINTP   0x00040000
 extended flag for FULLPRINTP More...
 
#define FLAG_EX_CASEIGNOREDP   0x00080000
 extended flag for CASEIGNOREDP More...
 
#define FLAG_EX_LOGOPLATFORM   0x00100000
 extended flag for LOGOPLATFORM More...
 
#define FLAG_EX_LOGOVERSION   0x00200000
 extended flag for LOGOVERSION More...
 
#define FLAG_EX_LOGODIALECT   0x00400000
 extended flag for LOGODIALECT More...
 
#define DUMP_BUF_SIZE   128
 

Typedefs

typedef struct prim_t primitive_t
 description structure of a primitive More...
 

Functions

void init_vars ()
 initializes variables More...
 
void finit_vars ()
 finalizes the Varss module More...
 
atom_t new_var (atom_t name, atom_t parent, int attach)
 creates a new var atom More...
 
int need_descr2 (atom_t var)
 creates var descriptor if needed More...
 
void delete_var (atom_t a)
 deletes var atom More...
 
void dump_var (atom_t a, int level)
 dumps error atom More...
 
atom_t find_var (atom_t name, atom_t parent)
 searches a variable More...
 
atom_t find_local_runtime_var (atom_t name, int frame)
 searches a variable at runtime More...
 
atom_t find_runtime_var (atom_t name, int frame)
 searches a variable at runtime More...
 
atom_t find_local_var (atom_t name, atom_t parent)
 searches a local variable More...
 
atom_t new_local_var (atom_t name, atom_t function, int quoted)
 creates a new local var More...
 
void copy_local_vars (int frame)
 copy local vars to parent More...
 

Variables

atom_t root
 parent of all variables More...
 
atom_t word_to
 word containing "TO" token More...
 
atom_t word_to_syn
 word containing a synonym of "TO" token More...
 
atom_t word_end
 word containing "END" token More...
 
atom_t word_run
 word containing "RUN" token More...
 
atom_t word_make
 word containing "MAKE" token More...
 
atom_t word_plus
 word containing "+" token More...
 
atom_t word_toplevel
 word containing "TOPLEVEL" token More...
 
atom_t word_system
 word containing "SYSTEM" token More...
 
atom_t word_error
 word containing "ERROR" token More...
 
atom_t unbound
 atom representing unbound values More...
 
atom_t stopped
 atom representing stop values More...
 
atom_t repeat_chain
 atom for the topmost repeat chain More...
 
atom_t globals
 collection of global system-wide persistent variables More...
 
atom_t printdepthlimit
 variable PRINTDEPTHLIMIT More...
 
atom_t printwidthlimit
 variable PRINTWIDTHLIMIT More...
 
atom_t fullprintp
 variable FULLPRINTP More...
 
atom_t caseignoredp
 variable CASEIGNOREDP More...
 
atom_t last_error
 last caught error (used by ERROR primitive) More...
 
atom_t delayed_free
 atoms sheduled for delayed free More...
 
int root_frame
 frame of root More...
 
int backup_frame
 run-time backup of frame More...
 
atom_t error_flag
 error flag (used by internal/external functions) More...
 
int catch_output_flag
 1 = there was output/stop in catch More...
 
primitive_t vars []
 array with actual properties of primitives More...
 

Macro Definition Documentation

#define FLAG_EX_PRINTDEPTHLIMIT   0x00010000

Definition at line 194 of file vars.c.

#define FLAG_EX_PRINTWIDTHLIMIT   0x00020000

Definition at line 195 of file vars.c.

#define FLAG_EX_FULLPRINTP   0x00040000

Definition at line 196 of file vars.c.

#define FLAG_EX_CASEIGNOREDP   0x00080000

Definition at line 197 of file vars.c.

#define FLAG_EX_LOGOPLATFORM   0x00100000

Definition at line 198 of file vars.c.

#define FLAG_EX_LOGOVERSION   0x00200000

Definition at line 199 of file vars.c.

#define FLAG_EX_LOGODIALECT   0x00400000

Definition at line 200 of file vars.c.

#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

Definition at line 525 of file vars.c.

526 {
527  #ifdef DEBUG_VAR
528  printf("<VAR> Vars initialized\n");
529  #endif //DEBUG_VAR
530 
531  // create the root variable
532  atom_t name = new_word( ROOT_VAR_NAME, -1 );
533  root = new_var( name, 0, 0 );
534  need_descr2( root );
536  LARGS( root ) = 0;
537  RARGS( root ) = 0;
538  LEVEL( root ) = 0;
540  DEUSE( name );
541 
542  // create the globals variable
543  name = new_word( GLOBALS_VAR_NAME, -1 );
544  globals = new_var( name, 0, 0 );
546  LARGS( root ) = 0;
547  RARGS( root ) = 0;
548  LEVEL( root ) = 0;
550  DEUSE( name );
551 
552  unbound = new_integer( 0 );
553  stopped = new_integer( 1 );
554 
556  REPCOUNT( CAR(repeat_chain) ) = -1;
557 
560 
561  atom_t names = new_word( TR_PRIMITIVES, UNKNOWN );
562  atom_t tokens = tokenize( names, TOKENIZE_DATA );
563 
564  // setting TO, END and other words
565  atom_t t = tokens;
566  false_true[0] = USE(CAR(t)); t = CDR(t);
567  false_true[1] = USE(CAR(t)); t = CDR(t);
568  word_to = USE(CAR(t)); t = CDR(t);
569  word_to_syn = USE(CAR(t)); t = CDR(t);
570  word_end = USE(CAR(t)); t = CDR(t);
571  word_toplevel = USE(CAR(t)); t = CDR(t);
572  word_system = USE(CAR(t)); t = CDR(t);
573  word_error = USE(CAR(t)); t = CDR(t);
574  //word_run -- set in the next FOR-cycle
575 
576  // create primitives
577  int i;
578  for( i = 0; vars[i].largs>=0; i++, t=CDR(t) )
579  {
580  #ifdef SAFEMODE
581  assert( IS_NOT_EMPTY(t) ); // too few words in TR_PRIMITIVES
582  #endif
583 
584  //printf("%d ",i); dumpln(CAR(t));
585  atom_t name = CAR(t);
586  if( LENGTH(name) )
587  {
588  atom_t var = new_var( name, globals, 1 );
589  ADDRESS( var ) = (int_t)vars[i].function;
590  LEVEL( var ) = 1;
591  LARGS( var ) = vars[i].largs;
592  RARGS( var ) = vars[i].rargs;
593 
594  if( vars[i].flags & FLAG_PRIORITY_MUL )
595  PRIORITY( var ) = PRIORITY_MUL;
596  else if( vars[i].flags & FLAG_PRIORITY_ADD )
597  PRIORITY( var ) = PRIORITY_ADD;
598  else if( vars[i].flags & FLAG_PRIORITY_LOG )
599  PRIORITY( var ) = PRIORITY_LOG;
600  else if( vars[i].flags & FLAG_PRIORITY_CMP )
601  PRIORITY( var ) = PRIORITY_CMP;
602  else if( vars[i].flags & FLAG_COMMAND )
603  PRIORITY( var ) = PRIORITY_CMD;
604  else
605  PRIORITY( var ) = PRIORITY_FUN;
606 
607  SET_FLAGS( var, (vars[i].flags&ALL_VAR_FLAGS) | FLAG_PRIMITIVE );
608 
609  // initialize system variables to (unbound)
610  if( IS_VARIABLE(var) )
611  {
612  if( vars[i].flags & FLAG_EX_PRINTDEPTHLIMIT ) printdepthlimit = var;
613  if( vars[i].flags & FLAG_EX_PRINTWIDTHLIMIT ) printwidthlimit = var;
614  if( vars[i].flags & FLAG_EX_FULLPRINTP ) fullprintp = var;
615  if( vars[i].flags & FLAG_EX_CASEIGNOREDP ) caseignoredp = var;
616 
617  if( vars[i].flags & FLAG_EX_LOGOPLATFORM )
618  VALUE(var) = new_word(LOGO_PLATFORM,-1);
619  else if( vars[i].flags & FLAG_EX_LOGOVERSION )
620  VALUE(var) = new_word(LOGO_VERSION,-1);
621  else if( vars[i].flags & FLAG_EX_LOGODIALECT )
622  VALUE(var) = new_word(LOGO_DIALECT,-1);
623  else
624  VALUE(var) = USE( unbound );
625 
626  VARTYPE(var) = VAR_TYPE_RUNTIME; // value is in var's atom
627  }
628 
629  //printf("{%d",REF(word_run));
630  if( ADDRESS(var) == (int_t)rt_run ) word_run = USE(name);
631  if( ADDRESS(var) == (int_t)rt_make ) word_make = USE(name);
632  if( ADDRESS(var) == (int_t)rt_plus ) word_plus = USE(name);
633  //printf("%d}\n",REF(word_run));
634  }
635  }
636 
637  #ifdef SAFEMODE
638  assert( IS_EMPTY(t) ); // too many words in TR_PRIMITIVES
639  #endif
640 
641  DEUSE( names );
642  DEUSE( tokens );
643 }
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.

Definition at line 661 of file vars.c.

662 {
663  DEUSE( globals );
664  DEUSE( root );
665  DEUSE( repeat_chain );
666 
667  if( REF(last_error)>1 ) REF(last_error)=1; // patch
668 
669 #ifdef SAFEMODE
670  //printf( "REF(unbound)=%d\n",REF(unbound) );
671  //printf( "REF(false_true[0])=%d\n",REF(false_true[0]) );
672  //printf( "REF(last_error=%x)=%d\n",(int)last_error,REF(last_error) );
673  //printf( "REF(word_run=%x)=%d\n",(int)word_run,REF(word_run) );
674  assert( REF(unbound)==1 );
675  assert( REF(stopped)==1 );
676  assert( REF(word_error)==1 );
677  assert( REF(word_system)==1 );
678  assert( REF(word_toplevel)==1 );
679  assert( REF(word_to)==1 );
680  assert( REF(word_to_syn)==1 );
681  assert( REF(word_end)==1 );
682  assert( REF(false_true[0])==1 );
683  assert( REF(false_true[1])==1 );
684  assert( REF(word_run)==1 );
685  assert( REF(word_make)==1 );
686  assert( REF(word_plus)==1 );
687  assert( REF(last_error)==1 );
688 #endif
689 
690  // IMPORTANT! The unbound atom is considered
691  // not use-able amd deuse-able, thus its reference
692  // count is always 1. Because of this DEUSE will
693  // not automatically delete it, thus we delete is
694  // manually and adjust statistics manually.
695  DEUSE( unbound );
696  DEUSE( stopped );
697 
698  #ifdef ADVANCED
699  stats[ID(unbound)].deallocs++;
700  stats_free++;
701  stats[ID(stopped)].deallocs++;
702  stats_free++;
703  #endif //ADVANCED
704  delete_numeric( unbound ); // special case
705  delete_numeric( stopped ); // special case
706  DEUSE( word_error );
707  DEUSE( word_system );
708  DEUSE( word_toplevel );
709  DEUSE( word_to );
710  DEUSE( word_to_syn );
711  DEUSE( word_end );
712  DEUSE( false_true[0] );
713  DEUSE( false_true[1] );
714  DEUSE( last_error );
715  DEUSE( delayed_free );
716  DEUSE( word_run );
717  DEUSE( word_make );
718  DEUSE( word_plus );
719 
720  #ifdef DEBUG_VAR
721  printf("<VAR> Vars finalized\n");
722  #endif //DEBUG_VAR
723 }
atom_t new_var ( atom_t  name,
atom_t  parent,
int  attach 
)
Parameters
nameword atom for the name of the variable
parentvar atom for the parent of the variable
attach1=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.

Definition at line 750 of file vars.c.

751 {
752  #ifdef SAFEMODE
753  assert( name );
754  assert( IS_WORD(name)||IS_SUBWORD(name)||IS_EMPTY(name) );
755  assert( !parent||IS_VARATOM(parent) );
756  #endif
757 
760  DESCR2(a) = 0;
761 
762  REF(a) = 1;
763  ID(a) = VAR_ID;
764 
765  NAME(a) = USE(name);
766  FLAGS(a) = 0;
767  PARENT(a) = parent; // weak link, no ref++
769  if( parent )
770  {
771  need_descr2( parent );
772  if( attach ) LOCALS(parent) = new_list( a, LOCALS(parent) );
773  LEVEL(a) = LEVEL(parent)+1;
774  OFFSET(a) = 0;
775  }
776  else
777  LEVEL(a) = 0;
778 
779  #ifdef DEBUG_ATOM
780  printf("<ATOM> [%08x] var="STR"\n",(int)a,STRING(name));
781  #endif //DEBUG_ATOM
782 
783  #ifdef ADVANCED
784  stats[ID(a)].allocs+=2; // it's 2 because of
785  stats_free-=2; // the 1st descriptor
786  if( stats[ID(a)].max<(stats[ID(a)].allocs-stats[ID(a)].deallocs) )
787  stats[ID(a)].max=(stats[ID(a)].allocs-stats[ID(a)].deallocs);
788  #endif //ADVANCED
789 
790 
791  #ifdef DEBUG_RUNTIME_ATOMS
793  {
794  outter( TEXT("<RUNTIME> new "), -1 );
795  dump_atom_address( a );
796  dump_atom( a, 1 );
797  outter( TEXT("\n"), -1 );
798  }
799  #endif
800  #ifdef DEBUG_COMPILETIME_ATOMS
801  if( compiling_code )
802  {
803  outter( TEXT("<COMPILETIME> new "), -1 );
804  dump_atom_address( a );
805  dump_atom( a, 1 );
806  outter( TEXT("\n"), -1 );
807  }
808  #endif
809 
810  return a;
811 }
int need_descr2 ( atom_t  var)
Parameters
varvar 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.

Definition at line 826 of file vars.c.

827 {
828  // create descr2 if it does not exist
829  if( DESCR2(var) ) return 0;
830  DESCR2(var) = take_from_pool( &data_pool );
831 
832  // initialize descr2
833  atom_t def = empty_list;
834  def = new_list( empty_list, def ); // TREE
835  def = new_list( empty_list, def ); // BODY
836  def = new_list( empty_list, def ); // SOURCE
837  def = new_list( empty_list, def ); // FULLSOURCE
838  DEFINITIONS(var) = def;
839  LOCALS(var) = empty_list;
840  BINARY(var) = empty_list;
841 
842  #ifdef ADVANCED
843  stats[ID(var)].allocs++;
844  if( stats[ID(var)].max<(stats[ID(var)].allocs-stats[ID(var)].deallocs) )
845  stats[ID(var)].max=(stats[ID(var)].allocs-stats[ID(var)].deallocs);
846  stats_free--;
847  #endif //ADVANCED
848 
849  return 1;
850 }
void delete_var ( atom_t  a)
Parameters
aatom 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.

Definition at line 864 of file vars.c.

865 {
866  //printf(">>>DELETEVAR "); dumpln(NAME(a));
867  //if( DESCR2(a) ) { printf(">>> DEFINITIONS "); dump_atom(DEFINITIONS(a),1); printf("\n\n"); }
868 
869  // dereference value of primitive/global variables
870  if( (IS_PRIMITIVE(a) || IS_GLOBAL(a) || IS_TAG(a) || IS_RUNTIME(a)) && IS_VARIABLE(a) )
871  {
872  //printf(">>>DELETEVARVALUE "); dumpln(VALUE(a));
873  DEUSE( VALUE(a) );
874  }
875 
876  //if(a==root){printf(">>>DELETEVARNAME "); dumpln(NAME(a));}
877  DEUSE( NAME(a) );
878 
879  // descriptors have no reference counts
881  #ifdef ADVANCED
882  stats[ID(a)].deallocs++;
883  stats_free++;
884  #endif //ADVANCED
885 
886  if( DESCR2(a) )
887  {
888  //printf(">>>DELETEVARLOCALS\n");
889  //printf(">>>id=%d ref=%d\n",ID(a),REF(a));
890  //dumpln(LOCALS(a));
891  DEUSE( LOCALS(a) );
892  //no-DEUSE( BODY(a) );
893  //no-DEUSE( TREE(a) );
894  //printf(">>>DELETEVARBINARY\n");
895  DEUSE( BINARY(a) );
896  //no-DEUSE( SOURCE(a) );
897  //if( a==root )
898  //{
899  //printf(">>>DELETEVARDEFINITIONS\n");
900  //printf(">>>BODY OF ROOT ID=%d\n",ID(root));
901  //dumpln(BODY(root)); printf("========\n");
902  //printf(">>>ROOT FULLSOURCE="); dumpln(FULLSOURCE(a));
903  //printf(">>>ROOT SOURCE="); dumpln(SOURCE(a));
904  //printf(">>>ROOT BODY="); dumpln(BODY(a));
905  //printf(">>>ROOT TREE="); dumpln(TREE(a));
906  //}
907  //printf("vvvvvvvvvvvvvvvvvvvvvvvv\n");
908  DEUSE( DEFINITIONS(a) );
909  //printf("^^^^^^^^^^^^^^^^^^^^^^^^\n");
910  //if( a==root )
911  //{
912  //printf(">>>DONE\n");
913  //}
914  //printf(">>>DELETEVARDEFINITIONS2\n");
916 
917  #ifdef ADVANCED
918  stats[ID(a)].deallocs++;
919  stats_free++;
920  #endif //ADVANCED
921  }
922  return_to_pool( &data_pool, a );
923  //if(a==root) printf(">>> DONE!\n");
924 }
void dump_var ( atom_t  a,
int  level 
)
Parameters
aatom to dump
leveldump level

Dumps var atom through the current outter function.

Definition at line 937 of file vars.c.

938 {
939 #ifdef ADVANCED
940  #define DUMP_BUF_SIZE 128
941  char_t buf[DUMP_BUF_SIZE];
942  int n;
943  int i;
944 
945  if( OPTION_USER_VARIABLES && IS_PRIMITIVE(a) ) return;
946 
947  // print required number of spaces
948  for( i=0; i<level; i++ ) outter( TEXT(" "), 3 );
949 
950  // print type, name and additional info
951  if( IS_PRIMITIVE(a) ) outter( TEXT("PRIM"), -1 );
952  if( IS_VARIABLE(a) ) outter( TEXT("VAR"), -1 );
953  if( IS_FUNCTION(a) ) outter( TEXT("FUN"), -1 );
954  if( IS_COMMAND(a) ) outter( TEXT("CMD"), -1 );
955 
956  if( IS_FUNCTION(a)||IS_COMMAND(a) )
957  {
958  n = SPRINTF( buf, DUMP_BUF_SIZE, TEXT("[%d"), LARGS(a) );
959  outter( buf, n );
960  n = SPRINTF( buf, DUMP_BUF_SIZE, TEXT(":%d]"), RARGS(a) );
961  outter( buf, n );
962  }
963 
964  outter( TEXT(" "), 1 );
965  outter( STRING(NAME(a)), LENGTH(NAME(a)) );
966  //if( !IS_PRIMITIVE(a) && (IS_FUNCTION(a)||IS_COMMAND(a)) )
967  //{
968  // outter( TEXT("="), 1 );
969  // dump( TREE(a) );
970  //}
971 
972  if( IS_VARIABLE(a) && a!=root && a!=globals )
973  if( IS_RUNTIME(a) )
974  {
975  outter( TEXT(" = "), 3 );
976  dump_atom( VALUE(a), 1 );
977  }
978 
979  outter( TEXT("\n"), 1 );
980 
981  if( DESCR2(a) )
982  {
983  atom_t locals = LOCALS(a);
984  for( ; IS_NOT_EMPTY(locals); locals=CDR(locals) )
985  dump_atom( CAR(locals), level+1 );
986  }
987 
988  #undef DUMP_BUF_SIZE
989 
990 #endif //ADVANCED
991 }
atom_t find_var ( atom_t  name,
atom_t  parent 
)
Parameters
nameword atom containing the searched name
parentvar 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.

Definition at line 1015 of file vars.c.

1016 {
1017 #ifdef SAFEMODE
1018  assert( IS_WORD(name) || IS_SUBWORD(name) );
1019  assert( parent );
1020  assert( IS_VARATOM(parent) );
1021 #endif
1022 
1023  #ifdef DEBUG_FIND_VAR
1024  printf("<FINDVAR> Search "); dumpln(name);
1025  printf("<FINDVAR> Current var tree "); dumpln(root);
1026  #endif
1027 
1028  // scan parent and its parents
1029  atom_t a;
1030  for( ; parent; parent=PARENT(parent) )
1031  {
1032  #ifdef DEBUG_FIND_VAR
1033  printf("<FINDVAR> Search it in parent "); dumpln(NAME(parent));
1034  #endif
1035  a = find_local_var( name, parent );
1036  #ifdef DEBUG_FIND_VAR
1037  if( a ) { printf("<FINDVAR> Found in "); dumpln(NAME(parent)); }
1038  #endif
1039  if( a ) return a;
1040  }
1041 
1042  #ifdef DEBUG_FIND_VAR
1043  printf("<FINDVAR> Search it in parent "); dumpln(NAME(globals));
1044  #endif
1045  a = find_local_var( name, globals );
1046  #ifdef DEBUG_FIND_VAR
1047  if( a ) { printf("<FINDVAR> Found in "); dumpln(NAME(globals)); }
1048  #endif
1049  if( a ) return a;
1050 
1051  #ifdef DEBUG_FIND_VAR
1052  printf("<FINDVAR> Not found\n");
1053  #endif
1054  return NULL; // not found
1055 }
atom_t find_local_runtime_var ( atom_t  name,
int  frame 
)
Parameters
nameword atom containing the searched name
framestarting 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.

Definition at line 1074 of file vars.c.

1075 {
1076  atom_t parent;
1077  atom_t var;
1078 
1079  #ifdef SAFEMODE
1080  assert( IS_WORD(name) || IS_SUBWORD(name) );
1081  #endif
1082 
1083  #ifdef DEBUG_FIND_RUNTIME_VAR
1084  printf("<FIND_LOCAL_RUNTIME_VAR> Search "); dumpln(name);
1085  #endif
1086 
1087  // first scan variables created at run-time
1088  parent = *(atom_t*)(frame+BASE_OFFSET_LOCALS);
1089  var = find_local_var( name, parent );
1090  #ifdef DEBUG_FIND_RUNTIME_VAR
1091  if( var ) { printf("<FIND_LOCAL_RUNTIME_VAR> Found runtimer "); dumpln(NAME(var)); }
1092  #endif
1093  if( var ) return var;
1094 
1095  // then scan variables created at compile-time
1096  parent = *(atom_t*)(frame+BASE_OFFSET_PARENT);
1097  var = find_local_var( name, parent );
1098  #ifdef DEBUG_FIND_RUNTIME_VAR
1099  if( var ) { printf("<FIND_LOCAL_RUNTIME_VAR> Found local "); dumpln(NAME(var)); }
1100  #endif
1101  if( var ) return var;
1102 
1103  #ifdef DEBUG_FIND_RUNTIME_VAR
1104  printf("<FIND_LOCAL_RUNTIME_VAR> Not found\n");
1105  #endif
1106  return NULL; // not found
1107 }
atom_t find_runtime_var ( atom_t  name,
int  frame 
)
Parameters
nameword atom containing the searched name
framestarting 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.

Definition at line 1133 of file vars.c.

1134 {
1135  atom_t parent;
1136  atom_t var;
1137 
1138  #ifdef SAFEMODE
1139  assert( IS_WORD(name) || IS_SUBWORD(name) );
1140  #endif
1141 
1142  #ifdef DEBUG_FIND_RUNTIME_VAR
1143  printf("<FIND_RUNTIME_VAR> Search "); dumpln(name);
1144  #endif
1145 
1146  // scan parent and its parents
1147  while( frame )
1148  {
1149  // first scan variables created at run-time
1150  parent = *(atom_t*)(frame+BASE_OFFSET_LOCALS);
1151  var = find_local_var( name, parent );
1152  #ifdef DEBUG_FIND_RUNTIME_VAR
1153  if( var ) { printf("<FIND_RUNTIME_VAR> Found runtimer "); dumpln(NAME(var)); }
1154  #endif
1155  if( var ) return var;
1156 
1157  // then scan variables created at compile-time
1158  parent = *(atom_t*)(frame+BASE_OFFSET_PARENT);
1159  var = find_local_var( name, parent );
1160  #ifdef DEBUG_FIND_RUNTIME_VAR
1161  if( var ) { printf("<FIND_RUNTIME_VAR> Found local "); dumpln(NAME(var)); }
1162  #endif
1163  if( var ) return var;
1164 
1165  // exit the loop if we reached the root variable
1166  if( parent==root ) break;
1167 
1168  // go to upper frame
1169  frame = *((int*)(frame));
1170  }
1171 
1172  // the variable is not found, thus now
1173  // scan the global variables
1174  var = find_local_var( name, globals );
1175  #ifdef DEBUG_FIND_RUNTIME_VAR
1176  if( var ) { printf("<FIND_RUNTIME_VAR> Found global "); dumpln(NAME(var)); }
1177  #endif
1178  if( var ) return var;
1179 
1180 
1181  #ifdef DEBUG_FIND_RUNTIME_VAR
1182  printf("<FIND_RUNTIME_VAR> Not found\n");
1183  #endif
1184  return NULL; // not found
1185 }
atom_t find_local_var ( atom_t  name,
atom_t  parent 
)
Parameters
nameword atom containing the searched name
parentvar 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)

Definition at line 1210 of file vars.c.

1211 {
1212 #ifdef SAFEMODE
1213  assert( IS_WORD(name) || IS_SUBWORD(name) );
1214  assert( parent );
1215  assert( IS_VARATOM(parent) || IS_LIST(parent) );
1216 #endif
1217 
1218  atom_t a;
1219 
1220  if( IS_LIST(parent) )
1221  {
1222  a = parent;
1223  }
1224  else
1225  {
1226  if( !DESCR2(parent) ) return NULL;
1227  a = LOCALS(parent);
1228  if( !a ) return NULL;
1229  }
1230 
1231  // scan all elements in the LOCALS
1232  for( ; IS_NOT_EMPTY(a); a=CDR(a) )
1233  if( same_words(name,NAME(CAR(a))) )
1234  {
1235  return CAR(a); // found
1236  }
1237 
1238  return NULL; // not found
1239 }
atom_t new_local_var ( atom_t  name,
atom_t  function,
int  quoted 
)
Parameters
nameword atom for the name of the variable
functionvar atom for the parent of the variable
quotedshows 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.

Definition at line 1258 of file vars.c.

1259 {
1260  #ifdef SAFE_MODE
1261  assert( IS_VAR(function) );
1262  assert( IS_ANY_WORD(name) );
1263  if( quoted )
1264  {
1265  assert( LENGTH(name)>1 );
1266  assert( *STRING(name)==TEXT(':') || *STRING(name)==TEXT('"') );
1267  }
1268  #endif
1269 
1270  atom_t real_name;
1271  if( quoted )
1272  real_name = new_subword( name, STRING(name)+1, LENGTH(name)-1 );
1273  else
1274  real_name = USE( name );
1275 
1276  if( find_local_var(real_name,function) )
1277  {
1278  //printf("THERE IS "); dump(real_name); printf(" IN FUNC "); dumpln(function);
1279  DEUSE( real_name );
1280  return new_error( ERROR_DUPLICATE_INPUT, name );
1281  }
1282 
1283  //printf("CREATED "); dump(real_name); printf(" IN FUNC "); dumpln(function);
1284  atom_t a = new_var( real_name, function, 1 );
1285  DEUSE( real_name );
1286  return a;
1287 }
atom_t copy_local_vars ( int  frame)
Parameters
framecurrent 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
  6. func/cmd normal
  7. func/cmd runtime
  8. func/cmd external
  9. func/cmd internal

Definition at line 1315 of file vars.c.

1316 {
1317  // get frame and var atom of the callee
1318  int callee_frame = frame;
1319  atom_t callee = *(atom_t*)(callee_frame+BASE_OFFSET_PARENT);
1320 
1321  // get frame and var atom of the caller
1322  int caller_frame = *(int*)(callee_frame+BASE_OFFSET_DYNAMIC);
1323  atom_t caller = *(atom_t*)(caller_frame+BASE_OFFSET_PARENT);;
1324 
1325  //printf( "}->callee = "); dumpln(NAME(callee));
1326  //printf( "}->caller = "); dumpln(NAME(caller));
1327 
1328 //#define FLAG_VARIABLE 0x0002
1329 //#define FLAG_FUNCTION 0x0004
1330 //#define FLAG_COMMAND 0x0008
1331 
1332 //#define VAR_TYPE_NORMAL 0x00 ///< variable value is in stack
1333 //#define VAR_TYPE_RUNTIME 0x01 ///< variable value is in the variable
1334 
1335  // Copies pure variable var from the callee to the caller.
1336  // If the variable exists in the caller, only its value
1337  // is transfered. If the variable does not exist, then
1338  // it is created as a runtime variable in the caller.
1339  // If to_atom is null, then there is no target variable
1340  void copy_var( atom_t from_var, atom_t to_var )
1341  {
1342  if( !to_var )
1343  {
1344  if( caller==root )
1345  {
1346  to_var = new_var( NAME(from_var), globals, 1 );
1347  }
1348  else
1349  {
1350  to_var = new_var( NAME(from_var), caller, 0 );
1351  atom_t* localsp = (atom_t*) (caller_frame + BASE_OFFSET_LOCALS);
1352  *localsp = new_list( to_var, *localsp ); // attach to other runtimers
1353  }
1354  VARTYPE( to_var ) = VAR_TYPE_RUNTIME;
1355  VALUE( to_var ) = USE( unbound );
1356  }
1357 
1358  //printf("copy "); dump_atom(NAME(PARENT(from_var)),1);
1359  //printf("."); dump_atom(NAME(from_var),1);
1360  //printf(" -> "); dump_atom(NAME(PARENT(to_var)),1);
1361  //printf("."); dump_atom(NAME(to_var),1);
1362 
1363  //printf("\n-->from_var=<|"); dump_atom((to_var),1);
1364  //printf("|>\n-->to_var=<|"); dump_atom((to_var),1);
1365  //printf("|>\n");
1366 
1367  // Continue with copying
1368  atom_t value;
1369 
1370  // get the value from the source variable variable
1371  SET_FLAGS( to_var, FLAG_VARIABLE );
1372  if( IS_NORMAL(from_var) )
1373  { // CASE 3: value is in the current stack
1374  value = *(atom_t*)((char*)callee_frame+OFFSET(from_var));
1375  }
1376  else
1377  { // CASE 4: value pointed by var's atom
1378  value = VALUE( from_var );
1379  }
1380 
1381  // put the value in the target variable
1382  if( IS_NORMAL(to_var) )
1383  {
1384  //printf("normal var\n");
1385  atom_t* varptr = (atom_t*) ((char*)caller_frame + OFFSET( to_var ));
1386  //printf(" old="); dump_atom(*varptr,1);
1387  DEUSE( *varptr );
1388  *varptr = USE( value );
1389  }
1390  else
1391  {
1392  //printf("runtime var %x %x\n",(unsigned int)to_var,(unsigned int)VALUE(to_var));
1393  //printf(" old="); dump_atom(VALUE(to_var),1);
1394  DEUSE( VALUE(to_var) );
1395  VALUE( to_var ) = USE(value);
1396  }
1397 
1398  //printf(" new="); dump_atom(value,1);
1399  //printf("\n");
1400  } //copy_var()
1401 
1402  // Copies function/command var from the callee to the caller.
1403  // If to_atom is null, then there is no target variable
1404  void copy_func( atom_t from_var, atom_t to_var )
1405  {
1406  // if target does not exist - attach the var to the target parent
1407  // decrease the level of all static locals and recompile
1408  if( !to_var )
1409  {
1410  to_var = USE( from_var );
1411  LOCALS( caller ) = new_list( to_var, LOCALS( caller ) );
1412  }
1413  else
1414  {
1415  // if definitions are incompatible (different number of
1416  // local parameters) then exit without copying
1417  if (LARGS( from_var ) != LARGS( to_var ) || RARGS( from_var ) != RARGS( to_var ))
1418  {
1419  return;
1420  }
1421 
1422  FLAGS( to_var ) = FLAGS( from_var );
1423  VARTYPE( to_var ) = VARTYPE( from_var );
1424  PRIORITY( to_var ) = PRIORITY( from_var );
1425  ADDRESS( to_var ) = ADDRESS( from_var );
1426 
1427  DEUSE( LOCALS( to_var ) );
1428  LOCALS( to_var ) = USE( LOCALS( from_var ) );
1429 
1430  DEUSE( DEFINITIONS( to_var ) );
1431  DEFINITIONS( to_var ) = USE( DEFINITIONS( from_var ) );
1432 
1433  DEUSE( BINARY( to_var ) );
1434  BINARY( to_var ) = USE( BINARY( from_var ) );
1435  }
1436  }
1437 
1438  void copy_var_or_func( atom_t from_var )
1439  {
1440  // primitives cannot be copied
1441  if( IS_PRIMITIVE(from_var) ) return;
1442 
1443  // not notmals and not runtimes cannot be copies
1444  if( !IS_NORMAL(from_var) && !IS_RUNTIME(from_var) ) return;
1445 
1446  // search the destination variable
1447  atom_t to_var = find_local_runtime_var( NAME(from_var), caller_frame );
1448 
1449  // destination var must be non-primitive and (normal or runtime)
1450  if( to_var )
1451  {
1452  if( IS_PRIMITIVE(to_var) ) return;
1453  if( !IS_NORMAL(to_var) && !IS_RUNTIME(to_var) ) return;
1454  }
1455 
1456  // if variable or function/command then copy the var
1457  if( IS_VARIABLE( from_var ) ) copy_var( from_var, to_var );
1458  if( IS_FUNCTION( from_var ) || IS_COMMAND( from_var ) ) copy_func( from_var, to_var );
1459 
1460  return;
1461  }
1462 
1463  atom_t vars;
1464 
1465  // first scan variables created at run-time
1466  vars = *(atom_t*)(callee_frame+BASE_OFFSET_LOCALS);
1467  for( ; IS_NOT_EMPTY(vars); vars=CDR(vars) ) copy_var_or_func( CAR(vars) );
1468 
1469  // then scan variables created at compile-time
1470  vars = LOCALS(callee);
1471  for( ; IS_NOT_EMPTY(vars); vars=CDR(vars) ) copy_var_or_func( CAR(vars) );
1472 }

Variable Documentation

atom_t root

Definition at line 146 of file vars.c.

atom_t word_to

Definition at line 147 of file vars.c.

atom_t word_to_syn

Definition at line 148 of file vars.c.

atom_t word_end

Definition at line 149 of file vars.c.

atom_t word_run

Definition at line 150 of file vars.c.

atom_t word_make

Definition at line 151 of file vars.c.

atom_t word_plus

Definition at line 152 of file vars.c.

atom_t word_toplevel

Definition at line 153 of file vars.c.

atom_t word_system

Definition at line 154 of file vars.c.

atom_t word_error

Definition at line 155 of file vars.c.

atom_t unbound

Definition at line 157 of file vars.c.

atom_t stopped

Definition at line 158 of file vars.c.

atom_t repeat_chain

Definition at line 160 of file vars.c.

atom_t globals

Definition at line 161 of file vars.c.

atom_t printdepthlimit

Definition at line 163 of file vars.c.

atom_t printwidthlimit

Definition at line 164 of file vars.c.

atom_t fullprintp

Definition at line 165 of file vars.c.

atom_t caseignoredp

Definition at line 166 of file vars.c.

atom_t last_error

Definition at line 168 of file vars.c.

atom_t delayed_free

Definition at line 169 of file vars.c.

int root_frame

Definition at line 171 of file vars.c.

int backup_frame

Definition at line 172 of file vars.c.

atom_t error_flag

Definition at line 173 of file vars.c.

int catch_output_flag

Definition at line 174 of file vars.c.

primitive_t vars[]

Definition at line 203 of file vars.c.


[ HOME | INDEX | ATOMS | VARS | REFERENCE ]
Lhogho Developer's Documentation
Wed Jul 10 2013