[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Requests for API changes
|
From: |
Dirk Herrmann |
|
Subject: |
Re: Requests for API changes |
|
Date: |
Thu, 7 Sep 2000 12:08:43 +0200 (MEST) |
Hi!
I have already prepared a patch that incorporates the proposed changes and
even some more. This, however, is just a partial move towards
incorporating the environments into guile. The advantage is, that this
patch already provides a lot of the improvements, while the cvs version of
guile will still be in a usable state. There are some incompatible
changes to the interface, but this can't be avoided anyway when the
environments are fully integrated. I think, however, that most of the
functions which have disappeared or which have slightly changed are not
widely used anyway. If someone thinks otherwise, please tell me.
I will wait for approval by the maintainers before I apply that
patch. As usual, comments are welcome. Below is the patch with some
remarks.
Best regards
Dirk
------------------
User visible changes are:
* remove scm_m_atfop, and the corresponding @fop syntax.
* eliminate the slot parameter from scm_makstr and scm_makfromstr.
* eliminate the macros SCM_SYMBOL_SLOTS, SCM_SLOTS, SCM_SYMBOL_FUNC,
SCM_SET_SYMBOL_FUNC, SCM_SYMBOL_PROPS and SCM_SET_SYMBOL_PROPS
* eliminate the hash-table size parameter from scm_strhash
* make scm_intern_obarray_soft static
* eliminate the functions scm_symbol_value0, scm_symbol_set_x,
scm_symbol_fref, scm_symbol_pref, scm_symbol_fset_x and scm_symbol_pset_x as
well as the corresponding scheme level functions symbol-set!, symbol-fref,
symbol-pref, symbol-fset! and symbol-pset!
* eliminate the type tags scm_tc7_ssymbol and scm_tc7_msymbol and replace them
by a common scm_tc7_symbol tag. Further, eliminate the scm_tcs_symbols
macro.
Implementation details:
* symbol properties are implemented by using the generic property functions.
* symbols are double cells <type/length, char*, rawhash, <unused>>
Index: ice-9/boot-9.scm
===================================================================
RCS file: /cvs/guile/guile-core/ice-9/boot-9.scm,v
retrieving revision 1.214
diff -u -r1.214 boot-9.scm
--- ice-9/boot-9.scm 2000/09/03 20:20:19 1.214
+++ ice-9/boot-9.scm 2000/09/07 09:19:52
@@ -135,25 +135,9 @@
(else (apply logior args))))
-;;; {Symbol Properties}
-;;;
-(define (symbol-property sym prop)
- (let ((pair (assoc prop (symbol-pref sym))))
- (and pair (cdr pair))))
-
-(define (set-symbol-property! sym prop val)
- (let ((pair (assoc prop (symbol-pref sym))))
- (if pair
- (set-cdr! pair val)
- (symbol-pset! sym (acons prop val (symbol-pref sym))))))
-
-(define (symbol-property-remove! sym prop)
- (let ((pair (assoc prop (symbol-pref sym))))
- (if pair
- (symbol-pset! sym (delq! pair (symbol-pref sym))))))
-
;;; {General Properties}
+;;;
;; This is a more modern interface to properties. It will replace all
;; other property-like things eventually.
@@ -163,6 +147,44 @@
(make-procedure-with-setter
(lambda (obj) (primitive-property-ref prop obj))
(lambda (obj val) (primitive-property-set! prop obj val)))))
+
+;;; {Symbol Properties}
+;;;
+
+(define symbol-property #f)
+(define set-symbol-property! #f)
+(define symbol-property-remove! #f)
+
+(let* ((object-property (make-object-property)))
+
+ (define (symbol-property-alist sym)
+ (if (symbol? sym)
+ (let* ((property-alist (object-property sym)))
+ (if property-alist
+ property-alist
+ '()))
+ (error 'wrong-type-argument sym)))
+
+ (set! symbol-property
+ (lambda (sym prop)
+ (let* ((alist (symbol-property-alist sym))
+ (pair (assoc prop alist)))
+ (and pair (cdr pair)))))
+
+ (set! set-symbol-property!
+ (lambda (sym prop val)
+ (let* ((alist (symbol-property-alist sym))
+ (pair (assoc prop alist)))
+ (if pair
+ (set-cdr! pair val)
+ (set! (object-property sym) (acons prop val alist))))))
+
+ (set! symbol-property-remove!
+ (lambda (sym prop)
+ (let* ((alist (symbol-property-alist sym))
+ (pair (assoc prop alist)))
+ (if pair
+ (set! (object-property sym) (delq! pair alist)))))))
Index: ice-9/syncase.scm
===================================================================
RCS file: /cvs/guile/guile-core/ice-9/syncase.scm,v
retrieving revision 1.15
diff -u -r1.15 syncase.scm
--- ice-9/syncase.scm 2000/08/13 20:26:49 1.15
+++ ice-9/syncase.scm 2000/09/07 09:19:52
@@ -97,7 +97,7 @@
(let* ((m (current-module))
(v (or (module-variable m symbol)
(module-make-local-var! m symbol))))
- (if (assq 'primitive-syntax (symbol-pref symbol))
+ (if (symbol-property symbol 'primitive-syntax)
(if (eq? (current-module) the-syncase-module)
(set-object-property! (module-variable the-root-module symbol)
key
Index: libguile/dynl.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/dynl.c,v
retrieving revision 1.48
diff -u -r1.48 dynl.c
--- libguile/dynl.c 2000/08/11 15:12:37 1.48
+++ libguile/dynl.c 2000/09/07 09:19:52
@@ -127,7 +127,7 @@
{
SCM_ASSERT (SCM_ROSTRINGP (rostr), rostr, argn, subr);
if (SCM_SUBSTRP (rostr))
- rostr = scm_makfromstr (SCM_ROCHARS (rostr), SCM_ROLENGTH (rostr), 0);
+ rostr = scm_makfromstr (SCM_ROCHARS (rostr), SCM_ROLENGTH (rostr));
return rostr;
}
Index: libguile/eval.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/eval.c,v
retrieving revision 1.170
diff -u -r1.170 eval.c
--- libguile/eval.c 2000/09/02 23:21:57 1.170
+++ libguile/eval.c 2000/09/07 09:19:55
@@ -1119,20 +1119,6 @@
return scm_cons (SCM_IM_1_IFY, SCM_CDR (xorig));
}
-SCM_SYNTAX (s_atfop, "@fop", scm_makmmacro, scm_m_atfop);
-
-SCM
-scm_m_atfop (SCM xorig, SCM env)
-{
- SCM x = SCM_CDR (xorig), vcell;
- SCM_ASSYNT (scm_ilength (x) >= 1, xorig, scm_s_expression, "@fop");
- vcell = scm_symbol_fref (SCM_CAR (x));
- SCM_ASSYNT (SCM_CONSP (vcell), x,
- "Symbol's function definition is void", NULL);
- SCM_SET_CELL_WORD_0 (x, SCM_UNPACK (vcell) + scm_tc3_cons_gloc);
- return x;
-}
-
SCM_SYNTAX (s_atbind, "@bind", scm_makmmacro, scm_m_atbind);
SCM
@@ -1913,7 +1899,7 @@
SCM_TICK;
switch (SCM_TYP7 (x))
{
- case scm_tcs_symbols:
+ case scm_tc7_symbol:
/* Only happens when called at top level.
*/
x = scm_cons (x, SCM_UNDEFINED);
@@ -3628,6 +3614,7 @@
}
if (elt_len != len)
+ /* Dirk:FIXME:: is 'out-of-range an appropriate error type here? */
scm_out_of_range (who, ve[i]);
}
Index: libguile/eval.h
===================================================================
RCS file: /cvs/guile/guile-core/libguile/eval.h,v
retrieving revision 1.44
diff -u -r1.44 eval.h
--- libguile/eval.h 2000/08/11 08:43:00 1.44
+++ libguile/eval.h 2000/09/07 09:19:55
@@ -219,7 +219,6 @@
extern SCM scm_m_0_cond (SCM xorig, SCM env);
extern SCM scm_m_0_ify (SCM xorig, SCM env);
extern SCM scm_m_1_ify (SCM xorig, SCM env);
-extern SCM scm_m_atfop (SCM xorig, SCM env);
extern SCM scm_m_atbind (SCM xorig, SCM env);
extern int scm_badargsp (SCM formals, SCM args);
extern SCM scm_ceval (SCM x, SCM env);
Index: libguile/filesys.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/filesys.c,v
retrieving revision 1.80
diff -u -r1.80 filesys.c
--- libguile/filesys.c 2000/08/18 17:12:37 1.80
+++ libguile/filesys.c 2000/09/07 09:19:57
@@ -544,12 +544,10 @@
SCM_VALIDATE_ROSTRING (1,oldpath);
if (SCM_SUBSTRP (oldpath))
- oldpath = scm_makfromstr (SCM_ROCHARS (oldpath),
- SCM_ROLENGTH (oldpath), 0);
+ oldpath = scm_makfromstr (SCM_ROCHARS (oldpath), SCM_ROLENGTH (oldpath));
SCM_VALIDATE_ROSTRING (2,newpath);
if (SCM_SUBSTRP (newpath))
- newpath = scm_makfromstr (SCM_ROCHARS (newpath),
- SCM_ROLENGTH (newpath), 0);
+ newpath = scm_makfromstr (SCM_ROCHARS (newpath), SCM_ROLENGTH (newpath));
SCM_SYSCALL (val = link (SCM_ROCHARS (oldpath), SCM_ROCHARS (newpath)));
if (val != 0)
SCM_SYSERROR;
@@ -700,7 +698,7 @@
SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CELL_WORD_1 (port)));
if (errno != 0)
SCM_SYSERROR;
- return (rdent ? scm_makfromstr (rdent->d_name, NAMLEN (rdent), 0)
+ return (rdent ? scm_makfromstr (rdent->d_name, NAMLEN (rdent))
: SCM_EOF_VAL);
}
#undef FUNC_NAME
@@ -808,7 +806,7 @@
}
if (rv == 0)
SCM_SYSERROR;
- result = scm_makfromstr (wd, strlen (wd), 0);
+ result = scm_makfromstr (wd, strlen (wd));
scm_must_free (wd);
return result;
}
@@ -1239,7 +1237,7 @@
}
if (rv == -1)
SCM_SYSERROR;
- result = scm_makfromstr (buf, rv, 0);
+ result = scm_makfromstr (buf, rv);
scm_must_free (buf);
return result;
}
@@ -1287,10 +1285,10 @@
SCM_VALIDATE_ROSTRING (1,oldfile);
if (SCM_SUBSTRP (oldfile))
- oldfile = scm_makfromstr (SCM_ROCHARS (oldfile), SCM_ROLENGTH (oldfile),
0);
+ oldfile = scm_makfromstr (SCM_ROCHARS (oldfile), SCM_ROLENGTH (oldfile));
SCM_VALIDATE_ROSTRING (2,newfile);
if (SCM_SUBSTRP (newfile))
- newfile = scm_makfromstr (SCM_ROCHARS (newfile), SCM_ROLENGTH (newfile),
0);
+ newfile = scm_makfromstr (SCM_ROCHARS (newfile), SCM_ROLENGTH (newfile));
if (stat (SCM_ROCHARS (oldfile), &oldstat) == -1)
SCM_SYSERROR;
oldfd = open (SCM_ROCHARS (oldfile), O_RDONLY);
Index: libguile/fports.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/fports.c,v
retrieving revision 1.79
diff -u -r1.79 fports.c
--- libguile/fports.c 2000/06/13 00:49:40 1.79
+++ libguile/fports.c 2000/09/07 09:19:57
@@ -279,9 +279,9 @@
SCM_VALIDATE_ROSTRING (1,filename);
SCM_VALIDATE_ROSTRING (2,modes);
if (SCM_SUBSTRP (filename))
- filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH
(filename), 0);
+ filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH
(filename));
if (SCM_SUBSTRP (modes))
- modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_ROLENGTH (modes), 0);
+ modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_ROLENGTH (modes));
file = SCM_ROCHARS (filename);
mode = SCM_ROCHARS (modes);
Index: libguile/gc.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/gc.c,v
retrieving revision 1.153
diff -u -r1.153 gc.c
--- libguile/gc.c 2000/09/02 21:52:35 1.153
+++ libguile/gc.c 2000/09/07 09:19:58
@@ -1313,11 +1353,7 @@
}
break;
- case scm_tc7_msymbol:
- scm_gc_mark (SCM_SYMBOL_FUNC (ptr));
- ptr = SCM_SYMBOL_PROPS (ptr);
- goto gc_mark_loop;
- case scm_tc7_ssymbol:
+ case scm_tc7_symbol:
case scm_tcs_subrs:
break;
case scm_tc7_port:
@@ -1653,16 +1689,11 @@
case scm_tc7_string:
m += SCM_HUGE_LENGTH (scmptr) + 1;
goto freechars;
- case scm_tc7_msymbol:
- m += (SCM_LENGTH (scmptr) + 1
- + (SCM_CHARS (scmptr) - (char *) SCM_SLOTS (scmptr)));
- scm_must_free ((char *)SCM_SLOTS (scmptr));
- break;
case scm_tc7_contin:
m += SCM_LENGTH (scmptr) * sizeof (SCM_STACKITEM) + sizeof
(scm_contregs);
if (SCM_VELTS (scmptr))
goto freechars;
- case scm_tc7_ssymbol:
+ case scm_tc7_symbol:
break;
case scm_tcs_subrs:
/* the various "subrs" (primitives) are never freed */
@@ -2515,7 +2546,7 @@
SCM_SETCDR (scm_undefineds, scm_undefineds);
scm_listofnull = scm_cons (SCM_EOL, SCM_EOL);
- scm_nullstr = scm_makstr (0L, 0);
+ scm_nullstr = scm_makstr (0);
scm_nullvect = scm_make_vector (SCM_INUM0, SCM_UNDEFINED);
scm_symhash = scm_make_vector (SCM_MAKINUM (scm_symhash_dim), SCM_EOL);
scm_weak_symhash = scm_make_weak_key_hash_table (SCM_MAKINUM
(scm_symhash_dim));
Index: libguile/gdbint.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/gdbint.c,v
retrieving revision 1.35
diff -u -r1.35 gdbint.c
--- libguile/gdbint.c 2000/08/27 03:34:27 1.35
+++ libguile/gdbint.c 2000/09/07 09:20:00
@@ -328,7 +328,7 @@
s);
gdb_input_port = scm_permanent_object (port);
- tok_buf = scm_permanent_object (scm_makstr (30L, 0));
+ tok_buf = scm_permanent_object (scm_makstr (30));
}
/*
Index: libguile/gh_data.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/gh_data.c,v
retrieving revision 1.39
diff -u -r1.39 gh_data.c
--- libguile/gh_data.c 2000/09/05 18:39:54 1.39
+++ libguile/gh_data.c 2000/09/07 09:20:00
@@ -93,7 +93,7 @@
SCM
gh_str2scm (const char *s, int len)
{
- return scm_makfromstr (s, len, 0);
+ return scm_makfromstr (s, len);
}
SCM
gh_str02scm (const char *s)
Index: libguile/hash.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/hash.c,v
retrieving revision 1.30
diff -u -r1.30 hash.c
--- libguile/hash.c 2000/05/23 22:23:56 1.30
+++ libguile/hash.c 2000/09/07 09:20:00
@@ -116,10 +116,10 @@
case scm_tc16_complex:
obj = scm_number_to_string(obj, SCM_MAKINUM(10));
}
- case scm_tcs_symbols:
+ case scm_tc7_symbol:
case scm_tc7_string:
case scm_tc7_substring:
- return scm_strhash(SCM_ROUCHARS(obj), (scm_sizet) SCM_ROLENGTH(obj), n);
+ return scm_strhash (SCM_ROUCHARS(obj), (scm_sizet) SCM_ROLENGTH(obj)) %
n;
case scm_tc7_wvect:
case scm_tc7_vector:
{
Index: libguile/load.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/load.c,v
retrieving revision 1.45
diff -u -r1.45 load.c
--- libguile/load.c 2000/08/11 08:43:49 1.45
+++ libguile/load.c 2000/09/07 09:20:00
@@ -129,7 +129,7 @@
{ /* scope */
SCM port, save_port;
port = scm_open_file (filename,
- scm_makfromstr ("r", (scm_sizet) sizeof (char), 0));
+ scm_makfromstr ("r", (scm_sizet) sizeof (char)));
save_port = port;
scm_internal_dynamic_wind (swap_port,
load,
@@ -210,7 +210,7 @@
/* Scan back to the beginning of the current element. */
do scan--;
while (scan >= path && *scan != ':');
- tail = scm_cons (scm_makfromstr (scan + 1, elt_end - (scan + 1), 0),
+ tail = scm_cons (scm_makfromstr (scan + 1, elt_end - (scan + 1)),
tail);
elt_end = scan;
} while (scan >= path);
@@ -388,7 +388,7 @@
if (stat (buf, &mode) == 0
&& ! (mode.st_mode & S_IFDIR))
{
- result = scm_makfromstr (buf, len + ext_len, 0);
+ result = scm_makfromstr (buf, len + ext_len);
goto end;
}
}
Index: libguile/net_db.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/net_db.c,v
retrieving revision 1.44
diff -u -r1.44 net_db.c
--- libguile/net_db.c 2000/08/18 16:52:15 1.44
+++ libguile/net_db.c 2000/09/07 09:20:01
@@ -95,7 +95,7 @@
SCM_VALIDATE_ROSTRING (1,address);
if (SCM_SUBSTRP (address))
- address = scm_makfromstr (SCM_ROCHARS (address), SCM_ROLENGTH (address),
0);
+ address = scm_makfromstr (SCM_ROCHARS (address), SCM_ROLENGTH (address));
if (inet_aton (SCM_ROCHARS (address), &soka) == 0)
SCM_MISC_ERROR ("bad address", SCM_EOL);
return scm_ulong2num (ntohl (soka.s_addr));
@@ -117,7 +117,7 @@
SCM answer;
addr.s_addr = htonl (SCM_NUM2ULONG (1,inetid));
s = inet_ntoa (addr);
- answer = scm_makfromstr (s, strlen (s), 0);
+ answer = scm_makfromstr (s, strlen (s));
return answer;
}
#undef FUNC_NAME
@@ -288,8 +288,7 @@
if (!entry)
scm_resolv_error (FUNC_NAME, host);
- ve[0] = scm_makfromstr (entry->h_name,
- (scm_sizet) strlen (entry->h_name), 0);
+ ve[0] = scm_makfromstr (entry->h_name, (scm_sizet) strlen (entry->h_name));
ve[1] = scm_makfromstrs (-1, entry->h_aliases);
ve[2] = SCM_MAKINUM (entry->h_addrtype + 0L);
ve[3] = SCM_MAKINUM (entry->h_length + 0L);
@@ -363,7 +362,7 @@
if (!entry)
SCM_SYSERROR_MSG ("no such network ~A",
scm_listify (net, SCM_UNDEFINED), errno);
- ve[0] = scm_makfromstr (entry->n_name, (scm_sizet) strlen (entry->n_name),
0);
+ ve[0] = scm_makfromstr (entry->n_name, (scm_sizet) strlen (entry->n_name));
ve[1] = scm_makfromstrs (-1, entry->n_aliases);
ve[2] = SCM_MAKINUM (entry->n_addrtype + 0L);
ve[3] = scm_ulong2num (entry->n_net + 0L);
@@ -415,7 +414,7 @@
if (!entry)
SCM_SYSERROR_MSG ("no such protocol ~A",
scm_listify (protocol, SCM_UNDEFINED), errno);
- ve[0] = scm_makfromstr (entry->p_name, (scm_sizet) strlen (entry->p_name),
0);
+ ve[0] = scm_makfromstr (entry->p_name, (scm_sizet) strlen (entry->p_name));
ve[1] = scm_makfromstrs (-1, entry->p_aliases);
ve[2] = SCM_MAKINUM (entry->p_proto + 0L);
return ans;
@@ -431,10 +430,10 @@
ans = scm_make_vector (SCM_MAKINUM (4), SCM_UNSPECIFIED);
ve = SCM_VELTS (ans);
- ve[0] = scm_makfromstr (entry->s_name, (scm_sizet) strlen (entry->s_name),
0);
+ ve[0] = scm_makfromstr (entry->s_name, (scm_sizet) strlen (entry->s_name));
ve[1] = scm_makfromstrs (-1, entry->s_aliases);
ve[2] = SCM_MAKINUM (ntohs (entry->s_port) + 0L);
- ve[3] = scm_makfromstr (entry->s_proto, (scm_sizet) strlen (entry->s_proto),
0);
+ ve[3] = scm_makfromstr (entry->s_proto, (scm_sizet) strlen (entry->s_proto));
return ans;
}
Index: libguile/numbers.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/numbers.c,v
retrieving revision 1.101
diff -u -r1.101 numbers.c
--- libguile/numbers.c 2000/08/12 23:15:48 1.101
+++ libguile/numbers.c 2000/09/07 09:20:03
@@ -2178,7 +2205,7 @@
scm_sizet radct = 0;
scm_sizet ch; /* jeh */
SCM_BIGDIG radpow = 1, radmod = 0;
- SCM ss = scm_makstr ((long) j, 0);
+ SCM ss = scm_makstr (j);
char *s = SCM_CHARS (ss), c;
while ((long) radpow * radix < SCM_BIGRAD)
{
@@ -2234,12 +2261,12 @@
if (SCM_INUMP (n)) {
char num_buf [SCM_INTBUFLEN];
scm_sizet length = scm_iint2str (SCM_INUM (n), base, num_buf);
- return scm_makfromstr (num_buf, length, 0);
+ return scm_makfromstr (num_buf, length);
} else if (SCM_BIGP (n)) {
return big2str (n, (unsigned int) base);
} else if (SCM_INEXACTP (n)) {
char num_buf [SCM_FLOBUFLEN];
- return scm_makfromstr (num_buf, iflo2str (n, num_buf), 0);
+ return scm_makfromstr (num_buf, iflo2str (n, num_buf));
} else {
SCM_WRONG_TYPE_ARG (1, n);
}
Index: libguile/objects.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/objects.c,v
retrieving revision 1.46
diff -u -r1.46 objects.c
--- libguile/objects.c 2000/08/27 03:20:48 1.46
+++ libguile/objects.c 2000/09/07 09:20:03
@@ -120,7 +120,7 @@
return scm_class_pair;
case scm_tcs_closures:
return scm_class_procedure;
- case scm_tcs_symbols:
+ case scm_tc7_symbol:
return scm_class_symbol;
case scm_tc7_vector:
case scm_tc7_wvect:
@@ -457,7 +457,7 @@
SCM_VALIDATE_STRING (2,layout);
pl = SCM_PACK (SCM_STRUCT_DATA (class) [scm_vtable_index_layout]);
/* Convert symbol->string */
- pl = scm_makfromstr (SCM_CHARS (pl), (scm_sizet) SCM_LENGTH (pl), 0);
+ pl = scm_makfromstr (SCM_CHARS (pl), (scm_sizet) SCM_LENGTH (pl));
return scm_i_make_class_object (SCM_STRUCT_VTABLE (class),
scm_string_append (SCM_LIST2 (pl, layout)),
SCM_CLASS_FLAGS (class));
Index: libguile/ports.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/ports.c,v
retrieving revision 1.114
diff -u -r1.114 ports.c
--- libguile/ports.c 2000/08/25 17:33:01 1.114
+++ libguile/ports.c 2000/09/07 09:20:04
@@ -289,7 +289,7 @@
if (pt->read_buf == pt->putback_buf)
count += pt->saved_read_end - pt->saved_read_pos;
- result = scm_makstr (count, 0);
+ result = scm_makstr (count);
dst = SCM_CHARS (result);
while (pt->read_pos < pt->read_end)
@@ -596,7 +596,7 @@
strcpy (modes, "w");
if (SCM_CELL_WORD_0 (port) & SCM_BUF0)
strcat (modes, "0");
- return scm_makfromstr (modes, strlen (modes), 0);
+ return scm_makfromstr (modes, strlen (modes));
}
#undef FUNC_NAME
Index: libguile/posix.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/posix.c,v
retrieving revision 1.70
diff -u -r1.70 posix.c
--- libguile/posix.c 2000/09/02 23:20:40 1.70
+++ libguile/posix.c 2000/09/07 09:20:05
@@ -266,7 +266,7 @@
{
SCM_VALIDATE_ROSTRING (1,user);
if (SCM_SUBSTRP (user))
- user = scm_makfromstr (SCM_ROCHARS (user), SCM_ROLENGTH (user), 0);
+ user = scm_makfromstr (SCM_ROCHARS (user), SCM_ROLENGTH (user));
entry = getpwnam (SCM_ROCHARS (user));
}
if (!entry)
@@ -1102,7 +1102,7 @@
SCM_VALIDATE_ROSTRING (1,path);
if (SCM_SUBSTRP (path))
- path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
+ path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path));
SCM_VALIDATE_INUM (2,how);
rv = access (SCM_ROCHARS (path), SCM_INUM (how));
return SCM_NEGATE_BOOL(rv);
Index: libguile/print.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/print.c,v
retrieving revision 1.95
diff -u -r1.95 print.c
--- libguile/print.c 2000/08/27 03:20:55 1.95
+++ libguile/print.c 2000/09/07 09:20:05
@@ -479,7 +479,7 @@
scm_lfwrite (SCM_ROCHARS (exp), (scm_sizet) SCM_ROLENGTH (exp),
port);
break;
- case scm_tcs_symbols:
+ case scm_tc7_symbol:
{
int pos;
int end;
Index: libguile/read.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/read.c,v
retrieving revision 1.57
diff -u -r1.57 read.c
--- libguile/read.c 2000/08/06 22:04:11 1.57
+++ libguile/read.c 2000/09/07 09:20:05
@@ -112,7 +112,7 @@
return SCM_EOF_VAL;
scm_ungetc (c, port);
- tok_buf = scm_makstr (30L, 0);
+ tok_buf = scm_makstr (30);
return scm_lreadr (&tok_buf, port, ©);
}
#undef FUNC_NAME
@@ -472,7 +472,7 @@
SCM_CHARS (*tok_buf)[j] = 0;
{
SCM str;
- str = scm_makfromstr (SCM_CHARS (*tok_buf), j, 0);
+ str = scm_makfromstr (SCM_CHARS (*tok_buf), j);
return str;
}
Index: libguile/simpos.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/simpos.c,v
retrieving revision 1.34
diff -u -r1.34 simpos.c
--- libguile/simpos.c 2000/08/18 16:52:15 1.34
+++ libguile/simpos.c 2000/09/07 09:20:05
@@ -86,7 +86,7 @@
SCM_DEFER_INTS;
errno = 0;
if (SCM_ROSTRINGP (cmd))
- cmd = scm_makfromstr (SCM_ROCHARS (cmd), SCM_ROLENGTH (cmd), 0);
+ cmd = scm_makfromstr (SCM_ROCHARS (cmd), SCM_ROLENGTH (cmd));
rv = system(SCM_ROCHARS(cmd));
if (rv == -1 || (rv == 127 && errno != 0))
SCM_SYSERROR;
@@ -106,9 +106,9 @@
{
char *val;
SCM_VALIDATE_ROSTRING (1,nam);
- nam = scm_makfromstr (SCM_ROCHARS (nam), SCM_ROLENGTH (nam), 0);
+ nam = scm_makfromstr (SCM_ROCHARS (nam), SCM_ROLENGTH (nam));
val = getenv(SCM_CHARS(nam));
- return (val) ? scm_makfromstr(val, (scm_sizet)strlen(val), 0) : SCM_BOOL_F;
+ return (val) ? scm_makfromstr(val, (scm_sizet)strlen(val)) : SCM_BOOL_F;
}
#undef FUNC_NAME
Index: libguile/socket.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/socket.c,v
retrieving revision 1.53
diff -u -r1.53 socket.c
--- libguile/socket.c 2000/09/02 23:19:25 1.53
+++ libguile/socket.c 2000/09/07 09:20:06
@@ -560,7 +560,7 @@
ve = SCM_VELTS (result);
ve[0] = scm_ulong2num ((unsigned long) fam);
ve[1] = scm_makfromstr (nad->sun_path,
- (scm_sizet) strlen (nad->sun_path), 0);
+ (scm_sizet) strlen (nad->sun_path));
}
else
#endif
Index: libguile/stime.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/stime.c,v
retrieving revision 1.56
diff -u -r1.56 stime.c
--- libguile/stime.c 2000/09/02 23:19:25 1.56
+++ libguile/stime.c 2000/09/07 09:20:07
@@ -642,7 +642,7 @@
#endif
}
- result = scm_makfromstr (tbuf+1, len-1, 0);
+ result = scm_makfromstr (tbuf+1, len-1);
scm_must_free (tbuf);
scm_must_free(myfmt);
return result;
Index: libguile/strings.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/strings.c,v
retrieving revision 1.37
diff -u -r1.37 strings.c
--- libguile/strings.c 2000/09/02 23:18:13 1.37
+++ libguile/strings.c 2000/09/07 09:20:07
@@ -105,7 +105,7 @@
long i = scm_ilength (chrs);
SCM_ASSERT (i >= 0, chrs, SCM_ARGn, FUNC_NAME);
- result = scm_makstr (i, 0);
+ result = scm_makstr (i);
}
{
@@ -125,24 +125,15 @@
#undef FUNC_NAME
SCM
-scm_makstr (long len, int slots)
+scm_makstr (long len)
{
SCM s;
- scm_bits_t * mem;
+ void * mem;
SCM_NEWCELL (s);
- --slots;
SCM_REDEFER_INTS;
- mem = (scm_bits_t *) scm_must_malloc (sizeof (scm_bits_t) * (slots + 1)
- + len + 1, "scm_makstr");
- if (slots >= 0)
- {
- int x;
- mem[slots] = (scm_bits_t) mem;
- for (x = 0; x < slots; ++x)
- mem[x] = SCM_UNPACK (SCM_BOOL_F);
- }
- SCM_SETCHARS (s, (char *) (mem + slots + 1));
+ mem = scm_must_malloc (len + 1, "scm_makstr");
+ SCM_SETCHARS (s, mem);
SCM_SETLENGTH (s, len, scm_tc7_string);
SCM_REALLOW_INTS;
SCM_CHARS (s)[len] = 0;
@@ -160,7 +151,7 @@
if (0 > i)
for (i = 0; argv[i]; i++);
while (i--)
- lst = scm_cons (scm_makfromstr (argv[i], (scm_sizet) strlen (argv[i]), 0),
lst);
+ lst = scm_cons (scm_makfromstr (argv[i], (scm_sizet) strlen (argv[i])),
lst);
return lst;
}
@@ -194,9 +185,9 @@
}
SCM
-scm_makfromstr (const char *src, scm_sizet len, int slots)
+scm_makfromstr (const char *src, scm_sizet len)
{
- SCM s = scm_makstr (len, slots);
+ SCM s = scm_makstr (len);
char *dst = SCM_CHARS (s);
while (len--)
@@ -208,7 +199,7 @@
scm_makfrom0str (const char *src)
{
if (!src) return SCM_BOOL_F;
- return scm_makfromstr (src, (scm_sizet) strlen (src), 0);
+ return scm_makfromstr (src, (scm_sizet) strlen (src));
}
@@ -232,7 +223,7 @@
SCM res;
register long i;
SCM_VALIDATE_INUM_MIN_COPY (1,k,0,i);
- res = scm_makstr (i, 0);
+ res = scm_makstr (i);
if (!SCM_UNBNDP (chr))
{
SCM_VALIDATE_CHAR (2,chr);
@@ -308,7 +299,7 @@
to = SCM_INUM (end);
SCM_ASSERT_RANGE (3, end, from <= to && to <= SCM_ROLENGTH (str));
- return scm_makfromstr (&SCM_ROCHARS (str)[from], (scm_sizet) (to - from), 0);
+ return scm_makfromstr (&SCM_ROCHARS (str)[from], (scm_sizet) (to - from));
}
#undef FUNC_NAME
@@ -330,7 +321,7 @@
SCM_VALIDATE_STRINGORSUBSTR (SCM_ARGn,s);
i += SCM_ROLENGTH (s);
}
- res = scm_makstr (i, 0);
+ res = scm_makstr (i);
data = SCM_UCHARS (res);
for (l = args;SCM_NIMP (l);l = SCM_CDR (l)) {
s = SCM_CAR (l);
Index: libguile/strings.h
===================================================================
RCS file: /cvs/guile/guile-core/libguile/strings.h,v
retrieving revision 1.16
diff -u -r1.16 strings.h
--- libguile/strings.h 2000/06/12 12:28:24 1.16
+++ libguile/strings.h 2000/09/07 09:20:07
@@ -62,11 +62,11 @@
extern SCM scm_string_p (SCM x);
extern SCM scm_read_only_string_p (SCM x);
extern SCM scm_string (SCM chrs);
-extern SCM scm_makstr (long len, int slots);
+extern SCM scm_makstr (long len);
extern SCM scm_makfromstrs (int argc, char **argv);
extern SCM scm_take_str (char *s, int len);
extern SCM scm_take0str (char *s);
-extern SCM scm_makfromstr (const char *src, scm_sizet len, int slots);
+extern SCM scm_makfromstr (const char *src, scm_sizet len);
extern SCM scm_makfrom0str (const char *src);
extern SCM scm_makfrom0str_opt (const char *src);
extern SCM scm_make_string (SCM k, SCM chr);
Index: libguile/strop.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/strop.c,v
retrieving revision 1.40
diff -u -r1.40 strop.c
--- libguile/strop.c 2000/09/02 23:18:13 1.40
+++ libguile/strop.c 2000/09/07 09:20:07
@@ -343,7 +343,7 @@
#define FUNC_NAME s_scm_string_copy
{
SCM_VALIDATE_STRINGORSUBSTR (1,str);
- return scm_makfromstr (SCM_ROCHARS (str), (scm_sizet)SCM_ROLENGTH (str), 0);
+ return scm_makfromstr (SCM_ROCHARS (str), (scm_sizet)SCM_ROLENGTH (str));
}
#undef FUNC_NAME
Index: libguile/strports.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/strports.c,v
retrieving revision 1.61
diff -u -r1.61 strports.c
--- libguile/strports.c 2000/08/12 23:15:48 1.61
+++ libguile/strports.c 2000/09/07 09:20:07
@@ -299,7 +299,7 @@
if (pt->rw_active == SCM_PORT_WRITE)
st_flush (port);
- return scm_makfromstr ((char *) pt->read_buf, pt->read_buf_size, 0);
+ return scm_makfromstr ((char *) pt->read_buf, pt->read_buf_size);
}
SCM_DEFINE (scm_call_with_output_string, "call-with-output-string", 1, 0, 0,
@@ -333,7 +333,7 @@
SCM str;
SCM port;
- str = scm_makstr (0, 0);
+ str = scm_makstr (0);
port = scm_mkstrport (SCM_INUM0, str, SCM_OPN | SCM_WRTNG,
"scm_strprint_obj");
scm_prin1 (obj, port, 1);
{
Index: libguile/symbols.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/symbols.c,v
retrieving revision 1.49
diff -u -r1.49 symbols.c
--- libguile/symbols.c 2000/09/06 14:45:59 1.49
+++ libguile/symbols.c 2000/09/07 09:20:08
@@ -65,27 +65,36 @@
-
/* NUM_HASH_BUCKETS is the number of symbol scm_hash table buckets.
*/
#define NUM_HASH_BUCKETS 137
+static char *
+duplicate_string (const char * src)
+{
+ unsigned long length = strlen (src);
+ char * dst = scm_must_malloc (length + 1, "duplicate_string");
+ memcpy (dst, src, length + 1);
+ return dst;
+}
+
+
/* {Symbols}
*/
unsigned long
-scm_strhash (const unsigned char *str, scm_sizet len, unsigned long n)
+scm_strhash (const unsigned char *str, scm_sizet len)
{
if (len > 5)
{
scm_sizet i = 5;
- unsigned long h = 264 % n;
+ unsigned long h = 264;
while (i--)
- h = ((h << 8) + ((unsigned) (scm_downcase (str[h % len])))) % n;
+ h = ((h << 8) + ((unsigned) (scm_downcase (str[h % len]))));
return h;
}
else
@@ -93,7 +102,7 @@
scm_sizet i = len;
unsigned long h = 0;
while (i)
- h = ((h << 8) + ((unsigned) (scm_downcase (str[--i])))) % n;
+ h = ((h << 8) + ((unsigned) (scm_downcase (str[--i]))));
return h;
}
}
@@ -133,8 +142,8 @@
SCM lsym;
SCM * lsymp;
SCM z;
- scm_sizet scm_hash = scm_strhash (SCM_UCHARS (sym), (scm_sizet)
SCM_LENGTH (sym),
- (unsigned long) scm_symhash_dim);
+ scm_sizet scm_hash
+ = scm_strhash (SCM_UCHARS (sym), SCM_LENGTH (sym)) % scm_symhash_dim;
SCM_DEFER_INTS;
for (lsym = SCM_VELTS (scm_symhash)[scm_hash]; SCM_NIMP (lsym); lsym =
SCM_CDR (lsym))
@@ -180,9 +189,7 @@
SCM lsym, z;
scm_sizet scm_hash;
- scm_hash = scm_strhash (SCM_UCHARS (sym),
- (scm_sizet) SCM_LENGTH (sym),
- SCM_LENGTH (obarray));
+ scm_hash = scm_strhash (SCM_UCHARS (sym), SCM_LENGTH (sym)) % SCM_LENGTH
(obarray);
SCM_REDEFER_INTS;
for (lsym = SCM_VELTS (obarray)[scm_hash];
SCM_NIMP (lsym);
@@ -234,46 +241,37 @@
check scm_weak_symhash instead. */
-SCM
-scm_intern_obarray_soft (const char *name,scm_sizet len,SCM obarray,int
softness)
+static SCM
+scm_intern_obarray_soft (const char *name,scm_sizet len,SCM obarray, unsigned
int softness)
{
SCM lsym;
- SCM z;
- register scm_sizet i;
- register unsigned char *tmp;
+ scm_sizet raw_hash = scm_strhash ((unsigned char *) name, len);
scm_sizet scm_hash;
SCM_REDEFER_INTS;
if (SCM_FALSEP (obarray))
{
- scm_hash = scm_strhash ((unsigned char *) name, len, 1019);
+ scm_hash = raw_hash % 1019;
goto uninterned_symbol;
}
-
- scm_hash = scm_strhash ((unsigned char *) name, len, SCM_LENGTH (obarray));
- /* softness == -1 used to mean that it was known that the symbol
- wasn't already in the obarray. I don't think there are any
- callers that use that case any more, but just in case...
- -- JimB, Oct 1996 */
- if (softness == -1)
- abort ();
+ scm_hash = raw_hash % SCM_LENGTH (obarray);
retry_new_obarray:
for (lsym = SCM_VELTS (obarray)[scm_hash]; SCM_NIMP (lsym); lsym = SCM_CDR
(lsym))
{
- z = SCM_CAR (lsym);
- z = SCM_CAR (z);
- tmp = SCM_UCHARS (z);
+ SCM z = SCM_CAAR (lsym);
+ unsigned char *tmp = SCM_UCHARS (z);
+ scm_sizet i;
+
if (SCM_LENGTH (z) != len)
goto trynext;
for (i = len; i--;)
if (((unsigned char *) name)[i] != tmp[i])
goto trynext;
{
- SCM a;
- a = SCM_CAR (lsym);
+ SCM a = SCM_CAR (lsym);
SCM_REALLOW_INTS;
return a;
}
@@ -293,11 +291,10 @@
return SCM_BOOL_F;
}
- lsym = scm_makfromstr (name, len, SCM_SYMBOL_SLOTS);
-
- SCM_SETLENGTH (lsym, (long) len, scm_tc7_msymbol);
- SCM_SYMBOL_HASH (lsym) = scm_hash;
- SCM_SET_SYMBOL_PROPS (lsym, SCM_EOL);
+ SCM_NEWCELL2 (lsym);
+ SCM_SETCHARS (lsym, duplicate_string (name));
+ SCM_SET_SYMBOL_HASH (lsym, raw_hash);
+ SCM_SETLENGTH (lsym, (long) len, scm_tc7_symbol);
if (SCM_FALSEP (obarray))
{
SCM answer;
@@ -364,12 +361,12 @@
{
SCM lsym;
scm_sizet len = strlen (name);
- scm_sizet scm_hash = scm_strhash ((unsigned char *) name,
- len,
- (unsigned long) scm_symhash_dim);
- SCM_NEWCELL (lsym);
- SCM_SETLENGTH (lsym, (long) len, scm_tc7_ssymbol);
+ scm_sizet raw_hash = scm_strhash ((unsigned char *) name, len);
+ scm_sizet scm_hash = raw_hash % scm_symhash_dim;
+ SCM_NEWCELL2 (lsym);
SCM_SETCHARS (lsym, name);
+ SCM_SET_SYMBOL_HASH (lsym, raw_hash);
+ SCM_SETLENGTH (lsym, (long) len, scm_tc7_symbol);
lsym = scm_cons (lsym, SCM_UNDEFINED);
SCM_VELTS (scm_symhash)[scm_hash] = scm_cons (lsym, SCM_VELTS
(scm_symhash)[scm_hash]);
SCM_ALLOW_INTS;
@@ -406,33 +403,17 @@
return scm_sysintern0_no_module_lookup (name);
}
-/* Lookup the value of the symbol named by the nul-terminated string
- NAME in the current module. */
-SCM
-scm_symbol_value0 (const char *name)
-{
- /* This looks silly - we look up the symbol twice. But it is in
- fact necessary given the current module system because the module
- lookup closures are written in scheme which needs real symbols. */
- SCM symbol = scm_intern_obarray_soft (name, strlen (name), scm_symhash, 0);
- SCM vcell = scm_sym2vcell (SCM_CAR (symbol),
- SCM_TOP_LEVEL_LOOKUP_CLOSURE,
- SCM_BOOL_F);
- if (SCM_FALSEP (vcell))
- return SCM_UNDEFINED;
- return SCM_CDR (vcell);
-}
SCM_DEFINE (scm_symbol_p, "symbol?", 1, 0, 0,
(SCM obj),
"Returns @t{#t} if @var{obj} is a symbol, otherwise returns @t{#f}.
(r5rs)")
#define FUNC_NAME s_scm_symbol_p
{
- if SCM_IMP(obj) return SCM_BOOL_F;
- return SCM_BOOL(SCM_SYMBOLP(obj));
+ return SCM_BOOL (SCM_SYMBOLP (obj));
}
#undef FUNC_NAME
+
SCM_DEFINE (scm_symbol_to_string, "symbol->string", 1, 0, 0,
(SCM s),
"Returns the name of @var{symbol} as a string. If the symbol was
part of\n"
@@ -460,7 +441,7 @@
#define FUNC_NAME s_scm_symbol_to_string
{
SCM_VALIDATE_SYMBOL (1,s);
- return scm_makfromstr(SCM_CHARS(s), (scm_sizet)SCM_LENGTH(s), 0);
+ return scm_makfromstr(SCM_CHARS(s), (scm_sizet)SCM_LENGTH(s));
}
#undef FUNC_NAME
@@ -557,7 +538,7 @@
if (SCM_FALSEP (o))
o = scm_symhash;
SCM_VALIDATE_VECTOR (1,o);
- hval = scm_strhash (SCM_UCHARS (s), SCM_LENGTH (s), SCM_LENGTH(o));
+ hval = scm_strhash (SCM_UCHARS (s), SCM_LENGTH (s)) % SCM_LENGTH(o);
/* If the symbol is already interned, simply return. */
SCM_REDEFER_INTS;
{
@@ -594,7 +575,7 @@
if (SCM_FALSEP (o))
o = scm_symhash;
SCM_VALIDATE_VECTOR (1,o);
- hval = scm_strhash (SCM_UCHARS (s), SCM_LENGTH (s), SCM_LENGTH(o));
+ hval = scm_strhash (SCM_UCHARS (s), SCM_LENGTH (s)) % SCM_LENGTH(o);
SCM_DEFER_INTS;
{
SCM lsym_follow;
@@ -666,7 +647,7 @@
(SCM o, SCM s),
"Return @var{#t} if @var{obarray} contains a symbol with name\n"
"@var{string} bound to a defined value. This differs from\n"
- "@var{symbol-bound?} in that the mere mention of a symbol usually
causes\n"
+ "@var{symbol-interned?} in that the mere mention of a symbol
usually causes\n"
"it to be interned; @code{symbol-bound?} determines whether a
symbol has\n"
"been given any meaningful value.")
#define FUNC_NAME s_scm_symbol_bound_p
@@ -682,103 +663,6 @@
#undef FUNC_NAME
-SCM_DEFINE (scm_symbol_set_x, "symbol-set!", 3, 0, 0,
- (SCM o, SCM s, SCM v),
- "Find the symbol in @var{obarray} whose name is @var{string}, and
rebind\n"
- "it to @var{value}. An error is signalled if @var{string} is not
present\n"
- "in @var{obarray}.")
-#define FUNC_NAME s_scm_symbol_set_x
-{
- SCM vcell;
- SCM_VALIDATE_SYMBOL (2,s);
- if (SCM_FALSEP (o))
- o = scm_symhash;
- SCM_VALIDATE_VECTOR (1,o);
- vcell = scm_sym2ovcell (s, o);
- SCM_SETCDR (vcell, v);
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-static void
-msymbolize (SCM s)
-{
- SCM string;
- string = scm_makfromstr (SCM_CHARS (s), SCM_LENGTH (s), SCM_SYMBOL_SLOTS);
- SCM_SETCHARS (s, SCM_CHARS (string));
- SCM_SETLENGTH (s, SCM_LENGTH (s), scm_tc7_msymbol);
- SCM_SETCDR (string, SCM_EOL);
- SCM_SETCAR (string, SCM_EOL);
- SCM_SET_SYMBOL_PROPS (s, SCM_EOL);
- /* If it's a tc7_ssymbol, it comes from scm_symhash */
- SCM_SYMBOL_HASH (s) = scm_strhash (SCM_UCHARS (s),
- (scm_sizet) SCM_LENGTH (s),
- SCM_LENGTH (scm_symhash));
-}
-
-
-SCM_DEFINE (scm_symbol_fref, "symbol-fref", 1, 0, 0,
- (SCM s),
- "Return the contents of @var{symbol}'s @dfn{function slot}.")
-#define FUNC_NAME s_scm_symbol_fref
-{
- SCM_VALIDATE_SYMBOL (1,s);
- SCM_DEFER_INTS;
- if (SCM_TYP7(s) == scm_tc7_ssymbol)
- msymbolize (s);
- SCM_ALLOW_INTS;
- return SCM_SYMBOL_FUNC (s);
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_symbol_pref, "symbol-pref", 1, 0, 0,
- (SCM s),
- "Return the @dfn{property list} currently associated with
@var{symbol}.")
-#define FUNC_NAME s_scm_symbol_pref
-{
- SCM_VALIDATE_SYMBOL (1,s);
- SCM_DEFER_INTS;
- if (SCM_TYP7(s) == scm_tc7_ssymbol)
- msymbolize (s);
- SCM_ALLOW_INTS;
- return SCM_SYMBOL_PROPS (s);
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_symbol_fset_x, "symbol-fset!", 2, 0, 0,
- (SCM s, SCM val),
- "Change the binding of @var{symbol}'s function slot.")
-#define FUNC_NAME s_scm_symbol_fset_x
-{
- SCM_VALIDATE_SYMBOL (1,s);
- SCM_DEFER_INTS;
- if (SCM_TYP7(s) == scm_tc7_ssymbol)
- msymbolize (s);
- SCM_ALLOW_INTS;
- SCM_SET_SYMBOL_FUNC (s, val);
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_symbol_pset_x, "symbol-pset!", 2, 0, 0,
- (SCM s, SCM val),
- "Change the binding of @var{symbol}'s property slot.")
-#define FUNC_NAME s_scm_symbol_pset_x
-{
- SCM_VALIDATE_SYMBOL (1,s);
- SCM_DEFER_INTS;
- if (SCM_TYP7(s) == scm_tc7_ssymbol)
- msymbolize (s);
- SCM_SET_SYMBOL_PROPS (s, val);
- SCM_ALLOW_INTS;
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
SCM_DEFINE (scm_symbol_hash, "symbol-hash", 1, 0, 0,
(SCM s),
"Return the hash value derived from @var{symbol}'s name, i.e. the
integer\n"
@@ -786,8 +670,6 @@
#define FUNC_NAME s_scm_symbol_hash
{
SCM_VALIDATE_SYMBOL (1,s);
- if (SCM_TYP7(s) == scm_tc7_ssymbol)
- msymbolize (s);
return SCM_MAKINUM (SCM_UNPACK (s) ^ SCM_SYMBOL_HASH (s));
}
#undef FUNC_NAME
Index: libguile/symbols.h
===================================================================
RCS file: /cvs/guile/guile-core/libguile/symbols.h,v
retrieving revision 1.30
diff -u -r1.30 symbols.h
--- libguile/symbols.h 2000/08/11 08:45:19 1.30
+++ libguile/symbols.h 2000/09/07 09:20:08
@@ -54,30 +54,11 @@
/* SCM_LENGTH(SYM) is the length of SYM's name in characters, and
SCM_CHARS(SYM) is the address of the first character of SYM's name.
+ SCM_SYMBOL_HASH(SYM) is the hash value of the symbol.
+*/
- Beyond that, there are two kinds of symbols: ssymbols and msymbols,
- distinguished by the 'S' bit in the type.
-
- Ssymbols are just uniquified strings. They have a length, chars,
- and that's it. They use the scm_tc7_ssymbol tag (S bit clear).
-
- Msymbols are symbols with extra slots. These slots hold a property
- list and a function value (for Emacs Lisp compatibility), and a hash
- code. They use the scm_tc7_msymbol tag.
-
- We'd like SCM_CHARS to work on msymbols just as it does on
- ssymbols, so we'll have it point to the symbol's name as usual, and
- store a pointer to the slots just before the name in memory. Thus,
- you have to do some casting and pointer arithmetic to find the
- slots; see the SCM_SLOTS macro.
-
- In practice, the slots always live just before the pointer to them.
- So why not ditch the pointer, and use negative indices to refer to
- the slots? That's a good question; ask the author. I think it was
- the cognac. */
-
#define SCM_SYMBOLP(x) (SCM_NIMP (x) \
- && (SCM_TYP7S (x) == scm_tc7_ssymbol))
+ && (SCM_TYP7 (x) == scm_tc7_symbol))
#define SCM_LENGTH_MAX (0xffffffL)
#define SCM_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8)
@@ -87,16 +68,11 @@
#define SCM_UCHARS(x) ((unsigned char *) (SCM_CELL_WORD_1 (x)))
#define SCM_SETCHARS(x, v) (SCM_SET_CELL_WORD_1 ((x), (scm_bits_t) (v)))
-#define SCM_SYMBOL_SLOTS 4
-#define SCM_SLOTS(x) ((scm_bits_t *) (* ((scm_bits_t *)
SCM_CHARS (x) - 1)))
-#define SCM_SYMBOL_FUNC(X) (SCM_PACK (SCM_SLOTS (X) [0]))
-#define SCM_SET_SYMBOL_FUNC(X, v) (SCM_SLOTS (X) [0] = SCM_UNPACK (v))
-#define SCM_SYMBOL_PROPS(X) (SCM_PACK (SCM_SLOTS (X) [1]))
-#define SCM_SET_SYMBOL_PROPS(X, v) (SCM_SLOTS (X) [1] = SCM_UNPACK (v))
-#define SCM_SYMBOL_HASH(X) (SCM_SLOTS (X) [2])
+#define SCM_SYMBOL_HASH(x) (SCM_CELL_WORD_2 (x))
+#define SCM_SET_SYMBOL_HASH(x, v) (SCM_SET_CELL_WORD_2 ((x), (v)))
#define SCM_ROSTRINGP(x) (SCM_NIMP(x) && ((SCM_TYP7S(x)==scm_tc7_string) \
- || (SCM_TYP7S(x) == scm_tc7_ssymbol)))
+ || (SCM_TYP7 (x) == scm_tc7_symbol)))
#define SCM_ROCHARS(x) ((char *)((SCM_TYP7(x) == scm_tc7_substring) \
? SCM_INUM (SCM_CADR (x)) + SCM_CHARS (SCM_CDDR (x)) \
: SCM_CHARS (x)))
@@ -111,22 +87,20 @@
#define SCM_COERCE_SUBSTR(x) { if (SCM_SUBSTRP (x)) \
x = scm_makfromstr (SCM_ROCHARS (x), \
- SCM_ROLENGTH (x), 0); }
+ SCM_ROLENGTH (x)); }
-extern unsigned long scm_strhash (const unsigned char *str, scm_sizet len,
unsigned long n);
+extern unsigned long scm_strhash (const unsigned char *str, scm_sizet len);
extern SCM scm_sym2vcell (SCM sym, SCM thunk, SCM definep);
extern SCM scm_sym2ovcell_soft (SCM sym, SCM obarray);
extern SCM scm_sym2ovcell (SCM sym, SCM obarray);
-extern SCM scm_intern_obarray_soft (const char *name, scm_sizet len, SCM
obarray, int softness);
extern SCM scm_intern_obarray (const char *name, scm_sizet len, SCM obarray);
extern SCM scm_intern (const char *name, scm_sizet len);
extern SCM scm_intern0 (const char *name);
extern SCM scm_sysintern (const char *name, SCM val);
extern SCM scm_sysintern0 (const char *name);
extern SCM scm_sysintern0_no_module_lookup (const char *name);
-extern SCM scm_symbol_value0 (const char *name);
extern SCM scm_symbol_p (SCM x);
extern SCM scm_symbol_to_string (SCM s);
extern SCM scm_string_to_symbol (SCM s);
@@ -136,11 +110,6 @@
extern SCM scm_symbol_binding (SCM o, SCM s);
extern SCM scm_symbol_interned_p (SCM o, SCM s);
extern SCM scm_symbol_bound_p (SCM o, SCM s);
-extern SCM scm_symbol_set_x (SCM o, SCM s, SCM v);
-extern SCM scm_symbol_fref (SCM s);
-extern SCM scm_symbol_pref (SCM s);
-extern SCM scm_symbol_fset_x (SCM s, SCM val);
-extern SCM scm_symbol_pset_x (SCM s, SCM val);
extern SCM scm_symbol_hash (SCM s);
extern SCM scm_builtin_bindings (void);
extern SCM scm_builtin_weak_bindings (void);
Index: libguile/tag.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/tag.c,v
retrieving revision 1.19
diff -u -r1.19 tag.c
--- libguile/tag.c 2000/06/12 12:28:24 1.19
+++ libguile/tag.c 2000/09/07 09:20:08
@@ -118,7 +118,7 @@
return SCM_CDR (scm_utag_pair) ;
case scm_tcs_closures:
return SCM_CDR (scm_utag_closure) ;
- case scm_tcs_symbols:
+ case scm_tc7_symbol:
return SCM_CDR (scm_utag_symbol) ;
case scm_tc7_vector:
return SCM_CDR (scm_utag_vector) ;
Index: libguile/tags.h
===================================================================
RCS file: /cvs/guile/guile-core/libguile/tags.h,v
retrieving revision 1.64
diff -u -r1.64 tags.h
--- libguile/tags.h 2000/09/02 21:53:38 1.64
+++ libguile/tags.h 2000/09/07 09:20:08
@@ -333,9 +333,8 @@
-/* couple */
-#define scm_tc7_ssymbol 5
-#define scm_tc7_msymbol 7
+#define scm_tc7_symbol 5
+/* free 7 */
/* couple */
#define scm_tc7_vector 13
@@ -550,8 +549,6 @@
#define scm_tcs_subrs scm_tc7_asubr:case scm_tc7_subr_0:case
scm_tc7_subr_1:case scm_tc7_cxr:\
case scm_tc7_subr_3:case scm_tc7_subr_2:case scm_tc7_rpsubr:case
scm_tc7_subr_1o:\
case scm_tc7_subr_2o:case scm_tc7_lsubr_2:case scm_tc7_lsubr
-
-#define scm_tcs_symbols scm_tc7_ssymbol:case scm_tc7_msymbol
Index: libguile/vports.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/vports.c,v
retrieving revision 1.38
diff -u -r1.38 vports.c
--- libguile/vports.c 2000/08/12 22:18:04 1.38
+++ libguile/vports.c 2000/09/07 09:20:08
@@ -96,7 +96,7 @@
SCM p = SCM_PACK (SCM_STREAM (port));
scm_apply (SCM_VELTS (p)[1],
- scm_cons (scm_makfromstr ((char *) data, size, 0), SCM_EOL),
+ scm_cons (scm_makfromstr ((char *) data, size), SCM_EOL),
SCM_EOL);
}