guile 1.9.0 scm_read_hash_extend gc trouble

guile 1.9.0 scm_read_hash_extend gc trouble

[Bill Schottstaedt]

In the new Guile (1.9.0), the scsh-derived code to implement #|..|# block
comment processing triggers either a glibc memory complaint
or a segfault.  (The following code is slightly translated, so
I may have introduced typos, but the basic idea has worked for
maybe 10 years):

static SCM g_skip_block_comment(SCM ch, SCM port)
{
  int bang_seen = 0;
  while (true)
    {
      int c;
      c = scm_getc(port);
      if (c == EOF)
	{
	  fprintf(stderr, "unterminated `#| ... |#' comment");
	  return(SCM_BOOL_F);
	}
      if (c == '|')
	bang_seen = 1;
      else 
	{
	  if ((c == '#') && (bang_seen))
	    return(SCM_BOOL_F);
	  else bang_seen = 0;
	}
    }
  return(SCM_BOOL_F);
}


Then call scm_read_hash_extend with "|" to activate it.  If I have
a file such as:

#|
;;; a test
|#


(or any other file with such a comment), and read it in snd/guile:


*** glibc detected *** ../guile-snd/snd: free(): invalid next size (normal): 0x098c4730 ***
======= Backtrace: =========
/lib/libc.so.6[0x39e394]
/lib/libc.so.6(cfree+0x96)[0x3a0346]
/usr/local/lib/libguile.so.18(scm_gc_free+0x3c)[0x4006a59c]
/usr/local/lib/libguile.so.18[0x4008fb6a]
/usr/local/lib/libguile.so.18(scm_close_port+0xa5)[0x4008fc35]
/usr/local/lib/libguile.so.18(scm_primitive_load+0xdd)[0x4007ccdd]
/usr/local/lib/libguile.so.18(scm_c_primitive_load+0x25)[0x4007d135]
../guile-snd/snd[0x8160d46]
/usr/local/lib/libguile.so.18(scm_c_with_throw_handler+0x10b)[0x400c64db]
/usr/local/lib/libguile.so.18(scm_internal_lazy_catch+0x41)[0x400c6671]
/usr/local/lib/libguile.so.18[0x400c674f]
/usr/local/lib/libguile.so.18(scm_c_catch+0x28d)[0x400c69ed]
/usr/local/lib/libguile.so.18(scm_internal_catch+0x49)[0x400c6c39]
/usr/local/lib/libguile.so.18(scm_internal_stack_catch+0x4b)[0x400c6cfb]
../guile-snd/snd(snd_catch_any+0x42)[0x8161232]
../guile-snd/snd(snd_load_file+0xac)[0x816159c]
../guile-snd/snd(handle_next_startup_arg+0x29f)[0x8144dbf]
../guile-snd/snd(snd_doit+0x60d)[0x81cd26d]
/usr/local/lib/libguile.so.18[0x400788a6]
/usr/local/lib/libguile.so.18[0x4004e072]
/usr/local/lib/libguile.so.18(scm_c_catch+0x28d)[0x400c69ed]
/usr/local/lib/libguile.so.18[0x4004e692]
/usr/local/lib/libguile.so.18(scm_c_with_continuation_barrier+0x53)[0x4004e773]
/usr/local/lib/libguile.so.18[0x400c539c]
/usr/local/lib/libguile.so.18(scm_with_guile+0x2e)[0x400c54ae]
/usr/local/lib/libguile.so.18(scm_boot_guile+0x3f)[0x4007883f]
../guile-snd/snd(main+0x32)[0x8159782]
/lib/libc.so.6(__libc_start_main+0xe5)[0x3456d5]
../guile-snd/snd[0x8065621]
======= Memory map: ========
0030a000-0032a000 r-xp 00000000 fd:00 13018312   /lib/ld-2.9.so
0032b000-0032c000 r-xp 00020000 fd:00 13018312   /lib/ld-2.9.so
0032c000-0032d000 rwxp 00021000 fd:00 13018312   /lib/ld-2.9.so
0032f000-0049d000 r-xp 00000000 fd:00 13018313   /lib/libc-2.9.so
0049d000-0049f000 r-xp 0016e000 fd:00 13018313   /lib/libc-2.9.so
0049f000-004a0000 rwxp 00170000 fd:00 13018313   /lib/libc-2.9.so
004a0000-004a3000 rwxp 004a0000 00:00 0 
004a5000-004cc000 r-xp 00000000 fd:00 13018324   /lib/libm-2.9.so
004cc000-004cd000 r-xp 00026000 fd:00 13018324   /lib/libm-2.9.so
004cd000-004ce000 rwxp 00027000 fd:00 13018324   /lib/libm-2.9.so
004d0000-004d3000 r-xp 00000000 fd:00 13018319   /lib/libdl-2.9.so
004d3000-004d4000 r-xp 00002000 fd:00 13018319   /lib/libdl-2.9.so
004d4000-004d5000 rwxp 00003000 fd:00 13018319   /lib/libdl-2.9.so
004d7000-004ed000 r-xp 00000000 fd:00 13018314   /lib/libpthread-2.9.so
004ed000-004ee000 r-xp 00015000 fd:00 13018314   /lib/libpthread-2.9.so
004ee000-004ef000 rwxp 00016000 fd:00 13018314   /lib/libpthread-2.9.so
004ef000-004f1000 rwxp 004ef000 00:00 0 
009d4000-009e1000 r-xp 00000000 fd:00 13018327   /lib/libgcc_s-4.3.2-20081105.so.1
009e1000-009e2000 rwxp 0000c000 fd:00 13018327   /lib/libgcc_s-4.3.2-20081105.so.1
055c4000-055ce000 r-xp 00000000 fd:00 13018344   /lib/libcrypt-2.9.so
055ce000-055cf000 r-xp 00009000 fd:00 13018344   /lib/libcrypt-2.9.so
055cf000-055d0000 rwxp 0000a000 fd:00 13018344   /lib/libcrypt-2.9.so
055d0000-055f7000 rwxp 055d0000 00:00 0 
08048000-082eb000 r-xp 00000000 fd:00 21537167   /home/bil/guile-snd/snd
082eb000-082f1000 rwxp 002a3000 fd:00 21537167   /home/bil/guile-snd/snd
082f1000-082f3000 rwxp 082f1000 00:00 0 
0977f000-098db000 rwxp 0977f000 00:00 0          [heap]
40000000-40001000 r-xp 40000000 00:00 0          [vdso]
40001000-40002000 rwxp 40001000 00:00 0 
40002000-40005000 r-xs 00000000 fd:00 14231648   /usr/local/lib/guile/1.9/ccache/ice-
9/r4rs.go
40005000-40007000 r-xs 00000000 fd:00 14231672   /usr/local/lib/guile/1.9/ccache/ice-
9/posix.go
40007000-40009000 r-xs 00000000 fd:00 14231666   /usr/local/lib/guile/1.9/ccache/ice-
9/networking.go
40009000-4000c000 r-xs 00000000 fd:00 14231696   /usr/local/lib/guile/1.9/ccache/ice-
9/deprecated.go
4000c000-4000d000 r-xp 02388000 fd:00 13649054   /usr/lib/locale/locale-archive
4000d000-40012000 r-xs 00000000 fd:00 14231669   /usr/local/lib/guile/1.9/ccache/ice-
9/optargs.go
4001e000-4010c000 r-xp 00000000 fd:00 3154070    /usr/local/lib/libguile.so.18.0.0
4010c000-40110000 rwxp 000ee000 fd:00 3154070    /usr/local/lib/libguile.so.18.0.0
40110000-4011b000 rwxp 40110000 00:00 0 
4011b000-40223000 r-xp 00000000 fd:00 3154130    /usr/local/lib/libunistring.so.0.0.0
40223000-40225000 rwxp 00108000 fd:00 3154130    /usr/local/lib/libunistring.so.0.0.0
40225000-40270000 r-xp 00000000 fd:00 3154050    /usr/local/lib/libgmp.so.3.5.0
40270000-40271000 rwxp 0004a000 fd:00 3154050    /usr/local/lib/libgmp.so.3.5.0
40271000-40272000 rwxp 40271000 00:00 0 
40272000-40279000 r-xp 00000000 fd:00 3153921    /usr/local/lib/libltdl.so.7.2.0
40279000-4027a000 rwxp 00006000 fd:00 3153921    /usr/local/lib/libltdl.so.7.2.0
4027a000-4041b000 r-xp 00000000 fd:00 13653194   /usr/local/lib/libgsl.so.0.13.0
4041b000-40425000 rwxp 001a0000 fd:00 13653194   /usr/local/lib/libgsl.so.0.13.0
40425000-4045a000 r-xp 00000000 fd:00 13652488   /usr/local/lib/libgslcblas.so.0.0.0
4045a000-4045b000 rwxp 00035000 fd:00 13652488   /usr/local/lib/libgslcblas.so.0.0.0
4045b000-404a0000 rwxp 4045b000 00:00 0 
404a0000-404cb000 r-xs 00000000 fd:00 14231647   /usr/local/lib/guile/1.9/ccache/ice-
9/boot-9.go
404cb000-40500000 r-xs 00000000 fd:00 14231646   /usr/local/lib/guile/1.9/ccache/ice-
9/psyntax-pp.go
40500000-40700000 r-xp 00000000 fd:00 13649054   /usr/lib/locale/locale-archive
40700000-4073c000 r-xp 0232f000 fd:00 13649054   /usr/lib/locale/locale-archive
40800000-40821000 rwxp 40800000 00:00 0 
40821000-40900000 ---p 40821000 00:00 0 
bfbac000-bfbc1000 rwxp bffeb000 00:00 0          [stack]
Abort (core dumped)


in gdb:

Program received signal SIGABRT, Aborted.
0x40000424 in __kernel_vsyscall ()
Missing separate debuginfos, use: debuginfo-install glibc-2.9-2.i686 libgcc-4.3.2-7.i386
(gdb) where
#0  0x40000424 in __kernel_vsyscall ()
#1  0x0035a450 in raise () from /lib/libc.so.6
#2  0x0035be18 in abort () from /lib/libc.so.6
#3  0x00397fdd in __libc_message () from /lib/libc.so.6
#4  0x0039e394 in malloc_printerr () from /lib/libc.so.6
#5  0x003a0346 in free () from /lib/libc.so.6
#6  0x4006a59c in scm_gc_free (mem=0x8438738, size=92, what=0x400ff274 "port")
    at gc-malloc.c:370
#7  0x4008fb6a in scm_i_remove_port (port=0x841ef58) at ports.c:553
#8  0x4008fc35 in scm_close_port (port=0x841ef58) at ports.c:730
#9  0x4007ccdd in scm_primitive_load (filename=0x83c9410) at load.c:120
#10 0x4007d135 in scm_c_primitive_load (filename=0x84387f0 "/home/bil/cl/g.scm") at load.c:129
#11 0x08160d46 in eval_file_wrapper (data=0x84387f0) at snd-xen.c:979
#12 0x400c64db in scm_c_with_throw_handler (tag=0x104, body=0x8160d30 <eval_file_wrapper>, 
    body_data=0x84387f0, handler=0x400c6370 <ss_handler>, handler_data=0x0, lazy_catch_p=1)
    at throw.c:317
#13 0x400c6671 in scm_internal_lazy_catch (tag=0x104, body=0x8160d30 <eval_file_wrapper>, 
    body_data=0x84387f0, handler=0x400c6370 <ss_handler>, handler_data=0x0) at throw.c:332
#14 0x400c674f in cwss_body (data=0xbfffef48) at throw.c:361
#15 0x400c69ed in scm_c_catch (tag=0x104, body=0x400c6710 <cwss_body>, 
body_data=0xbfffef48, 
    handler=0x8162f00 <snd_catch_scm_error>, handler_data=0x8438470, pre_unwind_handler=0, 
    pre_unwind_handler_data=0x0) at throw.c:242
#16 0x400c6c39 in scm_internal_catch (tag=0x104, body=0x400c6710 <cwss_body>, 
    body_data=0xbfffef48, handler=0x8162f00 <snd_catch_scm_error>, handler_data=0x8438470)
    at throw.c:256
#17 0x400c6cfb in scm_internal_stack_catch (tag=0x104, body=0x8160d30 <eval_file_wrapper>, 
    body_data=0x84387f0, handler=0x8162f00 <snd_catch_scm_error>, handler_data=0x8438470)
    at throw.c:375
#18 0x08161232 in snd_internal_stack_catch () at snd-xen.c:644
#19 snd_catch_any (body=0x8160d30 <eval_file_wrapper>, body_data=0x84387f0, 
    caller=0x8438470 "(load \"g.scm\")") at snd-xen.c:666
#20 0x0816159c in snd_load_file (filename=0xbffff50f "g.scm") at snd-xen.c:1349
#21 0x08144dbf in handle_next_startup_arg (auto_open_ctr=1, auto_open_file_names=0xbffff348, 
    with_title=false, args=2) at snd-main.c:1579
#22 0x081cd26d in snd_doit (argc=3, argv=0xbffff344) at snd-nogui.c:720
#23 0x400788a6 in invoke_main_func (body_data=0xbffff274) at init.c:372
#24 0x4004e072 in c_body (d=0xbffff1c8) at continuations.c:354
#25 0x400c69ed in scm_c_catch (tag=0x104, body=0x4004e060 <c_body>, body_data=0xbffff1c8, 
    handler=0x4004e080 <c_handler>, handler_data=0xbffff1c8, 
    pre_unwind_handler=0x400c5c40 <scm_handle_by_message_noexit>, 
pre_unwind_handler_data=0x0)
    at throw.c:242
#26 0x4004e692 in scm_i_with_continuation_barrier (body=0x4004e060 <c_body>, 
    body_data=0xbffff1c8, handler=0x4004e080 <c_handler>, handler_data=0xbffff1c8, 
    pre_unwind_handler=0x400c5c40 <scm_handle_by_message_noexit>, 
pre_unwind_handler_data=0x0)
    at continuations.c:330
#27 0x4004e773 in scm_c_with_continuation_barrier (func=0x40078860 <invoke_main_func>, 
    data=0xbffff274) at continuations.c:372
#28 0x400c539c in scm_i_with_guile_and_parent (func=0x40078860 <invoke_main_func>, 
    data=0xbffff274, parent=0x0) at threads.c:852
#29 0x400c54ae in scm_with_guile (func=0x40078860 <invoke_main_func>, data=0xbffff274)
    at threads.c:831
#30 0x4007883f in scm_boot_guile (argc=3, argv=0xbffff344, main_func=0x815a120 <snd_main>, 
    closure=0x0) at init.c:355
#31 0x08159782 in main (argc=Cannot access memory at address 0x7358
) at snd.c:518


