mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-21 03:00:19 +02:00
Code Activity

Merge remote-tracking branch 'local-2.0/stable-2.0'

Browse source 
Conflicts:
	module/ice-9/psyntax-pp.scm
	module/language/tree-il/compile-glil.scm
This commit is contained in:
Andy Wingo 2011-06-18 00:45:19 +02:00
commit 78f0ef20a7
30 changed files with 3077 additions and 2094 deletions
Download patch file Download diff file Expand all files Collapse all files

4
libguile/Makefile.am
View file

@ -433,7 +433,7 @@ EXTRA_libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = _scm.h \
dynl.c regex-posix.c \
posix.c net_db.c socket.c \
debug-malloc.c mkstemp.c \
win32-uname.c win32-dirent.c win32-socket.c \
win32-uname.c win32-socket.c \
locale-categories.h
## delete guile-snarf.awk from the installation bindir, in case it's
@ -450,7 +450,7 @@ noinst_HEADERS = conv-integer.i.c conv-uinteger.i.c \
ieee-754.h \
srfi-14.i.c \
quicksort.i.c \
win32-uname.h win32-dirent.h win32-socket.h \
win32-uname.h win32-socket.h \
private-gc.h private-options.h
# vm instructions

6
libguile/filesys.c
View file

@ -97,11 +97,7 @@
#endif
#if defined (__MINGW32__) || defined (_MSC_VER) || defined (__BORLANDC__)
# include "win32-dirent.h"
# define NAMLEN(dirent) strlen((dirent)->d_name)
/* The following bits are per AC_HEADER_DIRENT doco in the autoconf manual */
#elif HAVE_DIRENT_H
#if HAVE_DIRENT_H
# include <dirent.h>
# define NAMLEN(dirent) strlen((dirent)->d_name)
#else

29
libguile/load.c
View file

@ -293,6 +293,12 @@ scm_init_load_path ()
snprintf (cachedir, sizeof(cachedir), "%s/.cache/" FALLBACK_DIR,
pwd->pw_dir);
#endif /* HAVE_GETPWENT */
#ifdef __MINGW32__
else if ((e = getenv ("LOCALAPPDATA")))
snprintf (cachedir, sizeof (cachedir), "%s/.cache/" FALLBACK_DIR, e);
else if ((e = getenv ("APPDATA")))
snprintf (cachedir, sizeof (cachedir), "%s/.cache/" FALLBACK_DIR, e);
#endif /* __MINGW32__ */
else
cachedir[0] = 0;
@ -730,14 +736,27 @@ static SCM
auto_compile_catch_handler (void *data, SCM tag, SCM throw_args)
{
SCM source = PTR2SCM (data);
SCM oport, lines;
oport = scm_open_output_string ();
scm_print_exception (oport, SCM_BOOL_F, tag, throw_args);
scm_puts (";;; WARNING: compilation of ", scm_current_error_port ());
scm_display (source, scm_current_error_port ());
scm_puts (" failed:\n", scm_current_error_port ());
scm_puts (";;; key ", scm_current_error_port ());
scm_write (tag, scm_current_error_port ());
scm_puts (", throw args ", scm_current_error_port ());
scm_write (throw_args, scm_current_error_port ());
scm_newline (scm_current_error_port ());
lines = scm_string_split (scm_get_output_string (oport),
SCM_MAKE_CHAR ('\n'));
for (; scm_is_pair (lines); lines = scm_cdr (lines))
if (scm_c_string_length (scm_car (lines)))
{
scm_puts (";;; ", scm_current_error_port ());
scm_display (scm_car (lines), scm_current_error_port ());
scm_newline (scm_current_error_port ());
}
scm_close_port (oport);
return SCM_BOOL_F;
}

37
libguile/strings.c
View file

@ -2052,8 +2052,9 @@ SCM_DEFINE (scm_string_normalize_nfkd, "string-normalize-nfkd", 1, 0, 0,
}
#undef FUNC_NAME
/* converts C scm_array of strings to SCM scm_list of strings. */
/* If argc < 0, a null terminated scm_array is assumed. */
/* converts C scm_array of strings to SCM scm_list of strings.
If argc < 0, a null terminated scm_array is assumed.
The current locale encoding is assumed */
SCM
scm_makfromstrs (int argc, char **argv)
{
@ -2067,37 +2068,43 @@ scm_makfromstrs (int argc, char **argv)
}
/* Return a newly allocated array of char pointers to each of the strings
in args, with a terminating NULL pointer. */
in args, with a terminating NULL pointer. The strings are encoded using
the current locale. */
char **
scm_i_allocate_string_pointers (SCM list)
#define FUNC_NAME "scm_i_allocate_string_pointers"
{
char **result;
int len = scm_ilength (list);
int list_len = scm_ilength (list);
int i;
if (len < 0)
if (list_len < 0)
scm_wrong_type_arg_msg (NULL, 0, list, "proper list");
result = scm_gc_malloc ((len + 1) * sizeof (char *),
result = scm_gc_malloc ((list_len + 1) * sizeof (char *),
"string pointers");
result[len] = NULL;
result[list_len] = NULL;
/* The list might be have been modified in another thread, so
/* The list might have been modified in another thread, so
we check LIST before each access.
*/
for (i = 0; i < len && scm_is_pair (list); i++)
for (i = 0; i < list_len && scm_is_pair (list); i++)
{
SCM str;
size_t len;
SCM str = SCM_CAR (list);
size_t len; /* String length in bytes */
char *c_str = scm_to_locale_stringn (str, &len);
str = SCM_CAR (list);
len = scm_c_string_length (str);
/* OPTIMIZE-ME: Right now, scm_to_locale_stringn always uses
scm_malloc to allocate the returned string, which must be
explicitly deallocated. This forces us to copy the string a
second time into a new buffer. Ideally there would be variants
of scm_to_*_stringn that can return garbage-collected buffers. */
result[i] = scm_gc_malloc_pointerless (len + 1, "string pointers");
memcpy (result[i], scm_i_string_chars (str), len);
result[i] = scm_gc_malloc_pointerless (len + 1, "string");
memcpy (result[i], c_str, len);
result[i][len] = '\0';
free (c_str);
list = SCM_CDR (list);
}

133
libguile/win32-dirent.c
View file

@ -1,133 +0,0 @@
/* Copyright (C) 2001, 2006, 2008 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 3 of
* the License, or (at your option) any later version.
*
* This library is distributed in the hope that it will be useful, but
* WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
* 02110-1301 USA
*/
#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#include "libguile/__scm.h"
#include <windows.h>
#include <stdio.h>
#include <string.h>
#include "win32-dirent.h"
DIR *
opendir (const char * name)
{
DIR *dir;
HANDLE hnd;
char *file;
WIN32_FIND_DATA find;
if (!name || !*name)
return NULL;
file = malloc (strlen (name) + 3);
strcpy (file, name);
if (file[strlen (name) - 1] != '/' && file[strlen (name) - 1] != '\\')
strcat (file, "/*");
else
strcat (file, "*");
if ((hnd = FindFirstFile (file, &find)) == INVALID_HANDLE_VALUE)
{
free (file);
return NULL;
}
dir = malloc (sizeof (DIR));
dir->mask = file;
dir->fd = (int) hnd;
dir->data = malloc (sizeof (WIN32_FIND_DATA));
dir->allocation = sizeof (WIN32_FIND_DATA);
dir->size = dir->allocation;
dir->filepos = 0;
memcpy (dir->data, &find, sizeof (WIN32_FIND_DATA));
return dir;
}
struct dirent *
readdir (DIR * dir)
{
static struct dirent entry;
WIN32_FIND_DATA *find;
entry.d_ino = 0;
entry.d_type = 0;
find = (WIN32_FIND_DATA *) dir->data;
if (dir->filepos)
{
if (!FindNextFile ((HANDLE) dir->fd, find))
return NULL;
}
entry.d_off = dir->filepos;
strncpy (entry.d_name, find->cFileName, sizeof (entry.d_name));
entry.d_reclen = strlen (find->cFileName);
dir->filepos++;
return &entry;
}
int
closedir (DIR * dir)
{
HANDLE hnd = (HANDLE) dir->fd;
free (dir->data);
free (dir->mask);
free (dir);
return FindClose (hnd) ? 0 : -1;
}
void
rewinddir (DIR * dir)
{
HANDLE hnd = (HANDLE) dir->fd;
WIN32_FIND_DATA *find = (WIN32_FIND_DATA *) dir->data;
FindClose (hnd);
hnd = FindFirstFile (dir->mask, find);
dir->fd = (int) hnd;
dir->filepos = 0;
}
void
seekdir (DIR * dir, off_t offset)
{
off_t n;
rewinddir (dir);
for (n = 0; n < offset; n++)
{
if (FindNextFile ((HANDLE) dir->fd, (WIN32_FIND_DATA *) dir->data))
dir->filepos++;
}
}
off_t
telldir (DIR * dir)
{
return dir->filepos;
}
int
dirfd (DIR * dir)
{
return dir->fd;
}

65
libguile/win32-dirent.h
View file

@ -1,65 +0,0 @@
/* classes: h_files */
#ifndef SCM_WIN32_DIRENT_H
#define SCM_WIN32_DIRENT_H
/* Copyright (C) 2001, 2006 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 3 of
* the License, or (at your option) any later version.
*
* This library is distributed in the hope that it will be useful, but
* WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
* 02110-1301 USA
*/
/* Directory stream type.
The miscellaneous Unix `readdir' implementations read directory data
into a buffer and return `struct dirent *' pointers into it. */
#include <sys/types.h>
struct dirstream
{
int fd; /* File descriptor. */
char *data; /* Directory block. */
size_t allocation; /* Space allocated for the block. */
size_t size; /* Total valid data in the block. */
size_t offset; /* Current offset into the block. */
off_t filepos; /* Position of next entry to read. */
char *mask; /* Initial file mask. */
};
struct dirent
{
long d_ino;
off_t d_off;
unsigned short int d_reclen;
unsigned char d_type;
char d_name[256];
};
#define d_fileno d_ino /* Backwards compatibility. */
/* This is the data type of directory stream objects.
The actual structure is opaque to users. */
typedef struct dirstream DIR;
DIR * opendir (const char * name);
struct dirent * readdir (DIR * dir);
int closedir (DIR * dir);
void rewinddir (DIR * dir);
void seekdir (DIR * dir, off_t offset);
off_t telldir (DIR * dir);
int dirfd (DIR * dir);
#endif /* SCM_WIN32_DIRENT_H */