diff options
-rw-r--r-- | NEWS | 20 | ||||
-rw-r--r-- | libguile/ChangeLog | 19 | ||||
-rw-r--r-- | libguile/error.c | 3 | ||||
-rw-r--r-- | libguile/error.h | 2 | ||||
-rw-r--r-- | libguile/eval.c | 15 | ||||
-rw-r--r-- | libguile/filesys.c | 62 | ||||
-rw-r--r-- | libguile/posix.c | 85 | ||||
-rw-r--r-- | libguile/scm_validate.h | 5 | ||||
-rw-r--r-- | libguile/simpos.c | 10 | ||||
-rw-r--r-- | libguile/stime.c | 15 |
10 files changed, 95 insertions, 141 deletions
@@ -15,7 +15,7 @@ guile-doc-snarf script (that uses guile-doc-snarf.awk). Also, many SCM_VALIDATE_* macros are defined to ease the redundancy and improve the readability of argument checking. -I replaced (nearly?) all K&R prototypes for functions with ANSI C equivalents. +All (nearly?) K&R prototypes for functions replaced with ANSI C equivalents. * Changes to the distribution @@ -101,6 +101,9 @@ at the top of the script. ** New procedure: port-closed? PORT Returns #t if PORT is closed or #f if it is open. +** Attempting to get the value of an unbound variable now produces +an exception with a key of 'unbound-variable instead of 'misc-error. + * Changes to the scm_ interface ** Port internals: the rw_random variable in the scm_port structure @@ -124,6 +127,21 @@ although to actually avoid resetting the buffers and discard unread chars requires further hacking that depends on the characteristics of the ptob. +** The scm_sysmissing procedure is no longer used in libguile. +Unless it turns out to be unexpectedly useful to somebody, it will be +removed in a future version. + +* Changes to system call interfaces: + +** If a facility is not available on the system when Guile is +compiled, the corresponding primitive procedure will not be defined. +Previously it would have been defined but would throw a system-error +exception if called. Exception handlers which catch this case may +need minor modification: an error will be thrown with key +'unbound-variable instead of 'system-error. Alternatively it's +now possible to use `defined?' to check whether the facility is +available. + * Changes to the networking interfaces: ** New functions: htons, ntohs, htonl, ntohl: for converting short and diff --git a/libguile/ChangeLog b/libguile/ChangeLog index cefa2526c..4d9dccc6c 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,22 @@ +2000-01-09 Gary Houston <ghouston@arglist.com> + + * eval.c: define scm_unbound_variable_key ('unbound-variable). + scm_lookupcar1: throw an error with key 'unbound-variable instead + of 'misc-error when an unbound variable is encountered. + + * filesys.c (scm_mkdir, scm_rmdir, scm_getcwd, scm_select, + scm_symlink, scm_readlink, scm_lstat), + posix.c (scm_setpgid, scm_setsid, scm_ctermid, scm_tcgetpgrp, + scm_tcsetpgrp, scm_uname, scm_setlocale, scm_mknod, scm_nice, + scm_sync), + simpos.c (scm_system), + stime.c (scm_times, scm_strptime): + move the HAVE_XXX feature tests out of the procedure bodies. + don't use SCM_SYSMISSING. + scm_validate.h (SCM_SYSMISSING): removed. + error.h, error.c (scm_sysmissing): comment that this is deprecated. + see ChangeLog entry for 1999-12-28. + Sat Jan 8 19:52:04 2000 Greg J. Badros <gjb@cs.washington.edu> * scm_validate.h (SCM_VALIDATE_BOOL_COPY): Fix typo. diff --git a/libguile/error.c b/libguile/error.c index 52bda683c..f23ee6ed5 100644 --- a/libguile/error.c +++ b/libguile/error.c @@ -145,6 +145,9 @@ scm_syserror_msg (const char *subr, const char *message, SCM args, int eno) scm_cons (SCM_MAKINUM (eno), SCM_EOL)); } +/* scm_sysmissing is no longer used in libguile. it can probably be + removed after a release or two. there's a comment in NEWS about it + (2000-01-09). */ void scm_sysmissing (const char *subr) { diff --git a/libguile/error.h b/libguile/error.h index 61bf5ec8d..42cd6f9ca 100644 --- a/libguile/error.h +++ b/libguile/error.h @@ -67,6 +67,8 @@ extern SCM scm_strerror (SCM err); extern void scm_syserror SCM_P ((const char *subr)) SCM_NORETURN; extern void scm_syserror_msg SCM_P ((const char *subr, const char *message, SCM args, int eno)) SCM_NORETURN; +/* scm_sysmissing is no longer used in libguile. it can probably be + removed after a release or two (2000-01-09). */ extern void scm_sysmissing SCM_P ((const char *subr)) SCM_NORETURN; extern void scm_num_overflow SCM_P ((const char *subr)) SCM_NORETURN; extern void scm_out_of_range SCM_P ((const char *subr, SCM bad_value)) diff --git a/libguile/eval.c b/libguile/eval.c index 59481e4a6..bf9cda4e1 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -254,6 +254,8 @@ scm_ilookup (SCM iloc, SCM env) */ static scm_cell undef_cell = { SCM_UNDEFINED, SCM_UNDEFINED }; +SCM_SYMBOL (scm_unbound_variable_key, "unbound-variable"); + #ifdef USE_THREADS static SCM * scm_lookupcar1 (SCM vloc, SCM genv, int check) @@ -342,11 +344,14 @@ scm_lookupcar (SCM vloc, SCM genv, int check) errout: /* scm_everr (vloc, genv,...) */ if (check) - scm_misc_error (NULL, - SCM_NULLP (env) - ? "Unbound variable: %S" - : "Damaged environment: %S", - scm_listify (var, SCM_UNDEFINED)); + { + if (SCM_NULLP (env)) + scm_error (scm_unbound_variable_key, NULL, "Unbound variable: %S", + scm_cons (var, SCM_EOL), SCM_BOOL_F); + else + scm_misc_error (NULL, "Damaged environment: %S", + scm_cons (var, SCM_EOL)); + } else return SCM_CDRLOC (&undef_cell); } diff --git a/libguile/filesys.c b/libguile/filesys.c index 142abb54e..e2c66b3f4 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -614,6 +614,7 @@ SCM_DEFINE (scm_delete_file, "delete-file", 1, 0, 0, } #undef FUNC_NAME +#ifdef HAVE_MKDIR SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0, (SCM path, SCM mode), "Create a new directory named by @var{path}. If @var{mode} is omitted @@ -622,7 +623,6 @@ umask. Otherwise they are set to the decimal value specified with @var{mode}. The return value is unspecified.") #define FUNC_NAME s_scm_mkdir { -#ifdef HAVE_MKDIR int rv; mode_t mask; SCM_VALIDATE_ROSTRING (1,path); @@ -641,22 +641,17 @@ umask. Otherwise they are set to the decimal value specified with if (rv != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; -#else - SCM_SYSMISSING; - /* not reached. */ - return SCM_BOOL_F; -#endif } #undef FUNC_NAME +#endif /* HAVE_MKDIR */ - +#ifdef HAVE_RMDIR SCM_DEFINE (scm_rmdir, "rmdir", 1, 0, 0, (SCM path), "Remove the existing directory named by @var{path}. The directory must be empty for this to succeed. The return value is unspecified.") #define FUNC_NAME s_scm_rmdir { -#ifdef HAVE_RMDIR int val; SCM_VALIDATE_ROSTRING (1,path); @@ -665,13 +660,9 @@ be empty for this to succeed. The return value is unspecified.") if (val != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; -#else - SCM_SYSMISSING; - /* not reached. */ - return SCM_BOOL_F; -#endif } #undef FUNC_NAME +#endif /* {Examining Directories} @@ -807,14 +798,12 @@ The return value is unspecified.") } #undef FUNC_NAME - - +#ifdef HAVE_GETCWD SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0, (), "Returns the name of the current working directory.") #define FUNC_NAME s_scm_getcwd { -#ifdef HAVE_GETCWD char *rv; scm_sizet size = 100; @@ -833,13 +822,9 @@ SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0, result = scm_makfromstr (wd, strlen (wd), 0); scm_must_free (wd); return result; -#else - SCM_SYSMISSING; - /* not reached. */ - return SCM_BOOL_F; -#endif } #undef FUNC_NAME +#endif /* HAVE_GETCWD */ @@ -935,6 +920,7 @@ retrieve_select_type (SELECT_TYPE *set, SCM list) } } +#ifdef HAVE_SELECT /* Static helper functions above refer to s_scm_select directly as s_select */ SCM_DEFINE (scm_select, "select", 3, 2, 0, (SCM reads, SCM writes, SCM excepts, SCM secs, SCM usecs), @@ -963,7 +949,6 @@ values instead of a list and has an additional select! interface. ") #define FUNC_NAME s_scm_select { -#ifdef HAVE_SELECT struct timeval timeout; struct timeval * time_p; SELECT_TYPE read_set; @@ -1034,13 +1019,9 @@ values instead of a list and has an additional select! interface. retrieve_select_type (&write_set, writes), retrieve_select_type (&except_set, excepts), SCM_UNDEFINED); -#else - SCM_SYSMISSING; - /* not reached. */ - return SCM_BOOL_F; -#endif } #undef FUNC_NAME +#endif /* HAVE_SELECT */ @@ -1129,13 +1110,13 @@ The return value is unspecified.") } #undef FUNC_NAME +#ifdef HAVE_SYMLINK SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0, (SCM oldpath, SCM newpath), "Create a symbolic link named @var{path-to} with the value (i.e., pointing to) @var{path-from}. The return value is unspecified.") #define FUNC_NAME s_scm_symlink { -#ifdef HAVE_SYMLINK int val; SCM_VALIDATE_ROSTRING (1,oldpath); @@ -1146,15 +1127,11 @@ SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0, if (val != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; -#else - SCM_SYSMISSING; - /* not reached. */ - return SCM_BOOL_F; -#endif } #undef FUNC_NAME +#endif /* HAVE_SYMLINK */ - +#ifdef HAVE_READLINK SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0, (SCM path), "Returns the value of the symbolic link named by @@ -1162,7 +1139,6 @@ SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0, file that the link points to.") #define FUNC_NAME s_scm_readlink { -#ifdef HAVE_READLINK int rv; int size = 100; char *buf; @@ -1181,15 +1157,11 @@ file that the link points to.") result = scm_makfromstr (buf, rv, 0); scm_must_free (buf); return result; -#else - SCM_SYSMISSING; - /* not reached. */ - return SCM_BOOL_F; -#endif } #undef FUNC_NAME +#endif /* HAVE_READLINK */ - +#ifdef HAVE_LSTAT SCM_DEFINE (scm_lstat, "lstat", 1, 0, 0, (SCM str), "Similar to @code{stat}, but does not follow symbolic links, i.e., @@ -1197,7 +1169,6 @@ it will return information about a symbolic link itself, not the file it points to. @var{path} must be a string.") #define FUNC_NAME s_scm_lstat { -#ifdef HAVE_LSTAT int rv; struct stat stat_temp; @@ -1215,14 +1186,9 @@ file it points to. @var{path} must be a string.") en); } return scm_stat2scm(&stat_temp); -#else - SCM_SYSMISSING; - /* not reached. */ - return SCM_BOOL_F; -#endif } #undef FUNC_NAME - +#endif /* HAVE_LSTAT */ SCM_DEFINE (scm_copy_file, "copy-file", 2, 0, 0, (SCM oldfile, SCM newfile), diff --git a/libguile/posix.c b/libguile/posix.c index 7c2789715..4ceea9e5d 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -680,6 +680,7 @@ This is the POSIX definition, not BSD.") } #undef FUNC_NAME +#ifdef HAVE_SETPGID SCM_DEFINE (scm_setpgid, "setpgid", 2, 0, 0, (SCM pid, SCM pgid), "Move the process @var{pid} into the process group @var{pgid}. @var{pid} or @@ -689,21 +690,17 @@ Fails on systems that do not support job control. The return value is unspecified.") #define FUNC_NAME s_scm_setpgid { -#ifdef HAVE_SETPGID SCM_VALIDATE_INUM (1,pid); SCM_VALIDATE_INUM (2,pgid); /* FIXME(?): may be known as setpgrp. */ if (setpgid (SCM_INUM (pid), SCM_INUM (pgid)) != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; -#else - SCM_SYSMISSING; - /* not reached. */ - return SCM_BOOL_F; -#endif } #undef FUNC_NAME +#endif /* HAVE_SETPGID */ +#ifdef HAVE_SETSID SCM_DEFINE (scm_setsid, "setsid", 0, 0, 0, (), "Creates a new session. The current process becomes the session leader @@ -712,18 +709,13 @@ from its controlling terminal if it has one. The return value is an integer representing the new process group ID.") #define FUNC_NAME s_scm_setsid { -#ifdef HAVE_SETSID pid_t sid = setsid (); if (sid == -1) SCM_SYSERROR; return SCM_UNSPECIFIED; -#else - SCM_SYSMISSING; - /* not reached. */ - return SCM_BOOL_F; -#endif } #undef FUNC_NAME +#endif /* HAVE_SETSID */ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0, (SCM port), @@ -747,26 +739,22 @@ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0, } #undef FUNC_NAME - +#ifdef HAVE_CTERMID SCM_DEFINE (scm_ctermid, "ctermid", 0, 0, 0, (), "Returns a string containing the file name of the controlling terminal for the current process.") #define FUNC_NAME s_scm_ctermid { -#ifdef HAVE_CTERMID char *result = ctermid (NULL); if (*result == '\0') SCM_SYSERROR; return scm_makfrom0str (result); -#else - SCM_SYSMISSING; - /* not reached. */ - return SCM_BOOL_F; -#endif } #undef FUNC_NAME +#endif /* HAVE_CTERMID */ +#ifdef HAVE_TCGETPGRP SCM_DEFINE (scm_tcgetpgrp, "tcgetpgrp", 1, 0, 0, (SCM port), "Returns the process group ID of the foreground @@ -781,7 +769,6 @@ terminated, and no other job has yet been moved into the foreground.") #define FUNC_NAME s_scm_tcgetpgrp { -#ifdef HAVE_TCGETPGRP int fd; pid_t pgid; @@ -792,14 +779,11 @@ foreground.") if ((pgid = tcgetpgrp (fd)) == -1) SCM_SYSERROR; return SCM_MAKINUM (pgid); -#else - SCM_SYSMISSING; - /* not reached. */ - return SCM_BOOL_F; -#endif } #undef FUNC_NAME +#endif /* HAVE_TCGETPGRP */ +#ifdef HAVE_TCSETPGRP SCM_DEFINE (scm_tcsetpgrp, "tcsetpgrp", 2, 0, 0, (SCM port, SCM pgid), "Set the foreground process group ID for the terminal used by the file @@ -809,7 +793,6 @@ must be a member of the same session as @var{pgid} and must have the same controlling terminal. The return value is unspecified.") #define FUNC_NAME s_scm_tcsetpgrp { -#ifdef HAVE_TCSETPGRP int fd; port = SCM_COERCE_OUTPORT (port); @@ -820,14 +803,9 @@ controlling terminal. The return value is unspecified.") if (tcsetpgrp (fd, SCM_INUM (pgid)) == -1) SCM_SYSERROR; return SCM_UNSPECIFIED; -#else - SCM_SYSMISSING; - /* not reached. */ - return SCM_BOOL_F; -#endif } #undef FUNC_NAME - +#endif /* HAVE_TCSETPGRP */ /* Copy exec args from an SCM vector into a new C array. */ @@ -987,14 +965,13 @@ with the scsh fork.") } #undef FUNC_NAME - +#ifdef HAVE_UNAME SCM_DEFINE (scm_uname, "uname", 0, 0, 0, (), "Returns an object with some information about the computer system the program is running on.") #define FUNC_NAME s_scm_uname { -#ifdef HAVE_UNAME struct utsname buf; SCM ans = scm_make_vector (SCM_MAKINUM(5), SCM_UNSPECIFIED); SCM *ve = SCM_VELTS (ans); @@ -1010,13 +987,9 @@ program is running on.") ve[5] = scm_makfrom0str (buf.domainname); */ return ans; -#else - SCM_SYSMISSING; - /* not reached. */ - return SCM_BOOL_F; -#endif } #undef FUNC_NAME +#endif /* HAVE_UNAME */ SCM_DEFINE (scm_environ, "environ", 0, 1, 0, (SCM env), @@ -1194,6 +1167,7 @@ The return value is unspecified.") } #undef FUNC_NAME +#ifdef HAVE_SETLOCALE SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0, (SCM category, SCM locale), "If @var{locale} is omitted, returns the current value of the specified @@ -1208,7 +1182,6 @@ and the new value is returned as a system-dependent string. If @var{locale} is an empty string, the locale will be set using envirionment variables.") #define FUNC_NAME s_scm_setlocale { -#ifdef HAVE_SETLOCALE char *clocale; char *rv; @@ -1228,14 +1201,11 @@ is an empty string, the locale will be set using envirionment variables.") if (rv == NULL) SCM_SYSERROR; return scm_makfrom0str (rv); -#else - SCM_SYSMISSING; - /* not reached. */ - return SCM_BOOL_F; -#endif } #undef FUNC_NAME +#endif /* HAVE_SETLOCALE */ +#ifdef HAVE_MKNOD SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0, (SCM path, SCM type, SCM perms, SCM dev), "Creates a new special file, such as a file corresponding to a device. @@ -1255,7 +1225,6 @@ E.g., The return value is unspecified.") #define FUNC_NAME s_scm_mknod { -#ifdef HAVE_MKNOD int val; char *p; int ctype = 0; @@ -1289,15 +1258,11 @@ The return value is unspecified.") if (val != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; -#else - SCM_SYSMISSING; - /* not reached. */ - return SCM_BOOL_F; -#endif } #undef FUNC_NAME +#endif /* HAVE_MKNOD */ - +#ifdef HAVE_NICE SCM_DEFINE (scm_nice, "nice", 1, 0, 0, (SCM incr), "Increment the priority of the current process by @var{incr}. A higher @@ -1305,35 +1270,25 @@ priority value means that the process runs less often. The return value is unspecified.") #define FUNC_NAME s_scm_nice { -#ifdef HAVE_NICE SCM_VALIDATE_INUM (1,incr); if (nice(SCM_INUM(incr)) != 0) SCM_SYSERROR; return SCM_UNSPECIFIED; -#else - SCM_SYSMISSING; - /* not reached. */ - return SCM_BOOL_F; -#endif } #undef FUNC_NAME +#endif /* HAVE_NICE */ - +#ifdef HAVE_SYNC SCM_DEFINE (scm_sync, "sync", 0, 0, 0, (), "Flush the operating system disk buffers. The return value is unspecified.") #define FUNC_NAME s_scm_sync { -#ifdef HAVE_SYNC sync(); -#else - SCM_SYSMISSING; - /* not reached. */ -#endif - return SCM_UNSPECIFIED; } #undef FUNC_NAME +#endif /* HAVE_SYNC */ void scm_init_posix () diff --git a/libguile/scm_validate.h b/libguile/scm_validate.h index 7b6f54739..99fc5a01c 100644 --- a/libguile/scm_validate.h +++ b/libguile/scm_validate.h @@ -1,4 +1,4 @@ -/* $Id: scm_validate.h,v 1.14 2000-01-09 03:52:29 gjb Exp $ */ +/* $Id: scm_validate.h,v 1.15 2000-01-09 13:41:53 ghouston Exp $ */ /* Copyright (C) 1999 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify @@ -54,9 +54,6 @@ #define SCM_SYSERROR_MSG(str,args,val) \ do { scm_syserror_msg(FUNC_NAME,(str),(args),(val)); } while (0) -#define SCM_SYSMISSING \ - do { scm_sysmissing(FUNC_NAME); } while (0) - #define SCM_WTA(pos,scm) \ do { scm_wta(scm,(char *)pos,FUNC_NAME); } while (0) diff --git a/libguile/simpos.c b/libguile/simpos.c index 447a4d255..1f66288f0 100644 --- a/libguile/simpos.c +++ b/libguile/simpos.c @@ -63,6 +63,7 @@ extern int system(); +#ifdef HAVE_SYSTEM SCM_DEFINE (scm_system, "system", 0, 1, 0, (SCM cmd), "Executes @var{cmd} using the operating system's "command processor". @@ -78,15 +79,10 @@ indicating whether the command processor is available.") if (SCM_UNBNDP (cmd)) { -#ifdef HAVE_SYSTEM rv = system (NULL); -#else - rv = 0; -#endif return SCM_BOOL(rv); } SCM_VALIDATE_ROSTRING (1,cmd); -#ifdef HAVE_SYSTEM SCM_DEFER_INTS; errno = 0; if (SCM_ROSTRINGP (cmd)) @@ -96,11 +92,9 @@ indicating whether the command processor is available.") SCM_SYSERROR; SCM_ALLOW_INTS; return SCM_MAKINUM (rv); -#else - SCM_SYSMISSING; -#endif } #undef FUNC_NAME +#endif /* HAVE_SYSTEM */ extern char *getenv(); SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0, diff --git a/libguile/stime.c b/libguile/stime.c index 1338f9598..7e921ed95 100644 --- a/libguile/stime.c +++ b/libguile/stime.c @@ -164,6 +164,7 @@ SCM_DEFINE (scm_get_internal_real_time, "get-internal-real-time", 0, 0, 0, #endif +#ifdef HAVE_TIMES SCM_DEFINE (scm_times, "times", 0, 0, 0, (void), "Returns an object with information about real and processor time. @@ -187,7 +188,6 @@ terminated child processes. @end table") #define FUNC_NAME s_scm_times { -#ifdef HAVE_TIMES struct tms t; clock_t rv; @@ -201,11 +201,9 @@ terminated child processes. SCM_VELTS (result)[3] = scm_long2num (t.tms_cutime); SCM_VELTS (result)[4] = scm_long2num (t.tms_cstime); return result; -#else - SCM_SYSMISSING; -#endif } #undef FUNC_NAME +#endif /* HAVE_TIMES */ #ifndef HAVE_TZSET /* GNU-WIN32's cygwin.dll doesn't have this. */ @@ -593,6 +591,7 @@ is the formatted string. } #undef FUNC_NAME +#ifdef HAVE_STRPTIME SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0, (SCM format, SCM string), "Performs the reverse action to @code{strftime}, parsing @var{string} @@ -604,10 +603,9 @@ in the form returned by @code{localtime} or @code{gmtime}, but the time zone components are not usefully set. The CDR reports the number of characters from @var{string} which -were used for the conversion.") +vwere used for the conversion.") #define FUNC_NAME s_scm_strptime { -#ifdef HAVE_STRPTIME struct tm t; char *fmt, *str, *rest; @@ -638,12 +636,9 @@ were used for the conversion.") SCM_ALLOW_INTS; return scm_cons (filltime (&t, 0, NULL), SCM_MAKINUM (rest - str)); - -#else - SCM_SYSMISSING; -#endif } #undef FUNC_NAME +#endif /* HAVE_STRPTIME */ void scm_init_stime() |