From 53befeb700c31dec58cec2c8f6f34535541a2f39 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Wed, 17 Jun 2009 00:22:09 +0100 Subject: Change Guile license to LGPLv3+ (Not quite finished, the following will be done tomorrow. module/srfi/*.scm module/rnrs/*.scm module/scripts/*.scm testsuite/*.scm guile-readline/* ) --- libguile/struct.c | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) (limited to 'libguile/struct.c') diff --git a/libguile/struct.c b/libguile/struct.c index cae0f31d0..9cb165e2f 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -1,18 +1,19 @@ /* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public - * License as published by the Free Software Foundation; either - * version 2.1 of the License, or (at your option) any later version. + * modify it under the terms of the GNU Lesser General Public License + * as published by the Free Software Foundation; either version 3 of + * the License, or (at your option) any later version. * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of + * This library is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA */ -- cgit v1.2.3 From 27646f414e9350c2bf9f35982082bcabfb475c5d Mon Sep 17 00:00:00 2001 From: Michael Gran Date: Sat, 22 Aug 2009 10:15:53 -0700 Subject: Use string and symbol accessors in struct, throw, and array funcs * libguile/struct.c (scm_make_struct_layout, scm_struct_init) (scm_struct_vtable_p, scm_struct_ref, scm_struct_set_x): use string and symbol accessors and avoid unpacking strings and symbols * libguile/throw.c (scm_ithrow): allow wide symbols in the error message * libguile/unif.c (scm_enclose_array, scm_istr2bve): use string accessors and avoid unpacking strings --- libguile/struct.c | 76 +++++++++++++++++++++++++++---------------------------- libguile/throw.c | 9 +++++-- libguile/unif.c | 11 +++----- 3 files changed, 48 insertions(+), 48 deletions(-) (limited to 'libguile/struct.c') diff --git a/libguile/struct.c b/libguile/struct.c index 9cb165e2f..f78a812ab 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -30,6 +30,7 @@ #include "libguile/hashtab.h" #include "libguile/ports.h" #include "libguile/strings.h" +#include "libguile/srfi-13.h" #include "libguile/validate.h" #include "libguile/struct.h" @@ -61,9 +62,9 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0, { SCM new_sym; SCM_VALIDATE_STRING (1, fields); + scm_t_wchar c; { /* scope */ - const char * field_desc; size_t len; int x; @@ -72,11 +73,9 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0, SCM_MISC_ERROR ("odd length field specification: ~S", scm_list_1 (fields)); - field_desc = scm_i_string_chars (fields); - for (x = 0; x < len; x += 2) { - switch (field_desc[x]) + switch (c = scm_i_string_ref (fields, x)) { case 'u': case 'p': @@ -88,13 +87,13 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0, break; default: SCM_MISC_ERROR ("unrecognized field type: ~S", - scm_list_1 (SCM_MAKE_CHAR (field_desc[x]))); + scm_list_1 (SCM_MAKE_CHAR (c))); } - switch (field_desc[x + 1]) + switch (c = scm_i_string_ref (fields, x + 1)) { case 'w': - if (field_desc[x] == 's') + if (scm_i_string_ref (fields, x) == 's') SCM_MISC_ERROR ("self fields not writable", SCM_EOL); case 'r': case 'o': @@ -102,7 +101,7 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0, case 'R': case 'W': case 'O': - if (field_desc[x] == 's') + if (scm_i_string_ref (fields, x) == 's') SCM_MISC_ERROR ("self fields not allowed in tail array", SCM_EOL); if (x != len - 2) @@ -111,12 +110,12 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0, break; default: SCM_MISC_ERROR ("unrecognized ref specification: ~S", - scm_list_1 (SCM_MAKE_CHAR (field_desc[x + 1]))); + scm_list_1 (SCM_MAKE_CHAR (c))); } #if 0 - if (field_desc[x] == 'd') + if (scm_i_string_ref (fields, x, 'd')) { - if (field_desc[x + 2] != '-') + if (!scm_i_string_ref (fields, x+2, '-')) SCM_MISC_ERROR ("missing dash field at position ~A", scm_list_1 (scm_from_int (x / 2))); x += 2; @@ -138,18 +137,18 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0, static void scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, int tail_elts, SCM inits) { - unsigned const char *fields_desc = - (unsigned const char *) scm_i_symbol_chars (layout) - 2; - unsigned char prot = 0; + scm_t_wchar prot = 0; int n_fields = scm_i_symbol_length (layout) / 2; int tailp = 0; + int i; + i = -2; while (n_fields) { if (!tailp) { - fields_desc += 2; - prot = fields_desc[1]; + i += 2; + prot = scm_i_symbol_ref (layout, i+1); if (SCM_LAYOUT_TAILP (prot)) { tailp = 1; @@ -160,8 +159,7 @@ scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, int tail_elts, SCM in break; } } - - switch (*fields_desc) + switch (scm_i_symbol_ref (layout, i)) { #if 0 case 'i': @@ -237,7 +235,8 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0, { SCM layout; scm_t_bits * mem; - int tmp; + SCM tmp; + size_t len; if (!SCM_STRUCTP (x)) return SCM_BOOL_F; @@ -248,11 +247,14 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0, < scm_i_string_length (required_vtable_fields)) return SCM_BOOL_F; - tmp = strncmp (scm_i_symbol_chars (layout), - scm_i_string_chars (required_vtable_fields), - scm_i_string_length (required_vtable_fields)); - scm_remember_upto_here_1 (required_vtable_fields); - if (tmp) + len = scm_i_string_length (required_vtable_fields); + tmp = scm_string_eq (scm_symbol_to_string (layout), + required_vtable_fields, + scm_from_size_t (0), + scm_from_size_t (len), + scm_from_size_t (0), + scm_from_size_t (len)); + if (scm_is_false (tmp)) return SCM_BOOL_F; mem = SCM_STRUCT_DATA (x); @@ -646,8 +648,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0, size_t layout_len; size_t p; scm_t_bits n_fields; - const char *fields_desc; - char field_type = 0; + scm_t_wchar field_type = 0; SCM_VALIDATE_STRUCT (1, handle); @@ -656,7 +657,6 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0, data = SCM_STRUCT_DATA (handle); p = scm_to_size_t (pos); - fields_desc = scm_i_symbol_chars (layout); layout_len = scm_i_symbol_length (layout); if (SCM_STRUCT_VTABLE_FLAGS (handle) & SCM_STRUCTF_LIGHT) /* no extra words */ @@ -668,9 +668,9 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0, if (p * 2 < layout_len) { - char ref; - field_type = fields_desc[p * 2]; - ref = fields_desc[p * 2 + 1]; + scm_t_wchar ref; + field_type = scm_i_symbol_ref (layout, p * 2); + ref = scm_i_symbol_ref (layout, p * 2 + 1); if ((ref != 'r') && (ref != 'w')) { if ((ref == 'R') || (ref == 'W')) @@ -679,8 +679,8 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0, SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos)); } } - else if (fields_desc[layout_len - 1] != 'O') - field_type = fields_desc[layout_len - 2]; + else if (scm_i_symbol_ref (layout, layout_len - 1) != 'O') + field_type = scm_i_symbol_ref(layout, layout_len - 2); else SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos)); @@ -728,8 +728,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0, size_t layout_len; size_t p; int n_fields; - const char *fields_desc; - char field_type = 0; + scm_t_wchar field_type = 0; SCM_VALIDATE_STRUCT (1, handle); @@ -737,7 +736,6 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0, data = SCM_STRUCT_DATA (handle); p = scm_to_size_t (pos); - fields_desc = scm_i_symbol_chars (layout); layout_len = scm_i_symbol_length (layout); if (SCM_STRUCT_VTABLE_FLAGS (handle) & SCM_STRUCTF_LIGHT) /* no extra words */ @@ -750,13 +748,13 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0, if (p * 2 < layout_len) { char set_x; - field_type = fields_desc[p * 2]; - set_x = fields_desc [p * 2 + 1]; + field_type = scm_i_symbol_ref (layout, p * 2); + set_x = scm_i_symbol_ref (layout, p * 2 + 1); if (set_x != 'w') SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos)); } - else if (fields_desc[layout_len - 1] == 'W') - field_type = fields_desc[layout_len - 2]; + else if (scm_i_symbol_ref (layout, layout_len - 1) == 'W') + field_type = scm_i_symbol_ref (layout, layout_len - 2); else SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos)); diff --git a/libguile/throw.c b/libguile/throw.c index 4413efadf..cf6ea4a49 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -23,6 +23,7 @@ #endif #include +#include #include "libguile/_scm.h" #include "libguile/async.h" #include "libguile/smob.h" @@ -744,8 +745,12 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED) */ fprintf (stderr, "throw from within critical section.\n"); if (scm_is_symbol (key)) - fprintf (stderr, "error key: %s\n", scm_i_symbol_chars (key)); - + { + if (scm_i_is_narrow_symbol (key)) + fprintf (stderr, "error key: %s\n", scm_i_symbol_chars (key)); + else + ulc_fprintf (stderr, "error key: %llU\n", scm_i_symbol_wide_chars (key)); + } for (; scm_is_pair (s); s = scm_cdr (s), i++) { diff --git a/libguile/unif.c b/libguile/unif.c index 84b532347..cf39d055e 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -1149,7 +1149,6 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1, #define FUNC_NAME s_scm_enclose_array { SCM axv, res, ra_inr; - const char *c_axv; scm_t_array_dim vdim, *s = &vdim; int ndim, j, k, ninr, noutr; @@ -1197,10 +1196,9 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1, SCM_I_ARRAY_DIMS (ra_inr)[k].inc = s[j].inc; scm_c_string_set_x (axv, j, SCM_MAKE_CHAR (1)); } - c_axv = scm_i_string_chars (axv); for (j = 0, k = 0; k < noutr; k++, j++) { - while (c_axv[j]) + while (!scm_i_string_ref (axv, j) == '\0') j++; SCM_I_ARRAY_DIMS (res)[k].lbnd = s[j].lbnd; SCM_I_ARRAY_DIMS (res)[k].ubnd = s[j].ubnd; @@ -2329,13 +2327,12 @@ scm_istr2bve (SCM str) SCM res = vec; scm_t_uint32 mask; - size_t k, j; - const char *c_str; + size_t k, j, p; scm_t_uint32 *data; data = scm_bitvector_writable_elements (vec, &handle, NULL, NULL, NULL); - c_str = scm_i_string_chars (str); + p = 0; for (k = 0; k < (len + 31) / 32; k++) { data[k] = 0L; @@ -2343,7 +2340,7 @@ scm_istr2bve (SCM str) if (j > 32) j = 32; for (mask = 1L; j--; mask <<= 1) - switch (*c_str++) + switch (scm_i_string_ref (str, p++)) { case '0': break; -- cgit v1.2.3 From f86f3b5b113b4cb383c531150b13bef9b2789221 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 25 Aug 2009 23:57:49 +0200 Subject: Remove the `scm_tc_free_cell' SMOB type. * libguile/deprecated.h (SCM_FREEP, SCM_NFREEP): Changed to constants. * libguile/gc.c (scm_i_tag_name): Remove reference to `scm_tc_free_cell'. * libguile/gc.h (SCM_FREE_CELL_CDR, SCM_SET_FREE_CELL_CDR): Remove. * libguile/smob.c (free_print): Remove. (scm_smob_prehistory): Don't create the "free" SMOB type. * libguile/struct.c (struct_finalizer_trampoline): Use a bare `scm_tc3_struct' tag for finalized structs instead of `scm_tc_free_cell'. * libguile/tags.h (scm_tc_free_cell): Remove. --- libguile/deprecated.h | 6 +++--- libguile/gc.c | 11 +++-------- libguile/gc.h | 9 --------- libguile/smob.c | 25 ------------------------- libguile/struct.c | 4 ++-- libguile/tags.h | 12 +----------- 6 files changed, 9 insertions(+), 58 deletions(-) (limited to 'libguile/struct.c') diff --git a/libguile/deprecated.h b/libguile/deprecated.h index 5b443c761..68eddb39e 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -5,7 +5,7 @@ #ifndef SCM_DEPRECATED_H #define SCM_DEPRECATED_H -/* Copyright (C) 2003,2004, 2005, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 2003,2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -117,8 +117,8 @@ SCM_API SCM scm_unprotect_object (SCM obj); (SCM_SETCDR ((x), SCM_PACK (SCM_UNPACK (SCM_CDR (x)) & (y)))) #define SCM_SETOR_CDR(x, y)\ (SCM_SETCDR ((x), SCM_PACK (SCM_UNPACK (SCM_CDR (x)) | (y)))) -#define SCM_FREEP(x) (SCM_FREE_CELL_P (x)) -#define SCM_NFREEP(x) (!SCM_FREE_CELL_P (x)) +#define SCM_FREEP(x) (0) +#define SCM_NFREEP(x) (1) #define SCM_GC8MARKP(x) SCM_GC_MARK_P (x) #define SCM_SETGC8MARK(x) SCM_SET_GC_MARK (x) #define SCM_CLRGC8MARK(x) SCM_CLEAR_GC_MARK (x) diff --git a/libguile/gc.c b/libguile/gc.c index cef9b3f6f..84d5ba8fa 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -763,15 +763,10 @@ scm_i_tag_name (scm_t_bits tag) { if (tag >= 255) { - if (tag == scm_tc_free_cell) - return "free cell"; - - { - int k = 0xff & (tag >> 8); - return (scm_smobs[k].name); - } + int k = 0xff & (tag >> 8); + return (scm_smobs[k].name); } - + switch (tag) /* 7 bits */ { case scm_tcs_struct: diff --git a/libguile/gc.h b/libguile/gc.h index e886bec4b..63b7c4eed 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -116,15 +116,6 @@ typedef struct scm_t_cell #define SCM_CELL_TYPE(x) SCM_CELL_WORD_0 (x) #define SCM_SET_CELL_TYPE(x, t) SCM_SET_CELL_WORD_0 ((x), (t)) -/* Freelists consist of linked cells where the type entry holds the value - * scm_tc_free_cell and the second entry holds a pointer to the next cell of - * the freelist. Due to this structure, freelist cells are not cons cells - * and thus may not be accessed using SCM_CAR and SCM_CDR. */ - -#define SCM_FREE_CELL_CDR(x) \ - (SCM_GC_CELL_OBJECT ((x), 1)) -#define SCM_SET_FREE_CELL_CDR(x, v) \ - (SCM_GC_SET_CELL_OBJECT ((x), 1, (v))) #if (SCM_DEBUG_CELL_ACCESSES == 1) /* Set this to != 0 if every cell that is accessed shall be checked: diff --git a/libguile/smob.c b/libguile/smob.c index b2c083cd3..86bb22f47 100644 --- a/libguile/smob.c +++ b/libguile/smob.c @@ -471,26 +471,6 @@ scm_make_smob (scm_t_bits tc) SCM_RETURN_NEWSMOB (tc, data); } - -/* {Initialization for the type of free cells} - */ - -static int -free_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) -{ - char buf[100]; - sprintf (buf, "#", - (void *) SCM_UNPACK (exp)); - scm_puts (buf, port); - -#if (SCM_DEBUG_CELL_ACCESSES == 1) - if (scm_debug_cell_accesses_p) - abort(); -#endif - - - return 1; -} /* Marking SMOBs using user-supplied mark procedures. */ @@ -632,7 +612,6 @@ void scm_smob_prehistory () { long i; - scm_t_bits tc; smob_gc_kind = GC_new_kind (GC_new_free_list (), GC_MAKE_PROC (GC_new_proc (smob_mark), 0), @@ -657,10 +636,6 @@ scm_smob_prehistory () scm_smobs[i].apply_3 = 0; scm_smobs[i].gsubr_type = 0; } - - /* WARNING: This scm_make_smob_type call must be done first. */ - tc = scm_make_smob_type ("free", 0); - scm_set_smob_print (tc, free_print); } /* diff --git a/libguile/struct.c b/libguile/struct.c index 062b5245d..f701f8f83 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. +/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -338,7 +338,7 @@ struct_finalizer_trampoline (GC_PTR ptr, GC_PTR unused_data) scm_t_struct_free free_struct_data = ((scm_t_struct_free) vtable_data[scm_struct_i_free]); - SCM_SET_CELL_TYPE (obj, scm_tc_free_cell); + SCM_SET_CELL_TYPE (obj, scm_tc3_struct); #if 0 /* A sanity check. However, this check can fail if the free function diff --git a/libguile/tags.h b/libguile/tags.h index 329453341..43853dc60 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -3,7 +3,7 @@ #ifndef SCM_TAGS_H #define SCM_TAGS_H -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008 +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008,2009 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -374,10 +374,6 @@ typedef unsigned long scm_t_bits; * tc16 (for tc7==scm_tc7_smob): * The largest part of the space of smob types is not subdivided in a * predefined way, since smobs can be added arbitrarily by user C code. - * However, while Guile also defines a number of smob types throughout, - * there is one smob type, namely scm_tc_free_cell, for which Guile assumes - * that it is declared first and thus gets a known-in-advance tc16-code. - * The reason of requiring a fixed tc16-code for this type is performance. */ @@ -484,12 +480,6 @@ typedef unsigned long scm_t_bits; #define SCM_TYP16_PREDICATE(tag, x) (!SCM_IMP (x) && SCM_TYP16 (x) == (tag)) -/* Here is the first smob subtype. */ - -/* scm_tc_free_cell is the 0th smob type. We place this in free cells to tell - * the conservative marker not to trace it. */ -#define scm_tc_free_cell (scm_tc7_smob + 0 * 256L) - /* {Immediate Values} -- cgit v1.2.3