merge from 1.8 branch
This commit is contained in:
Kevin Ryde
parent
a4f1c77ddb
commit
23f2b9a3de
32 changed files with 752 additions and 190 deletions
33
ChangeLog
33
ChangeLog
|
|
@ -8,6 +8,39 @@
|
||||||
autoconf macro archive, to fix pthread linking problem on Solaris
|
autoconf macro archive, to fix pthread linking problem on Solaris
|
||||||
10, reported by Charles Gagnon.
|
10, reported by Charles Gagnon.
|
||||||
|
|
||||||
|
2006-05-28 Kevin Ryde <user42@zip.com.au>
|
||||||
|
|
||||||
|
* configure.in (isnan): Remove "#ifdef __MINGW32__, #define isnan
|
||||||
|
_isnan". Mingw provides isnan as a macro (in math.h), the test
|
||||||
|
already detects it just fine with no special case.
|
||||||
|
|
||||||
|
2006-05-26 Kevin Ryde <user42@zip.com.au>
|
||||||
|
|
||||||
|
* configure.in (AC_CHECK_FUNCS): Add ioctl.
|
||||||
|
(pthread_attr_getstack): Restrict test to pthreads case, to avoid
|
||||||
|
AC_TRY_RUN when cross-compiling --without-threads.
|
||||||
|
|
||||||
|
2006-05-20 Kevin Ryde <user42@zip.com.au>
|
||||||
|
|
||||||
|
* configure.in (S_ISLNK): Remove test, leave it to #ifdef in the .c
|
||||||
|
files.
|
||||||
|
|
||||||
|
2006-05-16 Kevin Ryde <user42@zip.com.au>
|
||||||
|
|
||||||
|
* configure.in (struct stat st_blocks): Change AC_STRUCT_ST_BLOCKS to
|
||||||
|
a plain AC_CHECK_MEMBERS, we don't want AC_LIBOBJ(fileblocks) which
|
||||||
|
the former gives. Remove the commented-out code that was to have
|
||||||
|
munged fileblocks out of LIBOBJS. This fixes mingw, where the lack of
|
||||||
|
st_blocks and absense of the fileblocks.c replacement caused build
|
||||||
|
failure. Reported by "The Senator".
|
||||||
|
(struct stat st_rdev, st_blksize): Combine into a single
|
||||||
|
AC_CHECK_MEMBERS.
|
||||||
|
|
||||||
|
2006-04-18 Rob Browning <rlb@defaultvalue.org>
|
||||||
|
|
||||||
|
* configure.in: Add AC_CONFIG_AUX_DIR([.]) as suggested in the
|
||||||
|
autotools documentation.
|
||||||
|
|
||||||
2006-04-16 Kevin Ryde <user42@zip.com.au>
|
2006-04-16 Kevin Ryde <user42@zip.com.au>
|
||||||
|
|
||||||
* configure.in (stat64, off_t): New tests.
|
* configure.in (stat64, off_t): New tests.
|
||||||
|
|
|
||||||
47
configure.in
47
configure.in
|
|
@ -29,6 +29,7 @@ AC_PREREQ(2.53)
|
||||||
|
|
||||||
AC_INIT(m4_esyscmd(. ./GUILE-VERSION && echo -n ${PACKAGE}),
|
AC_INIT(m4_esyscmd(. ./GUILE-VERSION && echo -n ${PACKAGE}),
|
||||||
m4_esyscmd(. ./GUILE-VERSION && echo -n ${GUILE_VERSION}))
|
m4_esyscmd(. ./GUILE-VERSION && echo -n ${GUILE_VERSION}))
|
||||||
|
AC_CONFIG_AUX_DIR([.])
|
||||||
AC_CONFIG_SRCDIR(GUILE-VERSION)
|
AC_CONFIG_SRCDIR(GUILE-VERSION)
|
||||||
AM_INIT_AUTOMAKE([no-define])
|
AM_INIT_AUTOMAKE([no-define])
|
||||||
|
|
||||||
|
|
@ -592,13 +593,14 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
|
||||||
# DQNAN - OSF specific
|
# DQNAN - OSF specific
|
||||||
# (DINFINITY and DQNAN are actually global variables, not functions)
|
# (DINFINITY and DQNAN are actually global variables, not functions)
|
||||||
# fesetround - available in C99, but not older systems
|
# fesetround - available in C99, but not older systems
|
||||||
|
# ioctl - not in mingw.
|
||||||
# gmtime_r - recent posix, not on old systems
|
# gmtime_r - recent posix, not on old systems
|
||||||
# readdir_r - recent posix, not on old systems
|
# readdir_r - recent posix, not on old systems
|
||||||
# stat64 - SuS largefile stuff, not on old systems
|
# stat64 - SuS largefile stuff, not on old systems
|
||||||
# sysconf - not on old systems
|
# sysconf - not on old systems
|
||||||
# _NSGetEnviron - Darwin specific
|
# _NSGetEnviron - Darwin specific
|
||||||
#
|
#
|
||||||
AC_CHECK_FUNCS([DINFINITY DQNAN ctermid fesetround ftime fchown getcwd geteuid gettimeofday gmtime_r lstat mkdir mknod nice readdir_r readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex unsetenv _NSGetEnviron])
|
AC_CHECK_FUNCS([DINFINITY DQNAN ctermid fesetround ftime fchown getcwd geteuid gettimeofday gmtime_r ioctl lstat mkdir mknod nice readdir_r readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex unsetenv _NSGetEnviron])
|
||||||
|
|
||||||
# Reasons for testing:
|
# Reasons for testing:
|
||||||
# netdb.h - not in mingw
|
# netdb.h - not in mingw
|
||||||
|
|
@ -900,9 +902,6 @@ int main () { return (isinf(0.0) != 0); }],
|
||||||
AC_MSG_CHECKING([for isnan])
|
AC_MSG_CHECKING([for isnan])
|
||||||
AC_LINK_IFELSE(
|
AC_LINK_IFELSE(
|
||||||
[#include <math.h>
|
[#include <math.h>
|
||||||
#ifdef __MINGW32__
|
|
||||||
#define isnan _isnan
|
|
||||||
#endif
|
|
||||||
int main () { return (isnan(0.0) != 0); }],
|
int main () { return (isnan(0.0) != 0); }],
|
||||||
[AC_MSG_RESULT([yes])
|
[AC_MSG_RESULT([yes])
|
||||||
AC_DEFINE(HAVE_ISNAN, 1,
|
AC_DEFINE(HAVE_ISNAN, 1,
|
||||||
|
|
@ -919,22 +918,16 @@ then
|
||||||
AC_ERROR([No native alloca found.])
|
AC_ERROR([No native alloca found.])
|
||||||
fi
|
fi
|
||||||
|
|
||||||
AC_CHECK_MEMBERS([struct stat.st_rdev])
|
# Reasons for checking:
|
||||||
AC_CHECK_MEMBERS([struct stat.st_blksize])
|
#
|
||||||
|
# st_rdev
|
||||||
AC_STRUCT_ST_BLOCKS
|
# st_blksize
|
||||||
|
# st_blocks not in mingw
|
||||||
AC_CACHE_CHECK([for S_ISLNK in sys/stat.h], ac_cv_macro_S_ISLNK,
|
#
|
||||||
[AC_TRY_CPP([#include <sys/stat.h>
|
# Note AC_STRUCT_ST_BLOCKS is not used here because we don't want the
|
||||||
#ifndef S_ISLNK
|
# AC_LIBOBJ(fileblocks) replacement which that macro gives.
|
||||||
#error no S_ISLNK
|
#
|
||||||
#endif],
|
AC_CHECK_MEMBERS([struct stat.st_rdev, struct stat.st_blksize, struct stat.st_blocks])
|
||||||
ac_cv_macro_S_ISLNK=yes,
|
|
||||||
ac_cv_macro_S_ISLNK=no)])
|
|
||||||
if test $ac_cv_macro_S_ISLNK = yes; then
|
|
||||||
AC_DEFINE(HAVE_S_ISLNK, 1,
|
|
||||||
[Define this if your system defines S_ISLNK in sys/stat.h.])
|
|
||||||
fi
|
|
||||||
|
|
||||||
AC_STRUCT_TIMEZONE
|
AC_STRUCT_TIMEZONE
|
||||||
GUILE_STRUCT_UTIMBUF
|
GUILE_STRUCT_UTIMBUF
|
||||||
|
|
@ -1039,6 +1032,8 @@ AC_MSG_RESULT($with_threads)
|
||||||
|
|
||||||
## Check whether pthread_attr_getstack works for the main thread
|
## Check whether pthread_attr_getstack works for the main thread
|
||||||
|
|
||||||
|
if test "$with_threads" = pthreads; then
|
||||||
|
|
||||||
AC_MSG_CHECKING(whether pthread_attr_getstack works for the main thread)
|
AC_MSG_CHECKING(whether pthread_attr_getstack works for the main thread)
|
||||||
old_CFLAGS="$CFLAGS"
|
old_CFLAGS="$CFLAGS"
|
||||||
CFLAGS="$PTHREAD_CFLAGS $CFLAGS"
|
CFLAGS="$PTHREAD_CFLAGS $CFLAGS"
|
||||||
|
|
@ -1075,6 +1070,9 @@ AC_DEFINE(PTHREAD_ATTR_GETSTACK_WORKS, [1], [Define when pthread_att_get_stack w
|
||||||
CFLAGS="$old_CFLAGS"
|
CFLAGS="$old_CFLAGS"
|
||||||
AC_MSG_RESULT($works)
|
AC_MSG_RESULT($works)
|
||||||
|
|
||||||
|
fi # with_threads=pthreads
|
||||||
|
|
||||||
|
|
||||||
## Cross building
|
## Cross building
|
||||||
if test "$cross_compiling" = "yes"; then
|
if test "$cross_compiling" = "yes"; then
|
||||||
AC_MSG_CHECKING(cc for build)
|
AC_MSG_CHECKING(cc for build)
|
||||||
|
|
@ -1137,15 +1135,6 @@ case "$GCC" in
|
||||||
;;
|
;;
|
||||||
esac
|
esac
|
||||||
|
|
||||||
## NOTE the code below sets LIBOBJS directly and so is now forbidden
|
|
||||||
## -- I'm disabling it for now in the hopes that the newer autoconf
|
|
||||||
## will DTRT -- if not, we need to fix up the sed command to match the
|
|
||||||
## others...
|
|
||||||
##
|
|
||||||
## Remove fileblocks.o from the object list. This file gets added by
|
|
||||||
## the Autoconf macro AC_STRUCT_ST_BLOCKS. But there is no need.
|
|
||||||
#LIBOBJS="`echo ${LIBOBJS} | sed 's/fileblocks\.o//g'`"
|
|
||||||
|
|
||||||
## If we're creating a shared library (using libtool!), then we'll
|
## If we're creating a shared library (using libtool!), then we'll
|
||||||
## need to generate a list of .lo files corresponding to the .o files
|
## need to generate a list of .lo files corresponding to the .o files
|
||||||
## given in LIBOBJS. We'll call it LIBLOBJS.
|
## given in LIBOBJS. We'll call it LIBLOBJS.
|
||||||
|
|
|
||||||
|
|
@ -1,3 +1,9 @@
|
||||||
|
2006-04-21 Kevin Ryde <user42@zip.com.au>
|
||||||
|
|
||||||
|
* hierarchy.pdf: New file, converted from hierarchy.eps using
|
||||||
|
epstopdf, to let "make pdf" work.
|
||||||
|
* Makefile.am: (goops_TEXINFOS): Add it.
|
||||||
|
|
||||||
2006-03-08 Ludovic Courtès <ludovic.courtes@laas.fr>
|
2006-03-08 Ludovic Courtès <ludovic.courtes@laas.fr>
|
||||||
|
|
||||||
* goops.texi (Slot Options): Note init-value is shared.
|
* goops.texi (Slot Options): Note init-value is shared.
|
||||||
|
|
|
||||||
|
|
@ -23,6 +23,7 @@ AUTOMAKE_OPTIONS = gnu
|
||||||
|
|
||||||
info_TEXINFOS = goops.texi
|
info_TEXINFOS = goops.texi
|
||||||
|
|
||||||
goops_TEXINFOS = goops-tutorial.texi hierarchy.eps hierarchy.png hierarchy.txt
|
goops_TEXINFOS = goops-tutorial.texi \
|
||||||
|
hierarchy.eps hierarchy.png hierarchy.txt hierarchy.pdf
|
||||||
|
|
||||||
TEXINFO_TEX = ../ref/texinfo.tex
|
TEXINFO_TEX = ../ref/texinfo.tex
|
||||||
|
|
|
||||||
74
doc/goops/hierarchy.pdf
Normal file
74
doc/goops/hierarchy.pdf
Normal file
|
|
@ -0,0 +1,74 @@
|
||||||
|
%PDF-1.3
|
||||||
|
%Çì<C387>¢
|
||||||
|
5 0 obj
|
||||||
|
<</Length 6 0 R/Filter /FlateDecode>>
|
||||||
|
stream
|
||||||
|
xœm”Ën1 E÷ú
|
||||||
|
-íÅ°¢(êš6-Ð][ï‚.Ç
Äy¸)úû½Ò¼ ÛÀ ‘wŽ(Šä«uÄÖÕgø_o͇ ÉÞý1<C3BD>Ôþ3lï<6C>³_Môl9„b·óë£ùi¼}0š(:U[|†[¢-¥:s¦<73>"V!’zirù €ÒE«û /Nú-À#K5<4B>n[ŒœÑ{ âÀr¶E#¼™]±%—w
‚af€J˜Aœ<<3C>#ž"§ªðn ¯‰J=u ŒïFÚ$9Á“"T‚ZQAn*P”mજH²XÉŽ²+sº<12>d"ñstÎ 1¼¾<C2BC>sUÁ.a©-<ç•pSÁ9Chá<68>’cž†L’eÉ8ÙtÓ®*4"w!çJi¢MŠ–ff™iÑ Ôâßs¢”Þz‚Ð^]žï1&¤dÞô=©¬E8{Ç^x¬Îã„–K=M»!T¨õ®…ÍŠk®A—¬${›4Ð'!kÞ»!ŸêW‘ò)MŠ%’“D ü1àÊÄ‚ã G©èÕ\—ˆ6<CB86>dŠ+ñ€‰”PL5ô 2ƒ÷„²À<‰žd¶ÄªôÉld.Ó^n¯ŒÄ%´LòNaq5O…ÝœÈè$Ü *<2A>ÂÒ7Éž·aš½çÜ™WÔt›]Ãßzk/V˜bø <1C>dW¿M?ÚØv•R
|
||||||
|
~V[³ø¸\aƘë…oW·fñ¹Úæ<>
ƒå²Zº€‰<E282AC>S-W‹‹e§ #‰,>-¾™b;ô{UijdS[gUÓÙóÍÃfýv^=ÅÙ(½õíùåü8€«ÅÙËõýî|Ù±GéÄ„õîy½¹ý»ÛT£¢°íÙÓßíÍ¦É µP°®¼ZAý>»ÍõcÛ¨C”½Íxÿô¶¹«ßÃ~¹2ßñü<07>(8endstream
|
||||||
|
endobj
|
||||||
|
6 0 obj
|
||||||
|
660
|
||||||
|
endobj
|
||||||
|
4 0 obj
|
||||||
|
<</Type/Page/MediaBox [0 0 361 217]
|
||||||
|
/Parent 3 0 R
|
||||||
|
/Resources<</ProcSet[/PDF /Text]
|
||||||
|
/ExtGState 9 0 R
|
||||||
|
/Font 10 0 R
|
||||||
|
>>
|
||||||
|
/Contents 5 0 R
|
||||||
|
>>
|
||||||
|
endobj
|
||||||
|
3 0 obj
|
||||||
|
<< /Type /Pages /Kids [
|
||||||
|
4 0 R
|
||||||
|
] /Count 1
|
||||||
|
>>
|
||||||
|
endobj
|
||||||
|
1 0 obj
|
||||||
|
<</Type /Catalog /Pages 3 0 R
|
||||||
|
>>
|
||||||
|
endobj
|
||||||
|
7 0 obj
|
||||||
|
<</Type/ExtGState
|
||||||
|
/OPM 1>>endobj
|
||||||
|
9 0 obj
|
||||||
|
<</R7
|
||||||
|
7 0 R>>
|
||||||
|
endobj
|
||||||
|
10 0 obj
|
||||||
|
<</R8
|
||||||
|
8 0 R>>
|
||||||
|
endobj
|
||||||
|
8 0 obj
|
||||||
|
<</BaseFont/Times-Bold/Type/Font
|
||||||
|
/Subtype/Type1>>
|
||||||
|
endobj
|
||||||
|
2 0 obj
|
||||||
|
<</Producer(GPL Ghostscript 8.15)
|
||||||
|
/CreationDate(D:20060418115825)
|
||||||
|
/ModDate(D:20060418115825)
|
||||||
|
/Title(/tmp/xfig-fig016295)
|
||||||
|
/Creator(fig2dev)
|
||||||
|
/Author(eg@kaolin \(Erick Gallesio\))>>endobj
|
||||||
|
xref
|
||||||
|
0 11
|
||||||
|
0000000000 65535 f
|
||||||
|
0000000973 00000 n
|
||||||
|
0000001186 00000 n
|
||||||
|
0000000914 00000 n
|
||||||
|
0000000764 00000 n
|
||||||
|
0000000015 00000 n
|
||||||
|
0000000745 00000 n
|
||||||
|
0000001021 00000 n
|
||||||
|
0000001121 00000 n
|
||||||
|
0000001062 00000 n
|
||||||
|
0000001091 00000 n
|
||||||
|
trailer
|
||||||
|
<< /Size 11 /Root 1 0 R /Info 2 0 R
|
||||||
|
/ID [(<28>¿Ccežò3f¾q \\[)(<28>¿Ccežò3f¾q \\[)]
|
||||||
|
>>
|
||||||
|
startxref
|
||||||
|
1379
|
||||||
|
%%EOF
|
||||||
|
|
@ -8,6 +8,50 @@
|
||||||
* api-compound.texi (Structure Concepts): Mentioned the behavior
|
* api-compound.texi (Structure Concepts): Mentioned the behavior
|
||||||
of `equal?' for structures.
|
of `equal?' for structures.
|
||||||
|
|
||||||
|
2006-05-28 Kevin Ryde <user42@zip.com.au>
|
||||||
|
|
||||||
|
* srfi-modules.texi (SRFI-1 Length Append etc): Add an append-reverse
|
||||||
|
example.
|
||||||
|
|
||||||
|
2006-05-20 Kevin Ryde <user42@zip.com.au>
|
||||||
|
|
||||||
|
* api-compound.texi (Pairs): Cross reference SRFI-1 second, third,
|
||||||
|
fourth.
|
||||||
|
(List Modification): Cross reference SRFI-1 delete and lset-difference.
|
||||||
|
(List Searching): Cross reference SRFI-1 member.
|
||||||
|
(List Mapping): Cross reference SRFI-1 map etc.
|
||||||
|
(Retrieving Alist Entries): Cross reference SRFI-1 assoc.
|
||||||
|
|
||||||
|
* srfi-modules.texi (SRFI-1 Association Lists): Describe argument
|
||||||
|
order for "=" procedure.
|
||||||
|
|
||||||
|
2006-05-15 Kevin Ryde <user42@zip.com.au>
|
||||||
|
|
||||||
|
* posix.texi (Processes): Add primitive-_exit.
|
||||||
|
|
||||||
|
2006-05-10 Kevin Ryde <user42@zip.com.au>
|
||||||
|
|
||||||
|
* intro.texi (Linking Guile into Programs): Enhance example program,
|
||||||
|
change scm_str2string to scm_from_locale_string, since scm_str2string
|
||||||
|
is "discouraged". And check for NULL from getenv since neither
|
||||||
|
scm_str2string nor scm_from_locale_string can cope with that.
|
||||||
|
Reported by Frithjof.
|
||||||
|
|
||||||
|
2006-05-09 Kevin Ryde <user42@zip.com.au>
|
||||||
|
|
||||||
|
* api-control.texi (Multiple Values): In `receive', add an example,
|
||||||
|
cross ref SRFI-8, tweak wording.
|
||||||
|
|
||||||
|
* api-io.texi (Port Implementation): @defun style for
|
||||||
|
scm_make_port_type and the various set functions.
|
||||||
|
|
||||||
|
* posix.texi (Ports and File Descriptors): Tweaks to fcntl.
|
||||||
|
|
||||||
|
2006-04-29 Kevin Ryde <user42@zip.com.au>
|
||||||
|
|
||||||
|
* api-scheduling.texi (Threads): In call-with-new-thread, handler arg
|
||||||
|
is optional (as of 1.8.0).
|
||||||
|
|
||||||
2006-04-15 Kevin Ryde <user42@zip.com.au>
|
2006-04-15 Kevin Ryde <user42@zip.com.au>
|
||||||
|
|
||||||
* api-scheduling.texi (System asyncs): "{void *}" in @deffnx to keep
|
* api-scheduling.texi (System asyncs): "{void *}" in @deffnx to keep
|
||||||
|
|
|
||||||
|
|
@ -189,6 +189,11 @@ for example @code{caddr} could be defined by
|
||||||
@lisp
|
@lisp
|
||||||
(define caddr (lambda (x) (car (cdr (cdr x)))))
|
(define caddr (lambda (x) (car (cdr (cdr x)))))
|
||||||
@end lisp
|
@end lisp
|
||||||
|
|
||||||
|
@code{cadr}, @code{caddr} and @code{cadddr} pick out the second, third
|
||||||
|
or fourth elements of a list, respectively. SRFI-1 provides the same
|
||||||
|
under the names @code{second}, @code{third} and @code{fourth}
|
||||||
|
(@pxref{SRFI-1 Selectors}).
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
@rnindex set-car!
|
@rnindex set-car!
|
||||||
|
|
@ -509,6 +514,10 @@ Return a newly-created copy of @var{lst} with elements
|
||||||
@code{equal?} to @var{item} removed. This procedure mirrors
|
@code{equal?} to @var{item} removed. This procedure mirrors
|
||||||
@code{member}: @code{delete} compares elements of @var{lst}
|
@code{member}: @code{delete} compares elements of @var{lst}
|
||||||
against @var{item} with @code{equal?}.
|
against @var{item} with @code{equal?}.
|
||||||
|
|
||||||
|
See also SRFI-1 which has an extended @code{delete} (@ref{SRFI-1
|
||||||
|
Deleting}), and also an @code{lset-difference} which can delete
|
||||||
|
multiple @var{item}s in one call (@ref{SRFI-1 Set Operations}).
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
@deffn {Scheme Procedure} delq! item lst
|
@deffn {Scheme Procedure} delq! item lst
|
||||||
|
|
@ -598,6 +607,9 @@ the non-empty lists returned by @code{(list-tail @var{lst}
|
||||||
@var{k})} for @var{k} less than the length of @var{lst}. If
|
@var{k})} for @var{k} less than the length of @var{lst}. If
|
||||||
@var{x} does not occur in @var{lst}, then @code{#f} (not the
|
@var{x} does not occur in @var{lst}, then @code{#f} (not the
|
||||||
empty list) is returned.
|
empty list) is returned.
|
||||||
|
|
||||||
|
See also SRFI-1 which has an extended @code{member} function
|
||||||
|
(@ref{SRFI-1 Searching}).
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -633,6 +645,8 @@ and the result(s) of the procedure applications are thrown away. The
|
||||||
return value is not specified.
|
return value is not specified.
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
|
See also SRFI-1 which extends these functions to take lists of unequal
|
||||||
|
lengths (@ref{SRFI-1 Fold and Map}).
|
||||||
|
|
||||||
@node Vectors
|
@node Vectors
|
||||||
@subsection Vectors
|
@subsection Vectors
|
||||||
|
|
@ -3262,7 +3276,8 @@ return is the pair @code{(KEY . VALUE)} from @var{alist}. If there's
|
||||||
no matching entry the return is @code{#f}.
|
no matching entry the return is @code{#f}.
|
||||||
|
|
||||||
@code{assq} compares keys with @code{eq?}, @code{assv} uses
|
@code{assq} compares keys with @code{eq?}, @code{assv} uses
|
||||||
@code{eqv?} and @code{assoc} uses @code{equal?}.
|
@code{eqv?} and @code{assoc} uses @code{equal?}. See also SRFI-1
|
||||||
|
which has an extended @code{assoc} (@ref{SRFI-1 Association Lists}).
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
@deffn {Scheme Procedure} assq-ref alist key
|
@deffn {Scheme Procedure} assq-ref alist key
|
||||||
|
|
|
||||||
|
|
@ -544,20 +544,34 @@ of the call to @code{call-with-values}.
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
In addition to the fundamental procedures described above, Guile has a
|
In addition to the fundamental procedures described above, Guile has a
|
||||||
module which exports a syntax called @code{receive}, which is much more
|
module which exports a syntax called @code{receive}, which is much
|
||||||
convenient. If you want to use it in your programs, you have to load
|
more convenient. This is in the @code{(ice-9 receive)} and is the
|
||||||
the module @code{(ice-9 receive)} with the statement
|
same as specified by SRFI-8 (@pxref{SRFI-8}).
|
||||||
|
|
||||||
@lisp
|
@lisp
|
||||||
(use-modules (ice-9 receive))
|
(use-modules (ice-9 receive))
|
||||||
@end lisp
|
@end lisp
|
||||||
|
|
||||||
@deffn {library syntax} receive formals expr body @dots{}
|
@deffn {library syntax} receive formals expr body @dots{}
|
||||||
Evaluate the expression @var{expr}, and bind the result values (zero or
|
Evaluate the expression @var{expr}, and bind the result values (zero
|
||||||
more) to the formal arguments in the formal argument list @var{formals}.
|
or more) to the formal arguments in @var{formals}. @var{formals} is a
|
||||||
@var{formals} must have the same syntax like the formal argument list
|
list of symbols, like the argument list in a @code{lambda}
|
||||||
used in @code{lambda} (@pxref{Lambda}). After binding the variables,
|
(@pxref{Lambda}). After binding the variables, the expressions in
|
||||||
the expressions in @var{body} @dots{} are evaluated in order.
|
@var{body} @dots{} are evaluated in order, the return value is the
|
||||||
|
result from the last expression.
|
||||||
|
|
||||||
|
For example getting results from @code{partition} in SRFI-1
|
||||||
|
(@pxref{SRFI-1}),
|
||||||
|
|
||||||
|
@example
|
||||||
|
(receive (odds evens)
|
||||||
|
(partition odd? '(7 4 2 8 3))
|
||||||
|
(display odds)
|
||||||
|
(display " and ")
|
||||||
|
(display evens))
|
||||||
|
@print{} (7 3) and (4 2 8)
|
||||||
|
@end example
|
||||||
|
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1118,15 +1118,17 @@ As described in the previous section, a port type object (ptob) is
|
||||||
a structure of type @code{scm_ptob_descriptor}. A ptob is created by
|
a structure of type @code{scm_ptob_descriptor}. A ptob is created by
|
||||||
calling @code{scm_make_port_type}.
|
calling @code{scm_make_port_type}.
|
||||||
|
|
||||||
|
@deftypefun scm_t_bits scm_make_port_type (char *name, int (*fill_input) (SCM port), void (*write) (SCM port, const void *data, size_t size))
|
||||||
|
Return a new port type object. The @var{name}, @var{fill_input} and
|
||||||
|
@var{write} parameters are initial values for those port type fields,
|
||||||
|
as described below. The other fields are initialized with default
|
||||||
|
values and can be changed later.
|
||||||
|
@end deftypefun
|
||||||
|
|
||||||
All of the elements of the ptob, apart from @code{name}, are procedures
|
All of the elements of the ptob, apart from @code{name}, are procedures
|
||||||
which collectively implement the port behaviour. Creating a new port
|
which collectively implement the port behaviour. Creating a new port
|
||||||
type mostly involves writing these procedures.
|
type mostly involves writing these procedures.
|
||||||
|
|
||||||
@code{scm_make_port_type} initializes three elements of the structure
|
|
||||||
(@code{name}, @code{fill_input} and @code{write}) from its arguments.
|
|
||||||
The remaining elements are initialized with default values and can be
|
|
||||||
set later if required.
|
|
||||||
|
|
||||||
@table @code
|
@table @code
|
||||||
@item name
|
@item name
|
||||||
A pointer to a NUL terminated string: the name of the port type. This
|
A pointer to a NUL terminated string: the name of the port type. This
|
||||||
|
|
@ -1136,25 +1138,42 @@ a procedure. Set via the first argument to @code{scm_make_port_type}.
|
||||||
@item mark
|
@item mark
|
||||||
Called during garbage collection to mark any SCM objects that a port
|
Called during garbage collection to mark any SCM objects that a port
|
||||||
object may contain. It doesn't need to be set unless the port has
|
object may contain. It doesn't need to be set unless the port has
|
||||||
@code{SCM} components. Set using @code{scm_set_port_mark}.
|
@code{SCM} components. Set using
|
||||||
|
|
||||||
|
@deftypefun void scm_set_port_mark (scm_t_bits tc, SCM (*mark) (SCM port))
|
||||||
|
@end deftypefun
|
||||||
|
|
||||||
@item free
|
@item free
|
||||||
Called when the port is collected during gc. It
|
Called when the port is collected during gc. It
|
||||||
should free any resources used by the port.
|
should free any resources used by the port.
|
||||||
Set using @code{scm_set_port_free}.
|
Set using
|
||||||
|
|
||||||
|
@deftypefun void scm_set_port_free (scm_t_bits tc, size_t (*free) (SCM port))
|
||||||
|
@end deftypefun
|
||||||
|
|
||||||
@item print
|
@item print
|
||||||
Called when @code{write} is called on the port object, to print a
|
Called when @code{write} is called on the port object, to print a
|
||||||
port description. e.g., for an fport it may produce something like:
|
port description. E.g., for an fport it may produce something like:
|
||||||
@code{#<input: /etc/passwd 3>}. Set using @code{scm_set_port_print}.
|
@code{#<input: /etc/passwd 3>}. Set using
|
||||||
|
|
||||||
|
@deftypefun void scm_set_port_print (scm_t_bits tc, int (*print) (SCM port, SCM dest_port, scm_print_state *pstate))
|
||||||
|
The first argument @var{port} is the object being printed, the second
|
||||||
|
argument @var{dest_port} is where its description should go.
|
||||||
|
@end deftypefun
|
||||||
|
|
||||||
@item equalp
|
@item equalp
|
||||||
Not used at present. Set using @code{scm_set_port_equalp}.
|
Not used at present. Set using
|
||||||
|
|
||||||
|
@deftypefun void scm_set_port_equalp (scm_t_bits tc, SCM (*equalp) (SCM, SCM))
|
||||||
|
@end deftypefun
|
||||||
|
|
||||||
@item close
|
@item close
|
||||||
Called when the port is closed, unless it was collected during gc. It
|
Called when the port is closed, unless it was collected during gc. It
|
||||||
should free any resources used by the port.
|
should free any resources used by the port.
|
||||||
Set using @code{scm_set_port_close}.
|
Set using
|
||||||
|
|
||||||
|
@deftypefun void scm_set_port_close (scm_t_bits tc, int (*close) (SCM port))
|
||||||
|
@end deftypefun
|
||||||
|
|
||||||
@item write
|
@item write
|
||||||
Accept data which is to be written using the port. The port implementation
|
Accept data which is to be written using the port. The port implementation
|
||||||
|
|
@ -1164,12 +1183,18 @@ Set via the third argument to @code{scm_make_port_type}.
|
||||||
@item flush
|
@item flush
|
||||||
Complete the processing of buffered output data. Reset the value of
|
Complete the processing of buffered output data. Reset the value of
|
||||||
@code{rw_active} to @code{SCM_PORT_NEITHER}.
|
@code{rw_active} to @code{SCM_PORT_NEITHER}.
|
||||||
Set using @code{scm_set_port_flush}.
|
Set using
|
||||||
|
|
||||||
|
@deftypefun void scm_set_port_flush (scm_t_bits tc, void (*flush) (SCM port))
|
||||||
|
@end deftypefun
|
||||||
|
|
||||||
@item end_input
|
@item end_input
|
||||||
Perform any synchronization required when switching from input to output
|
Perform any synchronization required when switching from input to output
|
||||||
on the port. Reset the value of @code{rw_active} to @code{SCM_PORT_NEITHER}.
|
on the port. Reset the value of @code{rw_active} to @code{SCM_PORT_NEITHER}.
|
||||||
Set using @code{scm_set_port_end_input}.
|
Set using
|
||||||
|
|
||||||
|
@deftypefun void scm_set_port_end_input (scm_t_bits tc, void (*end_input) (SCM port, int offset))
|
||||||
|
@end deftypefun
|
||||||
|
|
||||||
@item fill_input
|
@item fill_input
|
||||||
Read new data into the read buffer and return the first character. It
|
Read new data into the read buffer and return the first character. It
|
||||||
|
|
@ -1180,7 +1205,10 @@ Set via the second argument to @code{scm_make_port_type}.
|
||||||
Return a lower bound on the number of bytes that could be read from the
|
Return a lower bound on the number of bytes that could be read from the
|
||||||
port without blocking. It can be assumed that the current state of
|
port without blocking. It can be assumed that the current state of
|
||||||
@code{rw_active} is @code{SCM_PORT_NEITHER}.
|
@code{rw_active} is @code{SCM_PORT_NEITHER}.
|
||||||
Set using @code{scm_set_port_input_waiting}.
|
Set using
|
||||||
|
|
||||||
|
@deftypefun void scm_set_port_input_waiting (scm_t_bits tc, int (*input_waiting) (SCM port))
|
||||||
|
@end deftypefun
|
||||||
|
|
||||||
@item seek
|
@item seek
|
||||||
Set the current position of the port. The procedure can not make
|
Set the current position of the port. The procedure can not make
|
||||||
|
|
@ -1189,10 +1217,10 @@ called. It can reset the buffers first if desired by using something
|
||||||
like:
|
like:
|
||||||
|
|
||||||
@example
|
@example
|
||||||
if (pt->rw_active == SCM_PORT_READ)
|
if (pt->rw_active == SCM_PORT_READ)
|
||||||
scm_end_input (object);
|
scm_end_input (port);
|
||||||
else if (pt->rw_active == SCM_PORT_WRITE)
|
else if (pt->rw_active == SCM_PORT_WRITE)
|
||||||
ptob->flush (object);
|
ptob->flush (port);
|
||||||
@end example
|
@end example
|
||||||
|
|
||||||
However note that this will have the side effect of discarding any data
|
However note that this will have the side effect of discarding any data
|
||||||
|
|
@ -1202,12 +1230,18 @@ when seek is called to measure the current position of the port, i.e.,
|
||||||
@code{(seek p 0 SEEK_CUR)}. The libguile fport and string port
|
@code{(seek p 0 SEEK_CUR)}. The libguile fport and string port
|
||||||
implementations take care to avoid this problem.
|
implementations take care to avoid this problem.
|
||||||
|
|
||||||
The procedure is set using @code{scm_set_port_seek}.
|
The procedure is set using
|
||||||
|
|
||||||
|
@deftypefun void scm_set_port_seek (scm_t_bits tc, off_t (*seek) (SCM port, off_t offset, int whence))
|
||||||
|
@end deftypefun
|
||||||
|
|
||||||
@item truncate
|
@item truncate
|
||||||
Truncate the port data to be specified length. It can be assumed that the
|
Truncate the port data to be specified length. It can be assumed that the
|
||||||
current state of @code{rw_active} is @code{SCM_PORT_NEITHER}.
|
current state of @code{rw_active} is @code{SCM_PORT_NEITHER}.
|
||||||
Set using @code{scm_set_port_truncate}.
|
Set using
|
||||||
|
|
||||||
|
@deftypefun void scm_set_port_truncate (scm_t_bits tc, void (*truncate) (SCM port, off_t length))
|
||||||
|
@end deftypefun
|
||||||
|
|
||||||
@end table
|
@end table
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -240,7 +240,7 @@ Return the thread that called this function.
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
@c begin (texi-doc-string "guile" "call-with-new-thread")
|
@c begin (texi-doc-string "guile" "call-with-new-thread")
|
||||||
@deffn {Scheme Procedure} call-with-new-thread thunk handler
|
@deffn {Scheme Procedure} call-with-new-thread thunk [handler]
|
||||||
Call @code{thunk} in a new thread and with a new dynamic state,
|
Call @code{thunk} in a new thread and with a new dynamic state,
|
||||||
returning the new thread. The procedure @var{thunk} is called via
|
returning the new thread. The procedure @var{thunk} is called via
|
||||||
@code{with-continuation-barrier}.
|
@code{with-continuation-barrier}.
|
||||||
|
|
|
||||||
|
|
@ -193,7 +193,11 @@ functions provided by Guile, it will also offer the function
|
||||||
static SCM
|
static SCM
|
||||||
my_hostname (void)
|
my_hostname (void)
|
||||||
@{
|
@{
|
||||||
return scm_str2string (getenv ("HOSTNAME"));
|
char *s = getenv ("HOSTNAME");
|
||||||
|
if (s == NULL)
|
||||||
|
return SCM_BOOL_F;
|
||||||
|
else
|
||||||
|
return scm_from_locale_string (s);
|
||||||
@}
|
@}
|
||||||
|
|
||||||
static void
|
static void
|
||||||
|
|
|
||||||
|
|
@ -472,10 +472,11 @@ If @var{size} is omitted, a default size will be used.
|
||||||
@end defvar
|
@end defvar
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
@deffn {Scheme Procedure} fcntl object cmd [value]
|
@deffn {Scheme Procedure} fcntl port/fd cmd [value]
|
||||||
@deffnx {C Function} scm_fcntl (object, cmd, value)
|
@deffnx {C Function} scm_fcntl (object, cmd, value)
|
||||||
Apply @var{cmd} on @var{object}, either a port or file descriptor.
|
Apply @var{cmd} on @var{port/fd}, either a port or file descriptor.
|
||||||
The @var{value} is an integer argument, for the @code{SET} commands.
|
The @var{value} argument is used by the @code{SET} commands described
|
||||||
|
below, it's an integer value.
|
||||||
|
|
||||||
Values for @var{cmd} are:
|
Values for @var{cmd} are:
|
||||||
|
|
||||||
|
|
@ -497,6 +498,13 @@ flag,
|
||||||
@example
|
@example
|
||||||
(fcntl port F_SETFD FD_CLOEXEC)
|
(fcntl port F_SETFD FD_CLOEXEC)
|
||||||
@end example
|
@end example
|
||||||
|
|
||||||
|
Or better, set it but leave any other possible future flags unchanged,
|
||||||
|
|
||||||
|
@example
|
||||||
|
(fcntl port F_SETFD (logior FD_CLOEXEC
|
||||||
|
(fcntl port F_GETFD)))
|
||||||
|
@end example
|
||||||
@end defvar
|
@end defvar
|
||||||
@end defvar
|
@end defvar
|
||||||
|
|
||||||
|
|
@ -509,8 +517,8 @@ A common use is to set @code{O_NONBLOCK} on a network socket. The
|
||||||
following sets that flag, and leaves other flags unchanged.
|
following sets that flag, and leaves other flags unchanged.
|
||||||
|
|
||||||
@example
|
@example
|
||||||
(fcntl sock F_SETFL
|
(fcntl sock F_SETFL (logior O_NONBLOCK
|
||||||
(logior (fcntl sock F_GETFL) O_NONBLOCK))
|
(fcntl sock F_GETFL)))
|
||||||
@end example
|
@end example
|
||||||
@end defvar
|
@end defvar
|
||||||
|
|
||||||
|
|
@ -1644,10 +1652,28 @@ Example: (system* "echo" "foo" "bar")
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
@deffn {Scheme Procedure} primitive-exit [status]
|
@deffn {Scheme Procedure} primitive-exit [status]
|
||||||
|
@deffnx {Scheme Procedure} primitive-_exit [status]
|
||||||
@deffnx {C Function} scm_primitive_exit (status)
|
@deffnx {C Function} scm_primitive_exit (status)
|
||||||
Terminate the current process without unwinding the Scheme stack.
|
@deffnx {C Function} scm_primitive__exit (status)
|
||||||
This is would typically be useful after a fork. The exit status
|
Terminate the current process without unwinding the Scheme stack. The
|
||||||
is @var{status} if supplied, otherwise zero.
|
exit status is @var{status} if supplied, otherwise zero.
|
||||||
|
|
||||||
|
@code{primitive-exit} uses the C @code{exit} function and hence runs
|
||||||
|
usual C level cleanups (flush output streams, call @code{atexit}
|
||||||
|
functions, etc, see @ref{Normal Termination,,, libc, The GNU C Library
|
||||||
|
Reference Manual})).
|
||||||
|
|
||||||
|
@code{primitive-_exit} is the @code{_exit} system call
|
||||||
|
(@pxref{Termination Internals,,, libc, The GNU C Library Reference
|
||||||
|
Manual}). This terminates the program immediately, with neither
|
||||||
|
Scheme-level nor C-level cleanups.
|
||||||
|
|
||||||
|
The typical use for @code{primitive-_exit} is from a child process
|
||||||
|
created with @code{primitive-fork}. For example in a Gdk program the
|
||||||
|
child process inherits the X server connection and a C-level
|
||||||
|
@code{atexit} cleanup which will close that connection. But closing
|
||||||
|
in the child would upset the protocol in the parent, so
|
||||||
|
@code{primitive-_exit} should be used to exit without that.
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
@deffn {Scheme Procedure} execl filename . args
|
@deffn {Scheme Procedure} execl filename . args
|
||||||
|
|
|
||||||
|
|
@ -414,9 +414,13 @@ have a limit on the number of arguments a function takes, which the
|
||||||
|
|
||||||
@deffn {Scheme Procedure} append-reverse rev-head tail
|
@deffn {Scheme Procedure} append-reverse rev-head tail
|
||||||
@deffnx {Scheme Procedure} append-reverse! rev-head tail
|
@deffnx {Scheme Procedure} append-reverse! rev-head tail
|
||||||
Reverse @var{rev-head}, append @var{tail} and return the result. This
|
Reverse @var{rev-head}, append @var{tail} to it, and return the
|
||||||
is equivalent to @code{(append (reverse @var{rev-head}) @var{tail})},
|
result. This is equivalent to @code{(append (reverse @var{rev-head})
|
||||||
but more efficient.
|
@var{tail})}, but its implementation is more efficient.
|
||||||
|
|
||||||
|
@example
|
||||||
|
(append-reverse '(1 2 3) '(4 5 6)) @result{} (3 2 1 4 5 6)
|
||||||
|
@end example
|
||||||
|
|
||||||
@code{append-reverse!} may modify @var{rev-head} in order to produce
|
@code{append-reverse!} may modify @var{rev-head} in order to produce
|
||||||
the result.
|
the result.
|
||||||
|
|
@ -937,12 +941,21 @@ Lists}. The present section only documents the additional procedures
|
||||||
for dealing with association lists defined by SRFI-1.
|
for dealing with association lists defined by SRFI-1.
|
||||||
|
|
||||||
@deffn {Scheme Procedure} assoc key alist [=]
|
@deffn {Scheme Procedure} assoc key alist [=]
|
||||||
Return the pair from @var{alist} which matches @var{key}. Equality is
|
Return the pair from @var{alist} which matches @var{key}. This
|
||||||
determined by @var{=}, which defaults to @code{equal?} if not given.
|
extends the core @code{assoc} (@pxref{Retrieving Alist Entries}) by
|
||||||
@var{alist} must be an association lists---a list of pairs.
|
taking an optional @var{=} comparison procedure.
|
||||||
|
|
||||||
This function extends the core @code{assoc} by accepting an equality
|
The default comparison is @code{equal?}. If an @var{=} parameter is
|
||||||
predicate. (@pxref{Association Lists})
|
given it's called @code{(@var{=} @var{key} @var{alistcar})}, ie. the
|
||||||
|
given target @var{key} is the first argument, and a @code{car} from
|
||||||
|
@var{alist} is second.
|
||||||
|
|
||||||
|
For example a case-insensitive string lookup,
|
||||||
|
|
||||||
|
@example
|
||||||
|
(assoc "yy" '(("XX" . 1) ("YY" . 2)) string-ci=?)
|
||||||
|
@result{} ("YY" . 2)
|
||||||
|
@end example
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
@deffn {Scheme Procedure} alist-cons key datum alist
|
@deffn {Scheme Procedure} alist-cons key datum alist
|
||||||
|
|
|
||||||
|
|
@ -147,7 +147,7 @@ EXTRA_DOT_DOC_FILES = @EXTRA_DOT_DOC_FILES@
|
||||||
|
|
||||||
BUILT_SOURCES = cpp_err_symbols.c cpp_sig_symbols.c libpath.h \
|
BUILT_SOURCES = cpp_err_symbols.c cpp_sig_symbols.c libpath.h \
|
||||||
version.h scmconfig.h \
|
version.h scmconfig.h \
|
||||||
$(DOT_X_FILES) $(EXTRA_DOT_X_FILES) guile.texi
|
$(DOT_X_FILES) $(EXTRA_DOT_X_FILES)
|
||||||
|
|
||||||
EXTRA_libguile_la_SOURCES = _scm.h \
|
EXTRA_libguile_la_SOURCES = _scm.h \
|
||||||
inet_aton.c memmove.c putenv.c strerror.c \
|
inet_aton.c memmove.c putenv.c strerror.c \
|
||||||
|
|
@ -274,9 +274,9 @@ SUFFIXES = .x .doc
|
||||||
(./guile-snarf-docs $(snarfcppopts) $< | \
|
(./guile-snarf-docs $(snarfcppopts) $< | \
|
||||||
./guile_filter_doc_snarfage$(EXEEXT) --filter-snarfage) > $@ || { rm $@; false; }
|
./guile_filter_doc_snarfage$(EXEEXT) --filter-snarfage) > $@ || { rm $@; false; }
|
||||||
|
|
||||||
$(DOT_X_FILES) $(EXTRA_DOT_DOC_FILES): snarf.h guile-snarf.in
|
$(DOT_X_FILES) $(EXTRA_DOT_X_FILES): scmconfig.h snarf.h guile-snarf.in
|
||||||
|
|
||||||
$(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES): snarf.h guile-snarf-docs.in guile_filter_doc_snarfage$(EXEEXT)
|
$(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES): scmconfig.h snarf.h guile-snarf-docs.in guile_filter_doc_snarfage$(EXEEXT)
|
||||||
|
|
||||||
error.x: cpp_err_symbols.c
|
error.x: cpp_err_symbols.c
|
||||||
posix.x: cpp_sig_symbols.c
|
posix.x: cpp_sig_symbols.c
|
||||||
|
|
|
||||||
|
|
@ -53,6 +53,9 @@ char *alloca ();
|
||||||
# endif
|
# endif
|
||||||
# endif
|
# endif
|
||||||
#endif
|
#endif
|
||||||
|
#if HAVE_MALLOC_H
|
||||||
|
#include <malloc.h> /* alloca on mingw */
|
||||||
|
#endif
|
||||||
|
|
||||||
#include <assert.h>
|
#include <assert.h>
|
||||||
#include "libguile/_scm.h"
|
#include "libguile/_scm.h"
|
||||||
|
|
|
||||||
|
|
@ -45,6 +45,9 @@ char *alloca ();
|
||||||
# endif
|
# endif
|
||||||
# endif
|
# endif
|
||||||
#endif
|
#endif
|
||||||
|
#if HAVE_MALLOC_H
|
||||||
|
#include <malloc.h> /* alloca on mingw, though its not used on that system */
|
||||||
|
#endif
|
||||||
|
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
#include <errno.h>
|
#include <errno.h>
|
||||||
|
|
@ -349,7 +352,7 @@ SCM_DEFINE (scm_open_fdes, "open-fdes", 2, 1, 0,
|
||||||
|
|
||||||
iflags = SCM_NUM2INT (2, flags);
|
iflags = SCM_NUM2INT (2, flags);
|
||||||
imode = SCM_NUM2INT_DEF (3, mode, 0666);
|
imode = SCM_NUM2INT_DEF (3, mode, 0666);
|
||||||
STRING_SYSCALL (path, c_path, fd = open (c_path, iflags, imode));
|
STRING_SYSCALL (path, c_path, fd = open_or_open64 (c_path, iflags, imode));
|
||||||
if (fd == -1)
|
if (fd == -1)
|
||||||
SCM_SYSERROR;
|
SCM_SYSERROR;
|
||||||
return scm_from_int (fd);
|
return scm_from_int (fd);
|
||||||
|
|
@ -466,7 +469,7 @@ SCM_DEFINE (scm_close_fdes, "close-fdes", 1, 0, 0,
|
||||||
|
|
||||||
SCM_SYMBOL (scm_sym_regular, "regular");
|
SCM_SYMBOL (scm_sym_regular, "regular");
|
||||||
SCM_SYMBOL (scm_sym_directory, "directory");
|
SCM_SYMBOL (scm_sym_directory, "directory");
|
||||||
#ifdef HAVE_S_ISLNK
|
#ifdef S_ISLNK
|
||||||
SCM_SYMBOL (scm_sym_symlink, "symlink");
|
SCM_SYMBOL (scm_sym_symlink, "symlink");
|
||||||
#endif
|
#endif
|
||||||
SCM_SYMBOL (scm_sym_block_special, "block-special");
|
SCM_SYMBOL (scm_sym_block_special, "block-special");
|
||||||
|
|
@ -512,7 +515,8 @@ scm_stat2scm (struct stat_or_stat64 *stat_temp)
|
||||||
SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_regular);
|
SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_regular);
|
||||||
else if (S_ISDIR (mode))
|
else if (S_ISDIR (mode))
|
||||||
SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_directory);
|
SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_directory);
|
||||||
#ifdef HAVE_S_ISLNK
|
#ifdef S_ISLNK
|
||||||
|
/* systems without symlinks probably don't have S_ISLNK */
|
||||||
else if (S_ISLNK (mode))
|
else if (S_ISLNK (mode))
|
||||||
SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_symlink);
|
SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_symlink);
|
||||||
#endif
|
#endif
|
||||||
|
|
@ -1707,6 +1711,9 @@ scm_init_filesys ()
|
||||||
#ifdef O_SYNC
|
#ifdef O_SYNC
|
||||||
scm_c_define ("O_SYNC", scm_from_long (O_SYNC));
|
scm_c_define ("O_SYNC", scm_from_long (O_SYNC));
|
||||||
#endif
|
#endif
|
||||||
|
#ifdef O_LARGEFILE
|
||||||
|
scm_c_define ("O_LARGEFILE", scm_from_long (O_LARGEFILE));
|
||||||
|
#endif
|
||||||
|
|
||||||
#ifdef F_DUPFD
|
#ifdef F_DUPFD
|
||||||
scm_c_define ("F_DUPFD", scm_from_long (F_DUPFD));
|
scm_c_define ("F_DUPFD", scm_from_long (F_DUPFD));
|
||||||
|
|
|
||||||
|
|
@ -37,8 +37,6 @@
|
||||||
#endif
|
#endif
|
||||||
#ifdef HAVE_UNISTD_H
|
#ifdef HAVE_UNISTD_H
|
||||||
#include <unistd.h>
|
#include <unistd.h>
|
||||||
#else
|
|
||||||
size_t fwrite ();
|
|
||||||
#endif
|
#endif
|
||||||
#ifdef HAVE_IO_H
|
#ifdef HAVE_IO_H
|
||||||
#include <io.h>
|
#include <io.h>
|
||||||
|
|
@ -460,9 +458,8 @@ scm_fdes_to_port (int fdes, char *mode, SCM name)
|
||||||
static int
|
static int
|
||||||
fport_input_waiting (SCM port)
|
fport_input_waiting (SCM port)
|
||||||
{
|
{
|
||||||
int fdes = SCM_FSTREAM (port)->fdes;
|
|
||||||
|
|
||||||
#ifdef HAVE_SELECT
|
#ifdef HAVE_SELECT
|
||||||
|
int fdes = SCM_FSTREAM (port)->fdes;
|
||||||
struct timeval timeout;
|
struct timeval timeout;
|
||||||
SELECT_TYPE read_set;
|
SELECT_TYPE read_set;
|
||||||
SELECT_TYPE write_set;
|
SELECT_TYPE write_set;
|
||||||
|
|
@ -482,10 +479,15 @@ fport_input_waiting (SCM port)
|
||||||
< 0)
|
< 0)
|
||||||
scm_syserror ("fport_input_waiting");
|
scm_syserror ("fport_input_waiting");
|
||||||
return FD_ISSET (fdes, &read_set) ? 1 : 0;
|
return FD_ISSET (fdes, &read_set) ? 1 : 0;
|
||||||
#elif defined (FIONREAD)
|
|
||||||
|
#elif HAVE_IOCTL && defined (FIONREAD)
|
||||||
|
/* Note: cannot test just defined(FIONREAD) here, since mingw has FIONREAD
|
||||||
|
(for use with winsock ioctlsocket()) but not ioctl(). */
|
||||||
|
int fdes = SCM_FSTREAM (port)->fdes;
|
||||||
int remir;
|
int remir;
|
||||||
ioctl(fdes, FIONREAD, &remir);
|
ioctl(fdes, FIONREAD, &remir);
|
||||||
return remir;
|
return remir;
|
||||||
|
|
||||||
#else
|
#else
|
||||||
scm_misc_error ("fport_input_waiting",
|
scm_misc_error ("fport_input_waiting",
|
||||||
"Not fully implemented on this platform",
|
"Not fully implemented on this platform",
|
||||||
|
|
|
||||||
|
|
@ -248,6 +248,27 @@ SCM_C_INLINE
|
||||||
int
|
int
|
||||||
scm_is_pair (SCM x)
|
scm_is_pair (SCM x)
|
||||||
{
|
{
|
||||||
|
/* The following "workaround_for_gcc_295" avoids bad code generated by
|
||||||
|
i386 gcc 2.95.4 (the Debian packaged 2.95.4-24 at least).
|
||||||
|
|
||||||
|
Under the default -O2 the inlined SCM_I_CONSP test gets "optimized" so
|
||||||
|
the fetch of the tag word from x is done before confirming it's a
|
||||||
|
non-immediate (SCM_NIMP). Needless to say that bombs badly if x is a
|
||||||
|
immediate. This was seen to afflict scm_srfi1_split_at and something
|
||||||
|
deep in the bowels of ceval(). In both cases segvs resulted from
|
||||||
|
deferencing a random immediate value. srfi-1.test exposes the problem
|
||||||
|
through a short list, the immediate being SCM_EOL in that case.
|
||||||
|
Something in syntax.test exposed the ceval() problem.
|
||||||
|
|
||||||
|
Just "volatile SCM workaround_for_gcc_295 = lst" is enough to avoid the
|
||||||
|
problem, without even using that variable. The "w=w" is just to
|
||||||
|
prevent a warning about it being unused.
|
||||||
|
*/
|
||||||
|
#if defined (__GNUC__) && __GNUC__ == 2 && __GNUC_MINOR__ == 95
|
||||||
|
volatile SCM workaround_for_gcc_295 = x;
|
||||||
|
workaround_for_gcc_295 = workaround_for_gcc_295;
|
||||||
|
#endif
|
||||||
|
|
||||||
return SCM_I_CONSP (x);
|
return SCM_I_CONSP (x);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -4779,6 +4779,19 @@ scm_i_divide (SCM x, SCM y, int inexact)
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
/* big_x / big_y */
|
/* big_x / big_y */
|
||||||
|
if (inexact)
|
||||||
|
{
|
||||||
|
/* It's easily possible for the ratio x/y to fit a double
|
||||||
|
but one or both x and y be too big to fit a double,
|
||||||
|
hence the use of mpq_get_d rather than converting and
|
||||||
|
dividing. */
|
||||||
|
mpq_t q;
|
||||||
|
*mpq_numref(q) = *SCM_I_BIG_MPZ (x);
|
||||||
|
*mpq_denref(q) = *SCM_I_BIG_MPZ (y);
|
||||||
|
return scm_from_double (mpq_get_d (q));
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
int divisible_p = mpz_divisible_p (SCM_I_BIG_MPZ (x),
|
int divisible_p = mpz_divisible_p (SCM_I_BIG_MPZ (x),
|
||||||
SCM_I_BIG_MPZ (y));
|
SCM_I_BIG_MPZ (y));
|
||||||
if (divisible_p)
|
if (divisible_p)
|
||||||
|
|
@ -4791,15 +4804,7 @@ scm_i_divide (SCM x, SCM y, int inexact)
|
||||||
return scm_i_normbig (result);
|
return scm_i_normbig (result);
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
return scm_i_make_ratio (x, y);
|
||||||
if (inexact)
|
|
||||||
{
|
|
||||||
double dbx = mpz_get_d (SCM_I_BIG_MPZ (x));
|
|
||||||
double dby = mpz_get_d (SCM_I_BIG_MPZ (y));
|
|
||||||
scm_remember_upto_here_2 (x, y);
|
|
||||||
return scm_from_double (dbx / dby);
|
|
||||||
}
|
|
||||||
else return scm_i_make_ratio (x, y);
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -165,50 +165,50 @@ scm_make_port_type (char *name,
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
scm_set_port_mark (long tc, SCM (*mark) (SCM))
|
scm_set_port_mark (scm_t_bits tc, SCM (*mark) (SCM))
|
||||||
{
|
{
|
||||||
scm_ptobs[SCM_TC2PTOBNUM (tc)].mark = mark;
|
scm_ptobs[SCM_TC2PTOBNUM (tc)].mark = mark;
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
scm_set_port_free (long tc, size_t (*free) (SCM))
|
scm_set_port_free (scm_t_bits tc, size_t (*free) (SCM))
|
||||||
{
|
{
|
||||||
scm_ptobs[SCM_TC2PTOBNUM (tc)].free = free;
|
scm_ptobs[SCM_TC2PTOBNUM (tc)].free = free;
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
scm_set_port_print (long tc, int (*print) (SCM exp, SCM port,
|
scm_set_port_print (scm_t_bits tc, int (*print) (SCM exp, SCM port,
|
||||||
scm_print_state *pstate))
|
scm_print_state *pstate))
|
||||||
{
|
{
|
||||||
scm_ptobs[SCM_TC2PTOBNUM (tc)].print = print;
|
scm_ptobs[SCM_TC2PTOBNUM (tc)].print = print;
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
scm_set_port_equalp (long tc, SCM (*equalp) (SCM, SCM))
|
scm_set_port_equalp (scm_t_bits tc, SCM (*equalp) (SCM, SCM))
|
||||||
{
|
{
|
||||||
scm_ptobs[SCM_TC2PTOBNUM (tc)].equalp = equalp;
|
scm_ptobs[SCM_TC2PTOBNUM (tc)].equalp = equalp;
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
scm_set_port_flush (long tc, void (*flush) (SCM port))
|
scm_set_port_flush (scm_t_bits tc, void (*flush) (SCM port))
|
||||||
{
|
{
|
||||||
scm_ptobs[SCM_TC2PTOBNUM (tc)].flush = flush;
|
scm_ptobs[SCM_TC2PTOBNUM (tc)].flush = flush;
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
scm_set_port_end_input (long tc, void (*end_input) (SCM port, int offset))
|
scm_set_port_end_input (scm_t_bits tc, void (*end_input) (SCM port, int offset))
|
||||||
{
|
{
|
||||||
scm_ptobs[SCM_TC2PTOBNUM (tc)].end_input = end_input;
|
scm_ptobs[SCM_TC2PTOBNUM (tc)].end_input = end_input;
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
scm_set_port_close (long tc, int (*close) (SCM))
|
scm_set_port_close (scm_t_bits tc, int (*close) (SCM))
|
||||||
{
|
{
|
||||||
scm_ptobs[SCM_TC2PTOBNUM (tc)].close = close;
|
scm_ptobs[SCM_TC2PTOBNUM (tc)].close = close;
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
scm_set_port_seek (long tc, off_t (*seek) (SCM port,
|
scm_set_port_seek (scm_t_bits tc, off_t (*seek) (SCM port,
|
||||||
off_t OFFSET,
|
off_t OFFSET,
|
||||||
int WHENCE))
|
int WHENCE))
|
||||||
{
|
{
|
||||||
|
|
@ -216,13 +216,13 @@ scm_set_port_seek (long tc, off_t (*seek) (SCM port,
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
scm_set_port_truncate (long tc, void (*truncate) (SCM port, off_t length))
|
scm_set_port_truncate (scm_t_bits tc, void (*truncate) (SCM port, off_t length))
|
||||||
{
|
{
|
||||||
scm_ptobs[SCM_TC2PTOBNUM (tc)].truncate = truncate;
|
scm_ptobs[SCM_TC2PTOBNUM (tc)].truncate = truncate;
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
scm_set_port_input_waiting (long tc, int (*input_waiting) (SCM))
|
scm_set_port_input_waiting (scm_t_bits tc, int (*input_waiting) (SCM))
|
||||||
{
|
{
|
||||||
scm_ptobs[SCM_TC2PTOBNUM (tc)].input_waiting = input_waiting;
|
scm_ptobs[SCM_TC2PTOBNUM (tc)].input_waiting = input_waiting;
|
||||||
}
|
}
|
||||||
|
|
@ -1372,37 +1372,36 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
|
||||||
"@end lisp")
|
"@end lisp")
|
||||||
#define FUNC_NAME s_scm_seek
|
#define FUNC_NAME s_scm_seek
|
||||||
{
|
{
|
||||||
off_t off;
|
|
||||||
off_t rv;
|
|
||||||
int how;
|
int how;
|
||||||
|
|
||||||
fd_port = SCM_COERCE_OUTPORT (fd_port);
|
fd_port = SCM_COERCE_OUTPORT (fd_port);
|
||||||
|
|
||||||
if (sizeof (off_t) == sizeof (scm_t_intmax))
|
|
||||||
off = scm_to_intmax (offset);
|
|
||||||
else
|
|
||||||
off = scm_to_long (offset);
|
|
||||||
how = scm_to_int (whence);
|
how = scm_to_int (whence);
|
||||||
|
|
||||||
if (how != SEEK_SET && how != SEEK_CUR && how != SEEK_END)
|
if (how != SEEK_SET && how != SEEK_CUR && how != SEEK_END)
|
||||||
SCM_OUT_OF_RANGE (3, whence);
|
SCM_OUT_OF_RANGE (3, whence);
|
||||||
|
|
||||||
if (SCM_OPPORTP (fd_port))
|
if (SCM_OPPORTP (fd_port))
|
||||||
{
|
{
|
||||||
scm_t_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (fd_port);
|
scm_t_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (fd_port);
|
||||||
|
off_t off = scm_to_off_t (offset);
|
||||||
|
off_t rv;
|
||||||
|
|
||||||
if (!ptob->seek)
|
if (!ptob->seek)
|
||||||
SCM_MISC_ERROR ("port is not seekable",
|
SCM_MISC_ERROR ("port is not seekable",
|
||||||
scm_cons (fd_port, SCM_EOL));
|
scm_cons (fd_port, SCM_EOL));
|
||||||
else
|
else
|
||||||
rv = ptob->seek (fd_port, off, how);
|
rv = ptob->seek (fd_port, off, how);
|
||||||
|
return scm_from_off_t (rv);
|
||||||
}
|
}
|
||||||
else /* file descriptor?. */
|
else /* file descriptor?. */
|
||||||
{
|
{
|
||||||
rv = lseek (scm_to_int (fd_port), off, how);
|
off_t_or_off64_t off = scm_to_off_t_or_off64_t (offset);
|
||||||
|
off_t_or_off64_t rv;
|
||||||
|
rv = lseek_or_lseek64 (scm_to_int (fd_port), off, how);
|
||||||
if (rv == -1)
|
if (rv == -1)
|
||||||
SCM_SYSERROR;
|
SCM_SYSERROR;
|
||||||
|
return scm_from_off_t_or_off64_t (rv);
|
||||||
}
|
}
|
||||||
return scm_from_intmax (rv);
|
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
@ -1450,8 +1449,9 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0,
|
||||||
object = SCM_COERCE_OUTPORT (object);
|
object = SCM_COERCE_OUTPORT (object);
|
||||||
if (scm_is_integer (object))
|
if (scm_is_integer (object))
|
||||||
{
|
{
|
||||||
off_t c_length = scm_to_off_t (length);
|
off_t_or_off64_t c_length = scm_to_off_t_or_off64_t (length);
|
||||||
SCM_SYSCALL (rv = ftruncate (scm_to_int (object), c_length));
|
SCM_SYSCALL (rv = ftruncate_or_ftruncate64 (scm_to_int (object),
|
||||||
|
c_length));
|
||||||
}
|
}
|
||||||
else if (SCM_OPOUTPORTP (object))
|
else if (SCM_OPOUTPORTP (object))
|
||||||
{
|
{
|
||||||
|
|
|
||||||
|
|
@ -205,28 +205,28 @@ SCM_API scm_t_bits scm_make_port_type (char *name,
|
||||||
void (*write) (SCM port,
|
void (*write) (SCM port,
|
||||||
const void *data,
|
const void *data,
|
||||||
size_t size));
|
size_t size));
|
||||||
SCM_API void scm_set_port_mark (long tc, SCM (*mark) (SCM));
|
SCM_API void scm_set_port_mark (scm_t_bits tc, SCM (*mark) (SCM));
|
||||||
SCM_API void scm_set_port_free (long tc, size_t (*free) (SCM));
|
SCM_API void scm_set_port_free (scm_t_bits tc, size_t (*free) (SCM));
|
||||||
SCM_API void scm_set_port_print (long tc,
|
SCM_API void scm_set_port_print (scm_t_bits tc,
|
||||||
int (*print) (SCM exp,
|
int (*print) (SCM exp,
|
||||||
SCM port,
|
SCM port,
|
||||||
scm_print_state *pstate));
|
scm_print_state *pstate));
|
||||||
SCM_API void scm_set_port_equalp (long tc, SCM (*equalp) (SCM, SCM));
|
SCM_API void scm_set_port_equalp (scm_t_bits tc, SCM (*equalp) (SCM, SCM));
|
||||||
SCM_API void scm_set_port_close (long tc, int (*close) (SCM));
|
SCM_API void scm_set_port_close (scm_t_bits tc, int (*close) (SCM));
|
||||||
|
|
||||||
SCM_API void scm_set_port_flush (long tc,
|
SCM_API void scm_set_port_flush (scm_t_bits tc,
|
||||||
void (*flush) (SCM port));
|
void (*flush) (SCM port));
|
||||||
SCM_API void scm_set_port_end_input (long tc,
|
SCM_API void scm_set_port_end_input (scm_t_bits tc,
|
||||||
void (*end_input) (SCM port,
|
void (*end_input) (SCM port,
|
||||||
int offset));
|
int offset));
|
||||||
SCM_API void scm_set_port_seek (long tc,
|
SCM_API void scm_set_port_seek (scm_t_bits tc,
|
||||||
off_t (*seek) (SCM port,
|
off_t (*seek) (SCM port,
|
||||||
off_t OFFSET,
|
off_t OFFSET,
|
||||||
int WHENCE));
|
int WHENCE));
|
||||||
SCM_API void scm_set_port_truncate (long tc,
|
SCM_API void scm_set_port_truncate (scm_t_bits tc,
|
||||||
void (*truncate) (SCM port,
|
void (*truncate) (SCM port,
|
||||||
off_t length));
|
off_t length));
|
||||||
SCM_API void scm_set_port_input_waiting (long tc, int (*input_waiting) (SCM));
|
SCM_API void scm_set_port_input_waiting (scm_t_bits tc, int (*input_waiting) (SCM));
|
||||||
SCM_API SCM scm_char_ready_p (SCM port);
|
SCM_API SCM scm_char_ready_p (SCM port);
|
||||||
size_t scm_take_from_input_buffers (SCM port, char *dest, size_t read_len);
|
size_t scm_take_from_input_buffers (SCM port, char *dest, size_t read_len);
|
||||||
SCM_API SCM scm_drain_input (SCM port);
|
SCM_API SCM scm_drain_input (SCM port);
|
||||||
|
|
|
||||||
|
|
@ -1132,16 +1132,25 @@ extern int mkstemp (char *);
|
||||||
|
|
||||||
SCM_DEFINE (scm_mkstemp, "mkstemp!", 1, 0, 0,
|
SCM_DEFINE (scm_mkstemp, "mkstemp!", 1, 0, 0,
|
||||||
(SCM tmpl),
|
(SCM tmpl),
|
||||||
"Create a new unique file in the file system and returns a new\n"
|
"Create a new unique file in the file system and return a new\n"
|
||||||
"buffered port open for reading and writing to the file.\n"
|
"buffered port open for reading and writing to the file.\n"
|
||||||
"\n"
|
"\n"
|
||||||
"@var{tmpl} is a string specifying where the file should be\n"
|
"@var{tmpl} is a string specifying where the file should be\n"
|
||||||
"created: it must end with @samp{XXXXXX} and will be changed in\n"
|
"created: it must end with @samp{XXXXXX} and those @samp{X}s\n"
|
||||||
"place to return the name of the temporary file.\n"
|
"will be changed in the string to return the name of the file.\n"
|
||||||
|
"(@code{port-filename} on the port also gives the name.)\n"
|
||||||
"\n"
|
"\n"
|
||||||
"The file is created with mode @code{0600}, which means read and\n"
|
"POSIX doesn't specify the permissions mode of the file, on GNU\n"
|
||||||
"write for the owner only. @code{chmod} can be used to change\n"
|
"and most systems it's @code{#o600}. An application can use\n"
|
||||||
"this.")
|
"@code{chmod} to relax that if desired. For example\n"
|
||||||
|
"@code{#o666} less @code{umask}, which is usual for ordinary\n"
|
||||||
|
"file creation,\n"
|
||||||
|
"\n"
|
||||||
|
"@example\n"
|
||||||
|
"(let ((port (mkstemp! (string-copy \"/tmp/myfile-XXXXXX\"))))\n"
|
||||||
|
" (chmod port (logand #o666 (lognot (umask))))\n"
|
||||||
|
" ...)\n"
|
||||||
|
"@end example")
|
||||||
#define FUNC_NAME s_scm_mkstemp
|
#define FUNC_NAME s_scm_mkstemp
|
||||||
{
|
{
|
||||||
char *c_tmpl;
|
char *c_tmpl;
|
||||||
|
|
@ -1419,8 +1428,11 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0,
|
||||||
ctype = S_IFREG;
|
ctype = S_IFREG;
|
||||||
else if (strcmp (p, "directory") == 0)
|
else if (strcmp (p, "directory") == 0)
|
||||||
ctype = S_IFDIR;
|
ctype = S_IFDIR;
|
||||||
|
#ifdef S_IFLNK
|
||||||
|
/* systems without symlinks probably don't have S_IFLNK defined */
|
||||||
else if (strcmp (p, "symlink") == 0)
|
else if (strcmp (p, "symlink") == 0)
|
||||||
ctype = S_IFLNK;
|
ctype = S_IFLNK;
|
||||||
|
#endif
|
||||||
else if (strcmp (p, "block-special") == 0)
|
else if (strcmp (p, "block-special") == 0)
|
||||||
ctype = S_IFBLK;
|
ctype = S_IFBLK;
|
||||||
else if (strcmp (p, "char-special") == 0)
|
else if (strcmp (p, "char-special") == 0)
|
||||||
|
|
|
||||||
|
|
@ -329,7 +329,9 @@ static SCM scm_get_hash_procedure(int c);
|
||||||
static SCM scm_i_lreadparen (SCM *, SCM, char *, SCM *, char);
|
static SCM scm_i_lreadparen (SCM *, SCM, char *, SCM *, char);
|
||||||
|
|
||||||
static char s_list[]="list";
|
static char s_list[]="list";
|
||||||
|
#if SCM_ENABLE_ELISP
|
||||||
static char s_vector[]="vector";
|
static char s_vector[]="vector";
|
||||||
|
#endif
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
|
scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
|
||||||
|
|
|
||||||
|
|
@ -195,9 +195,9 @@ SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0,
|
||||||
/* simple exit, without unwinding the scheme stack or flushing ports. */
|
/* simple exit, without unwinding the scheme stack or flushing ports. */
|
||||||
SCM_DEFINE (scm_primitive_exit, "primitive-exit", 0, 1, 0,
|
SCM_DEFINE (scm_primitive_exit, "primitive-exit", 0, 1, 0,
|
||||||
(SCM status),
|
(SCM status),
|
||||||
"Terminate the current process without unwinding the Scheme stack.\n"
|
"Terminate the current process without unwinding the Scheme\n"
|
||||||
"This is would typically be useful after a fork. The exit status\n"
|
"stack. The exit status is @var{status} if supplied, otherwise\n"
|
||||||
"is @var{status} if supplied, otherwise zero.")
|
"zero.")
|
||||||
#define FUNC_NAME s_scm_primitive_exit
|
#define FUNC_NAME s_scm_primitive_exit
|
||||||
{
|
{
|
||||||
int cstatus = 0;
|
int cstatus = 0;
|
||||||
|
|
@ -207,6 +207,25 @@ SCM_DEFINE (scm_primitive_exit, "primitive-exit", 0, 1, 0,
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
SCM_DEFINE (scm_primitive__exit, "primitive-_exit", 0, 1, 0,
|
||||||
|
(SCM status),
|
||||||
|
"Terminate the current process using the _exit() system call and\n"
|
||||||
|
"without unwinding the Scheme stack. The exit status is\n"
|
||||||
|
"@var{status} if supplied, otherwise zero.\n"
|
||||||
|
"\n"
|
||||||
|
"This function is typically useful after a fork, to ensure no\n"
|
||||||
|
"Scheme cleanups or @code{atexit} handlers are run (those\n"
|
||||||
|
"usually belonging in the parent rather than the child).")
|
||||||
|
#define FUNC_NAME s_scm_primitive__exit
|
||||||
|
{
|
||||||
|
int cstatus = 0;
|
||||||
|
if (!SCM_UNBNDP (status))
|
||||||
|
cstatus = scm_to_int (status);
|
||||||
|
_exit (cstatus);
|
||||||
|
}
|
||||||
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
void
|
void
|
||||||
scm_init_simpos ()
|
scm_init_simpos ()
|
||||||
|
|
|
||||||
|
|
@ -30,6 +30,7 @@ SCM_API SCM scm_system (SCM cmd);
|
||||||
SCM_API SCM scm_system_star (SCM cmds);
|
SCM_API SCM scm_system_star (SCM cmds);
|
||||||
SCM_API SCM scm_getenv (SCM nam);
|
SCM_API SCM scm_getenv (SCM nam);
|
||||||
SCM_API SCM scm_primitive_exit (SCM status);
|
SCM_API SCM scm_primitive_exit (SCM status);
|
||||||
|
SCM_API SCM scm_primitive__exit (SCM status);
|
||||||
SCM_API void scm_init_simpos (void);
|
SCM_API void scm_init_simpos (void);
|
||||||
|
|
||||||
#endif /* SCM_SIMPOS_H */
|
#endif /* SCM_SIMPOS_H */
|
||||||
|
|
|
||||||
|
|
@ -499,6 +499,11 @@ scm_handle_by_message (void *handler_data, SCM tag, SCM args)
|
||||||
|
|
||||||
handler_message (handler_data, tag, args);
|
handler_message (handler_data, tag, args);
|
||||||
scm_i_pthread_exit (NULL);
|
scm_i_pthread_exit (NULL);
|
||||||
|
|
||||||
|
/* this point not reached, but suppress gcc warning about no return value
|
||||||
|
in case scm_i_pthread_exit isn't marked as "noreturn" (which seemed not
|
||||||
|
to be the case on cygwin for instance) */
|
||||||
|
return SCM_BOOL_F;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -9,11 +9,34 @@
|
||||||
|
|
||||||
* tests/unif.test ("vector equal? one-dimensional array"): New.
|
* tests/unif.test ("vector equal? one-dimensional array"): New.
|
||||||
|
|
||||||
|
2006-05-28 Kevin Ryde <user42@zip.com.au>
|
||||||
|
|
||||||
|
* tests/numbers.test (number->string): Disable 11.333 and 1.324e44
|
||||||
|
tests, as these can't be expected to come out precisely in the current
|
||||||
|
implementation, and in fact don't under gcc 4. Reported by Hector
|
||||||
|
Herrera.
|
||||||
|
|
||||||
|
* tests/srfi-1.test (append-reverse, append-reverse!): New tests.
|
||||||
|
|
||||||
2006-05-28 Marius Vollmer <mvo@zagadka.de>
|
2006-05-28 Marius Vollmer <mvo@zagadka.de>
|
||||||
|
|
||||||
* tests/ports.test, tests/filesys.test: Delete test file after all
|
* tests/ports.test, tests/filesys.test: Delete test file after all
|
||||||
tests have run in order to make "make distcheck" work.
|
tests have run in order to make "make distcheck" work.
|
||||||
|
|
||||||
|
2006-05-20 Kevin Ryde <user42@zip.com.au>
|
||||||
|
|
||||||
|
* tests/srfi-1.test (assoc): A few tests, in particular "=" argument
|
||||||
|
order which had been wrong.
|
||||||
|
|
||||||
|
* tests/srfi-60.test (test-srfi-60): Use #:duplicates (last) to
|
||||||
|
suppress warning about replacing bit-count.
|
||||||
|
|
||||||
|
2006-05-09 Kevin Ryde <user42@zip.com.au>
|
||||||
|
|
||||||
|
* tests/numbers.test (exact->inexact): Test fractions big/big.
|
||||||
|
|
||||||
|
* tests/threads.test (n-par-for-each, n-for-each-par-map): New tests.
|
||||||
|
|
||||||
2006-04-17 Kevin Ryde <user42@zip.com.au>
|
2006-04-17 Kevin Ryde <user42@zip.com.au>
|
||||||
|
|
||||||
* tests/filesys.test (lstat): Allow for test-symlink not existing yet.
|
* tests/filesys.test (lstat): Allow for test-symlink not existing yet.
|
||||||
|
|
|
||||||
|
|
@ -1214,14 +1214,22 @@
|
||||||
(string=? (number->string 0.25 2) "0.010")))
|
(string=? (number->string 0.25 2) "0.010")))
|
||||||
(pass-if (string=? (number->string 255.0625 16) "FF.1"))
|
(pass-if (string=? (number->string 255.0625 16) "FF.1"))
|
||||||
(pass-if (string=? (number->string (/ 1 3) 3) "1/10"))
|
(pass-if (string=? (number->string (/ 1 3) 3) "1/10"))
|
||||||
(pass-if (or (string=? (number->string 11.33333333333333333 12)
|
|
||||||
"B.4")
|
;; Numeric conversion from decimal is not precise, in its current
|
||||||
(string=? (number->string 11.33333333333333333 12)
|
;; implementation, so 11.333... and 1.324... can't be expected to
|
||||||
"B.400000000000009")))
|
;; reliably come out to precise values. These tests did actually work
|
||||||
(pass-if (or (string=? (number->string 1.324e44 16)
|
;; for a while, but something in gcc changed, affecting the conversion
|
||||||
"5.EFE0A14FAFEe24")
|
;; code.
|
||||||
(string=? (number->string 1.324e44 16)
|
;;
|
||||||
"5.EFE0A14FAFDF8e24")))))
|
;; (pass-if (or (string=? (number->string 11.33333333333333333 12)
|
||||||
|
;; "B.4")
|
||||||
|
;; (string=? (number->string 11.33333333333333333 12)
|
||||||
|
;; "B.400000000000009")))
|
||||||
|
;; (pass-if (or (string=? (number->string 1.324e44 16)
|
||||||
|
;; "5.EFE0A14FAFEe24")
|
||||||
|
;; (string=? (number->string 1.324e44 16)
|
||||||
|
;; "5.EFE0A14FAFDF8e24")))
|
||||||
|
))
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; string->number
|
;;; string->number
|
||||||
|
|
@ -2745,7 +2753,17 @@
|
||||||
(n (- (ash 1 (+ 2 dbl-mant-dig)) 1) (1- (* 2 n)))
|
(n (- (ash 1 (+ 2 dbl-mant-dig)) 1) (1- (* 2 n)))
|
||||||
(want (+ (ash-flo 1.0 (+ 2 dbl-mant-dig)) 4.0) (* 2.0 want)))
|
(want (+ (ash-flo 1.0 (+ 2 dbl-mant-dig)) 4.0) (* 2.0 want)))
|
||||||
((> i 100))
|
((> i 100))
|
||||||
(try-i i n want))))
|
(try-i i n want)))
|
||||||
|
|
||||||
|
(pass-if "frac big/big"
|
||||||
|
(let ((big (ash 1 256)))
|
||||||
|
(= 1.0 (exact->inexact (/ (1+ big) big)))))
|
||||||
|
|
||||||
|
;; In guile 1.8.0 this failed, giving back "nan" because it tried to
|
||||||
|
;; convert the num and den to doubles, resulting in infs.
|
||||||
|
(pass-if "frac big/big, exceeding double"
|
||||||
|
(let ((big (ash 1 4096)))
|
||||||
|
(= 1.0 (exact->inexact (/ (1+ big) big))))))
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; floor
|
;;; floor
|
||||||
|
|
|
||||||
|
|
@ -201,6 +201,114 @@
|
||||||
(pass-if "(1) (2) / 9 9"
|
(pass-if "(1) (2) / 9 9"
|
||||||
(equal? '(1 2) (append-map noop '((1) (2)) '(9 9))))))
|
(equal? '(1 2) (append-map noop '((1) (2)) '(9 9))))))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; append-reverse
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "append-reverse"
|
||||||
|
|
||||||
|
;; return a list which is the cars and cdrs of LST
|
||||||
|
(define (list-contents lst)
|
||||||
|
(if (null? lst)
|
||||||
|
'()
|
||||||
|
(cons* (car lst) (cdr lst) (list-contents (cdr lst)))))
|
||||||
|
|
||||||
|
(define (valid-append-reverse revhead tail want)
|
||||||
|
(let ((revhead-contents (list-contents revhead))
|
||||||
|
(got (append-reverse revhead tail)))
|
||||||
|
(and (equal? got want)
|
||||||
|
;; revhead unchanged
|
||||||
|
(equal? revhead-contents (list-contents revhead)))))
|
||||||
|
|
||||||
|
(pass-if-exception "too few args (0)" exception:wrong-num-args
|
||||||
|
(append-reverse))
|
||||||
|
|
||||||
|
(pass-if-exception "too few args (1)" exception:wrong-num-args
|
||||||
|
(append-reverse '(x)))
|
||||||
|
|
||||||
|
(pass-if-exception "too many args (3)" exception:wrong-num-args
|
||||||
|
(append-reverse '() '() #f))
|
||||||
|
|
||||||
|
(pass-if (valid-append-reverse '() '() '()))
|
||||||
|
(pass-if (valid-append-reverse '() '(1 2 3) '(1 2 3)))
|
||||||
|
|
||||||
|
(pass-if (valid-append-reverse '(1) '() '(1)))
|
||||||
|
(pass-if (valid-append-reverse '(1) '(2) '(1 2)))
|
||||||
|
(pass-if (valid-append-reverse '(1) '(2 3) '(1 2 3)))
|
||||||
|
|
||||||
|
(pass-if (valid-append-reverse '(1 2) '() '(2 1)))
|
||||||
|
(pass-if (valid-append-reverse '(1 2) '(3) '(2 1 3)))
|
||||||
|
(pass-if (valid-append-reverse '(1 2) '(3 4) '(2 1 3 4)))
|
||||||
|
|
||||||
|
(pass-if (valid-append-reverse '(1 2 3) '() '(3 2 1)))
|
||||||
|
(pass-if (valid-append-reverse '(1 2 3) '(4) '(3 2 1 4)))
|
||||||
|
(pass-if (valid-append-reverse '(1 2 3) '(4 5) '(3 2 1 4 5))))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; append-reverse!
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "append-reverse!"
|
||||||
|
|
||||||
|
(pass-if-exception "too few args (0)" exception:wrong-num-args
|
||||||
|
(append-reverse!))
|
||||||
|
|
||||||
|
(pass-if-exception "too few args (1)" exception:wrong-num-args
|
||||||
|
(append-reverse! '(x)))
|
||||||
|
|
||||||
|
(pass-if-exception "too many args (3)" exception:wrong-num-args
|
||||||
|
(append-reverse! '() '() #f))
|
||||||
|
|
||||||
|
(pass-if (equal? '() (append-reverse! '() '())))
|
||||||
|
(pass-if (equal? '(1 2 3) (append-reverse! '() '(1 2 3))))
|
||||||
|
|
||||||
|
(pass-if (equal? '(1) (append-reverse! '(1) '())))
|
||||||
|
(pass-if (equal? '(1 2) (append-reverse! '(1) '(2))))
|
||||||
|
(pass-if (equal? '(1 2 3) (append-reverse! '(1) '(2 3))))
|
||||||
|
|
||||||
|
(pass-if (equal? '(2 1) (append-reverse! '(1 2) '())))
|
||||||
|
(pass-if (equal? '(2 1 3) (append-reverse! '(1 2) '(3))))
|
||||||
|
(pass-if (equal? '(2 1 3 4) (append-reverse! '(1 2) '(3 4))))
|
||||||
|
|
||||||
|
(pass-if (equal? '(3 2 1) (append-reverse! '(1 2 3) '())))
|
||||||
|
(pass-if (equal? '(3 2 1 4) (append-reverse! '(1 2 3) '(4))))
|
||||||
|
(pass-if (equal? '(3 2 1 4 5) (append-reverse! '(1 2 3) '(4 5)))))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; assoc
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "assoc"
|
||||||
|
|
||||||
|
(pass-if "not found"
|
||||||
|
(let ((alist '((a . 1)
|
||||||
|
(b . 2)
|
||||||
|
(c . 3))))
|
||||||
|
(eqv? #f (assoc 'z alist))))
|
||||||
|
|
||||||
|
(pass-if "found"
|
||||||
|
(let ((alist '((a . 1)
|
||||||
|
(b . 2)
|
||||||
|
(c . 3))))
|
||||||
|
(eqv? (second alist) (assoc 'b alist))))
|
||||||
|
|
||||||
|
;; this was wrong in guile 1.8.0 (a gremlin newly introduced in the 1.8
|
||||||
|
;; series, 1.6.x and earlier was ok)
|
||||||
|
(pass-if "= arg order"
|
||||||
|
(let ((alist '((b . 1)))
|
||||||
|
(good #f))
|
||||||
|
(assoc 'a alist (lambda (x y)
|
||||||
|
(set! good (and (eq? x 'a)
|
||||||
|
(eq? y 'b)))))
|
||||||
|
good))
|
||||||
|
|
||||||
|
;; likewise this one bad in guile 1.8.0
|
||||||
|
(pass-if "srfi-1 example <"
|
||||||
|
(let ((alist '((1 . a)
|
||||||
|
(5 . b)
|
||||||
|
(6 . c))))
|
||||||
|
(eq? (third alist) (assoc 5 alist <)))))
|
||||||
|
|
||||||
;;
|
;;
|
||||||
;; break
|
;; break
|
||||||
;;
|
;;
|
||||||
|
|
|
||||||
|
|
@ -18,6 +18,7 @@
|
||||||
;;;; Boston, MA 02110-1301 USA
|
;;;; Boston, MA 02110-1301 USA
|
||||||
|
|
||||||
(define-module (test-srfi-60)
|
(define-module (test-srfi-60)
|
||||||
|
#:duplicates (last) ;; avoid warning about srfi-60 replacing `bit-count'
|
||||||
#:use-module (test-suite lib)
|
#:use-module (test-suite lib)
|
||||||
#:use-module (srfi srfi-60))
|
#:use-module (srfi srfi-60))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -21,6 +21,8 @@
|
||||||
(test-suite lib))
|
(test-suite lib))
|
||||||
|
|
||||||
(if (provided? 'threads)
|
(if (provided? 'threads)
|
||||||
|
(begin
|
||||||
|
|
||||||
(with-test-prefix "parallel"
|
(with-test-prefix "parallel"
|
||||||
(pass-if "no forms"
|
(pass-if "no forms"
|
||||||
(call-with-values
|
(call-with-values
|
||||||
|
|
@ -51,4 +53,84 @@
|
||||||
(lambda (x y z)
|
(lambda (x y z)
|
||||||
(and (equal? x 1)
|
(and (equal? x 1)
|
||||||
(equal? y 2)
|
(equal? y 2)
|
||||||
(equal? z 3)))))))
|
(equal? z 3))))))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; n-par-for-each
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "n-par-for-each"
|
||||||
|
|
||||||
|
(pass-if "0 in limit 10"
|
||||||
|
(n-par-for-each 10 noop '())
|
||||||
|
#t)
|
||||||
|
|
||||||
|
(pass-if "6 in limit 10"
|
||||||
|
(let ((v (make-vector 6 #f)))
|
||||||
|
(n-par-for-each 10 (lambda (n)
|
||||||
|
(vector-set! v n #t))
|
||||||
|
'(0 1 2 3 4 5))
|
||||||
|
(equal? v '#(#t #t #t #t #t #t))))
|
||||||
|
|
||||||
|
(pass-if "6 in limit 1"
|
||||||
|
(let ((v (make-vector 6 #f)))
|
||||||
|
(n-par-for-each 1 (lambda (n)
|
||||||
|
(vector-set! v n #t))
|
||||||
|
'(0 1 2 3 4 5))
|
||||||
|
(equal? v '#(#t #t #t #t #t #t))))
|
||||||
|
|
||||||
|
(pass-if "6 in limit 2"
|
||||||
|
(let ((v (make-vector 6 #f)))
|
||||||
|
(n-par-for-each 2 (lambda (n)
|
||||||
|
(vector-set! v n #t))
|
||||||
|
'(0 1 2 3 4 5))
|
||||||
|
(equal? v '#(#t #t #t #t #t #t))))
|
||||||
|
|
||||||
|
(pass-if "6 in limit 3"
|
||||||
|
(let ((v (make-vector 6 #f)))
|
||||||
|
(n-par-for-each 3 (lambda (n)
|
||||||
|
(vector-set! v n #t))
|
||||||
|
'(0 1 2 3 4 5))
|
||||||
|
(equal? v '#(#t #t #t #t #t #t)))))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; n-for-each-par-map
|
||||||
|
;;
|
||||||
|
|
||||||
|
(with-test-prefix "n-for-each-par-map"
|
||||||
|
|
||||||
|
(pass-if "0 in limit 10"
|
||||||
|
(n-for-each-par-map 10 noop noop '())
|
||||||
|
#t)
|
||||||
|
|
||||||
|
(pass-if "6 in limit 10"
|
||||||
|
(let ((result '()))
|
||||||
|
(n-for-each-par-map 10
|
||||||
|
(lambda (n) (set! result (cons n result)))
|
||||||
|
(lambda (n) (* 2 n))
|
||||||
|
'(0 1 2 3 4 5))
|
||||||
|
(equal? result '(10 8 6 4 2 0))))
|
||||||
|
|
||||||
|
(pass-if "6 in limit 1"
|
||||||
|
(let ((result '()))
|
||||||
|
(n-for-each-par-map 1
|
||||||
|
(lambda (n) (set! result (cons n result)))
|
||||||
|
(lambda (n) (* 2 n))
|
||||||
|
'(0 1 2 3 4 5))
|
||||||
|
(equal? result '(10 8 6 4 2 0))))
|
||||||
|
|
||||||
|
(pass-if "6 in limit 2"
|
||||||
|
(let ((result '()))
|
||||||
|
(n-for-each-par-map 2
|
||||||
|
(lambda (n) (set! result (cons n result)))
|
||||||
|
(lambda (n) (* 2 n))
|
||||||
|
'(0 1 2 3 4 5))
|
||||||
|
(equal? result '(10 8 6 4 2 0))))
|
||||||
|
|
||||||
|
(pass-if "6 in limit 3"
|
||||||
|
(let ((result '()))
|
||||||
|
(n-for-each-par-map 3
|
||||||
|
(lambda (n) (set! result (cons n result)))
|
||||||
|
(lambda (n) (* 2 n))
|
||||||
|
'(0 1 2 3 4 5))
|
||||||
|
(equal? result '(10 8 6 4 2 0)))))))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue