core: Add an 'M1' register for the current module.

* include/mes/mes.h (M1): New variable.
* src/mes.c (main): Initialize it.
* src/gc.c (gc_flip): Account for it.
(gc_): Copy it.
(gc_dump_state): Dump it.
* src/test/gc.c (test_setup, main): Initialize it.
* src/module.c (current_module): New function.
* src/builtiins.c (mes_builtins): Register it as 'current-module'.
* include/mes/builtins.h (current_module): Declare it.

include/mes/builtins.h

@@ -103,6 +103,7 @@ struct scm *ash (struct scm *n, struct scm *count);
 struct scm *module_variable (struct scm *module, struct scm *name);
 struct scm *module_define_x (struct scm *module, struct scm *name, struct scm *value);
 struct scm *initial_module ();
+struct scm *current_module ();
 /* src/posix.c */
 struct scm *abort_ ();
 struct scm *exit_ (struct scm *x);

include/mes/mes.h

@@ -71,8 +71,10 @@ extern struct scm *R1;
 extern struct scm *R2;
 /* continuation */
 extern struct scm *R3;
-/* current-module */
+/* initial module obarray */
 extern struct scm *M0;
+/* current module */
+extern struct scm *M1;
 /* macro */
 extern struct scm *g_macros;
 extern struct scm *g_ports;

src/builtins.c

@@ -213,6 +213,7 @@ mes_builtins (struct scm *a)            /*:((internal)) */
   a = init_builtin (builtin_type, "module-variable", 2, &module_variable, a);
   a = init_builtin (builtin_type, "module-define!", 3, &module_define_x, a);
   a = init_builtin (builtin_type, "initial-module", 0, &initial_module, a);
+  a = init_builtin (builtin_type, "current-module", 0, &current_module, a);
   /* src/posix.c */
   a = init_builtin (builtin_type, "abort", 0, &abort_, a);
   a = init_builtin (builtin_type, "exit", 1, &exit_, a);

src/gc.c

@@ -476,6 +476,7 @@ gc_flip ()
   scm_hash_table_type = scm_hash_table_type - dist;
   scm_variable_type = scm_variable_type - dist;
   M0 = M0 - dist;
+  M1 = M1 - dist;
 
   long i;
   for (i = g_stack; i < STACK_SIZE; i = i + 1)
@@ -649,6 +650,7 @@ gc_ ()
   scm_hash_table_type = gc_copy (scm_hash_table_type);
   scm_variable_type = gc_copy (scm_variable_type);
   M0 = gc_copy (M0);
+  M1 = gc_copy (M1);
 
   long i;
   for (i = g_stack; i < STACK_SIZE; i = i + 1)
@@ -757,6 +759,7 @@ gc_dump_state ()
   gc_dump_register ("R2", R2);
   gc_dump_register ("R3", R3);
   gc_dump_register ("M0", M0);
+  gc_dump_register ("M1", M1);
   gc_dump_register ("g_symbols", g_symbols);
   gc_dump_register ("g_symbol_max", g_symbol_max);
   gc_dump_register ("g_macros", g_macros);

src/mes.c

@@ -190,6 +190,7 @@ main (int argc, char **argv, char **envp)
   a = mes_builtins (a);
   a = init_time (a);
   M0 = make_initial_module (a);
+  M1 = cell_f;
   R0 = cell_nil;
   g_macros = make_hash_table_ (0);
 

src/module.c

@@ -41,6 +41,12 @@ initial_module ()
   return M0;
 }
 
+struct scm *
+current_module ()
+{
+  return M1;
+}
+
 struct scm *
 module_variable (struct scm *module, struct scm *name)
 {

src/test/gc.c

@@ -44,6 +44,7 @@ test_setup ()
   g_macros = cell_zero;
   g_stack = STACK_SIZE;
   M0 = cell_zero;
+  M1 = cell_f;
 
   memset (g_arena + sizeof (struct scm), 0, ARENA_SIZE * sizeof (struct scm));
   cell_zero->type = TCHAR;
@@ -186,6 +187,7 @@ main (int argc, char **argv, char **envp)
   g_macros = cell_zero;
   g_stack = STACK_SIZE;
   M0 = cell_zero;
+  M1 = cell_f;
 
   test_empty ();
   test_number ();