Commit da662429 authored by Erick Gallesio's avatar Erick Gallesio

* New representation of global variable to permit aliases (not

  finished yet)
* Some modification in configure scripts for usage without gc
  installed
parent 19b1ef3d
......@@ -6705,7 +6705,8 @@ if test "$HAVE_GC" = "no"
then
echo "No Boehm-Demers-Weiser GC library. Using the one provided with the package"
(cd gc; CC="$CC" CFLAGS="$CFLAGS" sh ./configure --prefix=$prefix \
--enable-threads=$THREADS) || { echo "Cannot configure the GC"; exit; }
--includedir=$prefix/include/stklos --enable-threads=$THREADS) \
|| { echo "Cannot configure the GC"; exit; }
GC=gc
GCLIB="../gc/.libs/libgc.a"
......
# Makefile for stklos-pkgman
# Author: Erick Gallesio [eg@essi.fr]
# Creation date: 22-Dec-2006 12:00 (eg)
# Last file update: 21-Mar-2007 14:33 (eg)
# Last file update: 12-Apr-2007 12:03 (eg)
makefiledir= $(prefix)/etc/stklos
......@@ -28,7 +28,10 @@ $(bin_SCRIPTS): $(LEXOBJS) $(SRC)
# $(SCC) $(SFLAGS) -o $(bin_SCRIPTS) main.stk
clean:
$(RM) -f $(bin_SCRIPTS) $(LEXOBJS) *~
$(RM) -f $(bin_SCRIPTS) *~
distclean: clean
egclean: distclean
$(RM) -f $(LEXOBJS)
......@@ -17,7 +17,7 @@
# Makefile for stklos-pkgman
# Author: Erick Gallesio [eg@essi.fr]
# Creation date: 22-Dec-2006 12:00 (eg)
# Last file update: 21-Mar-2007 14:33 (eg)
# Last file update: 12-Apr-2007 12:03 (eg)
VPATH = @srcdir@
......@@ -402,9 +402,12 @@ $(bin_SCRIPTS): $(LEXOBJS) $(SRC)
# $(SCC) $(SFLAGS) -o $(bin_SCRIPTS) main.stk
clean:
$(RM) -f $(bin_SCRIPTS) $(LEXOBJS) *~
$(RM) -f $(bin_SCRIPTS) *~
distclean: clean
egclean: distclean
$(RM) -f $(LEXOBJS)
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
......@@ -2,7 +2,7 @@
*
* e n v . c -- Environment management
*
* Copyright 1993-2006 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
* Copyright 1993-2007 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
*
*
* This program is free software; you can redistribute it and/or modify
......@@ -22,7 +22,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 23-Oct-1993 21:37
* Last file update: 19-Dec-2006 10:11 (eg)
* Last file update: 11-Apr-2007 18:03 (eg)
*/
#include "stklos.h"
......@@ -340,7 +340,7 @@ DEFINE_PRIMITIVE("symbol-value", symbol_value, subr23,
res = STk_hash_get_variable(&MODULE_HASH_TABLE(module), symbol, &i);
if (res) {
return CDR(res);
return BOX_VALUE(CDR(res));
} else {
if (!default_value) error_unbound_variable(symbol);
return default_value;
......@@ -370,7 +370,7 @@ DEFINE_PRIMITIVE("%redefine-module-exports", redefine_module_exports, subr12,
res = STk_hash_get_variable(&MODULE_HASH_TABLE(from), CAR(lst), &i);
if (res)
/* symbol (car lst) is bound in module from. redefine it in module to */
STk_define_variable(CAR(lst), CDR(res), to);
STk_define_variable(CAR(lst), BOX_VALUE(CDR(res)), to);
}
return STk_void;
}
......@@ -419,6 +419,26 @@ DEFINE_PRIMITIVE("%symbol-define", symbol_define, subr3,
return value;
}
DEFINE_PRIMITIVE("%symbol-alias", symbol_alias, subr23,
(SCM new, SCM old, SCM module))
{
SCM res, mod = STk_current_module();;
int i;
if (!SYMBOLP(new)) error_bad_symbol(new);
if (!SYMBOLP(old)) error_bad_symbol(old);
if (!module)
module = mod;
else
if (!MODULEP(module)) error_bad_module(module);
res = STk_hash_get_variable(&MODULE_HASH_TABLE(module), old, &i);
if (!res)
error_unbound_variable(old);
STk_hash_set_alias(&MODULE_HASH_TABLE(mod), new, CDR(res));
return STk_void;
}
/*===========================================================================*\
......@@ -435,7 +455,7 @@ SCM STk_lookup(SCM symbol, SCM env, SCM *ref, int err_if_unbound)
res = STk_hash_get_variable(&MODULE_HASH_TABLE(env), symbol, &i);
if (res) {
*ref = res;
return CDR(res);
return BOX_VALUE(CDR(res));
}
else {
/* symbol was not found in the given env module. Try to find it in
......@@ -446,7 +466,7 @@ SCM STk_lookup(SCM symbol, SCM env, SCM *ref, int err_if_unbound)
res = STk_hash_get_variable(&MODULE_HASH_TABLE(module), symbol, &i);
if (res && VISIBLE_P(symbol, module)) {
*ref = res;
return CDR(res);
return BOX_VALUE(CDR(res));
}
}
......@@ -516,8 +536,9 @@ int STk_late_init_env(void)
ADD_PRIMITIVE(module_symbols);
ADD_PRIMITIVE(all_modules);
ADD_PRIMITIVE(symbol_define);
ADD_PRIMITIVE(symbol_value);
ADD_PRIMITIVE(symbol_define);
ADD_PRIMITIVE(symbol_alias);
return TRUE;
......
......@@ -2,7 +2,7 @@
*
* h a s h . c -- Hash Tables (mostly SRFI-69)
*
* Copyright © 1994-2006 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
* Copyright © 1994-2007 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
*
+=============================================================================
! This code is a rewriting of the file tclHash.c of the Tcl
......@@ -36,7 +36,7 @@
*
* Author: Erick Gallesio [eg@kaolin.unice.fr]
* Creation date: 17-Jan-1994 17:49
* Last file update: 12-Apr-2006 12:43 (eg)
* Last file update: 11-Apr-2007 17:57 (eg)
*/
#include "stklos.h"
......@@ -355,6 +355,32 @@ void STk_hash_set_variable(struct hash_table_obj *h, SCM v, SCM value)
z = STk_hash_get_variable(h, v, &index);
if (z) {
/* Variable already exists. Change its value*/
BOX_VALUE(CDR(z)) = value;
} else {
SCM z;
/* Create a new box or this value */
NEWCELL(z, box); BOX_VALUE(z) = value;
/* Enter the new variable in table */
HASH_BUCKETS(h)[index] = STk_cons(STk_cons(v, z),
HASH_BUCKETS(h)[index]);
HASH_NENTRIES(h) += 1;
/* If the table has exceeded a decent size, rebuild it */
if (HASH_NENTRIES(h) >= HASH_NEWSIZE(h)) enlarge_table(h);
}
}
void STk_hash_set_alias(struct hash_table_obj *h, SCM v, SCM value)
{
SCM z;
int index;
z = STk_hash_get_variable(h, v, &index);
if (z) {
/* Variable already exists. Change its value*/
CDR(z) = value;
......@@ -369,6 +395,8 @@ void STk_hash_set_variable(struct hash_table_obj *h, SCM v, SCM value)
}
/*===========================================================================*\
*
* Utilities on hash tables
......
......@@ -2,7 +2,7 @@
*
* h a s h . h -- Hash Tables
*
* Copyright © 1994-2000 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
* Copyright © 1994-2007 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
*
+=============================================================================
! This code is a rewriting of the file tclHash.c of the Tcl
......@@ -34,7 +34,7 @@
*
* Author: Erick Gallesio [eg@kaolin.unice.fr]
* Creation date: 17-Jan-1994 17:49
* Last file update: 14-Dec-2000 22:50 (eg)
* Last file update: 11-Apr-2007 17:58 (eg)
*/
......@@ -95,6 +95,7 @@ SCM STk_hash_intern_symbol(struct hash_table_obj *h, char *s,
*/
SCM STk_hash_get_variable(struct hash_table_obj *h, SCM v, int *index);
void STk_hash_set_variable(struct hash_table_obj *h, SCM v, SCM value);
void STk_hash_set_alias(struct hash_table_obj *h, SCM v, SCM value);
/*
* Utilities on hash tables
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: ??-Oct-1993 ??:??
* Last file update: 10-Jan-2007 11:09 (eg)
* Last file update: 11-Apr-2007 15:41 (eg)
*
*/
#include <ctype.h>
......@@ -189,6 +189,11 @@ void STk_print(SCM exp, SCM port, int mode)
case tc_string:
printstring(exp, port, mode);
return;
case tc_box: /* Should never occur in user code */
STk_putc('{', port);
STk_print(BOX_VALUE(exp), port, mode);
STk_putc('}', port);
break;
case tc_subr0: /* ==================> Utiliser un type tendu //FIXME */
case tc_subr1:
case tc_subr2:
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 28-Dec-1999 22:58 (eg)
* Last file update: 14-Mar-2007 15:14 (eg)
* Last file update: 11-Apr-2007 16:43 (eg)
*/
......@@ -179,7 +179,7 @@ typedef enum {
tc_hash_table, tc_port, tc_frame, tc_next_method, tc_promise, /* 25 */
tc_regexp, tc_process, tc_continuation, tc_values, tc_parameter, /* 30 */
tc_socket, tc_struct_type, tc_struct, tc_thread, tc_mutex, /* 35 */
tc_condv, /* 40 */
tc_condv, tc_box, /* 40 */
tc_last_standard /* must be last as indicated by its name */
} type_cell;
......@@ -408,6 +408,14 @@ void STk_signal(char *str);
----
------------------------------------------------------------------------------
*/
struct box_obj { /* A simple box (used for global variables */
stk_header header;
SCM value;
};
#define BOXP(p) (BOXED_TYPE_EQ((p), tc_box))
#define BOX_VALUE(p) (((struct box_obj *) (p))->value)
struct frame_obj {
stk_header header;
SCM next_frame;
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 1-Mar-2000 19:51 (eg)
* Last file update: 23-Feb-2007 23:01 (eg)
* Last file update: 11-Apr-2007 17:16 (eg)
*/
// INLINER values
......@@ -885,10 +885,10 @@ CASE(GLOBAL_REF) {
vm->val = STk_lookup(fetch_const(), vm->env, &ref, TRUE);
/* patch the code for optimize next accesses */
MUT_LOCK(global_lock);
vm->pc[-2] = (vm->pc[-2] == GLOBAL_REF) ? UGLOBAL_REF: PUSH_UGLOBAL_REF;
vm->pc[-1] = add_global(&CDR(ref));
MUT_UNLOCK(global_lock);
// MUT_LOCK(global_lock);
// vm->pc[-2] = (vm->pc[-2] == GLOBAL_REF) ? UGLOBAL_REF: PUSH_UGLOBAL_REF;
// vm->pc[-1] = add_global(&CDR(ref));
// MUT_UNLOCK(global_lock);
NEXT1;
}
......@@ -905,10 +905,10 @@ CASE(GLOBAL_REF_PUSH) {
push(STk_lookup(fetch_const(), vm->env, &ref, TRUE));
/* patch the code for optimize next accesses */
MUT_LOCK(global_lock);
vm->pc[-2] = UGLOBAL_REF_PUSH;
vm->pc[-1] = add_global(&CDR(ref));
MUT_UNLOCK(global_lock);
// MUT_LOCK(global_lock);
// vm->pc[-2] = UGLOBAL_REF_PUSH;
// vm->pc[-1] = add_global(&CDR(ref));
// MUT_UNLOCK(global_lock);
NEXT1;
}
CASE(UGLOBAL_REF_PUSH) {
......@@ -927,10 +927,10 @@ CASE(GREF_INVOKE) {
vm->val = STk_lookup(fetch_const(), vm->env, &ref, TRUE);
nargs = fetch_next();
/* patch the code for optimize next accesses (pc[-1] is already equal to nargs)*/
MUT_LOCK(global_lock);
vm->pc[-3] = (vm->pc[-3] == GREF_INVOKE)? UGREF_INVOKE : PUSH_UGREF_INVOKE;
vm->pc[-2] = add_global(&CDR(ref));
MUT_UNLOCK(global_lock);
// MUT_LOCK(global_lock);
// vm->pc[-3] = (vm->pc[-3] == GREF_INVOKE)? UGREF_INVOKE : PUSH_UGREF_INVOKE;
// vm->pc[-2] = add_global(&CDR(ref));
// MUT_UNLOCK(global_lock);
/*and now invoke */
tailp=FALSE; goto FUNCALL;
......@@ -954,11 +954,11 @@ CASE(GREF_TAIL_INVOKE) {
vm->val = STk_lookup(fetch_const(), vm->env, &ref, TRUE);
nargs = fetch_next();
/* patch the code for optimize next accesses (pc[-1] is already equal to nargs)*/
MUT_LOCK(global_lock);
vm->pc[-3] = (vm->pc[-3] == GREF_TAIL_INVOKE) ?
UGREF_TAIL_INVOKE: PUSH_UGREF_TAIL_INV;
vm->pc[-2] = add_global(&CDR(ref));
MUT_UNLOCK(global_lock);
// MUT_LOCK(global_lock);
// vm->pc[-3] = (vm->pc[-3] == GREF_TAIL_INVOKE) ?
// UGREF_TAIL_INVOKE: PUSH_UGREF_TAIL_INV;
// vm->pc[-2] = add_global(&CDR(ref));
// MUT_UNLOCK(global_lock);
/* and now invoke */
tailp=TRUE; goto FUNCALL;
......@@ -1036,12 +1036,12 @@ CASE(GLOBAL_SET) {
SCM ref;
STk_lookup(fetch_const(), vm->env, &ref, TRUE);
CDR(ref) = vm->val;
BOX_VALUE(CDR(ref)) = vm->val;
/* patch the code for optimize next accesses */
MUT_LOCK(global_lock);
vm->pc[-2] = UGLOBAL_SET;
vm->pc[-1] = add_global(&CDR(ref));
MUT_UNLOCK(global_lock);
// MUT_LOCK(global_lock);
// vm->pc[-2] = UGLOBAL_SET;
// vm->pc[-1] = add_global(&CDR(ref));
// MUT_UNLOCK(global_lock);
NEXT0;
}
CASE(UGLOBAL_SET) { /* Never produced by compiler */
......@@ -1295,16 +1295,14 @@ CASE(MAKE_EXPANDER) {
SCM name = fetch_const();
SCM ref, val;
STk_lookup(STk_intern("*expander-list*"), STk_current_module(), &ref, TRUE);
val = CDR(ref);
val = STk_lookup(STk_intern("*expander-list*"), STk_current_module(), &ref, TRUE);
if ( ! (CONSP(val) &&CONSP(CDR(val)) && (CAR(CAR(val)) == name)) ) {
/* We are just compiling this macro, so it is already entered in the
* table of expanders by the compiler. Don't add it twice.
* Note: if this test is false, this is probably that wa are reading
* back a bytecode file and the macro must be entered in the table
*/
CDR(ref) = STk_cons(STk_cons(name, vm->val), val);
BOX_VALUE(CDR(ref)) = STk_cons(STk_cons(name, vm->val), val);
}
vm->valc = 2;
vm->val = STk_void;
......
......@@ -22,7 +22,7 @@
#
# Author: Erick Gallesio [eg@unice.fr]
# Creation date: 27-Jul-2000 23:58 (eg)
# Last file update: 15-Apr-2006 09:52 (eg)
# Last file update: 12-Apr-2007 12:12 (eg)
prefix=@prefix@
......@@ -61,7 +61,7 @@ while test $# -gt 0; do
echo @VERSION@
;;
--compile|-c)
echo @CC@ @SH_COMP_FLAGS@ -I${prefix}/include/@PACKAGE@
echo @CC@ @SH_COMP_FLAGS@ -I${prefix}/include/@PACKAGE@ -I${prefix}/include/@PACKAGE@/gc
;;
--link|-l)
echo @SH_LOADER@ @SH_LOAD_FLAGS@
......
......@@ -2,7 +2,7 @@
# -*- shell-script -*-
# stklos-install -- Install STklos extensions
#
# Copyright 2001-2005 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
# Copyright 2001-2007 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
#
#
# This program is free software; you can redistribute it and/or modify
......@@ -22,7 +22,7 @@
#
# Author: Erick Gallesio [eg@essi.fr]
# Creation date: 18-Mar-2005 13:26 (eg)
# Last file update: 23-May-2005 14:40 (eg)
# Last file update: 12-Apr-2007 12:12 (eg)
#
DISTURL="http://www.stklos.net/download/extensions"
......@@ -128,7 +128,7 @@ function install_package()
cat $pkg.stgz | (cd $TMP; tar xvfz -)
(eval "cd ${BUILDDIR}*";
trace "Configuring package ..." && configure &&
trace "Configuring package ..." && ./configure &&
trace "Make package ..." && make &&
trace "Installing package ..." && make install)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment