Commit 8589777a authored by Erick Gallesio's avatar Erick Gallesio

current-module is now thread specific

parent 1839ff0b
2006-04-05 Erick Gallesio <eg@essi.fr>
* lib/computils.stk (symbol-bound?): Use SYMBOL-VALUE* instead of
SYMBOL-VALUE. This avoids some undefined symbols warnings.
2006-03-22 Erick Gallesio <eg@essi.fr> 2006-03-22 Erick Gallesio <eg@essi.fr>
* lib/srfi-27.stk (%random-source-current-time): Change * lib/srfi-27.stk (%random-source-current-time): Change
......
;;;; ;;;;
;;;; utils.stk -- Compiler Utilities ;;;; utils.stk -- Compiler Utilities
;;;; ;;;;
;;;; Copyright 2000-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> ;;;; Copyright 2000-2006 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; ;;;;
;;;; ;;;;
;;;; This program is free software; you can redistribute it and/or modify ;;;; This program is free software; you can redistribute it and/or modify
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
;;;; ;;;;
;;;; Author: Erick Gallesio [eg@unice.fr] ;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 14-Mar-2001 13:57 (eg) ;;;; Creation date: 14-Mar-2001 13:57 (eg)
;;;; Last file update: 20-Nov-2004 19:34 (eg) ;;;; Last file update: 5-Apr-2006 10:14 (eg)
;;;; ;;;;
...@@ -92,7 +92,7 @@ ...@@ -92,7 +92,7 @@
(define symbol-bound? (define symbol-bound?
(let ((unbound (list 'unbound))) (let ((unbound (list 'unbound)))
(lambda (symbol) (lambda (symbol)
(not (eq? (symbol-value symbol (current-module) unbound) unbound))))) (not (eq? (symbol-value* symbol (current-module) unbound) unbound)))))
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
* *
* b o o l e a n . c -- Booleans and Equivalence predicates * b o o l e a n . c -- Booleans and Equivalence predicates
* *
* Copyright © 1993-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> * Copyright © 1993-2006 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
* *
* *
* This program is free software; you can redistribute it and/or modify * This program is free software; you can redistribute it and/or modify
...@@ -22,7 +22,7 @@ ...@@ -22,7 +22,7 @@
* *
* Author: Erick Gallesio [eg@kaolin.unice.fr] * Author: Erick Gallesio [eg@kaolin.unice.fr]
* Creation date: 23-Oct-1993 21:37 * Creation date: 23-Oct-1993 21:37
* Last file update: 12-May-2004 18:01 (eg) * Last file update: 4-Apr-2006 18:44 (eg)
*/ */
#include "stklos.h" #include "stklos.h"
...@@ -194,7 +194,8 @@ DEFINE_PRIMITIVE("eqv?", eqv, subr2, (SCM x, SCM y)) ...@@ -194,7 +194,8 @@ DEFINE_PRIMITIVE("eqv?", eqv, subr2, (SCM x, SCM y))
if (STk_oo_initialized) { if (STk_oo_initialized) {
SCM fg, res; SCM fg, res;
fg = STk_lookup(STk_intern("object-eqv?"), STk_current_module, &res, FALSE); fg = STk_lookup(STk_intern("object-eqv?"), STk_current_module(),
&res, FALSE);
res = STk_C_apply(fg, 2, x, y); res = STk_C_apply(fg, 2, x, y);
return res; return res;
} }
...@@ -323,7 +324,8 @@ DEFINE_PRIMITIVE("equal?", equal, subr2, (SCM x, SCM y)) ...@@ -323,7 +324,8 @@ DEFINE_PRIMITIVE("equal?", equal, subr2, (SCM x, SCM y))
if (STk_oo_initialized) { if (STk_oo_initialized) {
SCM fg, res; SCM fg, res;
fg = STk_lookup(STk_intern("object-equal?"),STk_current_module,&res,FALSE); fg = STk_lookup(STk_intern("object-equal?"),STk_current_module(),
&res,FALSE);
res = STk_C_apply(fg, 2, x, y); res = STk_C_apply(fg, 2, x, y);
return res; return res;
} }
......
This diff is collapsed.
This diff is collapsed.
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
* *
* Author: Erick Gallesio [eg@essi.fr] * Author: Erick Gallesio [eg@essi.fr]
* Creation date: 22-May-2004 08:57 (eg) * Creation date: 22-May-2004 08:57 (eg)
* Last file update: 1-Feb-2006 18:13 (eg) * Last file update: 4-Apr-2006 20:07 (eg)
*/ */
#include "stklos.h" #include "stklos.h"
...@@ -465,7 +465,7 @@ SCM STk_make_C_cond(SCM type, int nargs, ...) ...@@ -465,7 +465,7 @@ SCM STk_make_C_cond(SCM type, int nargs, ...)
int STk_init_cond(void) int STk_init_cond(void)
{ {
SCM module = STk_current_module; SCM module = STk_STklos_module;
/* Build the special value SRFI-35 &condition */ /* Build the special value SRFI-35 &condition */
NEWCELL(root_condition, struct_type); NEWCELL(root_condition, struct_type);
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
* *
* e n v . c -- Environment management * e n v . c -- Environment management
* *
* Copyright 1993-2005 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> * Copyright 1993-2006 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
* *
* *
* This program is free software; you can redistribute it and/or modify * This program is free software; you can redistribute it and/or modify
...@@ -22,11 +22,13 @@ ...@@ -22,11 +22,13 @@
* *
* Author: Erick Gallesio [eg@unice.fr] * Author: Erick Gallesio [eg@unice.fr]
* Creation date: 23-Oct-1993 21:37 * Creation date: 23-Oct-1993 21:37
* Last file update: 23-Aug-2005 08:28 (eg) * Last file update: 4-Apr-2006 23:58 (eg)
*/ */
#include "stklos.h" #include "stklos.h"
#include "hash.h" #include "hash.h"
#include "vm.h"
#include "thread.h"
static void error_bad_module_name(SCM obj) static void error_bad_module_name(SCM obj)
...@@ -82,8 +84,7 @@ struct module_obj { ...@@ -82,8 +84,7 @@ struct module_obj {
#define VISIBLE_P(symb, mod) (STk_memq((symb), MODULE_EXPORTS(mod))!=STk_false) #define VISIBLE_P(symb, mod) (STk_memq((symb), MODULE_EXPORTS(mod))!=STk_false)
SCM STk_current_module; /* The current module */ SCM STk_STklos_module; /* The module whose name is STklos */
static SCM stklos_module; /* The module whose name is STklos */
static SCM all_modules; /* List of all knowm modules */ static SCM all_modules; /* List of all knowm modules */
...@@ -102,7 +103,7 @@ static SCM STk_makemodule(SCM name) ...@@ -102,7 +103,7 @@ static SCM STk_makemodule(SCM name)
NEWCELL(z, module); NEWCELL(z, module);
MODULE_NAME(z) = name; MODULE_NAME(z) = name;
MODULE_EXPORTS(z) = STk_nil; MODULE_EXPORTS(z) = STk_nil;
MODULE_IMPORTS(z) = (name == STk_void)? STk_nil : LIST1(stklos_module); MODULE_IMPORTS(z) = (name == STk_void)? STk_nil : LIST1(STk_STklos_module);
/* Initialize the associated hash table & stor the module in the global list*/ /* Initialize the associated hash table & stor the module in the global list*/
STk_hashtable_init(&MODULE_HASH_TABLE(z), HASH_VAR_FLAG); STk_hashtable_init(&MODULE_HASH_TABLE(z), HASH_VAR_FLAG);
all_modules = STk_cons(z, all_modules); all_modules = STk_cons(z, all_modules);
...@@ -115,7 +116,7 @@ static SCM find_module(SCM name, int create) ...@@ -115,7 +116,7 @@ static SCM find_module(SCM name, int create)
SCM tmp; SCM tmp;
if (name == STk_intern("STklos") || name == STk_intern("stklos")) if (name == STk_intern("STklos") || name == STk_intern("stklos"))
return stklos_module; return STk_STklos_module;
for (tmp = all_modules; !NULLP(tmp); tmp = CDR(tmp)) { for (tmp = all_modules; !NULLP(tmp); tmp = CDR(tmp)) {
if (MODULE_NAME(CAR(tmp)) == name) if (MODULE_NAME(CAR(tmp)) == name)
...@@ -141,9 +142,10 @@ DEFINE_PRIMITIVE("%create-module", create_module, subr1, (SCM name)) ...@@ -141,9 +142,10 @@ DEFINE_PRIMITIVE("%create-module", create_module, subr1, (SCM name))
DEFINE_PRIMITIVE("%select-module", select_module, subr1, (SCM module)) DEFINE_PRIMITIVE("%select-module", select_module, subr1, (SCM module))
{ {
vm_thread_t *vm = STk_get_current_vm();
if (!MODULEP(module)) error_bad_module(module); if (!MODULEP(module)) error_bad_module(module);
vm->current_module= module;
STk_current_module = module;
return STk_void; return STk_void;
} }
...@@ -224,9 +226,14 @@ DEFINE_PRIMITIVE("find-module", scheme_find_module, subr12, (SCM name, SCM def)) ...@@ -224,9 +226,14 @@ DEFINE_PRIMITIVE("find-module", scheme_find_module, subr12, (SCM name, SCM def))
* @end lisp * @end lisp
doc> doc>
*/ */
DEFINE_PRIMITIVE("current-module", scheme_current_module, subr0, (void)) DEFINE_PRIMITIVE("current-module", current_module, subr0, (void))
{ {
return STk_current_module; if (STk_primordial_thread) {
vm_thread_t *vm = STk_get_current_vm();
return vm->current_module;
} else {
return STk_STklos_module;
}
} }
...@@ -272,7 +279,7 @@ DEFINE_PRIMITIVE("module-exports", module_exports, subr1, (SCM module)) ...@@ -272,7 +279,7 @@ DEFINE_PRIMITIVE("module-exports", module_exports, subr1, (SCM module))
if (!MODULEP(module)) error_bad_module(module); if (!MODULEP(module)) error_bad_module(module);
/* STklos module is special: everything is exported ==> module-symbols */ /* STklos module is special: everything is exported ==> module-symbols */
return (module == stklos_module) ? return (module == STk_STklos_module) ?
STk_hash_keys(&MODULE_HASH_TABLE(module)) : STk_hash_keys(&MODULE_HASH_TABLE(module)) :
MODULE_EXPORTS(module); MODULE_EXPORTS(module);
} }
...@@ -413,8 +420,8 @@ SCM STk_lookup(SCM symbol, SCM env, SCM *ref, int err_if_unbound) ...@@ -413,8 +420,8 @@ SCM STk_lookup(SCM symbol, SCM env, SCM *ref, int err_if_unbound)
/* Not found in the imported modules. Try in the stklos module (if we /* Not found in the imported modules. Try in the stklos module (if we
* didn't had searched it yet * didn't had searched it yet
*/ */
if (env != stklos_module) { if (env != STk_STklos_module) {
res = STk_hash_get_variable(&MODULE_HASH_TABLE(stklos_module), symbol, &i); res = STk_hash_get_variable(&MODULE_HASH_TABLE(STk_STklos_module), symbol, &i);
if (res) { if (res) {
*ref = res; *ref = res;
return CDR(res); return CDR(res);
...@@ -456,8 +463,7 @@ int STk_init_env(void) ...@@ -456,8 +463,7 @@ int STk_init_env(void)
all_modules = STk_nil; all_modules = STk_nil;
/* Create the stklos module */ /* Create the stklos module */
stklos_module = STk_makemodule(STk_void); /* will be changed later */ STk_STklos_module = STk_makemodule(STk_void); /* will be changed later */
STk_current_module = stklos_module;
/* Declare the extended types module_obj and frame_obj */ /* Declare the extended types module_obj and frame_obj */
DEFINE_XTYPE(module, &xtype_module); DEFINE_XTYPE(module, &xtype_module);
...@@ -468,7 +474,7 @@ int STk_init_env(void) ...@@ -468,7 +474,7 @@ int STk_init_env(void)
int STk_late_init_env(void) int STk_late_init_env(void)
{ {
/* Now that symbols are initialized change the STklos module name */ /* Now that symbols are initialized change the STklos module name */
MODULE_NAME(stklos_module) = STk_intern("stklos"); MODULE_NAME(STk_STklos_module) = STk_intern("stklos");
/* ==== Undocumented primitives ==== */ /* ==== Undocumented primitives ==== */
ADD_PRIMITIVE(create_module); ADD_PRIMITIVE(create_module);
...@@ -479,7 +485,7 @@ int STk_late_init_env(void) ...@@ -479,7 +485,7 @@ int STk_late_init_env(void)
/* ==== User primitives ==== */ /* ==== User primitives ==== */
ADD_PRIMITIVE(modulep); ADD_PRIMITIVE(modulep);
ADD_PRIMITIVE(scheme_find_module); ADD_PRIMITIVE(scheme_find_module);
ADD_PRIMITIVE(scheme_current_module); ADD_PRIMITIVE(current_module);
ADD_PRIMITIVE(module_name); ADD_PRIMITIVE(module_name);
ADD_PRIMITIVE(module_imports); ADD_PRIMITIVE(module_imports);
ADD_PRIMITIVE(module_exports); ADD_PRIMITIVE(module_exports);
...@@ -492,4 +498,3 @@ int STk_late_init_env(void) ...@@ -492,4 +498,3 @@ int STk_late_init_env(void)
return TRUE; return TRUE;
} }
/* /*
* f p o r t . c -- File ports * f p o r t . c -- File ports
* *
* Copyright 2000-2005 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> * Copyright 2000-2006 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
* *
* *
* This program is free software; you can redistribute it and/or modify * This program is free software; you can redistribute it and/or modify
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
* *
* Author: Erick Gallesio [eg@unice.fr] * Author: Erick Gallesio [eg@unice.fr]
* Creation date: 8-Jan-2000 14:48 (eg) * Creation date: 8-Jan-2000 14:48 (eg)
* Last file update: 13-Sep-2005 22:41 (eg) * Last file update: 4-Apr-2006 18:59 (eg)
* *
* This implementation is built by reverse engineering on an old SUNOS 4.1.1 * This implementation is built by reverse engineering on an old SUNOS 4.1.1
* stdio.h. It has been simplified to fit the needs for STklos. In particular * stdio.h. It has been simplified to fit the needs for STklos. In particular
...@@ -752,7 +752,7 @@ SCM STk_load_source_file(SCM f) ...@@ -752,7 +752,7 @@ SCM STk_load_source_file(SCM f)
*/ */
sexpr = STk_read_constant(f, STk_read_case_sensitive); sexpr = STk_read_constant(f, STk_read_case_sensitive);
if (sexpr == STk_eof) break; if (sexpr == STk_eof) break;
eval = STk_lookup(eval_symb, STk_current_module, &ref, TRUE); eval = STk_lookup(eval_symb, STk_current_module(), &ref, TRUE);
STk_C_apply(eval, 1, sexpr); STk_C_apply(eval, 1, sexpr);
} }
STk_close_port(f); STk_close_port(f);
......
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
* *
* Author: Erick Gallesio [eg@unice.fr] * Author: Erick Gallesio [eg@unice.fr]
* Creation date: 5-Jan-2000 12:17 (eg) * Creation date: 5-Jan-2000 12:17 (eg)
* Last file update: 2-Feb-2006 22:25 (eg) * Last file update: 4-Apr-2006 23:52 (eg)
*/ */
......
/* /*
* m i s c . c -- Misc. functions * m i s c . c -- Misc. functions
* *
* Copyright © 2000-2005 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> * Copyright © 2000-2006 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
* *
* *
* This program is free software; you can redistribute it and/or modify * This program is free software; you can redistribute it and/or modify
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
* *
* Author: Erick Gallesio [eg@unice.fr] * Author: Erick Gallesio [eg@unice.fr]
* Creation date: 9-Jan-2000 12:50 (eg) * Creation date: 9-Jan-2000 12:50 (eg)
* Last file update: 25-Apr-2005 17:14 (eg) * Last file update: 4-Apr-2006 19:00 (eg)
*/ */
#include "stklos.h" #include "stklos.h"
...@@ -55,7 +55,7 @@ void STk_add_primitive(struct primitive_obj *o) ...@@ -55,7 +55,7 @@ void STk_add_primitive(struct primitive_obj *o)
SCM symbol; SCM symbol;
symbol = STk_intern(o->name); symbol = STk_intern(o->name);
STk_define_variable(symbol, (SCM) o, STk_current_module); STk_define_variable(symbol, (SCM) o, STk_current_module());
} }
...@@ -484,8 +484,8 @@ DEFINE_PRIMITIVE("%debug", set_debug, subr0, (void)) ...@@ -484,8 +484,8 @@ DEFINE_PRIMITIVE("%debug", set_debug, subr0, (void))
DEFINE_PRIMITIVE("%test", test, subr1, (SCM s)) DEFINE_PRIMITIVE("%test", test, subr1, (SCM s))
{ {
/* A special place for doing tests */ /* A special place for doing tests */
STk_eval_C_string("(display \"Hello, world!\")", STk_current_module); STk_eval_C_string("(display \"Hello, world!\")", STk_current_module());
STk_eval_C_string("(display (fact 200))", STk_current_module); STk_eval_C_string("(display (fact 200))", STk_current_module());
return STk_void; return STk_void;
} }
#endif #endif
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
* *
* o b j e c t . c -- Objects support * o b j e c t . c -- Objects support
* *
* Copyright 1994-2005 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> * Copyright 1994-2006 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
* *
* This program is free software; you can redistribute it and/or modify * This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by * it under the terms of the GNU General Public License as published by
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
* *
* Author: Erick Gallesio [eg@unice.fr] * Author: Erick Gallesio [eg@unice.fr]
* Creation date: 9-Feb-1994 15:56 * Creation date: 9-Feb-1994 15:56
* Last file update: 25-Apr-2005 17:06 (eg) * Last file update: 4-Apr-2006 20:10 (eg)
*/ */
#include "stklos.h" #include "stklos.h"
...@@ -29,7 +29,7 @@ ...@@ -29,7 +29,7 @@
#include "struct.h" #include "struct.h"
#define GF_VAL(name) (STk_lookup(STk_intern(name), \ #define GF_VAL(name) (STk_lookup(STk_intern(name), \
STk_current_module, &unused, FALSE)) STk_current_module(), &unused, FALSE))
#define CALL_GF1(name,a) (STk_C_apply(GF_VAL(name), 1, (a))) #define CALL_GF1(name,a) (STk_C_apply(GF_VAL(name), 1, (a)))
#define CALL_GF2(name,a,b) (STk_C_apply(GF_VAL(name), 2, (a), (b))) #define CALL_GF2(name,a,b) (STk_C_apply(GF_VAL(name), 2, (a), (b)))
#define CALL_GF3(name,a,b,c) (STk_C_apply(GF_VAL(name), 3, (a), (b), (c))) #define CALL_GF3(name,a,b,c) (STk_C_apply(GF_VAL(name), 3, (a), (b), (c)))
...@@ -812,6 +812,7 @@ static void create_Top_Object_Class(void) ...@@ -812,6 +812,7 @@ static void create_Top_Object_Class(void)
STk_cons(STk_intern("getters-n-setters"), STk_cons(STk_intern("getters-n-setters"),
STk_cons(STk_intern("redefined"), STk_cons(STk_intern("redefined"),
STk_nil)))))))))); STk_nil))))))))));
SCM current_module = STk_STklos_module;
/* ========== Creation of the <Class> class ========== */ /* ========== Creation of the <Class> class ========== */
...@@ -833,21 +834,21 @@ static void create_Top_Object_Class(void) ...@@ -833,21 +834,21 @@ static void create_Top_Object_Class(void)
INST_SLOT(Class, S_getters_n_setters) = INST_ACCESSORS(Class); INST_SLOT(Class, S_getters_n_setters) = INST_ACCESSORS(Class);
INST_SLOT(Class, S_redefined) = STk_false; INST_SLOT(Class, S_redefined) = STk_false;
STk_define_variable(tmp, Class, STk_current_module); STk_define_variable(tmp, Class, current_module);
/* ========== Creation of the <Top> class ========== */ /* ========== Creation of the <Top> class ========== */
tmp = STk_intern("<top>"); tmp = STk_intern("<top>");
Top = basic_make_class(Class, tmp, STk_nil, STk_nil); Top = basic_make_class(Class, tmp, STk_nil, STk_nil);
STk_define_variable(tmp, Top, STk_current_module); STk_define_variable(tmp, Top, current_module);
/* ========== Creation of the <Object> class ========== */ /* ========== Creation of the <Object> class ========== */
tmp = STk_intern("<object>"); tmp = STk_intern("<object>");
Object = basic_make_class(Class, tmp, LIST1(Top), STk_nil); Object = basic_make_class(Class, tmp, LIST1(Top), STk_nil);
STk_define_variable(tmp, Object, STk_current_module); STk_define_variable(tmp, Object, current_module);
/* /*
* <top> <object> and <class> were partially initialized. * <top> <object> and <class> were partially initialized.
...@@ -864,7 +865,7 @@ static void mk_cls(SCM *var, char *name, SCM meta, SCM super, SCM slots) ...@@ -864,7 +865,7 @@ static void mk_cls(SCM *var, char *name, SCM meta, SCM super, SCM slots)
SCM tmp = STk_intern(name); SCM tmp = STk_intern(name);
*var = basic_make_class(meta, tmp, LIST1(super), slots); *var = basic_make_class(meta, tmp, LIST1(super), slots);
STk_define_variable(tmp, *var, STk_current_module); STk_define_variable(tmp, *var, STk_STklos_module);
} }
static void make_standard_classes(void) static void make_standard_classes(void)
...@@ -1088,7 +1089,7 @@ static void print_instance(SCM inst, SCM port, int mode) ...@@ -1088,7 +1089,7 @@ static void print_instance(SCM inst, SCM port, int mode)
SCM fct, res; SCM fct, res;
fct_name = (mode == DSP_MODE) ? "display-object" : "write-object"; fct_name = (mode == DSP_MODE) ? "display-object" : "write-object";
fct = STk_lookup(STk_intern(fct_name), STk_current_module, &res, FALSE); fct = STk_lookup(STk_intern(fct_name), STk_current_module(), &res, FALSE);
if (fct == STk_void) { if (fct == STk_void) {
/* Do a default print */ /* Do a default print */
......
/* /*
* parameter.c -- Parameter Objects (SRFI-39) * parameter.c -- Parameter Objects (SRFI-39)
* *
* Copyright © 2003-2005 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> * Copyright © 2003-2006 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
* *
* *
* This program is free software; you can redistribute it and/or modify * This program is free software; you can redistribute it and/or modify
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
* *
* Author: Erick Gallesio [eg@essi.fr] * Author: Erick Gallesio [eg@essi.fr]
* Creation date: 1-Jul-2003 11:38 (eg) * Creation date: 1-Jul-2003 11:38 (eg)
* Last file update: 26-Dec-2005 19:05 (eg) * Last file update: 4-Apr-2006 19:02 (eg)
*/ */
...@@ -92,7 +92,7 @@ SCM STk_make_C_parameter(SCM symbol, SCM value, SCM (*proc)(SCM new_value)) ...@@ -92,7 +92,7 @@ SCM STk_make_C_parameter(SCM symbol, SCM value, SCM (*proc)(SCM new_value))
PARAMETER_C_TYPE(z) = 1; PARAMETER_C_TYPE(z) = 1;
/* Bind it to the given symbol */ /* Bind it to the given symbol */
STk_define_variable(STk_intern(symbol), z, STk_current_module); STk_define_variable(STk_intern(symbol), z, STk_current_module());
return z; return z;
} }
......
...@@ -20,7 +20,7 @@ ...@@ -20,7 +20,7 @@
* *
* Author: Erick Gallesio [eg@unice.fr] * Author: Erick Gallesio [eg@unice.fr]
* Creation date: 17-Feb-1993 12:27 * Creation date: 17-Feb-1993 12:27
* Last file update: 7-Feb-2006 18:24 (eg) * Last file update: 4-Apr-2006 19:07 (eg)
* *
*/ */
...@@ -674,7 +674,7 @@ static SCM internal_format(int argc, SCM *argv, int error) ...@@ -674,7 +674,7 @@ static SCM internal_format(int argc, SCM *argv, int error)
if (argc-- <= 0) goto TooMuch; if (argc-- <= 0) goto TooMuch;
pp = STk_lookup(STk_intern("pp"), pp = STk_lookup(STk_intern("pp"),
STk_current_module, STk_current_module(),
&ref, &ref,
TRUE); TRUE);
STk_print(STk_C_apply(pp, 3, *argv--, STk_print(STk_C_apply(pp, 3, *argv--,
...@@ -714,7 +714,7 @@ static SCM internal_format(int argc, SCM *argv, int error) ...@@ -714,7 +714,7 @@ static SCM internal_format(int argc, SCM *argv, int error)
* Call the Scheme routine srfi48:format-fixed * Call the Scheme routine srfi48:format-fixed
*/ */
ff = STk_lookup(STk_intern("srfi48:format-fixed"), ff = STk_lookup(STk_intern("srfi48:format-fixed"),
STk_current_module, STk_current_module(),
&ref, &ref,
TRUE); TRUE);
tmp = STk_C_apply(ff, 3, tmp = STk_C_apply(ff, 3,
...@@ -747,7 +747,7 @@ static SCM internal_format(int argc, SCM *argv, int error) ...@@ -747,7 +747,7 @@ static SCM internal_format(int argc, SCM *argv, int error)
/* Do (apply format port fmt args) */ /* Do (apply format port fmt args) */
STk_C_apply_list(STk_lookup(STk_intern("format"), STk_C_apply_list(STk_lookup(STk_intern("format"),
STk_current_module, &ref, TRUE), STk_current_module(), &ref, TRUE),
STk_cons(port, STk_cons(fmt, args))); STk_cons(port, STk_cons(fmt, args)));
break; break;
} }
...@@ -756,7 +756,7 @@ static SCM internal_format(int argc, SCM *argv, int error) ...@@ -756,7 +756,7 @@ static SCM internal_format(int argc, SCM *argv, int error)
SCM ref, help; SCM ref, help;
help = STk_lookup(STk_intern("srfi48:help"), help = STk_lookup(STk_intern("srfi48:help"),
STk_current_module, STk_current_module(),
&ref, &ref,
TRUE); TRUE);
STk_C_apply(help, 1, port); STk_C_apply(help, 1, port);
...@@ -1284,7 +1284,7 @@ DEFINE_PRIMITIVE("port-rewind", port_rewind, subr1, (SCM port)) ...@@ -1284,7 +1284,7 @@ DEFINE_PRIMITIVE("port-rewind", port_rewind, subr1, (SCM port))
\*===========================================================================*/ \*===========================================================================*/
static void initialize_io_conditions(void) static void initialize_io_conditions(void)
{ {
SCM module = STk_current_module; SCM module = STk_STklos_module;
#define DEFCOND(x, name, parent, slots) \ #define DEFCOND(x, name, parent, slots) \
x = STk_defcond_type(name, parent, slots, module) x = STk_defcond_type(name, parent, slots, module)
......
...@@ -20,7 +20,7 @@ ...@@ -20,7 +20,7 @@
* *
* Author: Erick Gallesio [eg@unice.fr] * Author: Erick Gallesio [eg@unice.fr]
* Creation date: ??-Oct-1993 ??:?? * Creation date: ??-Oct-1993 ??:??
* Last file update: 7-Feb-2006 17:53 (eg) * Last file update: 4-Apr-2006 19:31 (eg)
* *
*/ */
...@@ -42,7 +42,7 @@ int STk_read_case_sensitive = 0; ...@@ -42,7 +42,7 @@ int STk_read_case_sensitive = 0;
#define PLACEHOLDERP(x) (CONSP(x) && (BOXED_INFO(x) & CONS_PLACEHOLDER)) #define PLACEHOLDERP(x) (CONSP(x) && (BOXED_INFO(x) & CONS_PLACEHOLDER))
#define PLACEHOLDER_VAL(x) (CDR(x)) #define PLACEHOLDER_VAL(x) (CDR(x))
#define SYMBOL_VALUE(x,ref) STk_lookup((x), STk_current_module, &(ref), FALSE) #define SYMBOL_VALUE(x,ref) STk_lookup((x), STk_current_module(), &(ref), FALSE)
/*===========================================================================*\ /*===========================================================================*\
* *
...@@ -732,7 +732,7 @@ DEFINE_PRIMITIVE("define-reader-ctor",reader_ctor, subr2, (SCM symbol, SCM proc) ...@@ -732,7 +732,7 @@ DEFINE_PRIMITIVE("define-reader-ctor",reader_ctor, subr2, (SCM symbol, SCM proc)
static SCM read_srfi10(SCM port, SCM l) static SCM read_srfi10(SCM port, SCM l)
{ {
int len = STk_int_length(l); int len = STk_int_length(l);
SCM tmp, ref; SCM tmp;
if (len < 0) if (len < 0)
signal_error(port, "bad list in a #,(...) form ~S", l); signal_error(port, "bad list in a #,(...) form ~S", l);
...@@ -804,7 +804,7 @@ int STk_init_reader(void) ...@@ -804,7 +804,7 @@ int STk_init_reader(void)
STk_intern("column"), STk_intern("column"),
STk_intern("position"), STk_intern("position"),
STk_intern("span")), STk_intern("span")),
STk_current_module); STk_STklos_module);
/* Declare SRFI-10 support function */ /* Declare SRFI-10 support function */
......
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
* *
* Author: Erick Gallesio [eg@unice.fr] * Author: Erick Gallesio [eg@unice.fr]
* Creation date: 28-Dec-1999 21:19 (eg) * Creation date: 28-Dec-1999 21:19 (eg)
* Last file update: 1-Feb-2006 13:41 (eg) * Last file update: 4-Apr-2006 19:26 (eg)
*/ */
#include <stklos.h> #include <stklos.h>
...@@ -134,7 +134,8 @@ static void build_scheme_args(int argc, char *argv[], char *argv0) ...@@ -134,7 +134,8 @@ static void build_scheme_args(int argc, char *argv[], char *argv0)
ADD_BOOL_OPTION(vanilla, ":no-init-file"); ADD_BOOL_OPTION(vanilla, ":no-init-file");
ADD_BOOL_OPTION(STk_interactive, ":interactive") ADD_BOOL_OPTION(STk_interactive, ":interactive")
STk_define_variable(STk_intern("*%program-args*"), options, STk_current_module); STk_define_variable(STk_intern("*%program-args*"), options,
STk_STklos_module);
} }
int main(int argc, char *argv[]) int main(int argc, char *argv[])
......
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
* *
* Author: Erick Gallesio [eg@unice.fr] * Author: Erick Gallesio [eg@unice.fr]
* Creation date: 28-Dec-1999 22:58 (eg) * Creation date: 28-Dec-1999 22:58 (eg)
* Last file update: 7-Feb-2006 16:07 (eg) * Last file update: 4-Apr-2006 19:23 (eg)
*/ */
#ifndef STKLOS_H #ifndef STKLOS_H
...@@ -378,8 +378,6 @@ struct frame_obj { ...@@ -378,8 +378,6 @@ struct frame_obj {
/* modules are defined in env.c but are private */ /* modules are defined in env.c but are private */
#define MODULEP(p) (BOXED_TYPE_EQ((p), tc_module))