diff options
49 files changed, 315 insertions, 1217 deletions
@@ -1,9 +1,17 @@ 2001-08-31 Dirk Herrmann <D.Herrmann@tu-bs.de> + * TODO: Added some points, and eliminated all done items. + + * acconfig.h, configure.in (SCM_DEBUG_DEPRECATED, + SCM_ENABLE_DEPRECATED): Renamed SCM_DEBUG_DEPRECATED to + SCM_ENABLE_DEPRECATED with the logic reversed. + +2001-08-31 Dirk Herrmann <D.Herrmann@tu-bs.de> + * libguile.h: Removed bogus comment, rearranged includes, removed deprecated definitions. - (LIBGUILEH, SCM_LIBGUILE_H): Renamed <foo>H to SCM_<foo>_H. + (LIBGUILEH, SCM_LIBGUILE_H): Renamed <foo>H to SCM_<foo>_H. 2001-08-30 Thien-Thi Nguyen <ttn@revel.glug.org> @@ -19,7 +19,6 @@ See also file HACKING. === Eventually: -- deprecate `read-only-string?' - [after signal handling and threading have been fixed] remove the code corresponding to GUILE_OLD_ASYNC_CLICK and the corresponding GUILE_OLD_ASYNC_CLICK macro. @@ -56,6 +55,12 @@ See also file HACKING. to convert source correctly in unmemocopy - eliminate argument checking for closures - Implement a thread-safe alternative to SCM's environment caches +- rename ice-9 to something more obvious +- implement implicitly shared substrings (thread-safe, copy on write). In + this context, the concept of read-only-strings might be re-introduced to + implement the symbol->string semantics of R5RS. +- implement internationalized strings +- revise the uniform vector implementation === Before releasing 1.8.0: @@ -69,107 +74,9 @@ See also file HACKING. - Start a new THANKS file. -- remove deprecated functions scm_read_0str, scm_eval_0str. +=== Before releasing 1.10.0: -- remove deprecated "scm_*_t" type names in libguile.h. - -- remove re-exporting behaviour of `export'. - in boot-9.scm, remove begin-deprecated part of `module-export!' - in format.scm, remove kluge at top - in srfi-13.scm, likewise - in srfi-1.scm, likewise - -- remove deprecated subr and gsubr functions - in procs.h, procs.c: scm_make_subr, scm_make_subr_opt, - scm_make_subr_with_generic, - in gsubr.h, gsubr.c: scm_make_gsubr, scm_make_gsubr_with_generic. - -- remove deprecated C interface to modules - in modules.h, modules.c: - root_module_lookup_closure, scm_sym_app, scm_sym_modules, - module_prefix, make_modules_in_var, beautify_user_module_x_var, - scm_the_root_module, scm_make_module, scm_ensure_user_module, - scm_load_scheme_module - -- remove vcell and obarray support. - Remove all code bracketed by `#if SCM_ENABLE_VCELLS'. - Remove SCM_ENABLE_VCELLS itself. - Also remove `variable-set-name-hint' completely. - -- remove compatability module (ice-9 and-let*). It - has been replaced by (ice-9 and-let-star) and/or (srfi srfi-2). - -- remove support for autoloading compiled-code modules: - try-module-linked - try-module-dynamic-link - init-dynamic-module, etc. - scm_register_module_xxx - scm_registered_modules - scm_clear_registered_modules - -- remove deprecated variables: - scm_top_level_lookup_closure_var - scm_scm_system_transformer - Remove all code that still sets them: - `use-syntax', scm_set_current_module, ... - -- remove deprecated functions: - eval.c: scm_eval2, scm_eval_3 - load.c: scm_read_and_eval_x - smob.c: scm_make_smob_type_mfpe, scm_set_smob_mfpe - gc.c: scm_remember - string.c: scm_makstr, scm_makfromstr -- remove deprecated procedures: - boot-9.scm: eval-in-module, id, -1+, return-it, string-character-length, - flags -- remove deprecated macros: SCM_OUTOFRANGE, SCM_NALLOC, SCM_HUP_SIGNAL, - SCM_INT_SIGNAL, SCM_FPE_SIGNAL, SCM_BUS_SIGNAL, SCM_SEGV_SIGNAL, - SCM_ALRM_SIGNAL, SCM_GC_SIGNAL, SCM_TICK_SIGNAL, SCM_SIG_ORD, - SCM_ORD_SIG, SCM_NUM_SIGS, SCM_SLOPPY_STRINGP, SCM_VALIDATE_STRINGORSUBSTR, - SCM_FREEP, SCM_NFREEP, SCM_CHARS, SCM_UCHARS, SCM_VALIDATE_ROSTRING, - SCM_VALIDATE_ROSTRING_COPY, SCM_VALIDATE_NULLORROSTRING_COPY, SCM_ROLENGTH, - SCM_LENGTH, SCM_HUGE_LENGTH, SCM_SUBSTRP, SCM_SUBSTR_STR, SCM_SUBSTR_OFFSET, - SCM_COERCE_SUBSTR, SCM_ROSTRINGP, SCM_RWSTRINGP, SCM_VALIDATE_RWSTRING, - SCM_ROCHARS, SCM_ROUCHARS, SCM_SETLENGTH, SCM_SETCHARS, SCM_LENGTH_MAX, - SCM_GC8MARKP, SCM_SETGC8MARK, SCM_CLRGC8MARK, SCM_GCTYP16, SCM_GCCDR, - SCM_SUBR_DOC, SCM_OPDIRP, SCM_VALIDATE_OPDIR, SCM_WTA, RETURN_SCM_WTA, - SCM_WNA, SCM_FUNC_NAME, SCM_VALIDATE_NUMBER_COPY, - SCM_VALIDATE_NUMBER_DEF_COPY, SCM_SLOPPY_CONSP, SCM_SLOPPY_NCONSP, - SCM_SETAND_CDR, SCM_SETOR_CDR, SCM_SETAND_CAR, SCM_SETOR_CAR, - SCM_ARRAY_CONTIGUOUS, - SCM_LIST0, SCM_LIST1, SCM_LIST2, SCM_LIST3, SCM_LIST4, SCM_LIST5, - SCM_LIST6, SCM_LIST7, SCM_LIST8, SCM_LIST9 -- remove scm_listify -- remove scm_vector_set_length_x -- remove function scm_call_catching_errors - (replaced by catch functions from throw.[ch]) -- remove support for "#&" reader syntax in (ice-9 optargs). -- remove scm_make_shared_substring -- remove scm_read_only_string_p -- remove scm_strhash -- remove scm_tc7_ssymbol -- remove scm_tc7_msymbol -- remove scm_tcs_symbols -- remove scm_sloppy_memq, scm_sloppy_memv, scm_sloppy_member -- consider removing the automatic loading of (ice-9 rdelim) when guile - starts up. This would be a brave move, since a lot of code will - assume that read-line is available by default. However it would make - it easier to use alternative implementations of this module, e.g., a - strictly scsh-compatible version which uses multiple values. For - interactive use it would be easy to load the module in ~/.guile. -- remove scm_close_all_ports_except -- remove scm_strprint_obj -- remove SCM_CONST_LONG -- remove scm_wta -- remove deprecated typedefs: long_long, ulong_long, scm_sizet -- remove deprecated macros: scm_contregs, scm_port_rw_active, - scm_port, scm_ptob_descriptor, scm_debug_info, scm_debug_frame, - scm_fport, SCM_FIXNUM_BIT, scm_option, scm_subr_entry, scm_rstate, - scm_rng, scm_i_rstate, scm_srcprops, scm_srcprops_chunk, - scm_info_frame, scm_stack, scm_array, scm_array_dim. -- remove deprecated functions: scm_mkbig, scm_big2num, scm_adjbig, - scm_normbig, scm_copybig, scm_2ulong2big, scm_dbl2big, scm_big2dbl. -- remove deprecated functions: scm_protect_object, - scm_unprotect_object, scm_create_hook. +- in boot-9.scm: + remove deprecated function `feature?“. [TODO ends here] diff --git a/acconfig.h b/acconfig.h index a449409aa..deff151c9 100644 --- a/acconfig.h +++ b/acconfig.h @@ -44,8 +44,8 @@ * If you do not wish that, delete this exception notice. */ -/* Define this if you want to exclude deprecated features */ -#undef SCM_DEBUG_DEPRECATED +/* Define this to 1 if you want to include deprecated features */ +#undef SCM_ENABLE_DEPRECATED /* Define this to control the default warning level for deprecated features */ #undef SCM_WARN_DEPRECATED_DEFAULT diff --git a/configure.in b/configure.in index 90401b040..c0c200273 100644 --- a/configure.in +++ b/configure.in @@ -111,7 +111,7 @@ AC_ARG_ENABLE(deprecated, [ --disable-deprecated omit deprecated features [no]]) if test "$enable_deprecated" = no; then - AC_DEFINE(SCM_DEBUG_DEPRECATED, 1) + AC_DEFINE(SCM_ENABLE_DEPRECATED, 0) else if test "$enable_deprecated" = yes || test "$enable_deprecated" = ""; then warn_default=summary @@ -120,7 +120,7 @@ else else warn_default=$enable_deprecated fi - AC_DEFINE(SCM_DEBUG_DEPRECATED, 0) + AC_DEFINE(SCM_ENABLE_DEPRECATED, 1) AC_DEFINE_UNQUOTED(SCM_WARN_DEPRECATED_DEFAULT, "$warn_default") fi diff --git a/guile-readline/ChangeLog b/guile-readline/ChangeLog index e5f9b5eea..8da222be4 100644 --- a/guile-readline/ChangeLog +++ b/guile-readline/ChangeLog @@ -1,5 +1,12 @@ 2001-08-31 Dirk Herrmann <D.Herrmann@tu-bs.de> + * readline.c (scm_readline, scm_add_history, + scm_filename_completion_function, completion_function): Remove + calls to SCM_STRING_COERCE_0TERMINATION_X. Since the substring + type is gone, all strings are 0-terminated anyway. + +2001-08-31 Dirk Herrmann <D.Herrmann@tu-bs.de> + * readline.scm: `feature?“ is deprecated. Use `provided?“ instead. diff --git a/guile-readline/readline.c b/guile-readline/readline.c index c9245caff..72d46c91c 100644 --- a/guile-readline/readline.c +++ b/guile-readline/readline.c @@ -171,7 +171,6 @@ SCM_DEFINE (scm_readline, "%readline", 0, 4, 0, --in_readline; scm_wrong_type_arg (s_scm_readline, SCM_ARG1, text); } - SCM_STRING_COERCE_0TERMINATION_X (text); } if (!((SCM_UNBNDP (inp) && SCM_OPINFPORTP (scm_cur_inp)) @@ -327,7 +326,6 @@ SCM_DEFINE (scm_add_history, "add-history", 1, 0, 0, { char* s; SCM_VALIDATE_STRING (1,text); - SCM_STRING_COERCE_0TERMINATION_X (text); s = SCM_STRING_CHARS (text); add_history (strdup (s)); @@ -377,7 +375,6 @@ SCM_DEFINE (scm_filename_completion_function, "filename-completion-function", 2, char *s; SCM ans; SCM_VALIDATE_STRING (1,text); - SCM_STRING_COERCE_0TERMINATION_X (text); #ifdef HAVE_RL_FILENAME_COMPLETION_FUNCTION s = rl_filename_completion_function (SCM_STRING_CHARS (text), SCM_NFALSEP (continuep)); #else @@ -417,7 +414,6 @@ completion_function (char *text, int continuep) scm_misc_error (s_scm_readline, "Completion function returned bogus value: %S", scm_list_1 (res)); - SCM_STRING_COERCE_0TERMINATION_X (res); return strdup (SCM_STRING_CHARS (res)); } } diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 2294c5d5b..842a8d90b 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,5 +1,29 @@ 2001-08-31 Dirk Herrmann <D.Herrmann@tu-bs.de> + * boot-9.scm: Don't load module (ice-9 rdelim). + + (feature?): Deprecated. + + (id, -1+, return-it, string-character-length, flags, + eval-in-module, split-c-module-name, + (convert-c-registered-modules, registered-modules, + register-modules, warn-autoload-deprecation, init-dynamic-module, + dynamic-maybe-call, dynamic-maybe-link, + find-and-link-dynamic-module, try-using-libtool-name, + try-using-sharlib-name, link-dynamic-module, try-module-linked, + try-module-dynamic-link): Removed. + + (module-make-local-var!, module-ensure-local-variable!, + module-define!): Eliminate call to `variable-set-name-hint!“. + + (try-load-module, use-syntax, module-export!): Remove deprecated + functionality. + + * format.scm: Remove deprecated definition of format that was + needed to trick export. + +2001-08-31 Dirk Herrmann <D.Herrmann@tu-bs.de> + * optargs.scm: Remove #& reader extension. 2001-08-31 Dirk Herrmann <D.Herrmann@tu-bs.de> diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index 0bfd735ac..396803d7b 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -82,8 +82,8 @@ (define (provided? feature) (and (memq feature *features*) #t)) -;;; presumably deprecated. -(define feature? provided?) +(begin-deprecated + (define feature? provided?)) ;;; let format alias simple-format until the more complete version is loaded (define format simple-format) @@ -135,17 +135,6 @@ (define (and=> value procedure) (and value (procedure value))) (define (make-hash-table k) (make-vector k '())) -(begin-deprecated - (define (id x) - (issue-deprecation-warning "`id' is deprecated. Use `identity' instead.") - (identity x)) - (define (-1+ n) - (issue-deprecation-warning "`-1+' is deprecated. Use `1-' instead.") - (1- n)) - (define (return-it . args) - (issue-deprecation-warning "`return-it' is deprecated. Use `noop' instead.") - (apply noop args))) - ;;; apply-to-args is functionally redundant with apply and, worse, ;;; is less general than apply since it only takes two arguments. ;;; @@ -173,14 +162,6 @@ (if (even? k) acc (proc acc x)) proc)))) -(begin-deprecated - (define (string-character-length s) - (issue-deprecation-warning "`string-character-length' is deprecated. Use `string-length' instead.") - (string-length s)) - (define (flags . args) - (issue-deprecation-warning "`flags' is deprecated. Use `logior' instead.") - (apply logior args))) - ;;; {Symbol Properties} ;;; @@ -1054,12 +1035,6 @@ ;; to maximally one module. (set-procedure-property! closure 'module module)))) -(begin-deprecated - (define (eval-in-module exp mod) - (issue-deprecation-warning - "`eval-in-module' is deprecated. Use `eval' instead.") - (eval exp mod))) - ;;; {Observer protocol} ;;; @@ -1287,7 +1262,6 @@ ((module-binder m) m v #t)) (begin (let ((answer (make-undefined-variable))) - (variable-set-name-hint! answer v) (module-obarray-set! (module-obarray m) v answer) (module-modified m) answer)))) @@ -1301,7 +1275,6 @@ (define (module-ensure-local-variable! module symbol) (or (module-local-variable module symbol) (let ((var (make-undefined-variable))) - (variable-set-name-hint! var symbol) (module-add! module symbol var) var))) @@ -1458,7 +1431,6 @@ (variable-set! variable value) (module-modified module)) (let ((variable (make-variable value))) - (variable-set-name-hint! variable name) (module-add! module name variable))))) ;; MODULE-DEFINED? -- exported @@ -1646,9 +1618,7 @@ ;; (define-special-value '(app modules new-ws) (lambda () (make-scm-module))) (define (try-load-module name) - (or (begin-deprecated (try-module-linked name)) - (try-module-autoload name) - (begin-deprecated (try-module-dynamic-link name)))) + (try-module-autoload name)) (define (purify-module! module) "Removes bindings in MODULE which are inherited from the (guile) module." @@ -1839,152 +1809,6 @@ ;;; Dynamic linking of modules -;; This method of dynamically linking Guile Extensions is deprecated. -;; Use `load-extension' explicitely from Scheme code instead. - -(begin-deprecated - - (define (split-c-module-name str) - (let loop ((rev '()) - (start 0) - (pos 0) - (end (string-length str))) - (cond - ((= pos end) - (reverse (cons (string->symbol (substring str start pos)) rev))) - ((eq? (string-ref str pos) #\space) - (loop (cons (string->symbol (substring str start pos)) rev) - (+ pos 1) - (+ pos 1) - end)) - (else - (loop rev start (+ pos 1) end))))) - - (define (convert-c-registered-modules dynobj) - (let ((res (map (lambda (c) - (list (split-c-module-name (car c)) (cdr c) dynobj)) - (c-registered-modules)))) - (c-clear-registered-modules) - res)) - - (define registered-modules '()) - - (define (register-modules dynobj) - (set! registered-modules - (append! (convert-c-registered-modules dynobj) - registered-modules))) - - (define (warn-autoload-deprecation modname) - (issue-deprecation-warning - "Autoloading of compiled code modules is deprecated." - "Write a Scheme file instead that uses `load-extension'.") - (issue-deprecation-warning - (simple-format #f "(You just autoloaded module ~S.)" modname))) - - (define (init-dynamic-module modname) - ;; Register any linked modules which have been registered on the C level - (register-modules #f) - (or-map (lambda (modinfo) - (if (equal? (car modinfo) modname) - (begin - (warn-autoload-deprecation modname) - (set! registered-modules (delq! modinfo registered-modules)) - (let ((mod (resolve-module modname #f))) - (save-module-excursion - (lambda () - (set-current-module mod) - (set-module-public-interface! mod mod) - (dynamic-call (cadr modinfo) (caddr modinfo)) - )) - #t)) - #f)) - registered-modules)) - - (define (dynamic-maybe-call name dynobj) - (catch #t ; could use false-if-exception here - (lambda () - (dynamic-call name dynobj)) - (lambda args - #f))) - - (define (dynamic-maybe-link filename) - (catch #t ; could use false-if-exception here - (lambda () - (dynamic-link filename)) - (lambda args - #f))) - - (define (find-and-link-dynamic-module module-name) - (define (make-init-name mod-name) - (string-append "scm_init" - (list->string (map (lambda (c) - (if (or (char-alphabetic? c) - (char-numeric? c)) - c - #\_)) - (string->list mod-name))) - "_module")) - - ;; Put the subdirectory for this module in the car of SUBDIR-AND-LIBNAME, - ;; and the `libname' (the name of the module prepended by `lib') in the cdr - ;; field. For example, if MODULE-NAME is the list (inet tcp-ip udp), then - ;; SUBDIR-AND-LIBNAME will be the pair ("inet/tcp-ip" . "libudp"). - (let ((subdir-and-libname - (let loop ((dirs "") - (syms module-name)) - (if (null? (cdr syms)) - (cons dirs (string-append "lib" (symbol->string (car syms)))) - (loop (string-append dirs (symbol->string (car syms)) "/") - (cdr syms))))) - (init (make-init-name (apply string-append - (map (lambda (s) - (string-append "_" - (symbol->string s))) - module-name))))) - (let ((subdir (car subdir-and-libname)) - (libname (cdr subdir-and-libname))) - - ;; Now look in each dir in %LOAD-PATH for `subdir/libfoo.la'. If that - ;; file exists, fetch the dlname from that file and attempt to link - ;; against it. If `subdir/libfoo.la' does not exist, or does not seem - ;; to name any shared library, look for `subdir/libfoo.so' instead and - ;; link against that. - (let check-dirs ((dir-list %load-path)) - (if (null? dir-list) - #f - (let* ((dir (in-vicinity (car dir-list) subdir)) - (sharlib-full - (or (try-using-libtool-name dir libname) - (try-using-sharlib-name dir libname)))) - (if (and sharlib-full (file-exists? sharlib-full)) - (link-dynamic-module sharlib-full init) - (check-dirs (cdr dir-list))))))))) - - (define (try-using-libtool-name libdir libname) - (let ((libtool-filename (in-vicinity libdir - (string-append libname ".la")))) - (and (file-exists? libtool-filename) - libtool-filename))) - - (define (try-using-sharlib-name libdir libname) - (in-vicinity libdir (string-append libname ".so"))) - - (define (link-dynamic-module filename initname) - ;; Register any linked modules which have been registered on the C level - (register-modules #f) - (let ((dynobj (dynamic-link filename))) - (dynamic-call initname dynobj) - (register-modules dynobj))) - - (define (try-module-linked module-name) - (init-dynamic-module module-name)) - - (define (try-module-dynamic-link module-name) - (and (find-and-link-dynamic-module module-name) - (init-dynamic-module module-name)))) -;; end of deprecated section - - (define autoloads-done '((guile . guile))) (define (autoload-done-or-in-progress? p m) @@ -2737,9 +2561,7 @@ (list ,@(compile-interface-spec spec)))) (set-module-transformer! (current-module) ,(car (last-pair spec)))) - `((set-module-transformer! (current-module) ,spec))) - (begin-deprecated - (fluid-set! scm:eval-transformer (module-transformer (current-module))))) + `((set-module-transformer! (current-module) ,spec)))) (else (error "use-syntax can only be used at the top level")))) @@ -2783,17 +2605,6 @@ (define (module-export! m names) (let ((public-i (module-public-interface m))) (for-each (lambda (name) - (begin-deprecated - (if (not (module-local-variable m name)) - (let ((v (module-variable m name))) - (cond - (v - (issue-deprecation-warning - "Using `export' to re-export imported bindings is deprecated. Use `re-export' instead.") - (issue-deprecation-warning - (simple-format #f "(You just re-exported `~a' from `~a'.)" - name (module-name m))) - (module-define! m name (variable-ref v))))))) (let ((var (module-ensure-local-variable! m name))) (module-add! public-i name var))) names))) @@ -3068,8 +2879,4 @@ (define-module (guile-user)) -(begin-deprecated - ;; automatic availability of this module is deprecated. - (use-modules (ice-9 rdelim))) - ;;; boot-9.scm ends here diff --git a/ice-9/format.scm b/ice-9/format.scm index c3b8666a7..5de6ea9f2 100644 --- a/ice-9/format.scm +++ b/ice-9/format.scm @@ -15,11 +15,6 @@ :use-module (ice-9 and-let-star) :autoload (ice-9 pretty-print) (pretty-print)) -(begin-deprecated - ;; So that `export' below will not accidentally re-export the - ;; `format' of the `(guile)' module. - (define format #f)) - (export format format:symbol-case-conv format:iobj-case-conv diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 956953644..b886a422f 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,120 @@ 2001-08-31 Dirk Herrmann <D.Herrmann@tu-bs.de> + * __scm.h: Added new section about compile time selectable + features. + + (long_long, ulong_long, scm_sizet, SCM_WNA, SCM_OUTOFRANGE, + SCM_NALLOC, SCM_HUP_SIGNAL, SCM_INT_SIGNAL, SCM_FPE_SIGNAL, + SCM_BUS_SIGNAL, SCM_SEGV_SIGNAL, SCM_ALRM_SIGNAL, SCM_GC_SIGNAL, + SCM_TICK_SIGNAL, SCM_SIG_ORD, SCM_ORD_SIG, SCM_NUM_SIGS): + Removed. + + * deprecation.c (scm_include_deprecated_features): Simplified. + + * eval.c (EVALCAR, unmemocopy), eval.h (SCM_XEVALCAR): Use + `SCM_IMP“ instead of `!SCM_CELLP“. + + * eval.c (unmemocopy): Eliminate redundant SCM_CELLP tests. + Extract side-effecting operations from macros. + + (scm_init_eval): Don't initialize *top-level-lookup-closure*, + scm_top_level_lookup_closure_var and scm_system_transformer. + + * gc.c (CELL_P): New local definition to replace SCM_CELLP. + + (heap_segment): Use CELL_P instead of SCM_CELLP. + + * init.c (start_stack): Don't initialize + scm_top_level_lookup_closure_var and scm_system_transformer. + + * modules.c (scm_set_current_module): Don't access + scm_top_level_lookup_closure_var and scm_system_transformer. + + (scm_sym2var): Don't call scm_variable_set_name_hint. + + (scm_post_boot_init_modules): Removed deprecated initializations. + + * print.c (scm_ipruk): Don't access cell contents of non cells. + + * strings.c (scm_string_set_x): All strings are writable. + + * strings.h (SCM_STRINGP): Use SCM_TYP7 to determine the string + type. There is only one string type now. + + (SCM_STRING_COERCE_0TERMINATION_X): Deprecated. + + * tags.h: Remove comments about two different string types. + + (SCM_CELLP, SCM_NCELLP): Deprecated. + + * variable.c (make_variable): Remove code variant for vcells. + + * variable.h (SCM_VARIABLE_REF, SCM_VARIABLE_SET, + SCM_VARIABLE_LOC): Remove code variant for vcells. + + * __scm.h, deprecation.[ch]: Renamed SCM_DEBUG_DEPRECATED to + SCM_ENABLE_DEPRECATED with the logic reversed. + + * dynl.c (moddata, registered_mods), dynl.[ch] + (scm_register_module_xxx, scm_registered_modules, + scm_clear_registered_modules), error.[ch] (scm_wta), eval.c + (*top-level-lookup-closure*), eval.[ch] + (scm_top_level_lookup_closure_var, scm_system_transformer, + scm_eval_3, scm_eval2), gc.h (SCM_SETAND_CAR, SCM_SETOR_CAR, + SCM_SETAND_CDR, SCM_SETOR_CDR, SCM_FREEP, SCM_NFREEP, + SCM_GC8MARKP, SCM_SETGC8MARK, SCM_CLRGC8MARK, SCM_GCTYP16, + SCM_GCCDR), gc.[ch] (scm_remember, scm_protect_object, + scm_unprotect_object), modules.c (root_module_lookup_closure, + scm_sym_app, scm_sym_modules, module_prefix, make_modules_in_var, + beautify_user_module_x_var, try_module_autoload_var, + scm_module_full_name), modules.[ch] (scm_the_root_module, + scm_make_module, scm_ensure_user_module, scm_load_scheme_module), + ports.h (scm_port, scm_ptob_descriptor, scm_port_rw_active), + ports.[ch] (scm_close_all_ports_except), random.h (scm_rstate, + scm_rng, scm_i_rstate), strings.h (SCM_SLOPPY_STRINGP, + SCM_RWSTRINGP, SCM_STRING_UCHARS, SCM_STRING_CHARS), strings.[ch] + (scm_read_only_string_p, scm_makstr, scm_makfromstr, + scm_make_shared_substring), tags.h (scm_tc7_substring, + SCM_SLOPPY_CONSP, SCM_SLOPPY_NCONSP, scm_tc7_ssymbol, + scm_tc7_msymbol, scm_tcs_symbols), variable.c (sym_huh), + variable.[ch] (scm_variable_set_name_hint, scm_builtin_variable), + variable.h (SCM_VARVCELL, SCM_UDVARIABLEP, SCM_DEFVARIABLEP): + Removed. + + * dynl.c (scm_dynamic_link, scm_dynamic_func), error.c + (scm_error_scm), filesys.c (scm_chown, scm_chmod, scm_open_fdes, + scm_stat, scm_link, scm_rename, scm_delete_file, scm_mkdir, + scm_rmdir, scm_opendir, scm_chdir, scm_symlink, scm_readlink, + scm_lstat, scm_copy_file), fports.c (scm_open_file), ioext.c + (scm_fdopen), net_db.c (scm_gethost, scm_getnet, scm_getproto, + scm_getserv), ports.c (scm_truncate_file, scm_sys_make_void_port), + posix.c (scm_getpwuid, scm_getgrgid, scm_execl, scm_execlp, + scm_execle, scm_mkstemp, scm_utime, scm_access, scm_setlocale, + scm_mknod, scm_crypt, scm_chroot, scm_getpass, scm_sethostname), + regex-posix.c (scm_make_regexp, scm_regexp_exec), simpos.c + (scm_system, scm_getenv), socket.c (scm_inet_aton), stime.c + (setzone, scm_strftime, scm_strptime), vports.c + (scm_make_soft_port): Remove calls to + SCM_STRING_COERCE_0TERMINATION_X. Since the substring type is + gone, all strings are 0-terminated anyway. + + * dynl.h (LIBGUILE_DYNL_H, SCM_DYNL_H), random.h (RANDOMH, + SCM_RANDOM_H): Renamed the macros that are defined to inhibit + double inclusion of the same headers to the SCM_<filename>_H + format. + + * eval.c (SCM_CEVAL), gc.c (MARK, scm_gc_sweep), gh_data.c + (gh_scm2chars), hash.c (scm_hasher), objects.c (scm_class_of), + print.c (scm_iprin1): The type scm_tc7_substring does not exist + any more. + + * ports.h (SCM_PORTP, SCM_OPPORTP, SCM_OPINPORTP, SCM_OPOUTPORTP, + SCM_INPUT_PORT_P, SCM_OUTPUT_PORT_P, SCM_OPENP), tags.h + (SCM_TYP16_PREDICATE), variable.h (SCM_VARIABLEP): Prefer + !SCM_<foo> over SCM_N<foo>. + +2001-08-31 Dirk Herrmann <D.Herrmann@tu-bs.de> + * Makefile.am: Remove references to symbols-deprecated.c. * symbols.c (scm_init_symbols): Don't initialize deprecated diff --git a/libguile/__scm.h b/libguile/__scm.h index bda6326f2..fb2d9c2cd 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -2,18 +2,19 @@ #ifndef SCM___SCM_H #define SCM___SCM_H + /* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc. - * + * * 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 * the Free Software Foundation; either version 2, or (at your option) * any later version. - * + * * This program 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 General Public License for more details. - * + * * You should have received a copy of the GNU General Public License * along with this software; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, @@ -42,6 +43,7 @@ * If you write modifications of your own for GUILE, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ + /* "What's the difference between _scm.h and __scm.h?" @@ -167,7 +169,7 @@ * common prefix for all option macros of this kind is "SCM_DEBUG_". It is * guaranteed that a macro named SCM_DEBUG_XXX is defined to be either 0 or 1, * i. e. there is no need to test for the undefined case. This allows to use - * these definitions comfortably in macro code, as in the following example: + * these definitions comfortably within code, as in the following example: * #define FOO do { if (SCM_DEBUG_XXX) bar(); else baz(); } while (0) * Any sane compiler will remove the unused branch without any performance * penalty for the resulting code. @@ -196,13 +198,6 @@ #define SCM_DEBUG_CELL_ACCESSES SCM_DEBUG #endif -/* If SCM_DEBUG_DEPRECATED is set to 1, deprecated code is not compiled. This - * can be used by developers to get rid of references to deprecated code. - */ -#ifndef SCM_DEBUG_DEPRECATED -#define SCM_DEBUG_DEPRECATED SCM_DEBUG -#endif - /* If SCM_DEBUG_INTERRUPTS is set to 1, with every deferring and allowing of * interrupts a consistency check will be performed. */ @@ -236,30 +231,34 @@ #define SCM_DEBUG_TYPING_STRICTNESS 1 #endif -/* If SCM_ENABLE_VCELLS is set to 1, a couple of functions that deal - * with vcells are defined for compatibility reasons. Supporting - * vcells reduces performance however. - * - * We use a dedicated macro instead of just SCM_DEBUG_DEPRECATED so - * that code the belongs to the `vcell' feature is easier to find. - */ -#define SCM_ENABLE_VCELLS !SCM_DEBUG_DEPRECATED - -#ifdef HAVE_LONG_LONGS - -/* Some auto-generated .h files contain unused prototypes - * that need these typedefs. +/* {Feature Options} + * + * These compile time options determine whether code for certain features + * should be compiled into guile. The common prefix for all option macros + * of this kind is "SCM_ENABLE_". It is guaranteed that a macro named + * SCM_ENABLE_XXX is defined to be either 0 or 1, i. e. there is no need to + * test for the undefined case. This allows to use these definitions + * comfortably within code, as in the following example: + * #define FOO do { if (SCM_ENABLE_XXX) bar(); else baz(); } while (0) + * Any sane compiler will remove the unused branch without any performance + * penalty for the resulting code. + * + * Note: Some SCM_ENABLE_XXX options are not settable at configure time. + * To change the value of such options you will have to edit this header + * file or give suitable options to make, like: + * make all CFLAGS="-DSCM_ENABLE_XXX=1 ..." */ -#if (SCM_DEBUG_DEPRECATED == 0) -typedef long long long_long; -typedef unsigned long long ulong_long; +/* If SCM_ENABLE_DEPRECATED is set to 1, deprecated code will be included in + * guile, as well as some functions to issue run-time warnings about uses of + * deprecated functions. + */ +#ifndef SCM_ENABLE_DEPRECATED +#define SCM_ENABLE_DEPRECATED 0 #endif -#endif /* HAVE_LONG_LONGS */ - /* {Architecture and compiler properties} @@ -319,10 +318,6 @@ typedef long ptrdiff_t; # include <stddef.h> #endif /* def STDC_HEADERS */ -#if (SCM_DEBUG_DEPRECATED == 0) -# define scm_sizet size_t -#endif - #include "libguile/tags.h" @@ -629,31 +624,6 @@ extern SCM scm_apply_generic (SCM gf, SCM args); #define SCM_ARG6 6 #define SCM_ARG7 7 -#if (SCM_DEBUG_DEPRECATED == 0) - -/* Use SCM_WRONG_NUM_ARGS instead of: */ -#define SCM_WNA 8 - -/* Use SCM_ASSERT_RANGE or SCM_VALIDATE_XXX_RANGE instead of: */ -#define SCM_OUTOFRANGE 10 - -/* Use scm_memory_error instead of: */ -#define SCM_NALLOC 11 - -#define SCM_HUP_SIGNAL 14 -#define SCM_INT_SIGNAL 15 -#define SCM_FPE_SIGNAL 16 -#define SCM_BUS_SIGNAL 17 -#define SCM_SEGV_SIGNAL 18 -#define SCM_ALRM_SIGNAL 19 -#define SCM_GC_SIGNAL 20 -#define SCM_TICK_SIGNAL 21 -#define SCM_SIG_ORD(X) ((X) - SCM_HUP_SIGNAL) -#define SCM_ORD_SIG(X) ((X) + SCM_HUP_SIGNAL) -#define SCM_NUM_SIGS (SCM_SIG_ORD (SCM_TICK_SIGNAL) + 1) - -#endif /* SCM_DEBUG_DEPRECATED == 0 */ - #endif /* SCM_MAGIC_SNARFER */ @@ -679,8 +649,6 @@ extern SCM scm_apply_generic (SCM gf, SCM args); #endif /* def vms */ #endif /* ndef SCM_EXIT_FAILURE */ - - #endif /* SCM___SCM_H */ /* diff --git a/libguile/deprecation.c b/libguile/deprecation.c index 9271fb0c5..192f25519 100644 --- a/libguile/deprecation.c +++ b/libguile/deprecation.c @@ -53,10 +53,10 @@ -#if (SCM_DEBUG_DEPRECATED == 0) +#if (SCM_ENABLE_DEPRECATED == 1) /* This is either a boolean (when a summary should be printed) or a - hashtab (when detailed warnings shouold be printed). + hashtab (when detailed warnings should be printed). */ SCM issued_msgs; @@ -121,11 +121,7 @@ SCM_DEFINE(scm_include_deprecated_features, "in public interfaces.") #define FUNC_NAME s_scm_include_deprecated_features { -#if SCM_DEBUG_DEPRECATED == 0 - return SCM_BOOL_T; -#else - return SCM_BOOL_F; -#endif + return SCM_BOOL (SCM_ENABLE_DEPRECATED == 1); } #undef FUNC_NAME @@ -135,7 +131,7 @@ SCM_DEFINE(scm_include_deprecated_features, void scm_init_deprecation () { -#if SCM_DEBUG_DEPRECATED == 0 +#if (SCM_ENABLE_DEPRECATED == 1) const char *level = getenv ("GUILE_WARN_DEPRECATED"); if (level == NULL) level = SCM_WARN_DEPRECATED_DEFAULT; diff --git a/libguile/deprecation.h b/libguile/deprecation.h index aa75824f2..726c64a05 100644 --- a/libguile/deprecation.h +++ b/libguile/deprecation.h @@ -2,18 +2,19 @@ #ifndef SCM_DEPRECATION_H #define SCM_DEPRECATION_H + /* Copyright (C) 2001 Free Software Foundation, Inc. - * + * * 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 * the Free Software Foundation; either version 2, or (at your option) * any later version. - * + * * This program 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 General Public License for more details. - * + * * You should have received a copy of the GNU General Public License * along with this software; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, @@ -42,12 +43,14 @@ * If you write modifications of your own for GUILE, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ + + #include "libguile/__scm.h" -#if SCM_DEBUG_DEPRECATED == 0 +#if (SCM_ENABLE_DEPRECATED == 1) void scm_c_issue_deprecation_warning (const char *msg); SCM scm_issue_deprecation_warning (SCM msgs); @@ -55,7 +58,6 @@ SCM scm_issue_deprecation_warning (SCM msgs); #endif SCM scm_include_deprecated_features (void); - void scm_init_deprecation (void); #endif /* SCM_DEPRECATION_H */ diff --git a/libguile/dynl.c b/libguile/dynl.c index 70d36341f..136595780 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -127,104 +127,6 @@ scm_must_free_argv(char **argv) free (argv); } -#if SCM_DEBUG_DEPRECATED == 0 - -/* Module registry - */ - -/* We can't use SCM objects here. One should be able to call - SCM_REGISTER_MODULE from a C++ constructor for a static - object. This happens before main and thus before libguile is - initialized. */ - -struct moddata { - struct moddata *link; - char *module_name; - void *init_func; -}; - -static struct moddata *registered_mods = NULL; - -void -scm_register_module_xxx (char *module_name, void *init_func) -{ - struct moddata *md; - - scm_c_issue_deprecation_warning - ("`scm_register_module_xxx' is deprecated. Use extensions instead."); - - /* XXX - should we (and can we) DEFER_INTS here? */ - - for (md = registered_mods; md; md = md->link) - if (!strcmp (md->module_name, module_name)) - { - md->init_func = init_func; - return; - } - - md = (struct moddata *) malloc (sizeof (struct moddata)); - if (md == NULL) - { - fprintf (stderr, - "guile: can't register module (%s): not enough memory", - module_name); - return; - } - - md->module_name = module_name; - md->init_func = init_func; - md->link = registered_mods; - registered_mods = md; -} - -SCM_DEFINE (scm_registered_modules, "c-registered-modules", 0, 0, 0, - (), - "Return a list of the object code modules that have been imported into\n" - "the current Guile process. Each element of the list is a pair whose\n" - "car is the name of the module, and whose cdr is the function handle\n" - "for that module's initializer function. The name is the string that\n" - "has been passed to scm_register_module_xxx.") -#define FUNC_NAME s_scm_registered_modules -{ - SCM res; - struct moddata *md; - - res = SCM_EOL; - for (md = registered_mods; md; md = md->link) - res = scm_cons (scm_cons (scm_makfrom0str (md->module_name), - scm_ulong2num ((unsigned long) md->init_func)), - res); - return res; -} -#undef FUNC_NAME - -SCM_DEFINE (scm_clear_registered_modules, "c-clear-registered-modules", 0, 0, 0, - (), - "Destroy the list of modules registered with the current Guile process.\n" - "The return value is unspecified. @strong{Warning:} this function does\n" - "not actually unlink or deallocate these modules, but only destroys the\n" - "records of which modules have been loaded. It should therefore be used\n" - "only by module bookkeeping operations.") -#define FUNC_NAME s_scm_clear_registered_modules -{ - struct moddata *md1, *md2; - - SCM_DEFER_INTS; - - for (md1 = registered_mods; md1; md1 = md2) - { - md2 = md1->link; - free (md1); - } - registered_mods = NULL; - - SCM_ALLOW_INTS; - return SCM_UNSPECIFIED; -} -#undef FUNC_NAME - -#endif /* !SCM_DEBUG_DEPRECATED */ - /* Dispatch to the system dependent files * * They define some static functions. These functions are called with @@ -365,7 +267,6 @@ SCM_DEFINE (scm_dynamic_link, "dynamic-link", 1, 0, 0, void *handle; SCM_VALIDATE_STRING (1, filename); - SCM_STRING_COERCE_0TERMINATION_X (filename); handle = sysdep_dynl_link (SCM_STRING_CHARS (filename), FUNC_NAME); SCM_RETURN_NEWSMOB2 (scm_tc16_dynamic_obj, SCM_UNPACK (filename), handle); } @@ -433,7 +334,6 @@ SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0, char *chars; SCM_DEFER_INTS; - SCM_STRING_COERCE_0TERMINATION_X (name); chars = SCM_STRING_CHARS (name); func = (void (*) ()) sysdep_dynl_func (chars, DYNL_HANDLE (dobj), FUNC_NAME); SCM_ALLOW_INTS; diff --git a/libguile/dynl.h b/libguile/dynl.h index e9b0a2d8a..9910499d5 100644 --- a/libguile/dynl.h +++ b/libguile/dynl.h @@ -1,15 +1,20 @@ -/* Copyright (C) 1996, 1998, 2000 Free Software Foundation, Inc. - * +/* classes: h_files */ + +#ifndef SCM_DYNL_H +#define SCM_DYNL_H + +/* Copyright (C) 1996,1998,2000,2001 Free Software Foundation, Inc. + * * 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 * the Free Software Foundation; either version 2, or (at your option) * any later version. - * + * * This program 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 General Public License for more details. - * + * * You should have received a copy of the GNU General Public License * along with this software; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, @@ -38,19 +43,13 @@ * If you write modifications of your own for GUILE, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ - -#ifndef LIBGUILE_DYNL_H -#define LIBGUILE_DYNL_H + #include "libguile/__scm.h" -void scm_register_module_xxx (char *module_name, void *init_func); -SCM scm_registered_modules (void); -SCM scm_clear_registered_modules (void); - SCM scm_dynamic_link (SCM fname); SCM scm_dynamic_unlink (SCM dobj); SCM scm_dynamic_object_p (SCM obj); @@ -60,7 +59,7 @@ SCM scm_dynamic_args_call (SCM symb, SCM dobj, SCM args); void scm_init_dynamic_linking (void); -#endif /* LIBGUILE_DYNL_H */ +#endif /* SCM_DYNL_H */ /* Local Variables: diff --git a/libguile/error.c b/libguile/error.c index 052d07e06..33665a0f8 100644 --- a/libguile/error.c +++ b/libguile/error.c @@ -133,7 +133,6 @@ SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0, else { SCM_VALIDATE_STRING (2, subr); - SCM_STRING_COERCE_0TERMINATION_X (subr); szSubr = SCM_STRING_CHARS (subr); } @@ -144,7 +143,6 @@ SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0, else { SCM_VALIDATE_STRING (2, message); - SCM_STRING_COERCE_0TERMINATION_X (message); szMessage = SCM_STRING_CHARS (message); } @@ -293,57 +291,6 @@ scm_misc_error (const char *subr, const char *message, SCM args) scm_error (scm_misc_error_key, subr, message, args, SCM_BOOL_F); } -#if (SCM_DEBUG_DEPRECATED == 0) - -SCM -scm_wta (SCM arg, const char *pos, const char *s_subr) -{ - if (!s_subr || !*s_subr) - s_subr = NULL; - if ((~0x1fL) & (long) pos) - { - /* error string supplied. */ - scm_misc_error (s_subr, pos, scm_list_1 (arg)); - } - else - { - /* numerical error code. */ - int error = (int) pos; - - switch (error) - { - case SCM_ARGn: - scm_wrong_type_arg (s_subr, 0, arg); - case SCM_ARG1: - scm_wrong_type_arg (s_subr, 1, arg); - case SCM_ARG2: - scm_wrong_type_arg (s_subr, 2, arg); - case SCM_ARG3: - scm_wrong_type_arg (s_subr, 3, arg); - case SCM_ARG4: - scm_wrong_type_arg (s_subr, 4, arg); - case SCM_ARG5: - scm_wrong_type_arg (s_subr, 5, arg); - case SCM_ARG6: - scm_wrong_type_arg (s_subr, 6, arg); - case SCM_ARG7: - scm_wrong_type_arg (s_subr, 7, arg); - case SCM_WNA: - scm_wrong_num_args (arg); - case SCM_OUTOFRANGE: - scm_out_of_range (s_subr, arg); - case SCM_NALLOC: - scm_memory_error (s_subr); - default: - /* this shouldn't happen. */ - scm_misc_error (s_subr, "Unknown error", SCM_EOL); - } - } - return SCM_UNSPECIFIED; -} - -#endif /* SCM_DEBUG_DEPRECATED == 0 */ - void scm_init_error () { diff --git a/libguile/error.h b/libguile/error.h index 37b8ee342..c7b7fd216 100644 --- a/libguile/error.h +++ b/libguile/error.h @@ -2,18 +2,19 @@ #ifndef SCM_ERROR_H #define SCM_ERROR_H + /* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc. - * + * * 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 * the Free Software Foundation; either version 2, or (at your option) * any later version. - * + * * This program 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 General Public License for more details. - * + * * You should have received a copy of the GNU General Public License * along with this software; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, @@ -42,7 +43,9 @@ * If you write modifications of your own for GUILE, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ + + #include "libguile/__scm.h" @@ -74,14 +77,6 @@ extern void scm_misc_error (const char *subr, const char *message, SCM args) SCM_NORETURN; extern void scm_init_error (void); - - -#if (SCM_DEBUG_DEPRECATED == 0) - -extern SCM scm_wta (SCM arg, const char *pos, const char *s_subr); - -#endif /* SCM_DEBUG_DEPRECATED == 0 */ - #endif /* SCM_ERROR_H */ /* diff --git a/libguile/eval.c b/libguile/eval.c index b896814d2..6ea2a9dd9 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -155,7 +155,7 @@ char *alloca (); ? *scm_lookupcar (x, env, 1) \ : SCM_CEVAL (SCM_CAR (x), env)) -#define EVALCAR(x, env) (!SCM_CELLP (SCM_CAR (x)) \ +#define EVALCAR(x, env) (SCM_IMP (SCM_CAR (x)) \ ? SCM_EVALIM (SCM_CAR (x), env) \ : EVALCELLCAR (x, env)) @@ -413,8 +413,7 @@ scm_unmemocar (SCM form, SCM env) c = SCM_CAR (form); if (SCM_VARIABLEP (c)) { - SCM sym = - scm_module_reverse_lookup (scm_env_module (env), c); + SCM sym = scm_module_reverse_lookup (scm_env_module (env), c); if (SCM_EQ_P (sym, SCM_BOOL_F)) sym = sym_three_question_marks; SCM_SETCAR (form, sym); @@ -1300,7 +1299,7 @@ unmemocopy (SCM x, SCM env) #ifdef DEBUG_EXTENSIONS SCM p; #endif - if (!SCM_CELLP (x) || !SCM_CONSP (x)) + if (!SCM_CONSP (x)) return x; #ifdef DEBUG_EXTENSIONS p = scm_whash_lookup (scm_source_whash, x); @@ -1468,15 +1467,17 @@ unmemocopy (SCM x, SCM env) env); } loop: - while (SCM_CELLP (x = SCM_CDR (x)) && SCM_CONSP (x)) + x = SCM_CDR (x); + while (SCM_CONSP (x)) { - if (SCM_ISYMP (SCM_CAR (x))) - /* skip body markers */ - continue; - SCM_SETCDR (z, unmemocar (scm_cons (unmemocopy (SCM_CAR (x), env), - SCM_UNSPECIFIED), - env)); - z = SCM_CDR (z); + SCM form = SCM_CAR (x); + if (!SCM_ISYMP (form)) + { + SCM copy = scm_cons (unmemocopy (form, env), SCM_UNSPECIFIED); + SCM_SETCDR (z, unmemocar (copy, env)); + z = SCM_CDR (z); + } + x = SCM_CDR (x); } SCM_SETCDR (z, x); #ifdef DEBUG_EXTENSIONS @@ -1975,7 +1976,7 @@ dispatch: } carloop: /* scm_eval car of last form in list */ - if (!SCM_CELLP (SCM_CAR (x))) + if (SCM_IMP (SCM_CAR (x))) { x = SCM_CAR (x); RETURN (SCM_EVALIM (x, env)) @@ -2508,7 +2509,6 @@ dispatch: #endif #endif case scm_tc7_string: - case scm_tc7_substring: case scm_tc7_smob: case scm_tcs_closures: case scm_tc7_cclo: @@ -4048,47 +4048,6 @@ SCM_DEFINE (scm_eval, "eval", 2, 0, 0, } #undef FUNC_NAME -#if (SCM_DEBUG_DEPRECATED == 0) - -/* Use scm_current_module () or scm_interaction_environment () - * instead. The former is the module selected during loading of code. - * The latter is the module in which the user of this thread currently - * types expressions. - */ - -SCM scm_top_level_lookup_closure_var; -SCM scm_system_transformer; - -/* Avoid using this functionality altogether (except for implementing - * libguile, where you can use scm_i_eval or scm_i_eval_x). - * - * Applications should use either C level scm_eval_x or Scheme - * scm_eval; or scm_primitive_eval_x or scm_primitive_eval. */ - -SCM -scm_eval_3 (SCM obj, int copyp, SCM env) -{ - if (copyp) - return scm_i_eval (obj, env); - else - return scm_i_eval_x (obj, env); -} - -SCM_DEFINE (scm_eval2, "eval2", 2, 0, 0, - (SCM obj, SCM env_thunk), - "Evaluate @var{exp}, a Scheme expression, in the environment\n" - "designated by @var{lookup}, a symbol-lookup function." - "Do not use this version of eval, it does not play well\n" - "with the module system. Use @code{eval} or\n" - "@code{primitive-eval} instead.") -#define FUNC_NAME s_scm_eval2 -{ - return scm_i_eval (obj, scm_top_level_env (env_thunk)); -} -#undef FUNC_NAME - -#endif /* DEPRECATED */ - /* At this point, scm_deval and scm_dapply are generated. */ @@ -4124,13 +4083,6 @@ scm_init_eval () /* acros */ /* end of acros */ -#if SCM_DEBUG_DEPRECATED == 0 - scm_top_level_lookup_closure_var = - scm_c_define ("*top-level-lookup-closure*", scm_make_fluid ()); - scm_system_transformer = - scm_c_define ("scm:eval-transformer", scm_make_fluid ()); -#endif - #ifndef SCM_MAGIC_SNARFER #include "libguile/eval.x" #endif diff --git a/libguile/eval.h b/libguile/eval.h index 18e245483..8895b9ccb 100644 --- a/libguile/eval.h +++ b/libguile/eval.h @@ -2,18 +2,19 @@ #ifndef SCM_EVAL_H #define SCM_EVAL_H + /* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc. - * + * * 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 * the Free Software Foundation; either version 2, or (at your option) * any later version. - * + * * This program 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 General Public License for more details. - * + * * You should have received a copy of the GNU General Public License * along with this software; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, @@ -42,6 +43,7 @@ * If you write modifications of your own for GUILE, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ + #include "libguile/__scm.h" @@ -114,7 +116,7 @@ extern SCM scm_eval_options_interface (SCM setting); #define SCM_XEVAL(x, env) (SCM_IMP (x) \ ? SCM_EVALIM2(x) \ : (*scm_ceval_ptr) ((x), (env))) -#define SCM_XEVALCAR(x, env) (SCM_NCELLP (SCM_CAR (x)) \ +#define SCM_XEVALCAR(x, env) (SCM_IMP (SCM_CAR (x)) \ ? SCM_EVALIM (SCM_CAR (x), env) \ : (SCM_SYMBOLP (SCM_CAR (x)) \ ? *scm_lookupcar (x, env, 1) \ @@ -134,13 +136,6 @@ extern SCM scm_eval_options_interface (SCM setting); #define SCM_TOP_LEVEL_LOOKUP_CLOSURE (scm_current_module_lookup_closure()) -#if SCM_DEBUG_DEPRECATED == 0 - -extern SCM scm_top_level_lookup_closure_var; -extern SCM scm_system_transformer; -#endif - - extern const char scm_s_expression[]; extern const char scm_s_test[]; @@ -244,10 +239,6 @@ extern SCM scm_force (SCM x); extern SCM scm_promise_p (SCM x); extern SCM scm_cons_source (SCM xorig, SCM x, SCM y); extern SCM scm_copy_tree (SCM obj); -#if SCM_DEBUG_DEPRECATED == 0 -extern SCM scm_eval_3 (SCM obj, int copyp, SCM env); -extern SCM scm_eval2 (SCM obj, SCM env_thunk); -#endif extern SCM scm_i_eval_x (SCM exp, SCM env); extern SCM scm_i_eval (SCM exp, SCM env); extern SCM scm_primitive_eval (SCM exp); diff --git a/libguile/filesys.c b/libguile/filesys.c index f86f790f9..1482db521 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -179,7 +179,6 @@ SCM_DEFINE (scm_chown, "chown", 3, 0, 0, #endif { SCM_VALIDATE_STRING (1, object); - SCM_STRING_COERCE_0TERMINATION_X (object); SCM_SYSCALL (rv = chown (SCM_STRING_CHARS (object), SCM_INUM (owner), SCM_INUM (group))); } @@ -219,7 +218,6 @@ SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0, else { SCM_VALIDATE_STRING (1, object); - SCM_STRING_COERCE_0TERMINATION_X (object); SCM_SYSCALL (rv = chmod (SCM_STRING_CHARS (object), SCM_INUM (mode))); } if (rv == -1) @@ -264,7 +262,6 @@ SCM_DEFINE (scm_open_fdes, "open-fdes", 2, 1, 0, int imode; SCM_VALIDATE_STRING (1, path); - SCM_STRING_COERCE_0TERMINATION_X (path); iflags = SCM_NUM2INT (2, flags); imode = SCM_NUM2INT_DEF (3, mode, 0666); SCM_SYSCALL (fd = open (SCM_STRING_CHARS (path), iflags, imode)); @@ -556,7 +553,6 @@ SCM_DEFINE (scm_stat, "stat", 1, 0, 0, } else if (SCM_STRINGP (object)) { - SCM_STRING_COERCE_0TERMINATION_X (object); SCM_SYSCALL (rv = stat (SCM_STRING_CHARS (object), &stat_temp)); } else @@ -596,9 +592,7 @@ SCM_DEFINE (scm_link, "link", 2, 0, 0, int val; SCM_VALIDATE_STRING (1, oldpath); - SCM_STRING_COERCE_0TERMINATION_X (oldpath); SCM_VALIDATE_STRING (2, newpath); - SCM_STRING_COERCE_0TERMINATION_X (newpath); SCM_SYSCALL (val = link (SCM_STRING_CHARS (oldpath), SCM_STRING_CHARS (newpath))); if (val != 0) @@ -619,8 +613,6 @@ SCM_DEFINE (scm_rename, "rename-file", 2, 0, 0, int rv; SCM_VALIDATE_STRING (1, oldname); SCM_VALIDATE_STRING (2, newname); - SCM_STRING_COERCE_0TERMINATION_X (oldname); - SCM_STRING_COERCE_0TERMINATION_X (newname); #ifdef HAVE_RENAME SCM_SYSCALL (rv = rename (SCM_STRING_CHARS (oldname), SCM_STRING_CHARS (newname))); #else @@ -647,7 +639,6 @@ SCM_DEFINE (scm_delete_file, "delete-file", 1, 0, 0, { int ans; SCM_VALIDATE_STRING (1, str); - SCM_STRING_COERCE_0TERMINATION_X (str); SCM_SYSCALL (ans = unlink (SCM_STRING_CHARS (str))); if (ans != 0) SCM_SYSERROR; @@ -667,7 +658,6 @@ SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0, int rv; mode_t mask; SCM_VALIDATE_STRING (1, path); - SCM_STRING_COERCE_0TERMINATION_X (path); if (SCM_UNBNDP (mode)) { mask = umask (0); @@ -696,7 +686,6 @@ SCM_DEFINE (scm_rmdir, "rmdir", 1, 0, 0, int val; SCM_VALIDATE_STRING (1, path); - SCM_STRING_COERCE_0TERMINATION_X (path); SCM_SYSCALL (val = rmdir (SCM_STRING_CHARS (path))); if (val != 0) SCM_SYSERROR; @@ -732,7 +721,6 @@ SCM_DEFINE (scm_opendir, "opendir", 1, 0, 0, { DIR *ds; SCM_VALIDATE_STRING (1, dirname); - SCM_STRING_COERCE_0TERMINATION_X (dirname); SCM_SYSCALL (ds = opendir (SCM_STRING_CHARS (dirname))); if (ds == NULL) SCM_SYSERROR; @@ -841,7 +829,6 @@ SCM_DEFINE (scm_chdir, "chdir", 1, 0, 0, int ans; SCM_VALIDATE_STRING (1, str); - SCM_STRING_COERCE_0TERMINATION_X (str); SCM_SYSCALL (ans = chdir (SCM_STRING_CHARS (str))); if (ans != 0) SCM_SYSERROR; @@ -1266,8 +1253,6 @@ SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0, SCM_VALIDATE_STRING (1, oldpath); SCM_VALIDATE_STRING (2, newpath); - SCM_STRING_COERCE_0TERMINATION_X (oldpath); - SCM_STRING_COERCE_0TERMINATION_X (newpath); SCM_SYSCALL (val = symlink (SCM_STRING_CHARS (oldpath), SCM_STRING_CHARS (newpath))); if (val != 0) SCM_SYSERROR; @@ -1288,7 +1273,6 @@ SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0, char *buf; SCM result; SCM_VALIDATE_STRING (1, path); - SCM_STRING_COERCE_0TERMINATION_X (path); buf = scm_must_malloc (size, FUNC_NAME); while ((rv = readlink (SCM_STRING_CHARS (path), buf, size)) == size) { @@ -1317,7 +1301,6 @@ SCM_DEFINE (scm_lstat, "lstat", 1, 0, 0, struct stat stat_temp; SCM_VALIDATE_STRING (1, str); - SCM_STRING_COERCE_0TERMINATION_X (str); SCM_SYSCALL (rv = lstat (SCM_STRING_CHARS (str), &stat_temp)); if (rv != 0) { @@ -1344,9 +1327,7 @@ SCM_DEFINE (scm_copy_file, "copy-file", 2, 0, 0, struct stat oldstat; SCM_VALIDATE_STRING (1, oldfile); - SCM_STRING_COERCE_0TERMINATION_X (oldfile); SCM_VALIDATE_STRING (2, newfile); - SCM_STRING_COERCE_0TERMINATION_X (newfile); if (stat (SCM_STRING_CHARS (oldfile), &oldstat) == -1) SCM_SYSERROR; oldfd = open (SCM_STRING_CHARS (oldfile), O_RDONLY); diff --git a/libguile/fports.c b/libguile/fports.c index 886caadf6..7317ed17d 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -297,8 +297,6 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0, SCM_VALIDATE_STRING (1, filename); SCM_VALIDATE_STRING (2, mode); - SCM_STRING_COERCE_0TERMINATION_X (filename); - SCM_STRING_COERCE_0TERMINATION_X (mode); file = SCM_STRING_CHARS (filename); md = SCM_STRING_CHARS (mode); diff --git a/libguile/gc.c b/libguile/gc.c index d63562f44..f9c7be170 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -94,6 +94,8 @@ +#define CELL_P(x) (SCM_ITAG3 (x) == scm_tc3_cons) + unsigned int scm_gc_running_p = 0; @@ -1227,7 +1229,7 @@ gc_mark_loop_first_time: SCM_MISC_ERROR ("rogue pointer in heap", SCM_EOL); #else /* In non-debug mode, do at least some cheap testing. */ - if (!SCM_CELLP (ptr)) + if (!CELL_P (ptr)) SCM_MISC_ERROR ("rogue pointer in heap", SCM_EOL); #endif @@ -1344,10 +1346,6 @@ gc_mark_loop_first_time: case scm_tc7_string: break; - case scm_tc7_substring: - ptr = SCM_CDR (ptr); - goto_gc_mark_loop; - case scm_tc7_wvect: SCM_SET_WVECT_GC_CHAIN (ptr, scm_weak_vectors); scm_weak_vectors = ptr; @@ -1509,7 +1507,7 @@ gc_mark_loop_first_time: static long int heap_segment (SCM obj) { - if (!SCM_CELLP (obj)) + if (!CELL_P (obj)) return -1; else { @@ -1783,8 +1781,6 @@ scm_gc_sweep () scm_must_free (SCM_UVECTOR_BASE (scmptr)); break; #endif - case scm_tc7_substring: - break; case scm_tc7_string: m += SCM_STRING_LENGTH (scmptr) + 1; scm_must_free (SCM_STRING_CHARS (scmptr)); @@ -2472,9 +2468,9 @@ alloc_some_heap (scm_t_freelist *freelist, policy_on_error error_policy) * scm_remember_upto_here* _behind_ the last code in your function, that * depends on the scheme object to exist. * - * Example: We want to make sure, that the string object str does not get - * garbage collected during the execution of 'some_function', because - * otherwise the characters belonging to str would be freed and + * Example: We want to make sure that the string object str does not get + * garbage collected during the execution of 'some_function' in the code + * below, because otherwise the characters belonging to str would be freed and * 'some_function' might access freed memory. To make sure that the compiler * keeps str alive on the stack or in a register such that it is visible to * the conservative gc we add the call to scm_remember_upto_here_1 _after_ the @@ -2503,34 +2499,6 @@ scm_remember_upto_here (SCM obj SCM_UNUSED, ...) /* Empty. Protects any number of objects from garbage collection. */ } - -#if (SCM_DEBUG_DEPRECATED == 0) - -void -scm_remember (SCM *ptr) -{ - scm_c_issue_deprecation_warning ("`scm_remember' is deprecated. " - "Use the `scm_remember_upto_here*' family of functions instead."); -} - -SCM -scm_protect_object (SCM obj) -{ - scm_c_issue_deprecation_warning ("`scm_protect_object' is deprecated. " - "Use `scm_gc_protect_object' instead."); - return scm_gc_protect_object (obj); -} - -SCM -scm_unprotect_object (SCM obj) -{ - scm_c_issue_deprecation_warning ("`scm_unprotect_object' is deprecated. " - "Use `scm_gc_unprotect_object' instead."); - return scm_gc_unprotect_object (obj); -} - -#endif /* SCM_DEBUG_DEPRECATED == 0 */ - /* These crazy functions prevent garbage collection of arguments after the first argument by diff --git a/libguile/gc.h b/libguile/gc.h index 07a11481b..3b0efff1e 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -2,6 +2,7 @@ #ifndef SCM_GC_H #define SCM_GC_H + /* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify @@ -390,32 +391,6 @@ extern int scm_init_storage (void); extern void *scm_get_stack_base (void); extern void scm_init_gc (void); - - -#if (SCM_DEBUG_DEPRECATED == 0) - -extern SCM scm_protect_object (SCM obj); -extern SCM scm_unprotect_object (SCM obj); - -#define SCM_SETAND_CAR(x, y) \ - (SCM_SETCAR ((x), SCM_PACK (SCM_UNPACK (SCM_CAR (x)) & (y)))) -#define SCM_SETOR_CAR(x, y)\ - (SCM_SETCAR ((x), SCM_PACK (SCM_UNPACK (SCM_CAR (x)) | (y)))) -#define SCM_SETAND_CDR(x, y)\ - (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_GC8MARKP(x) SCM_GCMARKP (x) -#define SCM_SETGC8MARK(x) SCM_SETGCMARK (x) -#define SCM_CLRGC8MARK(x) SCM_CLRGCMARK (x) -#define SCM_GCTYP16(x) SCM_TYP16 (x) -#define SCM_GCCDR(x) SCM_CDR (x) -extern void scm_remember (SCM * ptr); - -#endif /* SCM_DEBUG_DEPRECATED == 0 */ - #endif /* SCM_GC_H */ /* diff --git a/libguile/gh_data.c b/libguile/gh_data.c index f55b87ed9..0f503a950 100644 --- a/libguile/gh_data.c +++ b/libguile/gh_data.c @@ -288,7 +288,6 @@ gh_scm2chars (SCM obj, char *m) break; #endif case scm_tc7_string: - case scm_tc7_substring: n = SCM_STRING_LENGTH (obj); if (m == 0) m = (char *) malloc (n * sizeof (char)); diff --git a/libguile/hash.c b/libguile/hash.c index 70c12546f..3b8fcbc33 100644 --- a/libguile/hash.c +++ b/libguile/hash.c @@ -138,7 +138,6 @@ scm_hasher(SCM obj, unsigned long n, size_t d) obj = scm_number_to_string (obj, SCM_MAKINUM (10)); } case scm_tc7_string: - case scm_tc7_substring: return scm_string_hash (SCM_STRING_UCHARS (obj), SCM_STRING_LENGTH (obj)) % n; case scm_tc7_symbol: return SCM_SYMBOL_HASH (obj) % n; diff --git a/libguile/init.c b/libguile/init.c index 2c7901f50..f768cc7d9 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -176,11 +176,6 @@ start_stack (void *base) scm_exitval = SCM_BOOL_F; /* vestigial */ -#if SCM_DEBUG_DEPRECATED == 0 - scm_top_level_lookup_closure_var = SCM_BOOL_F; - scm_system_transformer = SCM_BOOL_F; -#endif - scm_root->fluids = scm_make_initial_fluids (); /* Create an object to hold the root continuation. diff --git a/libguile/ioext.c b/libguile/ioext.c index 4cb28ad62..dddd38dda 100644 --- a/libguile/ioext.c +++ b/libguile/ioext.c @@ -237,7 +237,6 @@ SCM_DEFINE (scm_fdopen, "fdopen", 2, 0, 0, { SCM_VALIDATE_INUM (1,fdes); SCM_VALIDATE_STRING (2, modes); - SCM_STRING_COERCE_0TERMINATION_X (modes); return scm_fdes_to_port (SCM_INUM (fdes), SCM_STRING_CHARS (modes), SCM_BOOL_F); } diff --git a/libguile/modules.c b/libguile/modules.c index ed8fdfdda..1d6040d62 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -91,13 +91,6 @@ SCM_DEFINE (scm_set_current_module, "set-current-module", 1, 0, 0, old = scm_current_module (); scm_fluid_set_x (the_module, module); -#if SCM_DEBUG_DEPRECATED == 0 - scm_fluid_set_x (SCM_VARIABLE_REF (scm_top_level_lookup_closure_var), - scm_current_module_lookup_closure ()); - scm_fluid_set_x (SCM_VARIABLE_REF (scm_system_transformer), - scm_current_module_transformer ()); -#endif - return old; } #undef FUNC_NAME @@ -429,9 +422,6 @@ scm_sym2var (SCM sym, SCM proc, SCM definep) if (var == SCM_BOOL_F) { var = scm_make_variable (SCM_UNDEFINED); -#if SCM_ENABLE_VCELLS - scm_variable_set_name_hint (var, sym); -#endif SCM_SETCDR (handle, var); } } @@ -573,18 +563,6 @@ SCM_DEFINE (scm_get_pre_modules_obarray, "%get-pre-modules-obarray", 0, 0, 0, } #undef FUNC_NAME -#if SCM_DEBUG_DEPRECATED == 0 - -static SCM root_module_lookup_closure; -SCM_SYMBOL (scm_sym_app, "app"); -SCM_SYMBOL (scm_sym_modules, "modules"); -static SCM module_prefix; -static SCM make_modules_in_var; -static SCM beautify_user_module_x_var; -static SCM try_module_autoload_var; - -#endif - SCM_SYMBOL (scm_sym_system_module, "system-module"); SCM @@ -635,73 +613,9 @@ scm_post_boot_init_modules () module_export_x_var = PERM (scm_c_lookup ("module-export!")); the_root_module_var = PERM (scm_c_lookup ("the-root-module")); -#if SCM_DEBUG_DEPRECATED == 0 - - module_prefix = PERM (scm_list_2 (scm_sym_app, scm_sym_modules)); - make_modules_in_var = PERM (scm_c_lookup ("make-modules-in")); - root_module_lookup_closure = - PERM (scm_module_lookup_closure (SCM_VARIABLE_REF (the_root_module_var))); - beautify_user_module_x_var = PERM (scm_c_lookup ("beautify-user-module!")); - try_module_autoload_var = PERM (scm_c_lookup ("try-module-autoload")); - -#endif - scm_module_system_booted_p = 1; } -#if SCM_DEBUG_DEPRECATED == 0 - -SCM -scm_the_root_module () -{ - scm_c_issue_deprecation_warning ("`scm_the_root_module' is deprecated. " - "Use `scm_c_resolve_module (\"guile\") " - "instead."); - - return the_root_module (); -} - -static SCM -scm_module_full_name (SCM name) -{ - if (SCM_EQ_P (SCM_CAR (name), scm_sym_app)) - return name; - else - return scm_append (scm_list_2 (module_prefix, name)); -} - -SCM -scm_make_module (SCM name) -{ - scm_c_issue_deprecation_warning ("`scm_make_module' is deprecated. " - "Use `scm_c_define_module instead."); - - return scm_call_2 (SCM_VARIABLE_REF (make_modules_in_var), - scm_the_root_module (), - scm_module_full_name (name)); -} - -SCM -scm_ensure_user_module (SCM module) -{ - scm_c_issue_deprecation_warning ("`scm_ensure_user_module' is deprecated. " - "Use `scm_c_define_module instead."); - - scm_call_1 (SCM_VARIABLE_REF (beautify_user_module_x_var), module); - return SCM_UNSPECIFIED; -} - -SCM -scm_load_scheme_module (SCM name) -{ - scm_c_issue_deprecation_warning ("`scm_load_scheme_module' is deprecated. " - "Use `scm_c_resolve_module instead."); - - return scm_call_1 (SCM_VARIABLE_REF (try_module_autoload_var), name); -} - -#endif - /* Local Variables: c-file-style: "gnu" diff --git a/libguile/modules.h b/libguile/modules.h index 55dd94744..ece08bb7b 100644 --- a/libguile/modules.h +++ b/libguile/modules.h @@ -2,18 +2,19 @@ #ifndef SCM_MODULES_H #define SCM_MODULES_H + /* Copyright (C) 1998,2000,2001 Free Software Foundation, Inc. - * + * * 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 * the Free Software Foundation; either version 2, or (at your option) * any later version. - * + * * This program 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 General Public License for more details. - * + * * You should have received a copy of the GNU General Public License * along with this software; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, @@ -42,6 +43,7 @@ * If you write modifications of your own for GUILE, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ + #include "libguile/__scm.h" @@ -130,15 +132,6 @@ extern SCM scm_system_module_env_p (SCM env); extern void scm_modules_prehistory (void); extern void scm_init_modules (void); -#if SCM_DEBUG_DEPRECATED == 0 - -extern SCM scm_the_root_module (void); -extern SCM scm_make_module (SCM name); -extern SCM scm_ensure_user_module (SCM name); -extern SCM scm_load_scheme_module (SCM name); - -#endif - #endif /* SCM_MODULES_H */ /* diff --git a/libguile/net_db.c b/libguile/net_db.c index bcb920708..91d0d8347 100644 --- a/libguile/net_db.c +++ b/libguile/net_db.c @@ -176,7 +176,6 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0, } else if (SCM_STRINGP (host)) { - SCM_STRING_COERCE_0TERMINATION_X (host); entry = gethostbyname (SCM_STRING_CHARS (host)); } else @@ -248,7 +247,6 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0, } else if (SCM_STRINGP (net)) { - SCM_STRING_COERCE_0TERMINATION_X (net); entry = getnetbyname (SCM_STRING_CHARS (net)); } else @@ -298,7 +296,6 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0, } else if (SCM_STRINGP (protocol)) { - SCM_STRING_COERCE_0TERMINATION_X (protocol); entry = getprotobyname (SCM_STRING_CHARS (protocol)); } else @@ -360,10 +357,8 @@ SCM_DEFINE (scm_getserv, "getserv", 0, 2, 0, return scm_return_entry (entry); } SCM_VALIDATE_STRING (2, protocol); - SCM_STRING_COERCE_0TERMINATION_X (protocol); if (SCM_STRINGP (name)) { - SCM_STRING_COERCE_0TERMINATION_X (name); entry = getservbyname (SCM_STRING_CHARS (name), SCM_STRING_CHARS (protocol)); } else diff --git a/libguile/objects.c b/libguile/objects.c index 424cd466e..aca2e55d0 100644 --- a/libguile/objects.c +++ b/libguile/objects.c @@ -132,7 +132,6 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0, #endif return scm_class_vector; case scm_tc7_string: - case scm_tc7_substring: return scm_class_string; case scm_tc7_asubr: case scm_tc7_subr_0: diff --git a/libguile/ports.c b/libguile/ports.c index 266ac0ea4..4ee18fc3d 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -743,47 +743,6 @@ SCM_DEFINE (scm_port_for_each, "port-for-each", 1, 0, 0, } #undef FUNC_NAME -#if (SCM_DEBUG_DEPRECATED == 0) - -SCM_DEFINE (scm_close_all_ports_except, "close-all-ports-except", 0, 0, 1, - (SCM ports), - "[DEPRECATED] Close all open file ports used by the interpreter\n" - "except for those supplied as arguments. This procedure\n" - "was intended to be used before an exec call to close file descriptors\n" - "which are not needed in the new process. However it has the\n" - "undesirable side-effect of flushing buffes, so it's deprecated.\n" - "Use port-for-each instead.") -#define FUNC_NAME s_scm_close_all_ports_except -{ - long i = 0; - SCM_VALIDATE_REST_ARGUMENT (ports); - while (i < scm_port_table_size) - { - SCM thisport = scm_port_table[i]->port; - int found = 0; - SCM ports_ptr = ports; - - while (!SCM_NULLP (ports_ptr)) - { - SCM port = SCM_COERCE_OUTPORT (SCM_CAR (ports_ptr)); - if (i == 0) - SCM_VALIDATE_OPPORT (SCM_ARG1,port); - if (SCM_EQ_P (port, thisport)) - found = 1; - ports_ptr = SCM_CDR (ports_ptr); - } - if (found) - i++; - else - /* i is not to be incremented here. */ - scm_close_port (thisport); - } - return SCM_UNSPECIFIED; -} -#undef FUNC_NAME - -#endif - /* Utter miscellany. Gosh, we should clean this up some time. */ @@ -1392,7 +1351,6 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0, else { SCM_VALIDATE_STRING (1, object); - SCM_STRING_COERCE_0TERMINATION_X (object); SCM_SYSCALL (rv = truncate (SCM_STRING_CHARS (object), c_length)); } if (rv == -1) @@ -1575,7 +1533,6 @@ SCM_DEFINE (scm_sys_make_void_port, "%make-void-port", 1, 0, 0, #define FUNC_NAME s_scm_sys_make_void_port { SCM_VALIDATE_STRING (1, mode); - SCM_STRING_COERCE_0TERMINATION_X (mode); return scm_void_port (SCM_STRING_CHARS (mode)); } #undef FUNC_NAME diff --git a/libguile/ports.h b/libguile/ports.h index 60877af8c..b0d97fd1e 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -2,18 +2,19 @@ #ifndef SCM_PORTS_H #define SCM_PORTS_H + /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc. - * + * * 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 * the Free Software Foundation; either version 2, or (at your option) * any later version. - * + * * This program 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 General Public License for more details. - * + * * You should have received a copy of the GNU General Public License * along with this software; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, @@ -44,6 +45,7 @@ * If you do not wish that, delete this exception notice. */ + #include "libguile/__scm.h" #include "libguile/print.h" @@ -150,17 +152,17 @@ extern long scm_port_table_size; /* Number of ports in scm_port_table. */ #define SCM_BUF0 (8L<<16) /* Is it unbuffered? */ #define SCM_BUFLINE (64L<<16) /* Is it line-buffered? */ -#define SCM_PORTP(x) (SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_port)) -#define SCM_OPPORTP(x) (SCM_NIMP(x) && (((0x7f | SCM_OPN) & SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_OPN))) -#define SCM_OPINPORTP(x) (SCM_NIMP(x) && (((0x7f | SCM_OPN | SCM_RDNG) & SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_OPN | SCM_RDNG))) -#define SCM_OPOUTPORTP(x) (SCM_NIMP(x) && (((0x7f | SCM_OPN | SCM_WRTNG) & SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_OPN | SCM_WRTNG))) +#define SCM_PORTP(x) (!SCM_IMP (x) && (SCM_TYP7 (x) == scm_tc7_port)) +#define SCM_OPPORTP(x) (!SCM_IMP(x) && (((0x7f | SCM_OPN) & SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_OPN))) +#define SCM_OPINPORTP(x) (!SCM_IMP(x) && (((0x7f | SCM_OPN | SCM_RDNG) & SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_OPN | SCM_RDNG))) +#define SCM_OPOUTPORTP(x) (!SCM_IMP(x) && (((0x7f | SCM_OPN | SCM_WRTNG) & SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_OPN | SCM_WRTNG))) #define SCM_INPUT_PORT_P(x) \ - (SCM_NIMP(x) \ + (!SCM_IMP(x) \ && (((0x7f | SCM_RDNG) & SCM_CELL_WORD_0(x)) == (scm_tc7_port | SCM_RDNG))) #define SCM_OUTPUT_PORT_P(x) \ - (SCM_NIMP(x) \ + (!SCM_IMP(x) \ && (((0x7f | SCM_WRTNG) & SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_WRTNG))) -#define SCM_OPENP(x) (SCM_NIMP(x) && (SCM_OPN & SCM_CELL_WORD_0 (x))) +#define SCM_OPENP(x) (!SCM_IMP(x) && (SCM_OPN & SCM_CELL_WORD_0 (x))) #define SCM_CLOSEDP(x) (!SCM_OPENP(x)) #define SCM_CLR_PORT_OPEN_FLAG(p) \ SCM_SET_CELL_WORD_0 ((p), SCM_CELL_WORD_0 (p) & ~SCM_OPN) @@ -204,12 +206,6 @@ typedef struct scm_t_ptob_descriptor } scm_t_ptob_descriptor; -#if (SCM_DEBUG_DEPRECATED == 0) -# define scm_port scm_t_port -# define scm_ptob_descriptor scm_t_ptob_descriptor -# define scm_port_rw_active scm_t_port_rw_active -#endif - #define SCM_TC2PTOBNUM(x) (0x0ff & ((x) >> 8)) #define SCM_PTOBNUM(x) (SCM_TC2PTOBNUM (SCM_CELL_TYPE (x))) /* SCM_PTOBNAME can be 0 if name is missing */ @@ -318,14 +314,6 @@ extern SCM scm_pt_size (void); extern SCM scm_pt_member (SCM member); #endif /* GUILE_DEBUG */ - - -#if (SCM_DEBUG_DEPRECATED == 0) - -extern SCM scm_close_all_ports_except (SCM ports); - -#endif /* SCM_DEBUG_DEPRECATED == 0 */ - #endif /* SCM_PORTS_H */ /* diff --git a/libguile/posix.c b/libguile/posix.c index 2fe0d4af2..54998f091 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -292,7 +292,6 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0, else { SCM_VALIDATE_STRING (1, user); - SCM_STRING_COERCE_0TERMINATION_X (user); entry = getpwnam (SCM_STRING_CHARS (user)); } if (!entry) @@ -362,7 +361,6 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0, else { SCM_VALIDATE_STRING (1, name); - SCM_STRING_COERCE_0TERMINATION_X (name); SCM_SYSCALL (entry = getgrnam (SCM_STRING_CHARS (name))); } if (!entry) @@ -895,7 +893,6 @@ SCM_DEFINE (scm_execl, "execl", 1, 0, 1, { char **execargv; SCM_VALIDATE_STRING (1, filename); - SCM_STRING_COERCE_0TERMINATION_X (filename); execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME); execv (SCM_STRING_CHARS (filename), execargv); SCM_SYSERROR; @@ -916,7 +913,6 @@ SCM_DEFINE (scm_execlp, "execlp", 1, 0, 1, { char **execargv; SCM_VALIDATE_STRING (1, filename); - SCM_STRING_COERCE_0TERMINATION_X (filename); execargv = scm_convert_exec_args (args, SCM_ARG2, FUNC_NAME); execvp (SCM_STRING_CHARS (filename), execargv); SCM_SYSERROR; @@ -969,7 +965,6 @@ SCM_DEFINE (scm_execle, "execle", 2, 0, 1, char **exec_env; SCM_VALIDATE_STRING (1, filename); - SCM_STRING_COERCE_0TERMINATION_X (filename); execargv = scm_convert_exec_args (args, SCM_ARG1, FUNC_NAME); exec_env = environ_list_to_c (env, SCM_ARG2, FUNC_NAME); @@ -1099,7 +1094,6 @@ SCM_DEFINE (scm_mkstemp, "mkstemp!", 1, 0, 0, char *c_tmpl; int rv; - SCM_STRING_COERCE_0TERMINATION_X (tmpl); SCM_VALIDATE_STRING_COPY (1, tmpl, c_tmpl); SCM_SYSCALL (rv = mkstemp (c_tmpl)); if (rv == -1) @@ -1126,7 +1120,6 @@ SCM_DEFINE (scm_utime, "utime", 1, 2, 0, struct utimbuf utm_tmp; SCM_VALIDATE_STRING (1, pathname); - SCM_STRING_COERCE_0TERMINATION_X (pathname); if (SCM_UNBNDP (actime)) SCM_SYSCALL (time (&utm_tmp.actime)); else @@ -1174,7 +1167,6 @@ SCM_DEFINE (scm_access, "access?", 2, 0, 0, int rv; SCM_VALIDATE_STRING (1, path); - SCM_STRING_COERCE_0TERMINATION_X (path); SCM_VALIDATE_INUM (2, how); rv = access (SCM_STRING_CHARS (path), SCM_INUM (how)); return SCM_NEGATE_BOOL(rv); @@ -1245,7 +1237,6 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0, else { SCM_VALIDATE_STRING (2, locale); - SCM_STRING_COERCE_0TERMINATION_X (locale); clocale = SCM_STRING_CHARS (locale); } @@ -1283,7 +1274,6 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0, SCM_VALIDATE_SYMBOL (2,type); SCM_VALIDATE_INUM (3,perms); SCM_VALIDATE_INUM (4,dev); - SCM_STRING_COERCE_0TERMINATION_X (path); p = SCM_SYMBOL_CHARS (type); if (strcmp (p, "regular") == 0) @@ -1354,8 +1344,6 @@ SCM_DEFINE (scm_crypt, "crypt", 2, 0, 0, SCM_VALIDATE_STRING (1, key); SCM_VALIDATE_STRING (2, salt); - SCM_STRING_COERCE_0TERMINATION_X (key); - SCM_STRING_COERCE_0TERMINATION_X (salt); p = crypt (SCM_STRING_CHARS (key), SCM_STRING_CHARS (salt)); return scm_makfrom0str (p); @@ -1374,7 +1362,6 @@ SCM_DEFINE (scm_chroot, "chroot", 1, 0, 0, #define FUNC_NAME s_scm_chroot { SCM_VALIDATE_STRING (1, path); - SCM_STRING_COERCE_0TERMINATION_X (path); if (chroot (SCM_STRING_CHARS (path)) == -1) SCM_SYSERROR; @@ -1512,7 +1499,6 @@ SCM_DEFINE (scm_getpass, "getpass", 1, 0, 0, SCM passwd; SCM_VALIDATE_STRING (1, prompt); - SCM_STRING_COERCE_0TERMINATION_X (prompt); p = getpass(SCM_STRING_CHARS (prompt)); passwd = scm_makfrom0str (p); @@ -1574,7 +1560,6 @@ SCM_DEFINE (scm_sethostname, "sethostname", 1, 0, 0, #define FUNC_NAME s_scm_sethostname { SCM_VALIDATE_STRING (1, name); - SCM_STRING_COERCE_0TERMINATION_X (name); if (sethostname (SCM_STRING_CHARS (name), SCM_STRING_LENGTH (name)) == -1) SCM_SYSERROR; diff --git a/libguile/print.c b/libguile/print.c index 6204a8738..e207f411a 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -507,7 +507,6 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate) scm_putc ('>', port); } break; - case scm_tc7_substring: case scm_tc7_string: if (SCM_WRITINGP (pstate)) { @@ -730,7 +729,7 @@ scm_ipruk (char *hdr, SCM ptr, SCM port) { scm_puts ("#<unknown-", port); scm_puts (hdr, port); - if (SCM_CELLP (ptr)) + if (scm_cellp (ptr)) { scm_puts (" (0x", port); scm_intprint (SCM_CELL_WORD_0 (ptr), 16, port); diff --git a/libguile/random.h b/libguile/random.h index 0901c597b..1de0380ed 100644 --- a/libguile/random.h +++ b/libguile/random.h @@ -1,19 +1,20 @@ /* classes: h_files */ -#ifndef RANDOMH -#define RANDOMH -/* Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. - * +#ifndef SCM_RANDOM_H +#define SCM_RANDOM_H + +/* Copyright (C) 1999,2000,2001 Free Software Foundation, Inc. + * * 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 * the Free Software Foundation; either version 2, or (at your option) * any later version. - * + * * This program 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 General Public License for more details. - * + * * You should have received a copy of the GNU General Public License * along with this software; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, @@ -85,12 +86,6 @@ typedef struct scm_t_i_rstate { unsigned long c; } scm_t_i_rstate; -#if (SCM_DEBUG_DEPRECATED == 0) -# define scm_rstate scm_t_rstate -# define scm_rng scm_t_rng -# define scm_i_rstate scm_t_i_rstate -#endif - extern unsigned long scm_i_uniform32 (scm_t_i_rstate *); extern void scm_i_init_rstate (scm_t_i_rstate *, char *seed, int n); extern scm_t_i_rstate *scm_i_copy_rstate (scm_t_i_rstate *); @@ -130,7 +125,7 @@ extern SCM scm_random_normal_vector_x (SCM v, SCM state); extern SCM scm_random_exp (SCM state); extern void scm_init_random (void); -#endif /* RANDOMH */ +#endif /* SCM_RANDOM_H */ /* Local Variables: diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c index d5d8fba63..3d1ef561d 100644 --- a/libguile/regex-posix.c +++ b/libguile/regex-posix.c @@ -188,7 +188,6 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1, SCM_VALIDATE_STRING (1, pat); SCM_VALIDATE_REST_ARGUMENT (flags); - SCM_STRING_COERCE_0TERMINATION_X (pat); /* Examine list of regexp flags. If REG_BASIC is supplied, then turn off REG_EXTENDED flag (on by default). */ @@ -255,7 +254,6 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0, if (SCM_UNBNDP (flags)) flags = SCM_INUM0; SCM_VALIDATE_INUM (4,flags); - SCM_STRING_COERCE_0TERMINATION_X (str); /* re_nsub doesn't account for the `subexpression' representing the whole regexp, so add 1 to nmatches. */ diff --git a/libguile/simpos.c b/libguile/simpos.c index 7f55c07ee..30b95eb8a 100644 --- a/libguile/simpos.c +++ b/libguile/simpos.c @@ -86,7 +86,6 @@ SCM_DEFINE (scm_system, "system", 0, 1, 0, SCM_VALIDATE_STRING (1, cmd); SCM_DEFER_INTS; errno = 0; - SCM_STRING_COERCE_0TERMINATION_X (cmd); rv = system (SCM_STRING_CHARS (cmd)); if (rv == -1 || (rv == 127 && errno != 0)) SCM_SYSERROR; @@ -106,7 +105,6 @@ SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0, { char *val; SCM_VALIDATE_STRING (1, nam); - SCM_STRING_COERCE_0TERMINATION_X (nam); val = getenv (SCM_STRING_CHARS (nam)); return val ? scm_mem2string (val, strlen (val)) : SCM_BOOL_F; } diff --git a/libguile/socket.c b/libguile/socket.c index 9c22c215a..44539bce9 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -171,7 +171,6 @@ SCM_DEFINE (scm_inet_aton, "inet-aton", 1, 0, 0, struct in_addr soka; SCM_VALIDATE_STRING (1, address); - SCM_STRING_COERCE_0TERMINATION_X (address); if (inet_aton (SCM_STRING_CHARS (address), &soka) == 0) SCM_MISC_ERROR ("bad address", SCM_EOL); return scm_ulong2num (ntohl (soka.s_addr)); diff --git a/libguile/stime.c b/libguile/stime.c index d90e9798d..4d310071f 100644 --- a/libguile/stime.c +++ b/libguile/stime.c @@ -311,7 +311,6 @@ setzone (SCM zone, int pos, const char *subr) char *buf; SCM_ASSERT (SCM_STRINGP (zone), zone, pos, subr); - SCM_STRING_COERCE_0TERMINATION_X (zone); buf = scm_must_malloc (SCM_STRING_LENGTH (zone) + sizeof (tzvar) + 1, subr); sprintf (buf, "%s=%s", tzvar, SCM_STRING_CHARS (zone)); oldenv = environ; @@ -580,7 +579,6 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0, SCM_VALIDATE_STRING (1, format); bdtime2c (stime, &t, SCM_ARG2, FUNC_NAME); - SCM_STRING_COERCE_0TERMINATION_X (format); fmt = SCM_STRING_CHARS (format); len = SCM_STRING_LENGTH (format); @@ -673,8 +671,6 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0, SCM_VALIDATE_STRING (1, format); SCM_VALIDATE_STRING (2, string); - SCM_STRING_COERCE_0TERMINATION_X (format); - SCM_STRING_COERCE_0TERMINATION_X (string); fmt = SCM_STRING_CHARS (format); str = SCM_STRING_CHARS (string); diff --git a/libguile/strings.c b/libguile/strings.c index 7c9d548e9..4d6201d5b 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -66,23 +66,6 @@ SCM_DEFINE (scm_string_p, "string?", 1, 0, 0, } #undef FUNC_NAME -#if SCM_DEBUG_DEPRECATED == 0 - -/* The concept of read-only strings will disappear in next release - * of Guile. - */ - -SCM_DEFINE (scm_read_only_string_p, "read-only-string?", 1, 0, 0, - (SCM obj), - "Return @code{#t} if @var{obj} is either a string or a symbol,\n" - "otherwise return @code{#f}.") -#define FUNC_NAME s_scm_read_only_string_p -{ - return SCM_BOOL(SCM_ROSTRINGP (obj)); -} -#undef FUNC_NAME - -#endif /* DEPRECATED */ SCM_REGISTER_PROC (s_scm_list_to_string, "list->string", 1, 0, 0, scm_string); @@ -118,33 +101,9 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1, } #undef FUNC_NAME -#if (SCM_DEBUG_DEPRECATED == 0) - -SCM -scm_makstr (size_t len, int dummy) -#define FUNC_NAME "scm_makstr" -{ - SCM s; - char *mem; - - SCM_ASSERT_RANGE (1, scm_long2num (len), len <= SCM_STRING_MAX_LENGTH); - - mem = (char *) scm_must_malloc (len + 1, FUNC_NAME); - mem[len] = 0; - - SCM_NEWCELL (s); - SCM_SET_STRING_CHARS (s, mem); - SCM_SET_STRING_LENGTH (s, len); - - return s; -} -#undef FUNC_NAME - -#endif /* SCM_DEBUG_DEPRECATED == 0 */ /* converts C scm_array of strings to SCM scm_list of strings. */ /* If argc < 0, a null terminated scm_array is assumed. */ - SCM scm_makfromstrs (int argc, char **argv) { @@ -191,18 +150,6 @@ scm_take0str (char *s) return scm_take_str (s, strlen (s)); } -#if (SCM_DEBUG_DEPRECATED == 0) - -SCM -scm_makfromstr (const char *src, size_t len, int dummy SCM_UNUSED) -{ - scm_c_issue_deprecation_warning ("`scm_makfromstr' is deprecated. " - "Use `scm_mem2string' instead."); - - return scm_mem2string (src, len); -} - -#endif SCM scm_mem2string (const char *src, size_t len) @@ -320,11 +267,7 @@ SCM_DEFINE (scm_string_set_x, "string-set!", 3, 0, 0, "@var{str}.") #define FUNC_NAME s_scm_string_set_x { -#if (SCM_DEBUG_DEPRECATED == 0) - SCM_VALIDATE_RWSTRING (1, str); -#else SCM_VALIDATE_STRING (1, str); -#endif SCM_VALIDATE_INUM_RANGE (2,k,0,SCM_STRING_LENGTH(str)); SCM_VALIDATE_CHAR (3,chr); SCM_STRING_UCHARS (str)[SCM_INUM (k)] = SCM_CHAR (chr); @@ -390,65 +333,6 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1, } #undef FUNC_NAME -#if SCM_DEBUG_DEPRECATED == 0 - -/* Explicit shared substrings will disappear from Guile. - * - * Instead, "normal" strings will be implemented using sharing - * internally, combined with a copy-on-write strategy. - */ - -SCM_DEFINE (scm_make_shared_substring, "make-shared-substring", 1, 2, 0, - (SCM str, SCM start, SCM end), - "Return a shared substring of @var{str}. The arguments are the\n" - "same as for the @code{substring} function: the shared substring\n" - "returned includes all of the text from @var{str} between\n" - "indexes @var{start} (inclusive) and @var{end} (exclusive). If\n" - "@var{end} is omitted, it defaults to the end of @var{str}. The\n" - "shared substring returned by @code{make-shared-substring}\n" - "occupies the same storage space as @var{str}.") -#define FUNC_NAME s_scm_make_shared_substring -{ - long f; - long t; - SCM answer; - SCM len_str; - - SCM_VALIDATE_ROSTRING (1,str); - SCM_VALIDATE_INUM_DEF_COPY (2,start,0,f); - SCM_VALIDATE_INUM_DEF_COPY (3,end,SCM_ROLENGTH(str),t); - - SCM_ASSERT_RANGE (2,start,(f >= 0)); - SCM_ASSERT_RANGE (3,end, (f <= t) && (t <= SCM_ROLENGTH (str))); - - SCM_NEWCELL (answer); - SCM_NEWCELL (len_str); - - SCM_DEFER_INTS; - if (SCM_SUBSTRP (str)) - { - long offset; - offset = SCM_INUM (SCM_SUBSTR_OFFSET (str)); - f += offset; - t += offset; - SCM_SETCAR (len_str, SCM_MAKINUM (f)); - SCM_SETCDR (len_str, SCM_SUBSTR_STR (str)); - SCM_SETCDR (answer, len_str); - SCM_SETLENGTH (answer, t - f, scm_tc7_substring); - } - else - { - SCM_SETCAR (len_str, SCM_MAKINUM (f)); - SCM_SETCDR (len_str, str); - SCM_SETCDR (answer, len_str); - SCM_SETLENGTH (answer, t - f, scm_tc7_substring); - } - SCM_ALLOW_INTS; - return answer; -} -#undef FUNC_NAME - -#endif /* DEPRECATED */ void scm_init_strings () diff --git a/libguile/strings.h b/libguile/strings.h index 9307a1742..dc96ef201 100644 --- a/libguile/strings.h +++ b/libguile/strings.h @@ -2,18 +2,19 @@ #ifndef SCM_STRINGS_H #define SCM_STRINGS_H + /* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc. - * + * * 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 * the Free Software Foundation; either version 2, or (at your option) * any later version. - * + * * This program 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 General Public License for more details. - * + * * You should have received a copy of the GNU General Public License * along with this software; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, @@ -49,24 +50,17 @@ -#define SCM_STRINGP(x) (!SCM_IMP (x) && (SCM_TYP7S (x) == scm_tc7_string)) -#if (SCM_DEBUG_DEPRECATED == 1) +#define SCM_STRINGP(x) (!SCM_IMP (x) && (SCM_TYP7 (x) == scm_tc7_string)) #define SCM_STRING_UCHARS(x) ((unsigned char *) (SCM_CELL_WORD_1 (x))) #define SCM_STRING_CHARS(x) ((char *) (SCM_CELL_WORD_1 (x))) -#endif #define SCM_SET_STRING_CHARS(s, c) (SCM_SET_CELL_WORD_1 ((s), (c))) #define SCM_STRING_MAX_LENGTH ((1UL << 24) - 1UL) #define SCM_STRING_LENGTH(x) ((size_t) (SCM_CELL_WORD_0 (x) >> 8)) #define SCM_SET_STRING_LENGTH(s, l) (SCM_SET_CELL_WORD_0 ((s), ((l) << 8) + scm_tc7_string)) -#define SCM_STRING_COERCE_0TERMINATION_X(x) \ - { if (!SCM_IMP (x) && (SCM_TYP7 (x) == scm_tc7_substring)) \ - x = scm_mem2string (SCM_STRING_CHARS (x), SCM_STRING_LENGTH (x)); } - 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_makfromstrs (int argc, char **argv); extern SCM scm_take_str (char *s, size_t len); @@ -85,23 +79,11 @@ extern void scm_init_strings (void); -#if (SCM_DEBUG_DEPRECATED == 0) +#if (SCM_ENABLE_DEPRECATED == 1) -#define SCM_SLOPPY_STRINGP(x) (SCM_STRINGP(x)) -#define SCM_RWSTRINGP(x) (!SCM_IMP (x) && (SCM_TYP7 (x) == scm_tc7_string)) -#define SCM_STRING_UCHARS(x) \ - ((SCM_TYP7 (x) == scm_tc7_substring) \ - ? (unsigned char *) SCM_CELL_WORD_1 (SCM_CDDR (x)) + SCM_INUM (SCM_CADR (x)) \ - : (unsigned char *) SCM_CELL_WORD_1 (x)) -#define SCM_STRING_CHARS(x) \ - ((SCM_TYP7 (x) == scm_tc7_substring) \ - ? (char *) SCM_CELL_WORD_1 (SCM_CDDR (x)) + SCM_INUM (SCM_CADR (x)) \ - : (char *) SCM_CELL_WORD_1 (x)) -extern SCM scm_make_shared_substring (SCM str, SCM frm, SCM to); -extern SCM scm_makstr (size_t len, int); -extern SCM scm_makfromstr (const char *src, size_t len, int); +#define SCM_STRING_COERCE_0TERMINATION_X(x) (x) -#endif /* SCM_DEBUG_DEPRECATED == 0 */ +#endif #endif /* SCM_STRINGS_H */ diff --git a/libguile/tags.h b/libguile/tags.h index 5dec122fb..6304a2625 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -2,6 +2,7 @@ #ifndef SCM_TAGS_H #define SCM_TAGS_H + /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify @@ -43,7 +44,6 @@ * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ - /** This file defines the format of SCM values and cons pairs. @@ -247,19 +247,6 @@ typedef signed long scm_t_signed_bits; * * TYP7S(X) returns TYP7, but masking out the option bit S. * - * For example, all strings have 0010 in the 'xxxx' bits - * in the diagram above, the S bit says whether it's a - * substring. - * - * for example: - * S - * scm_tc7_string = G0010101 - * scm_tc7_substring = G0010111 - * - * TYP7S turns both string tags into tc7_string; thus, - * testing TYP7S against tc7_string is a quick way to - * test for any kind of string, shared or unshared. - * * Some TC7 types are subdivided into 256 subtypes giving * rise to the macros: * @@ -292,9 +279,6 @@ typedef signed long scm_t_signed_bits; -#define SCM_CELLP(x) (((sizeof (scm_cell) - 1) & SCM_UNPACK (x)) == 0) -#define SCM_NCELLP(x) (!SCM_CELLP (x)) - /* See numbers.h for macros relating to immediate integers. */ @@ -323,7 +307,7 @@ typedef signed long scm_t_signed_bits; #define SCM_TYP16(x) (0xffff & SCM_CELL_TYPE (x)) #define SCM_TYP16S(x) (0xfeff & SCM_CELL_TYPE (x)) -#define SCM_TYP16_PREDICATE(tag,x) (SCM_NIMP (x) && SCM_TYP16 (x) == (tag)) +#define SCM_TYP16_PREDICATE(tag,x) (!SCM_IMP (x) && SCM_TYP16 (x) == (tag)) @@ -334,9 +318,8 @@ typedef signed long scm_t_signed_bits; #define scm_tc7_vector 13 #define scm_tc7_wvect 15 -/* couple */ #define scm_tc7_string 21 -#define scm_tc7_substring 23 +/* free 23 */ /* Many of the following should be turned * into structs or smobs. We need back some @@ -542,16 +525,12 @@ extern char *scm_isymnames[]; /* defined in print.c */ -#if (SCM_DEBUG_DEPRECATED == 0) - -#define SCM_SLOPPY_CONSP(x) ((1 & SCM_CELL_TYPE (x)) == 0) -#define SCM_SLOPPY_NCONSP(x) (!SCM_SLOPPY_CONSP(x)) +#if (SCM_ENABLE_DEPRECATED == 1) -#define scm_tc7_ssymbol scm_tc7_symbol -#define scm_tc7_msymbol scm_tc7_symbol -#define scm_tcs_symbols scm_tc7_symbol +#define SCM_CELLP(x) (((sizeof (scm_cell) - 1) & SCM_UNPACK (x)) == 0) +#define SCM_NCELLP(x) (!SCM_CELLP (x)) -#endif /* SCM_DEBUG_DEPRECATED == 0 */ +#endif #endif /* SCM_TAGS_H */ diff --git a/libguile/variable.c b/libguile/variable.c index 7ced1e9dd..7a4763b00 100644 --- a/libguile/variable.c +++ b/libguile/variable.c @@ -65,33 +65,15 @@ scm_i_variable_print (SCM exp, SCM port, scm_print_state *pstate) -#if SCM_ENABLE_VCELLS -SCM_SYMBOL (sym_huh, "???"); -#endif - static SCM make_variable (SCM init) { -#if !SCM_ENABLE_VCELLS - { - SCM z; - SCM_NEWCELL (z); - SCM_SET_CELL_WORD_1 (z, SCM_UNPACK (init)); - SCM_SET_CELL_TYPE (z, scm_tc7_variable); - scm_remember_upto_here_1 (init); - return z; - } -#else - { - SCM z; - SCM cell = scm_cons (sym_huh, init); - SCM_NEWCELL (z); - SCM_SET_CELL_WORD_1 (z, SCM_UNPACK (cell)); - SCM_SET_CELL_TYPE (z, scm_tc7_variable); - scm_remember_upto_here_1 (cell); - return z; - } -#endif + SCM z; + SCM_NEWCELL (z); + SCM_SET_CELL_WORD_1 (z, SCM_UNPACK (init)); + SCM_SET_CELL_TYPE (z, scm_tc7_variable); + scm_remember_upto_here_1 (init); + return z; } SCM_DEFINE (scm_make_variable, "make-variable", 1, 0, 0, @@ -165,37 +147,6 @@ SCM_DEFINE (scm_variable_bound_p, "variable-bound?", 1, 0, 0, } #undef FUNC_NAME -SCM_DEFINE (scm_variable_set_name_hint, "variable-set-name-hint!", 2, 0, 0, - (SCM var, SCM hint), - "Do not use this function.") -#define FUNC_NAME s_scm_variable_set_name_hint -{ - SCM_VALIDATE_VARIABLE (1, var); - SCM_VALIDATE_SYMBOL (2, hint); -#if SCM_ENABLE_VCELLS - SCM_SETCAR (SCM_SMOB_DATA (var), hint); -#endif - return SCM_UNSPECIFIED; -} -#undef FUNC_NAME - -#if SCM_ENABLE_VCELLS - -SCM_DEFINE (scm_builtin_variable, "builtin-variable", 1, 0, 0, - (SCM name), - "Return the built-in variable with the name @var{name}.\n" - "@var{name} must be a symbol (not a string).\n" - "Then use @code{variable-ref} to access its value.\n") -#define FUNC_NAME s_scm_builtin_variable -{ - SCM_VALIDATE_SYMBOL (1,name); - scm_c_issue_deprecation_warning ("`builtin-variable' is deprecated. " - "Use module system operations instead."); - return scm_sym2var (name, SCM_BOOL_F, SCM_BOOL_T); -} -#undef FUNC_NAME - -#endif /* SCM_ENABLE_VCELLS */ void scm_init_variable () diff --git a/libguile/variable.h b/libguile/variable.h index 577f1f820..6a6a8a04d 100644 --- a/libguile/variable.h +++ b/libguile/variable.h @@ -2,18 +2,19 @@ #ifndef SCM_VARIABLE_H #define SCM_VARIABLE_H + /* Copyright (C) 1995,1996,2000,2001 Free Software Foundation, Inc. - * + * * 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 * the Free Software Foundation; either version 2, or (at your option) * any later version. - * + * * This program 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 General Public License for more details. - * + * * You should have received a copy of the GNU General Public License * along with this software; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, @@ -44,29 +45,18 @@ * If you do not wish that, delete this exception notice. */ + #include "libguile/__scm.h" #include "libguile/smob.h" - /* Variables */ -#define SCM_VARIABLEP(X) (SCM_NIMP(X) && SCM_TYP7(X) == scm_tc7_variable) - -#if !SCM_ENABLE_VCELLS -#define SCM_VARIABLE_REF(V) SCM_CELL_OBJECT_1(V) +#define SCM_VARIABLEP(X) (!SCM_IMP (X) && SCM_TYP7(X) == scm_tc7_variable) +#define SCM_VARIABLE_REF(V) SCM_CELL_OBJECT_1 (V) #define SCM_VARIABLE_SET(V,X) SCM_SET_CELL_OBJECT_1 (V, X) #define SCM_VARIABLE_LOC(V) ((SCM *) SCM_CELL_WORD_LOC ((V), 1)) -#else -#define SCM_VARVCELL(V) SCM_CELL_OBJECT_1(V) -#define SCM_UDVARIABLEP(X) (SCM_VARIABLEP(X) && SCM_UNBNDP (SCM_CDR (SCM_VARVCELL (X)))) -#define SCM_DEFVARIABLEP(X) (SCM_VARIABLEP(X) && !SCM_UNBNDP (SCM_CDR (SCM_VARVCELL (X)))) - -#define SCM_VARIABLE_REF(V) SCM_CDR(SCM_VARVCELL(V)) -#define SCM_VARIABLE_SET(V,X) SCM_SETCDR(SCM_VARVCELL(V),X) -#define SCM_VARIABLE_LOC(V) SCM_CDRLOC(SCM_VARVCELL(V)) -#endif @@ -76,10 +66,6 @@ extern SCM scm_variable_p (SCM obj); extern SCM scm_variable_ref (SCM var); extern SCM scm_variable_set_x (SCM var, SCM val); extern SCM scm_variable_bound_p (SCM var); -extern SCM scm_variable_set_name_hint (SCM var, SCM hint); -#if SCM_ENABLE_VCELLS -extern SCM scm_builtin_variable (SCM name); -#endif extern void scm_i_variable_print (SCM var, SCM port, scm_print_state *pstate); diff --git a/libguile/vports.c b/libguile/vports.c index 68ed74c15..bce6bb867 100644 --- a/libguile/vports.c +++ b/libguile/vports.c @@ -189,7 +189,6 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0, SCM z; SCM_VALIDATE_VECTOR_LEN (1,pv,5); SCM_VALIDATE_STRING (2, modes); - SCM_STRING_COERCE_0TERMINATION_X (modes); SCM_NEWCELL (z); SCM_DEFER_INTS; pt = scm_add_to_port_table (z); diff --git a/srfi/ChangeLog b/srfi/ChangeLog index 8bf12a69e..c72e8380e 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,8 @@ +2001-08-31 Dirk Herrmann <D.Herrmann@tu-bs.de> + + * srfi-1.scm, srfi-13.scm: Remove the defines that were needed to + trick export from the beginning of the files. + 2001-08-25 Thien-Thi Nguyen <ttn@revel.glug.org> * srfi-19.scm (add-duration): Fix bug: Call `add-duration!' w/ diff --git a/srfi/srfi-1.scm b/srfi/srfi-1.scm index f58c1ebfe..b4605d97c 100644 --- a/srfi/srfi-1.scm +++ b/srfi/srfi-1.scm @@ -60,20 +60,6 @@ :use-module (ice-9 session) :use-module (ice-9 receive)) -(begin-deprecated - ;; Prevent `export' from re-exporting core bindings. This behaviour - ;; of `export' is deprecated and will disappear in one of the next - ;; releases. - (define iota #f) - (define map #f) - (define map-in-order #f) - (define for-each #f) - (define list-index #f) - (define member #f) - (define delete #f) - (define delete! #f) - (define assoc #f)) - (export ;;; Constructors ;; cons <= in the core diff --git a/srfi/srfi-13.scm b/srfi/srfi-13.scm index b623c405e..90e7691a0 100644 --- a/srfi/srfi-13.scm +++ b/srfi/srfi-13.scm @@ -43,19 +43,6 @@ (define-module (srfi srfi-13)) -(begin-deprecated - ;; Prevent `export' from re-exporting core bindings. This behaviour - ;; of `export' is deprecated and will disappear in one of the next - ;; releases. - (define string->list #f) - (define string-copy #f) - (define string-fill! #f) - (define string-index #f) - (define string-upcase #f) - (define string-upcase! #f) - (define string-downcase #f) - (define string-downcase! #f)) - (export ;;; Predicates ;; string? string-null? <= in the core |