[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
guile/guile-core/libguile struct.c stime.c srcp...
|
From: |
Marius Vollmer |
|
Subject: |
guile/guile-core/libguile struct.c stime.c srcp... |
|
Date: |
Mon, 14 May 2001 07:11:34 -0700 |
CVSROOT: /cvs
Module name: guile
Branch: mvo-vcell-cleanup-1-branch
Changes by: Marius Vollmer <address@hidden> 01/05/14 07:11:33
Modified files:
guile-core/libguile: struct.c stime.c srcprop.c socket.c snarf.h
script.c scmsigs.c regex-posix.c read.c
posix.c ports.c objects.c numbers.c
macros.c load.c hooks.c gh_funcs.c fports.c
filesys.c feature.c eval.c cpp_cnvt.awk
backtrace.c
Log message:
Replaced scm_define with scm_c_define and scm_lookup with scm_c_lookup.
CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/struct.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.75.2.1&tr2=1.75.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/stime.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.65.2.1&tr2=1.65.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/srcprop.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.46.2.1&tr2=1.46.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/socket.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.74.2.1&tr2=1.74.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/snarf.h.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.44.2.1&tr2=1.44.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/script.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.38.2.1&tr2=1.38.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/scmsigs.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.56.2.1&tr2=1.56.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/regex-posix.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.50.2.1&tr2=1.50.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/read.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.67.2.1&tr2=1.67.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/posix.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.88.2.1&tr2=1.88.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/ports.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.142.2.1&tr2=1.142.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/objects.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.56.2.1&tr2=1.56.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/numbers.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.127.2.1&tr2=1.127.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/macros.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.27.2.1&tr2=1.27.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/load.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.57.2.1&tr2=1.57.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/hooks.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.13.2.1&tr2=1.13.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/gh_funcs.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.8.2.1&tr2=1.8.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/fports.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.93.2.1&tr2=1.93.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/filesys.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.96.2.1&tr2=1.96.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/feature.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.45.2.1&tr2=1.45.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/eval.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.218.2.1&tr2=1.218.2.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/cpp_cnvt.awk.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.1.18.1&tr2=1.1.18.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/backtrace.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.62.2.1&tr2=1.62.2.2&r1=text&r2=text
Patches:
Index: guile/guile-core/libguile/backtrace.c
diff -u guile/guile-core/libguile/backtrace.c:1.61
guile/guile-core/libguile/backtrace.c:1.62
--- guile/guile-core/libguile/backtrace.c:1.61 Fri Mar 9 15:33:37 2001
+++ guile/guile-core/libguile/backtrace.c Sat Mar 31 13:19:50 2001
@@ -604,6 +604,8 @@
display_frame (frame, nfield, indentation, sport, a->port, pstate);
}
+ scm_remember_upto_here_1 (print_state);
+
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
Index: guile/guile-core/libguile/eval.c
diff -u guile/guile-core/libguile/eval.c:1.217
guile/guile-core/libguile/eval.c:1.218
--- guile/guile-core/libguile/eval.c:1.217 Fri May 4 14:54:00 2001
+++ guile/guile-core/libguile/eval.c Wed May 9 13:25:44 2001
@@ -3918,6 +3918,7 @@
SCM
scm_i_eval (SCM exp, SCM env)
{
+ exp = scm_copy_tree (exp);
return SCM_XEVAL (exp, env);
}
Index: guile/guile-core/libguile/feature.c
diff -u guile/guile-core/libguile/feature.c:1.44
guile/guile-core/libguile/feature.c:1.45
--- guile/guile-core/libguile/feature.c:1.44 Fri Dec 8 09:08:34 2000
+++ guile/guile-core/libguile/feature.c Fri Mar 9 15:33:38 2001
@@ -44,7 +44,6 @@
-#include <stdio.h>
#ifdef HAVE_STRING_H
#include <string.h>
#endif
Index: guile/guile-core/libguile/filesys.c
diff -u guile/guile-core/libguile/filesys.c:1.95
guile/guile-core/libguile/filesys.c:1.96
--- guile/guile-core/libguile/filesys.c:1.95 Tue Apr 3 06:19:04 2001
+++ guile/guile-core/libguile/filesys.c Tue Apr 10 00:57:05 2001
@@ -1,4 +1,4 @@
-/* Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 Free Software
Foundation, Inc.
+/* Copyright (C) 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
@@ -243,8 +243,8 @@
SCM_VALIDATE_STRING (1, path);
SCM_STRING_COERCE_0TERMINATION_X (path);
- iflags = SCM_NUM2LONG(2,flags);
- imode = SCM_NUM2LONG_DEF(3,mode,0666);
+ iflags = SCM_NUM2LONG (2, flags);
+ imode = SCM_NUM2LONG_DEF (3, mode, 0666);
SCM_SYSCALL (fd = open (SCM_STRING_CHARS (path), iflags, imode));
if (fd == -1)
SCM_SYSERROR;
@@ -286,7 +286,7 @@
int iflags;
fd = SCM_INUM (scm_open_fdes (path, flags, mode));
- iflags = SCM_NUM2LONG (2,flags);
+ iflags = SCM_NUM2LONG (2, flags);
if (iflags & O_RDWR)
{
if (iflags & O_APPEND)
Index: guile/guile-core/libguile/fports.c
diff -u guile/guile-core/libguile/fports.c:1.92
guile/guile-core/libguile/fports.c:1.93
--- guile/guile-core/libguile/fports.c:1.92 Sat Mar 17 08:59:48 2001
+++ guile/guile-core/libguile/fports.c Tue Apr 3 06:19:04 2001
@@ -243,12 +243,12 @@
* Return the new port.
*/
SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0,
- (SCM filename, SCM modes),
- "Open the file whose name is @var{string}, and return a port\n"
+ (SCM filename, SCM mode),
+ "Open the file whose name is @var{filename}, and return a port\n"
"representing that file. The attributes of the port are\n"
- "determined by the @var{mode} string. The way in \n"
- "which this is interpreted is similar to C stdio:\n\n"
- "The first character must be one of the following:\n\n"
+ "determined by the @var{mode} string. The way in which this is\n"
+ "interpreted is similar to C stdio. The first character must be\n"
+ "one of the following:\n"
"@table @samp\n"
"@item r\n"
"Open an existing file for input.\n"
@@ -256,48 +256,49 @@
"Open a file for output, creating it if it doesn't already exist\n"
"or removing its contents if it does.\n"
"@item a\n"
- "Open a file for output, creating it if it doesn't already exist.\n"
- "All writes to the port will go to the end of the file.\n"
+ "Open a file for output, creating it if it doesn't already\n"
+ "exist. All writes to the port will go to the end of the file.\n"
"The \"append mode\" can be turned off while the port is in use\n"
"@pxref{Ports and File Descriptors, fcntl}\n"
- "@end table\n\n"
- "The following additional characters can be appended:\n\n"
+ "@end table\n"
+ "The following additional characters can be appended:\n"
"@table @samp\n"
"@item +\n"
"Open the port for both input and output. E.g., @code{r+}: open\n"
"an existing file for both input and output.\n"
"@item 0\n"
- "Create an \"unbuffered\" port. In this case input and output
operations\n"
- "are passed directly to the underlying port implementation
without\n"
- "additional buffering. This is likely to slow down I/O
operations.\n"
- "The buffering mode can be changed while a port is in use\n"
- "@pxref{Ports and File Descriptors, setvbuf}\n"
+ "Create an \"unbuffered\" port. In this case input and output\n"
+ "operations are passed directly to the underlying port\n"
+ "implementation without additional buffering. This is likely to\n"
+ "slow down I/O operations. The buffering mode can be changed\n"
+ "while a port is in use @pxref{Ports and File Descriptors,\n"
+ "setvbuf}\n"
"@item l\n"
"Add line-buffering to the port. The port output buffer will be\n"
"automatically flushed whenever a newline character is written.\n"
- "@end table\n\n"
- "In theory we could create read/write ports which were buffered in
one\n"
- "direction only. However this isn't included in the current
interfaces.\n\n"
- "If a file cannot be opened with the access requested,\n"
- "@code{open-file} throws an exception.")
+ "@end table\n"
+ "In theory we could create read/write ports which were buffered\n"
+ "in one direction only. However this isn't included in the\n"
+ "current interfaces. If a file cannot be opened with the access\n"
+ "requested, @code{open-file} throws an exception.")
#define FUNC_NAME s_scm_open_file
{
SCM port;
int fdes;
int flags = 0;
char *file;
- char *mode;
+ char *md;
char *ptr;
SCM_VALIDATE_STRING (1, filename);
- SCM_VALIDATE_STRING (2, modes);
+ SCM_VALIDATE_STRING (2, mode);
SCM_STRING_COERCE_0TERMINATION_X (filename);
- SCM_STRING_COERCE_0TERMINATION_X (modes);
+ SCM_STRING_COERCE_0TERMINATION_X (mode);
file = SCM_STRING_CHARS (filename);
- mode = SCM_STRING_CHARS (modes);
+ md = SCM_STRING_CHARS (mode);
- switch (*mode)
+ switch (*md)
{
case 'r':
flags |= O_RDONLY;
@@ -309,9 +310,9 @@
flags |= O_WRONLY | O_CREAT | O_APPEND;
break;
default:
- scm_out_of_range (FUNC_NAME, modes);
+ scm_out_of_range (FUNC_NAME, mode);
}
- ptr = mode + 1;
+ ptr = md + 1;
while (*ptr != '\0')
{
switch (*ptr)
@@ -328,7 +329,7 @@
case 'l': /* line buffered: handled during output. */
break;
default:
- scm_out_of_range (FUNC_NAME, modes);
+ scm_out_of_range (FUNC_NAME, mode);
}
ptr++;
}
@@ -341,7 +342,7 @@
scm_cons (scm_makfrom0str (strerror (en)),
scm_cons (filename, SCM_EOL)), en);
}
- port = scm_fdes_to_port (fdes, mode, filename);
+ port = scm_fdes_to_port (fdes, md, filename);
return port;
}
#undef FUNC_NAME
Index: guile/guile-core/libguile/gh_funcs.c
diff -u guile/guile-core/libguile/gh_funcs.c:1.7
guile/guile-core/libguile/gh_funcs.c:1.8
--- guile/guile-core/libguile/gh_funcs.c:1.7 Mon Jun 12 05:28:23 2000
+++ guile/guile-core/libguile/gh_funcs.c Fri Mar 9 15:33:39 2001
@@ -43,8 +43,6 @@
/* Defining Scheme functions implemented by C functions --- subrs. */
-#include <stdio.h>
-
#include "libguile/gh.h"
/* allows you to define new scheme primitives written in C */
Index: guile/guile-core/libguile/hooks.c
diff -u guile/guile-core/libguile/hooks.c:1.12
guile/guile-core/libguile/hooks.c:1.13
--- guile/guile-core/libguile/hooks.c:1.12 Tue May 8 03:23:17 2001
+++ guile/guile-core/libguile/hooks.c Tue May 8 03:30:32 2001
@@ -247,7 +247,7 @@
SCM arity, rest;
int n_args;
SCM_VALIDATE_HOOK (1,hook);
- SCM_ASSERT (SCM_NFALSEP (arity = scm_i_procedure_arity (proc)),
+ SCM_ASSERT (!SCM_FALSEP (arity = scm_i_procedure_arity (proc)),
proc, SCM_ARG2, FUNC_NAME);
n_args = SCM_HOOK_ARITY (hook);
if (SCM_INUM (SCM_CAR (arity)) > n_args
Index: guile/guile-core/libguile/load.c
diff -u guile/guile-core/libguile/load.c:1.56
guile/guile-core/libguile/load.c:1.57
--- guile/guile-core/libguile/load.c:1.56 Sun Mar 11 01:44:08 2001
+++ guile/guile-core/libguile/load.c Sun Mar 11 23:08:46 2001
@@ -103,12 +103,13 @@
SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
(SCM filename),
- "Load @var{file} and evaluate its contents in the top-level
environment.\n"
- "The load paths are not searched; @var{file} must either be a
full\n"
- "pathname or be a pathname relative to the current directory. If
the\n"
- "variable @code{%load-hook} is defined, it should be bound to a
procedure\n"
- "that will be called before any code is loaded. See documentation
for\n"
- "@code{%load-hook} later in this section.")
+ "Load the file named @var{filename} and evaluate its contents in\n"
+ "the top-level environment. The load paths are not searched;\n"
+ "@var{filename} must either be a full pathname or be a pathname\n"
+ "relative to the current directory. If the variable\n"
+ "@code{%load-hook} is defined, it should be bound to a procedure\n"
+ "that will be called before any code is loaded. See the\n"
+ "documentation for @code{%load-hook} later in this section.")
#define FUNC_NAME s_scm_primitive_load
{
SCM hook = *scm_loc_load_hook;
@@ -409,13 +410,14 @@
If we find one, return its full filename; otherwise, return #f.
If FILENAME is absolute, return it unchanged. */
SCM_DEFINE (scm_sys_search_load_path, "%search-load-path", 1, 0, 0,
- (SCM filename),
- "Search @var{%load-path} for @var{file}, which must be readable by
the\n"
- "current user. If @var{file} is found in the list of paths to
search or\n"
- "is an absolute pathname, return its full pathname. Otherwise,
return\n"
- "@code{#f}. Filenames may have any of the optional extensions in
the\n"
- "@code{%load-extensions} list; @code{%search-load-path} will try
each\n"
- "extension automatically.")
+ (SCM filename),
+ "Search @var{%load-path} for the file named @var{filename},\n"
+ "which must be readable by the current user. If @var{filename}\n"
+ "is found in the list of paths to search or is an absolute\n"
+ "pathname, return its full pathname. Otherwise, return\n"
+ "@code{#f}. Filenames may have any of the optional extensions\n"
+ "in the @code{%load-extensions} list; @code{%search-load-path}\n"
+ "will try each extension automatically.")
#define FUNC_NAME s_scm_sys_search_load_path
{
SCM path = *scm_loc_load_path;
@@ -432,10 +434,11 @@
SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 0, 0,
- (SCM filename),
- "Search @var{%load-path} for @var{file} and load it into the
top-level\n"
- "environment. If @var{file} is a relative pathname and is not
found in\n"
- "the list of search paths, an error is signalled.")
+ (SCM filename),
+ "Search @var{%load-path} for the file named @var{filename} and\n"
+ "load it into the top-level environment. If @var{filename} is a\n"
+ "relative pathname and is not found in the list of search paths,\n"
+ "an error is signalled.")
#define FUNC_NAME s_scm_primitive_load_path
{
SCM full_filename;
Index: guile/guile-core/libguile/macros.c
diff -u guile/guile-core/libguile/macros.c:1.26
guile/guile-core/libguile/macros.c:1.27
--- guile/guile-core/libguile/macros.c:1.26 Tue Apr 3 06:19:04 2001
+++ guile/guile-core/libguile/macros.c Thu Apr 19 07:46:01 2001
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998, 2000 Free Software Foundation, Inc.
+/* 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
@@ -45,6 +45,10 @@
#include "libguile/_scm.h"
+#include "libguile/alist.h" /* for SCM_EXTEND_ENV (well...) */
+#include "libguile/eval.h"
+#include "libguile/ports.h"
+#include "libguile/print.h"
#include "libguile/root.h"
#include "libguile/smob.h"
@@ -53,6 +57,47 @@
scm_bits_t scm_tc16_macro;
+
+static int
+macro_print (SCM macro, SCM port, scm_print_state *pstate)
+{
+ SCM code = SCM_MACRO_CODE (macro);
+ if (!SCM_CLOSUREP (code)
+ || SCM_FALSEP (scm_procedure_p (SCM_PRINT_CLOSURE))
+ || SCM_FALSEP (scm_printer_apply (SCM_PRINT_CLOSURE,
+ macro, port, pstate)))
+ {
+ if (!SCM_CLOSUREP (code))
+ scm_puts ("#<primitive-", port);
+ else
+ scm_puts ("#<", port);
+
+ if (SCM_MACRO_TYPE (macro) == 0)
+ scm_puts ("syntax", port);
+ else if (SCM_MACRO_TYPE (macro) == 1)
+ scm_puts ("macro", port);
+ if (SCM_MACRO_TYPE (macro) == 2)
+ scm_puts ("macro!", port);
+ scm_putc (' ', port);
+ scm_iprin1 (scm_macro_name (macro), port, pstate);
+
+ if (SCM_CLOSUREP (code) && SCM_PRINT_SOURCE_P)
+ {
+ SCM formals = SCM_CLOSURE_FORMALS (code);
+ SCM env = SCM_ENV (code);
+ SCM xenv = SCM_EXTEND_ENV (formals, SCM_EOL, env);
+ SCM src = scm_unmemocopy (SCM_CODE (code), xenv);
+ scm_putc (' ', port);
+ scm_iprin1 (src, port, pstate);
+ }
+
+ scm_putc ('>', port);
+ }
+
+ return 1;
+}
+
+
SCM_DEFINE (scm_makacro, "procedure->syntax", 1, 0, 0,
(SCM code),
"Return a @dfn{macro} which, when a symbol defined to this value\n"
@@ -139,7 +184,7 @@
{
if (!SCM_TYP16_PREDICATE (scm_tc16_macro, m))
return SCM_BOOL_F;
- switch (SCM_CELL_WORD_0 (m) >> 16)
+ switch (SCM_MACRO_TYPE (m))
{
case 0: return scm_sym_syntax;
case 1: return scm_sym_macro;
@@ -186,6 +231,7 @@
{
scm_tc16_macro = scm_make_smob_type ("macro", 0);
scm_set_smob_mark (scm_tc16_macro, scm_markcdr);
+ scm_set_smob_print (scm_tc16_macro, macro_print);
#ifndef SCM_MAGIC_SNARFER
#include "libguile/macros.x"
#endif
Index: guile/guile-core/libguile/numbers.c
diff -u guile/guile-core/libguile/numbers.c:1.126
guile/guile-core/libguile/numbers.c:1.127
--- guile/guile-core/libguile/numbers.c:1.126 Sat May 5 18:26:23 2001
+++ guile/guile-core/libguile/numbers.c Tue May 8 03:23:17 2001
@@ -68,15 +68,10 @@
#define SCM_SWAP(x,y) do { SCM __t = x; x = y; y = __t; } while (0)
-/*#if (SCM_DEBUG_DEPRECATED == 1)*/ /* not defined in header yet? */
-#if 1
-
-/* SCM_FLOBUFLEN is the maximum number of characters neccessary for the
+/* FLOBUFLEN is the maximum number of characters neccessary for the
* printed or scm_string representation of an inexact number.
*/
-#define SCM_FLOBUFLEN (10+2*(sizeof(double)/sizeof(char)*SCM_CHAR_BIT*3+9)/10)
-
-#endif /* SCM_DEBUG_DEPRECATED == 1 */
+#define FLOBUFLEN (10+2*(sizeof(double)/sizeof(char)*SCM_CHAR_BIT*3+9)/10)
/* IS_INF tests its floating point number for infiniteness
@@ -2307,7 +2302,7 @@
} else if (SCM_BIGP (n)) {
return big2str (n, (unsigned int) base);
} else if (SCM_INEXACTP (n)) {
- char num_buf [SCM_FLOBUFLEN];
+ char num_buf [FLOBUFLEN];
return scm_makfromstr (num_buf, iflo2str (n, num_buf), 0);
} else {
SCM_WRONG_TYPE_ARG (1, n);
@@ -2322,7 +2317,7 @@
int
scm_print_real (SCM sexp, SCM port, scm_print_state *pstate)
{
- char num_buf[SCM_FLOBUFLEN];
+ char num_buf[FLOBUFLEN];
scm_lfwrite (num_buf, iflo2str (sexp, num_buf), port);
return !0;
}
@@ -2330,7 +2325,7 @@
int
scm_print_complex (SCM sexp, SCM port, scm_print_state *pstate)
{
- char num_buf[SCM_FLOBUFLEN];
+ char num_buf[FLOBUFLEN];
scm_lfwrite (num_buf, iflo2str (sexp, num_buf), port);
return !0;
}
Index: guile/guile-core/libguile/objects.c
diff -u guile/guile-core/libguile/objects.c:1.55
guile/guile-core/libguile/objects.c:1.56
--- guile/guile-core/libguile/objects.c:1.55 Fri Feb 16 07:02:35 2001
+++ guile/guile-core/libguile/objects.c Sat May 5 12:05:47 2001
@@ -374,9 +374,35 @@
}
#undef FUNC_NAME
+/* XXX - What code requires the object procedure to be only of certain
+ types? */
+
+SCM_DEFINE (scm_valid_object_procedure_p, "valid-object-procedure?", 1, 0, 0,
+ (SCM proc),
+ "Return @code{#t} iff @var{proc} is a procedure that can be used "
+ "with @code{set-object-procedure}. It is always valid to use "
+ "a closure constructed by @code{lambda}.")
+#define FUNC_NAME s_scm_valid_object_procedure_p
+{
+ if (SCM_IMP (proc))
+ return SCM_BOOL_F;
+ switch (SCM_TYP7 (proc))
+ {
+ default:
+ return SCM_BOOL_F;
+ case scm_tcs_closures:
+ case scm_tc7_subr_1:
+ case scm_tc7_subr_2:
+ case scm_tc7_subr_3:
+ case scm_tc7_lsubr_2:
+ return SCM_BOOL_T;
+ }
+}
+#undef FUNC_NAME
+
SCM_DEFINE (scm_set_object_procedure_x, "set-object-procedure!", 2, 0, 0,
(SCM obj, SCM proc),
- "Return the object procedure of @var{obj} to @var{proc}.\n"
+ "Set the object procedure of @var{obj} to @var{proc}.\n"
"@var{obj} must be either an entity or an operator.")
#define FUNC_NAME s_scm_set_object_procedure_x
{
@@ -388,7 +414,7 @@
obj,
SCM_ARG1,
FUNC_NAME);
- SCM_VALIDATE_PROC (2,proc);
+ SCM_ASSERT (scm_valid_object_procedure_p (proc), proc, SCM_ARG2, FUNC_NAME);
if (SCM_I_ENTITYP (obj))
SCM_SET_ENTITY_PROCEDURE (obj, proc);
else
Index: guile/guile-core/libguile/ports.c
diff -u guile/guile-core/libguile/ports.c:1.142
guile/guile-core/libguile/ports.c:1.143
--- guile/guile-core/libguile/ports.c:1.142 Wed May 9 09:32:06 2001
+++ guile/guile-core/libguile/ports.c Thu May 10 15:31:13 2001
@@ -557,7 +557,7 @@
#define FUNC_NAME s_scm_port_revealed
{
port = SCM_COERCE_OUTPORT (port);
- SCM_VALIDATE_PORT (1,port);
+ SCM_VALIDATE_OPENPORT (1,port);
return SCM_MAKINUM (scm_revealed_count (port));
}
#undef FUNC_NAME
@@ -570,7 +570,7 @@
#define FUNC_NAME s_scm_set_port_revealed_x
{
port = SCM_COERCE_OUTPORT (port);
- SCM_VALIDATE_PORT (1,port);
+ SCM_VALIDATE_OPENPORT (1,port);
SCM_VALIDATE_INUM (2,rcount);
SCM_REVEALED (port) = SCM_INUM (rcount);
return SCM_UNSPECIFIED;
Index: guile/guile-core/libguile/posix.c
diff -u guile/guile-core/libguile/posix.c:1.87
guile/guile-core/libguile/posix.c:1.88
--- guile/guile-core/libguile/posix.c:1.87 Tue Apr 3 06:19:04 2001
+++ guile/guile-core/libguile/posix.c Tue Apr 10 00:57:05 2001
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995, 96, 97, 98, 99, 2000, 2001 Free Software Foundation,
Inc.
+/* 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
@@ -1095,12 +1095,12 @@
if (SCM_UNBNDP (actime))
SCM_SYSCALL (time (&utm_tmp.actime));
else
- utm_tmp.actime = SCM_NUM2ULONG (2,actime);
+ utm_tmp.actime = SCM_NUM2ULONG (2, actime);
if (SCM_UNBNDP (modtime))
SCM_SYSCALL (time (&utm_tmp.modtime));
else
- utm_tmp.modtime = SCM_NUM2ULONG (3,modtime);
+ utm_tmp.modtime = SCM_NUM2ULONG (3, modtime);
SCM_SYSCALL (rv = utime (SCM_STRING_CHARS (pathname), &utm_tmp));
if (rv != 0)
Index: guile/guile-core/libguile/read.c
diff -u guile/guile-core/libguile/read.c:1.66
guile/guile-core/libguile/read.c:1.67
--- guile/guile-core/libguile/read.c:1.66 Sat Mar 17 05:34:21 2001
+++ guile/guile-core/libguile/read.c Thu Mar 22 04:52:02 2001
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997, 1999, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,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
@@ -116,7 +116,7 @@
return SCM_EOF_VAL;
scm_ungetc (c, port);
- tok_buf = scm_makstr (30L, 0);
+ tok_buf = scm_allocate_string (30);
return scm_lreadr (&tok_buf, port, ©);
}
#undef FUNC_NAME
@@ -127,7 +127,7 @@
scm_grow_tok_buf (SCM *tok_buf)
{
unsigned long int oldlen = SCM_STRING_LENGTH (*tok_buf);
- SCM newstr = scm_makstr (2 * oldlen, 0);
+ SCM newstr = scm_allocate_string (2 * oldlen);
unsigned long int i;
for (i = 0; i != oldlen; ++i)
Index: guile/guile-core/libguile/regex-posix.c
diff -u guile/guile-core/libguile/regex-posix.c:1.49
guile/guile-core/libguile/regex-posix.c:1.50
--- guile/guile-core/libguile/regex-posix.c:1.49 Tue Apr 3 06:19:04 2001
+++ guile/guile-core/libguile/regex-posix.c Sat May 5 17:39:01 2001
@@ -1,15 +1,15 @@
-/* Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
- *
+/* Copyright (C) 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,
@@ -37,7 +37,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.
+ * If you do not wish that, delete this exception notice.
*/
/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
@@ -133,7 +133,7 @@
return SCM_STRING_CHARS (errmsg);
}
-SCM_DEFINE (scm_regexp_p, "regexp?", 1, 0, 0,
+SCM_DEFINE (scm_regexp_p, "regexp?", 1, 0, 0,
(SCM obj),
"Return @code{#t} if @var{obj} is a compiled regular expression,\n"
"or @code{#f} otherwise.")
@@ -143,7 +143,7 @@
}
#undef FUNC_NAME
-SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
+SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
(SCM pat, SCM flags),
"Compile the regular expression described by @var{pat}, and\n"
"return the compiled regexp structure. If @var{pat} does not\n"
@@ -204,7 +204,7 @@
cflags |= SCM_INUM (SCM_CAR (flag));
flag = SCM_CDR (flag);
}
-
+
rx = SCM_MUST_MALLOC_TYPE (regex_t);
status = regcomp (rx, SCM_STRING_CHARS (pat),
/* Make sure they're not passing REG_NOSUB;
@@ -223,13 +223,27 @@
}
#undef FUNC_NAME
-SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
+SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
(SCM rx, SCM str, SCM start, SCM flags),
"Match the compiled regular expression @var{rx} against\n"
"@code{str}. If the optional integer @var{start} argument is\n"
"provided, begin matching from that position in the string.\n"
"Return a match structure describing the results of the match,\n"
- "or @code{#f} if no match could be found.")
+ "or @code{#f} if no match could be found.\n"
+ "\n"
+ "The @var{flags} arguments change the matching behavior.\n"
+ "The following flags may be supplied:\n"
+ "\n"
+ "@table @code\n"
+ "@item regexp/notbol\n"
+ "Operator @samp{^} always fails (unless @code{regexp/newline}\n"
+ "is used). Use this when the beginning of the string should\n"
+ "not be considered the beginning of a line.\n"
+ "@item regexp/noteol\n"
+ "Operator @samp{$} always fails (unless @code{regexp/newline}\n"
+ "is used). Use this when the end of the string should not be\n"
+ "considered the end of a line.\n"
+ "@end table")
#define FUNC_NAME s_scm_regexp_exec
{
int status, nmatches, offset;
Index: guile/guile-core/libguile/scmsigs.c
diff -u guile/guile-core/libguile/scmsigs.c:1.55
guile/guile-core/libguile/scmsigs.c:1.56
--- guile/guile-core/libguile/scmsigs.c:1.55 Tue Apr 10 00:57:05 2001
+++ guile/guile-core/libguile/scmsigs.c Fri May 4 14:54:00 2001
@@ -470,7 +470,6 @@
SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
(SCM sig),
- "\n"
"Sends a specified signal @var{sig} to the current process, where\n"
"@var{sig} is as described for the kill procedure.")
#define FUNC_NAME s_scm_raise
Index: guile/guile-core/libguile/script.c
diff -u guile/guile-core/libguile/script.c:1.37
guile/guile-core/libguile/script.c:1.38
--- guile/guile-core/libguile/script.c:1.37 Sat Mar 10 08:56:06 2001
+++ guile/guile-core/libguile/script.c Mon Apr 16 17:43:18 2001
@@ -411,16 +411,7 @@
probably agree. I'd say I didn't feel comfortable doing that in
the present system. You'd say, well, fix the system so you are
comfortable doing that. I'd agree again. *shrug*
-
- We load the ice-9 system from here. It might be nicer if the
- libraries initialized from the inner_main function in guile.c (which
- will be auto-generated eventually) could assume ice-9 were already
- loaded. Then again, it might be nice if ice-9 could assume that
- certain libraries were already loaded. The solution is to break up
- ice-9 into modules which can be frozen and statically linked like any
- other module. Then all the modules can describe their dependencies in
- the usual way, and the auto-generated inner_main will do the right
- thing. */
+ */
static char guile[] = "guile";
Index: guile/guile-core/libguile/snarf.h
diff -u guile/guile-core/libguile/snarf.h:1.43
guile/guile-core/libguile/snarf.h:1.44
--- guile/guile-core/libguile/snarf.h:1.43 Thu Mar 15 21:11:34 2001
+++ guile/guile-core/libguile/snarf.h Sun May 6 14:19:53 2001
@@ -52,7 +52,12 @@
#if defined(__cplusplus) || defined(GUILE_CPLUSPLUS_SNARF)
-#define SCM_FUNC_CAST_ARBITRARY_ARGS SCM (*)(...)
+
+/* This used to be "SCM (*)(...)" but GCC on RedHat 7.1 doesn't seem
+ to like it.
+ */
+#define SCM_FUNC_CAST_ARBITRARY_ARGS SCM (*)()
+
#else
#define SCM_FUNC_CAST_ARBITRARY_ARGS SCM (*)()
#endif
Index: guile/guile-core/libguile/socket.c
diff -u guile/guile-core/libguile/socket.c:1.73
guile/guile-core/libguile/socket.c:1.74
--- guile/guile-core/libguile/socket.c:1.73 Thu May 3 16:42:31 2001
+++ guile/guile-core/libguile/socket.c Sat May 5 01:31:00 2001
@@ -254,7 +254,7 @@
#undef FUNC_NAME
#endif
-#ifdef AF_INET6
+#ifdef HAVE_IPV6
/* flip a 128 bit IPv6 address between host and network order. */
#ifdef WORDS_BIGENDIAN
@@ -419,7 +419,7 @@
#undef FUNC_NAME
#endif
-#endif /* AF_INET6 */
+#endif /* HAVE_IPV6 */
SCM_SYMBOL (sym_socket, "socket");
@@ -713,7 +713,7 @@
*size = sizeof (struct sockaddr_in);
return (struct sockaddr *) soka;
}
-#ifdef AF_INET6
+#ifdef HAVE_IPV6
case AF_INET6:
{
/* see RFC2553. */
@@ -933,7 +933,7 @@
ve[2] = scm_ulong2num ((unsigned long) ntohs (nad->sin_port));
}
break;
-#ifdef AF_INET6
+#ifdef HAVE_IPV6
case AF_INET6:
{
const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address;
@@ -982,7 +982,7 @@
#define MAX_SIZE_UN 0
#endif
-#if defined (AF_INET6)
+#if defined (HAVE_IPV6)
#define MAX_SIZE_IN6 sizeof (struct sockaddr_in6)
#else
#define MAX_SIZE_IN6 0
Index: guile/guile-core/libguile/srcprop.c
diff -u guile/guile-core/libguile/srcprop.c:1.45
guile/guile-core/libguile/srcprop.c:1.46
--- guile/guile-core/libguile/srcprop.c:1.45 Sat Mar 10 08:56:07 2001
+++ guile/guile-core/libguile/srcprop.c Tue Apr 17 02:15:39 2001
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 Free Software
Foundation
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation
*
* 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
@@ -148,6 +148,7 @@
ptr->fname = filename;
ptr->copy = copy;
ptr->plist = plist;
+ SCM_ALLOW_INTS;
SCM_RETURN_NEWSMOB (scm_tc16_srcprops, ptr);
}
Index: guile/guile-core/libguile/stime.c
diff -u guile/guile-core/libguile/stime.c:1.64
guile/guile-core/libguile/stime.c:1.65
--- guile/guile-core/libguile/stime.c:1.64 Tue Apr 3 06:19:04 2001
+++ guile/guile-core/libguile/stime.c Tue Apr 10 00:57:05 2001
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998, 1999, 2000, 2001 Free Software
Foundation, Inc.
+/* 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
@@ -355,7 +355,7 @@
char **oldenv;
int err;
- itime = SCM_NUM2LONG (1,time);
+ itime = SCM_NUM2LONG (1, time);
/* deferring interupts is essential since a) setzone may install a temporary
environment b) localtime uses a static buffer. */
@@ -423,7 +423,7 @@
struct tm *bd_time;
SCM result;
- itime = SCM_NUM2LONG (1,time);
+ itime = SCM_NUM2LONG (1, time);
SCM_DEFER_INTS;
bd_time = gmtime (&itime);
if (bd_time == NULL)
Index: guile/guile-core/libguile/struct.c
diff -u guile/guile-core/libguile/struct.c:1.74
guile/guile-core/libguile/struct.c:1.75
--- guile/guile-core/libguile/struct.c:1.74 Tue Apr 10 00:57:05 2001
+++ guile/guile-core/libguile/struct.c Fri Apr 20 00:55:19 2001
@@ -377,7 +377,7 @@
{
/* Mark vtables in GC chain. GC mark set means delay freeing. */
SCM chain = newchain;
- while (SCM_NNULLP (chain))
+ while (!SCM_NULLP (chain))
{
SCM vtable = SCM_STRUCT_VTABLE (chain);
if (SCM_STRUCT_GC_CHAIN (vtable) != 0 && vtable != chain)
@@ -387,7 +387,7 @@
/* Free unmarked structs. */
chain = newchain;
newchain = SCM_EOL;
- while (SCM_NNULLP (chain))
+ while (!SCM_NULLP (chain))
{
SCM obj = chain;
chain = SCM_STRUCT_GC_CHAIN (chain);
@@ -402,7 +402,7 @@
scm_bits_t word0 = SCM_CELL_WORD_0 (obj) - scm_tc3_cons_gloc;
/* access as struct */
scm_bits_t * vtable_data = (scm_bits_t *) word0;
- scm_bits_t * data = (scm_bits_t *) SCM_UNPACK (SCM_CDR (obj));
+ scm_bits_t * data = SCM_STRUCT_DATA (obj);
scm_struct_free_t free_struct_data
= ((scm_struct_free_t) vtable_data[scm_struct_i_free]);
SCM_SET_CELL_TYPE (obj, scm_tc_free_cell);
@@ -410,7 +410,7 @@
}
}
}
- while (SCM_NNULLP (newchain));
+ while (!SCM_NULLP (newchain));
return 0;
}
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- guile/guile-core/libguile struct.c stime.c srcp...,
Marius Vollmer <=