(gdb) up
#7  0x4008fb6a in scm_i_remove_port (port=0x841ef58) at ports.c:553
553       scm_gc_free (p, sizeof (scm_t_port), "port");
(gdb) p p
$1 = (scm_t_port *) 0x8438738
(gdb) p ((scm_t_port *)p)[0]
$3 = {port = 0x841ef58, revealed = 0, stream = 138074392, file_name = 0x83c9410, 
  line_number = 3, column_number = 0, read_buf = 0x844d800 "#|\n;;; a test\n|#\n", 
  read_pos = 0x844d811 "", read_end = 0x844d811 "", read_buf_size = 4096, 
  saved_read_buf = 0x844d800 "#|\n;;; a test\n|#\n", 
  saved_read_pos = 0x844d802 "\n;;; a test\n|#\n", saved_read_end = 0x844d811 "", 
  saved_read_buf_size = 4096, write_buf = 0x8438780 "", write_pos = 0x8438780 "", 
  write_end = 0x8438781 "", write_buf_size = 1, shortbuf = 0 '\0', rw_random = 1, 
  rw_active = SCM_PORT_NEITHER, putback_buf = 0x83b3270 "\020Ù:\bp\001J", putback_buf_size = 
4}

Re: guile 1.9.0 scm_read_hash_extend gc trouble

[Neil Jerram]

"Bill Schottstaedt" <bil@ccrma.Stanford.EDU> writes:

> static SCM g_skip_block_comment(SCM ch, SCM port)
[...]
> Then call scm_read_hash_extend with "|" to activate it.

How do you wrap g_skip_block_comment to get a suitable argument for
scm_read_hash_extend () ?

Regards,
        Neil

Re: guile 1.9.0 scm_read_hash_extend gc trouble

[Neil Jerram]

[-- Attachment #1: Type: text/plain, Size: 579 bytes --]

Neil Jerram <neil@ossau.uklinux.net> writes:

> "Bill Schottstaedt" <bil@ccrma.Stanford.EDU> writes:
>
>> static SCM g_skip_block_comment(SCM ch, SCM port)
> [...]
>> Then call scm_read_hash_extend with "|" to activate it.
>
> How do you wrap g_skip_block_comment to get a suitable argument for
> scm_read_hash_extend () ?

I had a go using scm_c_make_subr ().  But with the attached program
and test input (and current Git HEAD) I can't reproduce the seg fault
that you described.  Can you spot some way in which what you are doing
is different to this?

Regards,
        Neil


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: bill.c --]
[-- Type: text/x-csrc, Size: 826 bytes --]


#include <libguile.h>

static SCM g_skip_block_comment(SCM ch, SCM port)
{
  int bang_seen = 0;
  while (1)
    {
      int c;
      c = scm_getc(port);
      if (c == EOF)
	{
	  fprintf(stderr, "unterminated `#| ... |#' comment");
	  return(SCM_BOOL_F);
	}
      if (c == '|')
	bang_seen = 1;
      else 
	{
	  if ((c == '#') && (bang_seen))
	    return(SCM_BOOL_F);
	  else bang_seen = 0;
	}
    }
  return(SCM_BOOL_F);
}

void inner_main (void *closure, int argc, char **argv)
{
  scm_read_hash_extend (scm_integer_to_char (scm_from_char ('|')),
			scm_c_make_subr ("skip-comment",
					 scm_tc7_subr_2,
					 g_skip_block_comment));
  scm_shell (argc, argv);
}

int main (int argc, char **argv)
{
  scm_boot_guile (argc, argv, inner_main, NULL);
}

/*
  Local variables:
  compile-command: "gcc bill.c -o bill"
  End:
*/

[-- Attachment #3: bill.scm --]
[-- Type: application/octet-stream, Size: 17 bytes --]

#|
;;; a test
|#

Re: guile 1.9.0 scm_read_hash_extend gc trouble

[Bill Schottstaedt]

> Can you spot some way in which what you are doing 
> is different to this? 

I believe this is a GC problem; you're doing exactly what I'm doing,
but in a context where the GC is not called.  If I place the
skip comment function in its own file, and compile it
with optimization turned off, everything is happy; if
optimization is on (either -O or -O2), it dies.  According to
valgrind the problem is in scm_getc -- the SCM_PTAB_ENTRY
pointer "pt" does not point to a valid structure, so the read
and subsuequent write through pt goes off into unallocated
memory.  I haven't tracked down the actual problem yet,
but gc-protecting the "port" variable does no good.

Re: guile 1.9.0 scm_read_hash_extend gc trouble

[Neil Jerram]

"Bill Schottstaedt" <bil@ccrma.Stanford.EDU> writes:

> I believe this is a GC problem; you're doing exactly what I'm doing,
> but in a context where the GC is not called.  If I place the
> skip comment function in its own file, and compile it
> with optimization turned off, everything is happy; if
> optimization is on (either -O or -O2), it dies.

I tried compiling my test with -O2; unfortunately it's still OK.

>  According to
> valgrind the problem is in scm_getc -- the SCM_PTAB_ENTRY
> pointer "pt" does not point to a valid structure, so the read
> and subsuequent write through pt goes off into unallocated
> memory.  I haven't tracked down the actual problem yet,
> but gc-protecting the "port" variable does no good.

Do you mean you think that pt has already been freed, or that it was
never valid?

If the former, it sounds like it would be worth trying to prove this,
by adding instrumentation to scm_gc_free that prints the pointer to
stdout whenever what is "port".

You could also instrument (or set a breakpoint on) scm_igc, to
investigate the GC factor.

I'm sorry that we've apparently broken this for you, and that I can't
help more yet...

Regards,
        Neil

Re: guile 1.9.0 scm_read_hash_extend gc trouble

[Bill Schottstaedt]

This is trickier than I thought -- it's not the GC after all.  In my configure
script for Snd, autoconf defines _FILE_OFFSET_BITS to 64 if large files are implemented.
The config.h "include" precedes everything else.  When scm_getc is called
within guile, it thinks sizeof(scm_t_port) is 92.  Everything is fine until
my skip comment procedure is called (with this 92 byte struct) -- it
thinks the scm_t_port size is 104, and fields like rw_active (in scm_getc
which is apparently expanded inline) are not where it expects them to be!
If I undef _FILE_OFFSET_BITS, both agree on the struct size, and there
is no problem.  

Re: guile 1.9.0 scm_read_hash_extend gc trouble

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 1107 bytes --]

Hello,

"Bill Schottstaedt" <bil@ccrma.Stanford.EDU> writes:

> This is trickier than I thought -- it's not the GC after all.  In my configure
> script for Snd, autoconf defines _FILE_OFFSET_BITS to 64 if large files are implemented.
> The config.h "include" precedes everything else.  When scm_getc is called
> within guile, it thinks sizeof(scm_t_port) is 92.  Everything is fine until
> my skip comment procedure is called (with this 92 byte struct) -- it
> thinks the scm_t_port size is 104, and fields like rw_active (in scm_getc
> which is apparently expanded inline) are not where it expects them to be!
> If I undef _FILE_OFFSET_BITS, both agree on the struct size, and there
> is no problem.  

Ouch!  That's a good illustration of the harm that can be done by
exposing data structures.

The attached patch adds a new `scm_t_off' type, whose definition does
not depend on the application's `_FILE_OFFSET_BITS' value.  Can you
confirm that it allows you to build Guile with 32-bit offsets and Snd
with 64-bit offsets (or vice versa)?

Neil: Does this sound like the right approach?

Thanks,
Ludo'.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: The patch --]
[-- Type: text/x-diff, Size: 7416 bytes --]

diff --git a/libguile/fports.c b/libguile/fports.c
index de788c9..53d1140 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -671,8 +671,8 @@ fport_seek_or_seek64 (SCM port, off_t_or_off64_t offset, int whence)
    fport_seek already.  */
 
 #if GUILE_USE_64_CALLS && HAVE_STAT64 && SIZEOF_OFF_T != SIZEOF_OFF64_T
-static off_t
-fport_seek (SCM port, off_t offset, int whence)
+static scm_t_off
+fport_seek (SCM port, scm_t_off offset, int whence)
 {
   off64_t rv = fport_seek_or_seek64 (port, (off64_t) offset, whence);
   if (rv > OFF_T_MAX || rv < OFF_T_MIN)
@@ -696,7 +696,7 @@ scm_i_fport_seek (SCM port, SCM offset, int how)
 }
 
 static void
-fport_truncate (SCM port, off_t length)
+fport_truncate (SCM port, scm_t_off length)
 {
   scm_t_fport *fp = SCM_FSTREAM (port);
 
diff --git a/libguile/gen-scmconfig.c b/libguile/gen-scmconfig.c
index 85ebfae..9715973 100644
--- a/libguile/gen-scmconfig.c
+++ b/libguile/gen-scmconfig.c
@@ -400,6 +400,22 @@ main (int argc, char *argv[])
   pf ("#define SCM_HAVE_READDIR64_R 0 /* 0 or 1 */\n");
 #endif
 
+  /* Arrange so that we have a file offset type that reflects the one
+     used when compiling Guile, regardless of the application's
+     `_FILE_OFFSET_BITS' says.
+
+     Note that we can't define `scm_t_off' in terms of `off_t' or
+     `off64_t' because they may or may not be available depending on
+     how the application that uses Guile is compiled.  */
+
+#if defined GUILE_USE_64_CALLS && defined HAVE_STAT64
+  pf ("typedef scm_t_int64 scm_t_off;\n");
+#elif SIZEOF_OFF_T == SIZEOF_INT
+  pf ("typedef int scm_t_off;\n");
+#else
+  pf ("typedef long int scm_t_off;\n");
+#endif
+
 #if USE_DLL_IMPORT
   pf ("\n");
   pf ("/* Define some additional CPP macros on Win32 platforms. */\n");
diff --git a/libguile/ports.c b/libguile/ports.c
index 248e0a4..1b7c9a5 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -222,15 +222,14 @@ scm_set_port_close (scm_t_bits tc, int (*close) (SCM))
 }
 
 void
-scm_set_port_seek (scm_t_bits tc, off_t (*seek) (SCM port,
-					   off_t OFFSET,
-					   int WHENCE))
+scm_set_port_seek (scm_t_bits tc,
+		   scm_t_off (*seek) (SCM, scm_t_off, int))
 {
   scm_ptobs[SCM_TC2PTOBNUM (tc)].seek = seek;
 }
 
 void
-scm_set_port_truncate (scm_t_bits tc, void (*truncate) (SCM port, off_t length))
+scm_set_port_truncate (scm_t_bits tc, void (*truncate) (SCM, scm_t_off))
 {
   scm_ptobs[SCM_TC2PTOBNUM (tc)].truncate = truncate;
 }
diff --git a/libguile/ports.h b/libguile/ports.h
index 64a0a89..48ed770 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -29,8 +29,6 @@
 #include "libguile/struct.h"
 #include "libguile/threads.h"
 
-/* Not sure if this is a good idea.  We need it for off_t.  */
-#include <sys/types.h>
 
 \f
 
@@ -70,7 +68,7 @@ typedef struct
   unsigned char *read_buf;	/* buffer start.  */
   const unsigned char *read_pos;/* the next unread char.  */
   unsigned char *read_end;      /* pointer to last buffered char + 1.  */
-  off_t read_buf_size;		/* size of the buffer.  */
+  scm_t_off read_buf_size;		/* size of the buffer.  */
 
   /* when chars are put back into the buffer, e.g., using peek-char or
      unread-string, the read-buffer pointers are switched to cbuf.
@@ -79,7 +77,7 @@ typedef struct
   unsigned char *saved_read_buf;
   const unsigned char *saved_read_pos;
   unsigned char *saved_read_end;
-  off_t saved_read_buf_size;
+  scm_t_off saved_read_buf_size;
 
   /* write requests are saved into this buffer at write_pos until it
      reaches write_buf + write_buf_size, then the ptob flush is
@@ -88,7 +86,7 @@ typedef struct
   unsigned char *write_buf;     /* buffer start.  */
   unsigned char *write_pos;     /* pointer to last buffered char + 1.  */
   unsigned char *write_end;     /* pointer to end of buffer + 1.  */
-  off_t write_buf_size;		/* size of the buffer.  */
+  scm_t_off write_buf_size;		/* size of the buffer.  */
 
   unsigned char shortbuf;       /* buffer for "unbuffered" streams.  */
 
@@ -185,8 +183,8 @@ typedef struct scm_t_ptob_descriptor
   int (*fill_input) (SCM port);
   int (*input_waiting) (SCM port);
 
-  off_t (*seek) (SCM port, off_t OFFSET, int WHENCE);
-  void (*truncate) (SCM port, off_t length);
+  scm_t_off (*seek) (SCM port, scm_t_off OFFSET, int WHENCE);
+  void (*truncate) (SCM port, scm_t_off length);
 
 } scm_t_ptob_descriptor;
 
@@ -224,12 +222,12 @@ SCM_API void scm_set_port_end_input (scm_t_bits tc,
 				     void (*end_input) (SCM port,
 							int offset));
 SCM_API void scm_set_port_seek (scm_t_bits tc,
-				off_t (*seek) (SCM port,
-					       off_t OFFSET,
+				scm_t_off (*seek) (SCM port,
+					       scm_t_off OFFSET,
 					       int WHENCE));
 SCM_API void scm_set_port_truncate (scm_t_bits tc,
 				    void (*truncate) (SCM port,
-						      off_t length));
+						      scm_t_off length));
 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);
 size_t scm_take_from_input_buffers (SCM port, char *dest, size_t read_len);
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index d77c214..4b6a251 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -125,8 +125,8 @@ bip_fill_input (SCM port)
   return result;
 }
 
-static off_t
-bip_seek (SCM port, off_t offset, int whence)
+static scm_t_off
+bip_seek (SCM port, scm_t_off offset, int whence)
 #define FUNC_NAME "bip_seek"
 {
   off_t c_result = 0;
@@ -217,8 +217,8 @@ cbp_mark (SCM port)
     return SCM_BOOL_F;
 }
 
-static off_t
-cbp_seek (SCM port, off_t offset, int whence)
+static scm_t_off
+cbp_seek (SCM port, scm_t_off offset, int whence)
 #define FUNC_NAME "cbp_seek"
 {
   SCM result;
@@ -885,8 +885,8 @@ bop_write (SCM port, const void *data, size_t size)
   buf->len = (buf->len > buf->pos) ? buf->len : buf->pos;
 }
 
-static off_t
-bop_seek (SCM port, off_t offset, int whence)
+static scm_t_off
+bop_seek (SCM port, scm_t_off offset, int whence)
 #define FUNC_NAME "bop_seek"
 {
   scm_t_bop_buffer *buf;
diff --git a/libguile/strports.c b/libguile/strports.c
index 3f8a22e..4f816f2 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2005, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2005, 2006, 2009 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -199,8 +199,8 @@ st_end_input (SCM port, int offset)
   pt->rw_active = SCM_PORT_NEITHER;
 }
 
-static off_t
-st_seek (SCM port, off_t offset, int whence)
+static scm_t_off
+st_seek (SCM port, scm_t_off offset, int whence)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
   off_t target;
@@ -272,7 +272,7 @@ st_seek (SCM port, off_t offset, int whence)
 }
 
 static void
-st_truncate (SCM port, off_t length)
+st_truncate (SCM port, scm_t_off length)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
 

Re: guile 1.9.0 scm_read_hash_extend gc trouble

[Neil Jerram]

ludo@gnu.org (Ludovic Courtès) writes:

> The attached patch adds a new `scm_t_off' type, whose definition does
> not depend on the application's `_FILE_OFFSET_BITS' value.  Can you
> confirm that it allows you to build Guile with 32-bit offsets and Snd
> with 64-bit offsets (or vice versa)?
>
> Neil: Does this sound like the right approach?

Yes, this looks great.  (In case it makes a difference, I've reviewed
the master commit, not the patch that you put in email.)

Also I think it means that we can delete some code that was needed to
handle the possibility that off_t might be 32-bit on a platform that
also supports large files.

- In scm_seek (), the "if (SCM_OPFPORTP (fd_port))" block is now not
  needed, because the following more general "if (SCM_OPPORTP
  (fd_port))" case will handle 64-bit correctly.

- Therefore scm_i_fport_seek () can be removed.

- The "#if GUILE_USE_64_CALLS && HAVE_STAT64 && SIZEOF_OFF_T !=
  SIZEOF_OFF64_T" implementation of fport_seek () can be removed,
  because fport_seek () is now always identical to
  fport_seek_or_seek64 ().

- Plus the same things again but for "truncate" instead of "seek".

Would you agree?

Regards,
        Neil

Re: guile 1.9.0 scm_read_hash_extend gc trouble

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 1830 bytes --]

Hi,

Neil Jerram <neil@ossau.uklinux.net> writes:

> ludo@gnu.org (Ludovic Courtès) writes:
>
>> The attached patch adds a new `scm_t_off' type, whose definition does
>> not depend on the application's `_FILE_OFFSET_BITS' value.  Can you
>> confirm that it allows you to build Guile with 32-bit offsets and Snd
>> with 64-bit offsets (or vice versa)?
>>
>> Neil: Does this sound like the right approach?
>
> Yes, this looks great.  (In case it makes a difference, I've reviewed
> the master commit, not the patch that you put in email.)

Perfect, thank you!

> Also I think it means that we can delete some code that was needed to
> handle the possibility that off_t might be 32-bit on a platform that
> also supports large files.
>
> - In scm_seek (), the "if (SCM_OPFPORTP (fd_port))" block is now not
>   needed, because the following more general "if (SCM_OPPORTP
>   (fd_port))" case will handle 64-bit correctly.
>
> - Therefore scm_i_fport_seek () can be removed.
>
> - The "#if GUILE_USE_64_CALLS && HAVE_STAT64 && SIZEOF_OFF_T !=
>   SIZEOF_OFF64_T" implementation of fport_seek () can be removed,
>   because fport_seek () is now always identical to
>   fport_seek_or_seek64 ().
>
> - Plus the same things again but for "truncate" instead of "seek".

Also:

 - `scm_t_off' and `off_t_or_off64_t' are now identical, so the latter
   could be removed.

> Would you agree?

Yes.  What do you think of the attached patch?

On my GNU/Linux machine where 64-bit offsets are used, I see this:

--8<---------------cut here---------------start------------->8---
scheme@(guile-user)> (open-input-file "/dev/zero")
$1 = #<input: /dev/zero 70>
scheme@(guile-user)> (seek $1 (expt 2 33) SEEK_SET)
$2 = 0
--8<---------------cut here---------------end--------------->8---

I can't think of a better test case, though.

Thanks,
Ludo'.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: The patch --]
[-- Type: text/x-patch, Size: 4032 bytes --]

diff --git a/libguile/fports.c b/libguile/fports.c
index f6e0556..cfb8b25 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -610,8 +610,8 @@ fport_fill_input (SCM port)
     }
 }
 
-static off_t_or_off64_t
-fport_seek_or_seek64 (SCM port, off_t_or_off64_t offset, int whence)
+static scm_t_off
+fport_seek (SCM port, scm_t_off offset, int whence)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
   scm_t_fport *fp = SCM_FSTREAM (port);
@@ -662,39 +662,6 @@ fport_seek_or_seek64 (SCM port, off_t_or_off64_t offset, int whence)
   return result;
 }
 
-/* If we've got largefile and off_t isn't already off64_t then
-   fport_seek_or_seek64 needs a range checking wrapper to be fport_seek in
-   the port descriptor.
-
-   Otherwise if no largefile, or off_t is the same as off64_t (which is the
-   case on NetBSD apparently), then fport_seek_or_seek64 is right to be
-   fport_seek already.  */
-
-#if GUILE_USE_64_CALLS && HAVE_STAT64 && SIZEOF_OFF_T != SIZEOF_OFF64_T
-static scm_t_off
-fport_seek (SCM port, scm_t_off offset, int whence)
-{
-  off64_t rv = fport_seek_or_seek64 (port, (off64_t) offset, whence);
-  if (rv > OFF_T_MAX || rv < OFF_T_MIN)
-    {
-      errno = EOVERFLOW;
-      scm_syserror ("fport_seek");
-    }
-  return (scm_t_off) rv;
-
-}
-#else
-#define fport_seek   fport_seek_or_seek64
-#endif
-
-/* `how' has been validated and is one of SEEK_SET, SEEK_CUR or SEEK_END */
-SCM
-scm_i_fport_seek (SCM port, SCM offset, int how)
-{
-  return scm_from_off_t_or_off64_t
-    (fport_seek_or_seek64 (port, scm_to_off_t_or_off64_t (offset), how));
-}
-
 static void
 fport_truncate (SCM port, scm_t_off length)
 {
@@ -704,13 +671,6 @@ fport_truncate (SCM port, scm_t_off length)
     scm_syserror ("ftruncate");
 }
 
-int
-scm_i_fport_truncate (SCM port, SCM length)
-{
-  scm_t_fport *fp = SCM_FSTREAM (port);
-  return ftruncate_or_ftruncate64 (fp->fdes, scm_to_off_t_or_off64_t (length));
-}
-
 /* helper for fport_write: try to write data, using multiple system
    calls if required.  */
 #define FUNC_NAME "write_all"
diff --git a/libguile/fports.h b/libguile/fports.h
index 2687504..cbef0f8 100644
--- a/libguile/fports.h
+++ b/libguile/fports.h
@@ -3,7 +3,7 @@
 #ifndef SCM_FPORTS_H
 #define SCM_FPORTS_H
 
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -59,8 +59,6 @@ SCM_INTERNAL void scm_init_fports (void);
 /* internal functions */
 
 SCM_INTERNAL SCM scm_i_fdes_to_port (int fdes, long mode_bits, SCM name);
-SCM_INTERNAL int scm_i_fport_truncate (SCM, SCM);
-SCM_INTERNAL SCM scm_i_fport_seek (SCM, SCM, int);
 
 
 #endif  /* SCM_FPORTS_H */
diff --git a/libguile/ports.c b/libguile/ports.c
index 98207b0..627fd3f 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -1390,12 +1390,7 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
   if (how != SEEK_SET && how != SEEK_CUR && how != SEEK_END)
     SCM_OUT_OF_RANGE (3, whence);
 
-  if (SCM_OPFPORTP (fd_port))
-    {
-      /* go direct to fport code to allow 64-bit offsets */
-      return scm_i_fport_seek (fd_port, offset, how);
-    }
-  else if (SCM_OPPORTP (fd_port))
+  if (SCM_OPPORTP (fd_port))
     {
       scm_t_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (fd_port);
       off_t_or_off64_t off = scm_to_off_t_or_off64_t (offset);
@@ -1488,11 +1483,6 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0,
       SCM_SYSCALL (rv = ftruncate_or_ftruncate64 (scm_to_int (object),
                                                   c_length));
     }
-  else if (SCM_OPOUTFPORTP (object))
-    {
-      /* go direct to fport code to allow 64-bit offsets */
-      rv = scm_i_fport_truncate (object, length);
-    }
   else if (SCM_OPOUTPORTP (object))
     {
       off_t_or_off64_t c_length = scm_to_off_t_or_off64_t (length);

Re: guile 1.9.0 scm_read_hash_extend gc trouble

[Ludovic Courtès]

Hi Neil,

ludo@gnu.org (Ludovic Courtès) writes:

> Yes.  What do you think of the attached patch?

For the record, I went ahead and committed it:

  http://git.savannah.gnu.org/cgit/guile.git/commit/?id=0a94eb002eba6539879f2cddf3e45fb25976af8d

Thanks,
Ludo'.

Re: guile 1.9.0 scm_read_hash_extend gc trouble

[Neil Jerram]

ludo@gnu.org (Ludovic Courtès) writes:

> Hi Neil,
>
> ludo@gnu.org (Ludovic Courtès) writes:
>
>> Yes.  What do you think of the attached patch?
>
> For the record, I went ahead and committed it:
>
>   http://git.savannah.gnu.org/cgit/guile.git/commit/?id=0a94eb002eba6539879f2cddf3e45fb25976af8d

Sorry for the delay.  It looks great, anyway.

    Neil

Re: guile 1.9.0 scm_read_hash_extend gc trouble

[Bill Schottstaedt]

> Can you confirm that it allows you to build Guile with 32-bit offsets and Snd
> with 64-bit offsets (or vice versa)?

Yes, I think it is ok.

Re: guile 1.9.0 scm_read_hash_extend gc trouble

[Thien-Thi Nguyen]

() "Bill Schottstaedt" <bil@ccrma.Stanford.EDU>
() Sun, 21 Jun 2009 05:10:09 -0700

   code to implement #|..|# block comment processing triggers either a
   glibc memory complaint or a segfault.

FWIW, below is the implementation from Guile 1.4.1.118 (not yet released).
It handles nesting (per R6RS, i believe) and a weird lookahead case.

thi

_____________________________________________________________
/* Skip #|...|# block comments.  */

static void
skip_hashpipe_block_comment (SCM port)
{
#define FUNC_NAME s_scm_read
  int c;
  bool pipep = false;
  int oline = SCM_LINUM (port);
  int ocol = SCM_COL (port);

  for (;;)
    {
      if (EOF == (c = GETC ()))
      toosoon:
        {
          char buf[149];

          snprintf (buf, 149, "%s\n%s:%d:%d: (starting here)",
                    "unterminated `#| ... |#' comment",
                    c_port_filename (port),
                    1 + oline, ocol - 1);
          BADNESS (0, buf);
        }

      if (pipep && '#' == c)
        return;

      /* Handle nested comments.  */
    retry:
      if ('#' == c)
        {
          if (EOF == (c = GETC ()))
            goto toosoon;
          if ('|' == c)
            {
              skip_hashpipe_block_comment (port);
              pipep = false;
            }
          else
            /* Don't get fooled by ##|...|# (ugh).  */
            goto retry;
        }

      pipep = ('|' == c);
    }
#undef FUNC_NAME
}