mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

* Removed lots of deprecated stuff.

Browse source
This commit is contained in:
Dirk Herrmann 2001-08-31 14:42:31 +00:00
parent dee01b012c
commit 8c494e9973
49 changed files with 315 additions and 1217 deletions
Download patch file Download diff file Expand all files Collapse all files

10
ChangeLog
View file

@ -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>

111
TODO
View file

@ -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]

4
acconfig.h
View file

@ -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

4
configure.in
View file

@ -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

7
guile-readline/ChangeLog
View file

@ -1,3 +1,10 @@
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?´

4
guile-readline/readline.c
View file

@ -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));
}
}

24
ice-9/ChangeLog
View file

@ -1,3 +1,27 @@
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.

201
ice-9/boot-9.scm
View file

@ -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

5
ice-9/format.scm
View file

@ -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

115
libguile/ChangeLog
View file

@ -1,3 +1,118 @@
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.

88
libguile/__scm.h
View file

@ -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 */
/*

12
libguile/deprecation.c
View file

@ -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;

12
libguile/deprecation.h
View file

@ -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 */

100
libguile/dynl.c
View file

@ -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;

23
libguile/dynl.h
View file

@ -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:

53
libguile/error.c
View file

@ -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 ()
{

17
libguile/error.h
View file

@ -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 */
/*

76
libguile/eval.c
View file

@ -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

21
libguile/eval.h
View file

@ -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);

19
libguile/filesys.c
View file

@ -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);

2
libguile/fports.c
View file

@ -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);

46
libguile/gc.c
View file

@ -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

27
libguile/gc.h
View file

@ -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 */
/*

1
libguile/gh_data.c
View file

@ -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));

1
libguile/hash.c
View file

@ -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;

5
libguile/init.c
View file

@ -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.

1
libguile/ioext.c
View file

@ -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);
}

86
libguile/modules.c
View file

@ -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"

17
libguile/modules.h
View file

@ -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 */
/*

5
libguile/net_db.c
View file

@ -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

1
libguile/objects.c
View file

@ -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:

43
libguile/ports.c
View file

@ -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

36
libguile/ports.h
View file

@ -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 */
/*

15
libguile/posix.c
View file

@ -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;

3
libguile/print.c
View file

@ -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);

21
libguile/random.h
View file

@ -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:

2
libguile/regex-posix.c
View file

@ -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. */

2
libguile/simpos.c
View file

@ -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;
}

1
libguile/socket.c
View file

@ -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));

4
libguile/stime.c
View file

@ -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);

116
libguile/strings.c
View file

@ -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 ()

34
libguile/strings.h
View file

@ -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 */

35
libguile/tags.h
View file

@ -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)
#if (SCM_ENABLE_DEPRECATED == 1)
#define SCM_SLOPPY_CONSP(x) ((1 & SCM_CELL_TYPE (x)) == 0)
#define SCM_SLOPPY_NCONSP(x) (!SCM_SLOPPY_CONSP(x))
#define SCM_CELLP(x) (((sizeof (scm_cell) - 1) & SCM_UNPACK (x)) == 0)
#define SCM_NCELLP(x) (!SCM_CELLP (x))
#define scm_tc7_ssymbol scm_tc7_symbol
#define scm_tc7_msymbol scm_tc7_symbol
#define scm_tcs_symbols scm_tc7_symbol
#endif /* SCM_DEBUG_DEPRECATED == 0 */
#endif
#endif /* SCM_TAGS_H */

61
libguile/variable.c
View file

@ -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 ()

28
libguile/variable.h
View file

@ -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);

1
libguile/vports.c
View file

@ -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);

5
srfi/ChangeLog
View file

@ -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/

14
srfi/srfi-1.scm
View file

@ -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

13
srfi/srfi-13.scm
View file

@ -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