diff options
author | Gary Houston <ghouston@arglist.com> | 1997-01-18 17:51:33 +0000 |
---|---|---|
committer | Gary Houston <ghouston@arglist.com> | 1997-01-18 17:51:33 +0000 |
commit | 3d8d56dfacd9a9072903e4b9c09ab1a81cd873cb (patch) | |
tree | 9436d8f9ad3a89adc4e37f051efb46e21c8a54f6 /libguile/unif.c | |
parent | 3f81f8f238fc2c467a867d5e72f83baa22ac7914 (diff) | |
download | guile-3d8d56dfacd9a9072903e4b9c09ab1a81cd873cb.tar.gz |
* init.scm (index, rindex): replace versions in utilities.scm with
primitives.
load errno.scm.
* netconst.scm: undefine maybe-define and maybe-define-so after use.
* errno.scm: new file.
* fports.c (scm_open_file): pass errno to scm_syserror_msg.
* filesys.h: update prototypes. Remove macros: SCM_FD_P, SCM_FD_FLAGS,
SCM_FD.
* filesys.c (scm_sys_stat, scm_sys_lstat): pass errno to
scm_syserror_msg.
* (scm_sys_read_fd, scm_sys_write_fd, scm_sys_close, scm_sys_lseek,
scm_sys_dup): deleted: FD capability will be added to other
procedures.
* Remove support for the FD object type: scm_tc16_fd, scm_fd_print,
scm_fd_free, fd_smob, scm_intern_fd.
* (scm_open): renamed from scm_sys_open. Return a port instead of
an FD object. Make the mode argument optional.
* (scm_sys_create): deleted, it's just a special case of open.
(scm_init_filesys): move interning of constants O_CREAT etc.,
here (were previously using SCM_CONST_LONG macro).
Add missing constants: O_RDONLY, O_WRONLY, O_RDWR, O_CREAT.
don't newsmob fd.
(numerous _sys_ procedures): remove gratuitous _sys_ from names.
include "fports.h" and <stdio.h>
(scm_stat, scm_select): don't support FD objects.
* error.h: adjust scm_syserror_msg prototype.
* error.c (scm_syserror_msg): take an extra argument for errno.
Using the global value didn't always work, since it could be
reset by procedure calls in the message or args arguments.
* fports.c (scm_setbuf0): call setbuf even if FIONREAD is not defined.
I don't understand why the check was there (and what about the
ultrix check?)
* strop.c (scm_string_copy): allow shared substrings to be copied.
* unif.h: corresponding change to prototypes.
* unif.c (scm_uniform_array_read_x, scm_uniform_array_write_x):
recognize two new optional arguments: offset and length. Allow
the port argument to be an integer (file descriptor, for scsh).
Include <unistd.h> for "read" prototype.
Diffstat (limited to 'libguile/unif.c')
-rw-r--r-- | libguile/unif.c | 162 |
1 files changed, 123 insertions, 39 deletions
diff --git a/libguile/unif.c b/libguile/unif.c index 87be8a22d..8e181f1a4 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -53,6 +53,10 @@ #include "unif.h" #include "ramap.h" +#ifdef HAVE_UNISTD_H +#include <unistd.h> +#endif + /* The set of uniform scm_vector types is: * Vector of: Called: @@ -1430,25 +1434,29 @@ scm_ra2contig (ra, copy) -SCM_PROC(s_uniform_array_read_x, "uniform-array-read!", 1, 1, 0, scm_uniform_array_read_x); +SCM_PROC(s_uniform_array_read_x, "uniform-array-read!", 1, 3, 0, scm_uniform_array_read_x); SCM -scm_uniform_array_read_x (ra, port) +scm_uniform_array_read_x (ra, port_or_fd, offset, length) SCM ra; - SCM port; + SCM port_or_fd; + SCM offset; + SCM length; { SCM cra = SCM_UNDEFINED, v = ra; - long sz, len, ans; + long sz, vlen, ans; long start = 0; + long len_to_read; - if (SCM_UNBNDP (port)) - port = scm_cur_inp; - else - SCM_ASSERT (SCM_NIMP (port) && SCM_OPINFPORTP (port), port, SCM_ARG2, - s_uniform_array_read_x); SCM_ASRTGO (SCM_NIMP (v), badarg1); + if (SCM_UNBNDP (port_or_fd)) + port_or_fd = scm_cur_inp; + else + SCM_ASSERT (SCM_INUMP (port_or_fd) + || (SCM_NIMP (port_or_fd) && SCM_OPINFPORTP (port_or_fd)), + port_or_fd, SCM_ARG2, s_uniform_array_read_x); + vlen = SCM_LENGTH (v); - len = SCM_LENGTH (v); loop: switch SCM_TYP7 (v) { @@ -1457,8 +1465,8 @@ loop: case scm_tc7_smob: SCM_ASRTGO (SCM_ARRAYP (v), badarg1); cra = scm_ra2contig (ra, 0); - start = SCM_ARRAY_BASE (cra); - len = SCM_ARRAY_DIMS (cra)->inc * + start += SCM_ARRAY_BASE (cra); + vlen = SCM_ARRAY_DIMS (cra)->inc * (SCM_ARRAY_DIMS (cra)->ubnd - SCM_ARRAY_DIMS (cra)->lbnd + 1); v = SCM_ARRAY_V (cra); goto loop; @@ -1467,7 +1475,7 @@ loop: sz = sizeof (char); break; case scm_tc7_bvect: - len = (len + SCM_LONG_BIT - 1) / SCM_LONG_BIT; + vlen = (vlen + SCM_LONG_BIT - 1) / SCM_LONG_BIT; start /= SCM_LONG_BIT; case scm_tc7_uvect: case scm_tc7_ivect: @@ -1495,19 +1503,52 @@ loop: break; #endif } + + len_to_read = vlen; + if (!SCM_UNBNDP (offset)) + { + long loff = + scm_num2long (offset, (char *) SCM_ARG3, s_uniform_array_read_x); - /* An ungetc before an fread will not work on some systems if setbuf(0). - do #define NOSETBUF in scmfig.h to fix this. */ - if (SCM_CRDYP (port)) - { /* UGGH!!! */ - ungetc (SCM_CGETUN (port), (FILE *)SCM_STREAM (port)); - SCM_CLRDY (port); /* Clear ungetted char */ + if (loff < 0 || loff >= vlen) + scm_out_of_range (s_uniform_array_read_x, offset); + start += loff; + len_to_read -= loff; + } + if (!SCM_UNBNDP (length)) + { + long llen = + scm_num2long (length, (char *) SCM_ARG4, s_uniform_array_read_x); + + if (llen < 0 || llen > len_to_read) + scm_out_of_range (s_uniform_array_read_x, length); + len_to_read = llen; } - SCM_SYSCALL (ans = fread (SCM_CHARS (v) + start * sz, - (scm_sizet) sz, (scm_sizet) len, - (FILE *)SCM_STREAM (port))); - + if (SCM_NIMP (port_or_fd)) + { + /* if we have stored a character from the port in our own buffer, + push it back onto the stream. */ + /* An ungetc before an fread will not work on some systems if + setbuf(0). do #define NOSETBUF in scmfig.h to fix this. */ + if (SCM_CRDYP (port_or_fd)) + { + ungetc (SCM_CGETUN (port_or_fd), (FILE *)SCM_STREAM (port_or_fd)); + SCM_CLRDY (port_or_fd); /* Clear ungetted char */ + } + SCM_SYSCALL (ans = fread (SCM_CHARS (v) + start * sz, + (scm_sizet) sz, (scm_sizet) len_to_read, + (FILE *)SCM_STREAM (port_or_fd))); + + } + else /* file descriptor. */ + { + SCM_SYSCALL (ans = read (SCM_INUM (port_or_fd), + SCM_CHARS (v) + start * sz, + (scm_sizet) (sz * len_to_read))); + if (ans == -1) + scm_syserror (s_uniform_array_read_x); + } if (SCM_TYP7 (v) == scm_tc7_bvect) ans *= SCM_LONG_BIT; @@ -1517,24 +1558,30 @@ loop: return SCM_MAKINUM (ans); } -SCM_PROC(s_uniform_array_write, "uniform-array-write", 1, 1, 0, scm_uniform_array_write); +SCM_PROC(s_uniform_array_write, "uniform-array-write", 1, 3, 0, scm_uniform_array_write); SCM -scm_uniform_array_write (v, port) +scm_uniform_array_write (v, port_or_fd, offset, length) SCM v; - SCM port; + SCM port_or_fd; + SCM offset; + SCM length; { - long sz, len, ans; + long sz, vlen, ans; long start = 0; - if (SCM_UNBNDP (port)) - port = scm_cur_outp; - else - SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTFPORTP (port), port, SCM_ARG2, s_uniform_array_write); + long len_to_write; + SCM_ASRTGO (SCM_NIMP (v), badarg1); - len = SCM_LENGTH (v); + if (SCM_UNBNDP (port_or_fd)) + port_or_fd = scm_cur_outp; + else + SCM_ASSERT (SCM_INUMP (port_or_fd) + || (SCM_NIMP (port_or_fd) && SCM_OPOUTFPORTP (port_or_fd)), + port_or_fd, SCM_ARG2, s_uniform_array_write); + vlen = SCM_LENGTH (v); + loop: - switch SCM_TYP7 - (v) + switch SCM_TYP7 (v) { default: badarg1:scm_wta (v, (char *) SCM_ARG1, s_uniform_array_write); @@ -1542,15 +1589,16 @@ loop: SCM_ASRTGO (SCM_ARRAYP (v), badarg1); v = scm_ra2contig (v, 1); start = SCM_ARRAY_BASE (v); - len = SCM_ARRAY_DIMS (v)->inc * (SCM_ARRAY_DIMS (v)->ubnd - SCM_ARRAY_DIMS (v)->lbnd + 1); + vlen = SCM_ARRAY_DIMS (v)->inc + * (SCM_ARRAY_DIMS (v)->ubnd - SCM_ARRAY_DIMS (v)->lbnd + 1); v = SCM_ARRAY_V (v); goto loop; - case scm_tc7_byvect: case scm_tc7_string: + case scm_tc7_byvect: sz = sizeof (char); break; case scm_tc7_bvect: - len = (len + SCM_LONG_BIT - 1) / SCM_LONG_BIT; + vlen = (vlen + SCM_LONG_BIT - 1) / SCM_LONG_BIT; start /= SCM_LONG_BIT; case scm_tc7_uvect: case scm_tc7_ivect: @@ -1578,9 +1626,45 @@ loop: break; #endif } - SCM_SYSCALL (ans = fwrite (SCM_CHARS (v) + start * sz, (scm_sizet) sz, (scm_sizet) len, (FILE *)SCM_STREAM (port))); + + len_to_write = vlen; + if (!SCM_UNBNDP (offset)) + { + long loff = + scm_num2long (offset, (char *) SCM_ARG3, s_uniform_array_write); + + if (loff < 0 || loff >= vlen) + scm_out_of_range (s_uniform_array_write, offset); + start += loff; + len_to_write -= loff; + } + if (!SCM_UNBNDP (length)) + { + long llen = + scm_num2long (length, (char *) SCM_ARG4, s_uniform_array_read_x); + + if (llen < 0 || llen > len_to_write) + scm_out_of_range (s_uniform_array_read_x, length); + len_to_write = llen; + } + + if (SCM_NIMP (port_or_fd)) + { + SCM_SYSCALL (ans = fwrite (SCM_CHARS (v) + start * sz, + (scm_sizet) sz, (scm_sizet) len_to_write, + (FILE *)SCM_STREAM (port_or_fd))); + } + else /* file descriptor. */ + { + SCM_SYSCALL (ans = write (SCM_INUM (port_or_fd), + SCM_CHARS (v) + start * sz, + (scm_sizet) (sz * len_to_write))); + if (ans == -1) + scm_syserror (s_uniform_array_write); + } if (SCM_TYP7 (v) == scm_tc7_bvect) ans *= SCM_LONG_BIT; + return SCM_MAKINUM (ans); } |