1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-29 08:20:20 +02:00

* Separate the handling of OPEN flags between ports and directories.

This commit is contained in:
Dirk Herrmann 2001-01-24 00:02:43 +00:00
parent 312ae976ad
commit 30ea841d0c
6 changed files with 69 additions and 24 deletions

8
NEWS
View file

@ -393,6 +393,10 @@ Use these instead of SCM_SETCHARS.
Use instead of SCM_COERCE_SUBSTR.
** New macros: SCM_DIR_OPEN_P, SCM_DIR_FLAG_OPEN
For directory objects, use these instead of SCM_OPDIRP and SCM_OPN.
** 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,
@ -403,7 +407,8 @@ 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_SETGC8MARK, SCM_CLRGC8MARK, SCM_GCTYP16, SCM_GCCDR, SCM_SUBR_DOC,
SCM_OPDIRP, SCM_VALIDATE_OPDIR
Use SCM_ASSERT_RANGE or SCM_VALIDATE_XXX_RANGE instead of SCM_OUTOFRANGE.
Use scm_memory_error instead of SCM_NALLOC.
@ -427,6 +432,7 @@ Use SCM_SETGCMARK instead of SCM_SETGC8MARK.
Use SCM_CLRGCMARK instead of SCM_CLRGC8MARK.
Use SCM_TYP16 instead of SCM_GCTYP16.
Use SCM_CDR instead of SCM_GCCDR.
Use SCM_DIR_OPEN_P instead of SCM_OPDIRP.
** Removed function: scm_struct_init

View file

@ -54,7 +54,7 @@ In release 1.6:
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_SUBR_DOC, SCM_OPDIRP, SCM_VALIDATE_OPDIR
- remove scm_vector_set_length_x
- remove function scm_call_catching_errors
(replaced by catch functions from throw.[ch])

View file

@ -1,3 +1,21 @@
2001-01-24 Dirk Herrmann <D.Herrmann@tu-bs.de>
* filesys.h (SCM_DIR_FLAG_OPEN, SCM_DIR_OPEN_P): Added.
(SCM_OPDIRP): Deprecated.
* filesys.c (scm_opendir): Use SCM_DIR_FLAG_OPEN instead of
SCM_OPN.
(scm_readdir, scm_rewinddir): Don't use SCM_VALIDATE_OPDIR.
Instead, give an explicit error message in case the directory is
closed.
(scm_closedir, scm_dir_print): Rewritten to use SCM_DIR_OPEN_P
instead of SCM_OPENP and SCM_CLOSEDP.
* validate.h (SCM_VALIDATE_OPDIR): Deprecated.
2001-01-22 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (inner_eval, scm_eval): Move all real functionality into

View file

@ -673,21 +673,24 @@ SCM_DEFINE (scm_rmdir, "rmdir", 1, 0, 0,
#endif
/* {Examining Directories}
*/
scm_bits_t scm_tc16_dir;
SCM_DEFINE (scm_directory_stream_p, "directory-stream?", 1, 0, 0,
(SCM obj),
"Returns a boolean indicating whether @var{object} is a directory stream\n"
"as returned by @code{opendir}.")
#define FUNC_NAME s_scm_directory_stream_p
{
return SCM_BOOL(SCM_DIRP (obj));
return SCM_BOOL (SCM_DIRP (obj));
}
#undef FUNC_NAME
SCM_DEFINE (scm_opendir, "opendir", 1, 0, 0,
(SCM dirname),
"Open the directory specified by @var{path} and return a directory\n"
@ -700,7 +703,7 @@ SCM_DEFINE (scm_opendir, "opendir", 1, 0, 0,
SCM_SYSCALL (ds = opendir (SCM_STRING_CHARS (dirname)));
if (ds == NULL)
SCM_SYSERROR;
SCM_RETURN_NEWSMOB (scm_tc16_dir | SCM_OPN, ds);
SCM_RETURN_NEWSMOB (scm_tc16_dir | SCM_DIR_FLAG_OPEN, ds);
}
#undef FUNC_NAME
@ -713,61 +716,68 @@ SCM_DEFINE (scm_readdir, "readdir", 1, 0, 0,
#define FUNC_NAME s_scm_readdir
{
struct dirent *rdent;
SCM_VALIDATE_OPDIR (1,port);
SCM_VALIDATE_DIR (1, port);
if (!SCM_DIR_OPEN_P (port))
SCM_MISC_ERROR ("Directory ~S is not open.", SCM_LIST1 (port));
errno = 0;
SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CELL_WORD_1 (port)));
if (errno != 0)
SCM_SYSERROR;
return (rdent ? scm_makfromstr (rdent->d_name, NAMLEN (rdent), 0)
: SCM_EOF_VAL);
}
#undef FUNC_NAME
SCM_DEFINE (scm_rewinddir, "rewinddir", 1, 0, 0,
(SCM port),
"Reset the directory port @var{stream} so that the next call to\n"
"@code{readdir} will return the first directory entry.")
#define FUNC_NAME s_scm_rewinddir
{
SCM_VALIDATE_OPDIR (1,port);
SCM_VALIDATE_DIR (1, port);
if (!SCM_DIR_OPEN_P (port))
SCM_MISC_ERROR ("Directory ~S is not open.", SCM_LIST1 (port));
rewinddir ((DIR *) SCM_CELL_WORD_1 (port));
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
SCM_DEFINE (scm_closedir, "closedir", 1, 0, 0,
(SCM port),
"Close the directory stream @var{stream}.\n"
"The return value is unspecified.")
#define FUNC_NAME s_scm_closedir
{
int sts;
SCM_VALIDATE_DIR (1, port);
SCM_VALIDATE_DIR (1,port);
if (SCM_CLOSEDP (port))
if (SCM_DIR_OPEN_P (port))
{
return SCM_UNSPECIFIED;
int sts;
SCM_SYSCALL (sts = closedir ((DIR *) SCM_CELL_WORD_1 (port)));
if (sts != 0)
SCM_SYSERROR;
SCM_SET_CELL_WORD_0 (port, scm_tc16_dir);
}
SCM_SYSCALL (sts = closedir ((DIR *) SCM_CELL_WORD_1 (port)));
if (sts != 0)
SCM_SYSERROR;
SCM_SET_CELL_WORD_0 (port, scm_tc16_dir);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
static int
scm_dir_print (SCM exp, SCM port, scm_print_state *pstate)
{
scm_puts ("#<", port);
if (SCM_CLOSEDP (exp))
if (!SCM_DIR_OPEN_P (exp))
scm_puts ("closed: ", port);
scm_puts ("directory stream ", port);
scm_intprint (SCM_CELL_WORD_1 (exp), 16, port);
@ -779,7 +789,7 @@ scm_dir_print (SCM exp, SCM port, scm_print_state *pstate)
static scm_sizet
scm_dir_free (SCM p)
{
if (SCM_OPENP (p))
if (SCM_DIR_OPEN_P (p))
closedir ((DIR *) SCM_CELL_WORD_1 (p));
return 0;
}

View file

@ -53,8 +53,11 @@
extern scm_bits_t scm_tc16_dir;
#define SCM_DIR_FLAG_OPEN (1L << 16)
#define SCM_DIRP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_dir))
#define SCM_OPDIRP(x) (!SCM_IMP (x) && (SCM_CELL_WORD_0 (x) == (scm_tc16_dir | SCM_OPN)))
#define SCM_DIR_OPEN_P(x) (SCM_CELL_WORD_0 (x) & SCM_DIR_FLAG_OPEN)
@ -90,6 +93,14 @@ extern SCM scm_basename (SCM filename, SCM suffix);
extern void scm_init_filesys (void);
#if (SCM_DEBUG_DEPRECATED == 0)
#define SCM_OPDIRP(x) (SCM_DIRP (x) && (SCM_DIR_OPEN_P (x)))
#endif /* SCM_DEBUG_DEPRECATED == 0 */
#endif /* FILESYSH */
/*

View file

@ -1,4 +1,4 @@
/* $Id: validate.h,v 1.24 2001-01-08 23:10:06 ghouston Exp $ */
/* $Id: validate.h,v 1.25 2001-01-24 00:02:43 dirk Exp $ */
/* Copyright (C) 1999, 2000 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
@ -337,8 +337,6 @@
#define SCM_VALIDATE_RGXP(pos, a) SCM_MAKE_VALIDATE (pos, a, RGXP)
#define SCM_VALIDATE_OPDIR(pos, port) SCM_MAKE_VALIDATE (pos, port, OPDIRP)
#define SCM_VALIDATE_DIR(pos, port) SCM_MAKE_VALIDATE (pos, port, DIRP)
#define SCM_VALIDATE_PORT(pos, port) SCM_MAKE_VALIDATE (pos, port, PORTP)
@ -437,6 +435,8 @@
scm_misc_error (FUNC_NAME, "argument is a read-only string", str); \
} while (0)
#define SCM_VALIDATE_OPDIR(pos, port) SCM_MAKE_VALIDATE (pos, port, OPDIRP)
#endif /* SCM_DEBUG_DEPRECATED == 0 */
#endif