mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-09 15:10:29 +02:00
1999-07-24 Gary Houston <ghouston@easynet.co.uk>
* gdbint.c (gdb_print, gdb_read): call scm_truncate_file. * ports.c (scm_truncate_file): renamed from scm_ftruncate. allow the 1st argument to be a fdes or filename as well as a port (as in the filesys.c version). * filesys.c (scm_truncate_file): removed.
This commit is contained in:
parent
eb9ef08b77
commit
69bc9ff335
7 changed files with 59 additions and 64 deletions
6
NEWS
6
NEWS
|
@ -989,9 +989,9 @@ work on any kind of port, not just ports which are open on a file.
|
|||
|
||||
** now 'l' in a port mode requests line buffering.
|
||||
|
||||
** new procedure: ftruncate PORT [LENGTH]
|
||||
Truncates PORT after LENGTH bytes, or at the current position if
|
||||
LENGTH is omitted. Works on random-access file and string ports.
|
||||
** The procedure truncate-file now works on string ports as well
|
||||
as file ports. If the size argument is omitted, the current
|
||||
file position is now used.
|
||||
|
||||
** new procedure: lseek PORT/FDES OFFSET WHENCE
|
||||
The arguments are the same as for the old fseek procedure, but it
|
||||
|
|
|
@ -1,3 +1,13 @@
|
|||
1999-07-24 Gary Houston <ghouston@easynet.co.uk>
|
||||
|
||||
* gdbint.c (gdb_print, gdb_read): call scm_truncate_file.
|
||||
|
||||
* ports.c (scm_truncate_file): renamed from scm_ftruncate.
|
||||
allow the 1st argument to be a fdes or filename as well as a
|
||||
port (as in the filesys.c version).
|
||||
|
||||
* filesys.c (scm_truncate_file): removed.
|
||||
|
||||
1999-07-24 Mikael Djurfeldt <mdj@thalamus.nada.kth.se>
|
||||
|
||||
* readline.c, readline.h: Removed.
|
||||
|
|
|
@ -513,37 +513,6 @@ scm_delete_file (str)
|
|||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
||||
SCM_PROC (s_truncate_file, "truncate-file", 2, 0, 0, scm_truncate_file);
|
||||
SCM
|
||||
scm_truncate_file (SCM object, SCM size)
|
||||
{
|
||||
int rv;
|
||||
scm_sizet csize;
|
||||
int fdes;
|
||||
|
||||
object = SCM_COERCE_OUTPORT (object);
|
||||
|
||||
csize = (scm_sizet) scm_num2long (size, (char *) SCM_ARG2, s_truncate_file);
|
||||
if (SCM_INUMP (object) || (SCM_NIMP (object) && SCM_OPFPORTP (object)))
|
||||
{
|
||||
if (SCM_INUMP (object))
|
||||
fdes = SCM_INUM (object);
|
||||
else
|
||||
fdes = SCM_FPORT_FDES (object);
|
||||
SCM_SYSCALL (rv = ftruncate (fdes, csize));
|
||||
}
|
||||
else
|
||||
{
|
||||
SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object),
|
||||
object, SCM_ARG1, s_chown);
|
||||
SCM_COERCE_SUBSTR (object);
|
||||
SCM_SYSCALL (rv = truncate (SCM_ROCHARS (object), csize));
|
||||
}
|
||||
if (rv == -1)
|
||||
scm_syserror (s_truncate_file);
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
||||
SCM_PROC (s_mkdir, "mkdir", 1, 1, 0, scm_mkdir);
|
||||
|
||||
SCM
|
||||
|
|
|
@ -64,7 +64,6 @@ extern SCM scm_stat SCM_P ((SCM object));
|
|||
extern SCM scm_link SCM_P ((SCM oldpath, SCM newpath));
|
||||
extern SCM scm_rename SCM_P ((SCM oldname, SCM newname));
|
||||
extern SCM scm_delete_file SCM_P ((SCM str));
|
||||
extern SCM scm_truncate_file (SCM object, SCM size);
|
||||
extern SCM scm_mkdir SCM_P ((SCM path, SCM mode));
|
||||
extern SCM scm_rmdir SCM_P ((SCM path));
|
||||
extern SCM scm_opendir SCM_P ((SCM dirname));
|
||||
|
|
|
@ -207,7 +207,7 @@ gdb_read (str)
|
|||
unmark_port (gdb_input_port);
|
||||
scm_lseek (gdb_input_port, SCM_INUM0, SCM_MAKINUM (SEEK_SET));
|
||||
scm_puts (str, gdb_input_port);
|
||||
scm_ftruncate (gdb_input_port, SCM_UNDEFINED);
|
||||
scm_truncate_file (gdb_input_port, SCM_UNDEFINED);
|
||||
scm_lseek (gdb_input_port, SCM_INUM0, SCM_MAKINUM (SEEK_SET));
|
||||
/* Read one object */
|
||||
tok_buf_mark_p = SCM_GC8MARKP (tok_buf);
|
||||
|
@ -269,7 +269,7 @@ gdb_print (obj)
|
|||
/* Reset stream */
|
||||
scm_lseek (gdb_output_port, SCM_INUM0, SCM_MAKINUM (SEEK_SET));
|
||||
scm_write (obj, gdb_output_port);
|
||||
scm_ftruncate (gdb_output_port, SCM_UNDEFINED);
|
||||
scm_truncate_file (gdb_output_port, SCM_UNDEFINED);
|
||||
SEND_STRING (SCM_CHARS (SCM_STREAM (gdb_output_port)));
|
||||
SCM_END_FOREIGN_BLOCK;
|
||||
return 0;
|
||||
|
|
|
@ -978,40 +978,57 @@ scm_lseek (SCM object, SCM offset, SCM whence)
|
|||
return scm_long2num (rv);
|
||||
}
|
||||
|
||||
SCM_PROC (s_ftruncate, "ftruncate", 1, 1, 0, scm_ftruncate);
|
||||
SCM_PROC (s_truncate_file, "truncate-file", 1, 1, 0, scm_truncate_file);
|
||||
|
||||
SCM
|
||||
scm_ftruncate (SCM port, SCM length)
|
||||
scm_truncate_file (SCM object, SCM length)
|
||||
{
|
||||
scm_port *pt;
|
||||
scm_ptobfuns *ptob;
|
||||
int rv;
|
||||
off_t c_length;
|
||||
|
||||
/* object can be a port, fdes or filename. */
|
||||
|
||||
port = SCM_COERCE_OUTPORT (port);
|
||||
SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1,
|
||||
s_ftruncate);
|
||||
pt = SCM_PTAB_ENTRY (port);
|
||||
ptob = scm_ptobs + SCM_PTOBNUM (port);
|
||||
if (!ptob->ftruncate)
|
||||
scm_misc_error (s_ftruncate, "port is not truncatable",
|
||||
scm_cons (port, SCM_EOL));
|
||||
if (SCM_UNBNDP (length))
|
||||
{
|
||||
length = scm_lseek (port, SCM_INUM0, SCM_MAKINUM (SEEK_CUR));
|
||||
/* must supply length if object is a filename. */
|
||||
if (SCM_NIMP (object) && SCM_ROSTRINGP (object))
|
||||
scm_wrong_num_args (scm_makfrom0str (s_truncate_file));
|
||||
|
||||
length = scm_lseek (object, SCM_INUM0, SCM_MAKINUM (SEEK_CUR));
|
||||
}
|
||||
if (pt->rw_active == SCM_PORT_READ)
|
||||
scm_read_flush (port);
|
||||
else if (pt->rw_active == SCM_PORT_WRITE)
|
||||
ptob->fflush (port);
|
||||
c_length = scm_num2long (length, (char *)SCM_ARG2, s_truncate_file);
|
||||
if (c_length < 0)
|
||||
scm_misc_error (s_truncate_file, "negative offset", SCM_EOL);
|
||||
|
||||
{
|
||||
off_t c_length = scm_num2long (length, (char *)SCM_ARG2, s_ftruncate);
|
||||
|
||||
if (c_length < 0)
|
||||
scm_misc_error (s_ftruncate, "negative offset",
|
||||
scm_cons (length, SCM_EOL));
|
||||
|
||||
ptob->ftruncate (port, c_length);
|
||||
}
|
||||
object = SCM_COERCE_OUTPORT (object);
|
||||
if (SCM_INUMP (object))
|
||||
{
|
||||
SCM_SYSCALL (rv = ftruncate (SCM_INUM (object), c_length));
|
||||
}
|
||||
else if (SCM_NIMP (object) && SCM_OPOUTPORTP (object))
|
||||
{
|
||||
scm_port *pt = SCM_PTAB_ENTRY (object);
|
||||
scm_ptobfuns *ptob = scm_ptobs + SCM_PTOBNUM (object);
|
||||
|
||||
if (!ptob->ftruncate)
|
||||
scm_misc_error (s_truncate_file, "port is not truncatable", SCM_EOL);
|
||||
if (pt->rw_active == SCM_PORT_READ)
|
||||
scm_read_flush (object);
|
||||
else if (pt->rw_active == SCM_PORT_WRITE)
|
||||
ptob->fflush (object);
|
||||
|
||||
ptob->ftruncate (object, c_length);
|
||||
rv = 0;
|
||||
}
|
||||
else
|
||||
{
|
||||
SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object),
|
||||
object, SCM_ARG1, s_truncate_file);
|
||||
SCM_COERCE_SUBSTR (object);
|
||||
SCM_SYSCALL (rv = truncate (SCM_ROCHARS (object), c_length));
|
||||
}
|
||||
if (rv == -1)
|
||||
scm_syserror (s_truncate_file);
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
||||
|
|
|
@ -237,7 +237,7 @@ extern SCM scm_unread_char SCM_P ((SCM cobj, SCM port));
|
|||
extern SCM scm_unread_string SCM_P ((SCM str, SCM port));
|
||||
extern char *scm_generic_fgets SCM_P ((SCM port, int *len));
|
||||
extern SCM scm_lseek (SCM object, SCM offset, SCM whence);
|
||||
extern SCM scm_ftruncate (SCM port, SCM length);
|
||||
extern SCM scm_truncate_file (SCM object, SCM length);
|
||||
extern SCM scm_port_line SCM_P ((SCM port));
|
||||
extern SCM scm_set_port_line_x SCM_P ((SCM port, SCM line));
|
||||
extern SCM scm_port_column SCM_P ((SCM port));
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue