Version française
Home     About     Download     Resources     Contact us    
Browse thread
[LONG] misc. patches against ocaml-2.02
[ Home ] [ Index: by date | by threads ]
[ Search: ]

[ Message by date: previous | next ] [ Message in thread: previous | next ] [ Thread: previous | next ]
Date: -- (:)
From: Joerg Czeranski <jc@j...>
Subject: [LONG] misc. patches against ocaml-2.02
Hi.

I ported O'Caml 2.02 to NetBSD/alpha 1.3.3 and OpenBSD/alpha 2.4
and in the process discovered a problem with Digital Unix 4.0D.

1.05 and 1.07 worked on 4.0A, but both 1.07 and 2.02 segfault:
cd stdlib; make COMPILER=../boot/ocamlc all
../boot/ocamlrun ../boot/ocamlc -g -nopervasives -c pervasives.mli
*** Segmentation fault - core dumped

That is the first call of ocamlrun, and it's the same symptom
described for gcc-2.7.2.1 on x86.  I wasn't able to reproduce the
latter with gcc-2.7.2.1 on FreeBSD/x86 or SuSE Linux/x86 BTW.

I'm not sure whether it's a bug in DEC C, as the wording of the
standards isn't very clear regarding setjmp/sigsetjmp/longjmp/siglongjmp.
I'll report it in a DEC newsgroup anyway.
But the patch (making initial_local_roots volatile in interp.c)
shouldn't hurt and makes it quite clear to the compiler that it
can't be optimized away.

The casts in intern.c prevent undefined behavior.  They probably don't
make a difference on most machines, but I patched it anyway while
searching for a bug, and Digital Unix 4.0D's cc.alt warned about
the shifts.

And finally there's another patch that makes LC_CTYPE work on
Digital Unix: LC_CTYPE can't be set to iso8859_1 but must be set
to <language>_<country>.ISO8859-1

patched file           | NetBSD | OpenBSD | Dec Unix | misc.
-----------------------+--------+---------+----------+------
configure              |   X    |    X    |          |
asmrun/alpha.S         |        |    X    |          |
asmcomp/alpha/emit.mlp |   X    |    X    |          |
byterun/interp.c       |        |         |    X     |
byterun/intern.c       |        |         |          |   X
byterun/str.c          |        |         |    X     |

It would be nice if these patches (or something to the same effect)
could make it into the next O'Caml release.

happy Caml'ing
joerch

==================== patches follow ====================
*** configure.orig	Wed Nov 18 19:10:51 1998
--- configure	Sat Apr  3 01:18:52 1999
***************
*** 262,267 ****
--- 262,269 ----
  case "$host" in
    alpha-*-osf*)                 arch=alpha; system=digital;;
    alpha-*-linux*)               arch=alpha; system=linux;;
+   alpha-*-netbsd*)              arch=alpha; system=netbsd;;
+   alpha-*-openbsd*)             arch=alpha; system=openbsd;;
    sparc-*-sunos4.*)             arch=sparc; system=sunos;;
    sparc-*-solaris2.*)           arch=sparc; system=solaris;;
    sparc-*-*bsd*)                arch=sparc; system=bsd;;
***************
*** 311,316 ****
--- 313,320 ----
    alpha,*,digital)  asflags='-O2'; asppflags='-O2 -DSYS_$(SYSTEM)';
                      asppprofflags='-pg -DPROFILING';;
    alpha,*,linux)    aspp='gcc'; asppflags='-c -DSYS_$(SYSTEM)';;
+   alpha,*,netbsd)   aspp='gcc'; asppflags='-c -DSYS_$(SYSTEM)';;
+   alpha,*,openbsd)  aspp='gcc'; asppflags='-c -DSYS_$(SYSTEM)';;
    mips,*,irix)      asflags='-n32 -O2'; asppflags="$asflags";;
    sparc,*,bsd)      aspp='gcc'; asppflags='-c -DSYS_$(SYSTEM)';;
    sparc,*,linux)    aspp='gcc'; asppflags='-c -DSYS_$(SYSTEM)';;
*** asmrun/alpha.S.orig	Sun Feb 14 17:48:23 1999
--- asmrun/alpha.S	Sat Apr  3 01:26:29 1999
***************
*** 422,428 ****
          br      caml_c_call             /* never returns */
          .end    caml_array_bound_error
  
! #ifdef SYS_digital	
          .rdata
  #else
          .section .rodata
--- 422,428 ----
          br      caml_c_call             /* never returns */
          .end    caml_array_bound_error
  
! #if defined(SYS_digital) || defined(SYS_openbsd)
          .rdata
  #else
          .section .rodata
*** asmcomp/alpha/emit.mlp.orig	Thu Nov 12 17:53:07 1998
--- asmcomp/alpha/emit.mlp	Sat Apr  3 01:29:36 1999
***************
*** 272,279 ****
  
  let rdata_section =
    match Config.system with
!     "digital" -> ".rdata"
!   | "linux"   -> ".section .rodata"
    | _         -> assert false
  
  (* Names of various instructions *)
--- 272,279 ----
  
  let rdata_section =
    match Config.system with
!     "digital" | "openbsd" -> ".rdata"
!   | "linux" | "netbsd" -> ".section .rodata"
    | _         -> assert false
  
  (* Names of various instructions *)
***************
*** 714,727 ****
    end;
    `	.end	{emit_symbol fundecl.fun_name}\n`;
    if !bigint_constants <> [] then begin
!     `	.section .rodata\n`;
      `	.align	3\n`;
      List.iter
        (fun (lbl, n) -> `{emit_label lbl}:	.quad	{emit_string(Nativeint.to_hexa_string n)}\n`)
        !bigint_constants
    end;
    if !float_constants <> [] then begin
!     `	.section .rodata\n`;
      `	.align	3\n`;
      List.iter
        (fun (lbl, s) -> `{emit_label lbl}:	.t_floating {emit_string s}\n`)
--- 714,727 ----
    end;
    `	.end	{emit_symbol fundecl.fun_name}\n`;
    if !bigint_constants <> [] then begin
!     `	{emit_string rdata_section}\n`;
      `	.align	3\n`;
      List.iter
        (fun (lbl, n) -> `{emit_label lbl}:	.quad	{emit_string(Nativeint.to_hexa_string n)}\n`)
        !bigint_constants
    end;
    if !float_constants <> [] then begin
!     `	{emit_string rdata_section}\n`;
      `	.align	3\n`;
      List.iter
        (fun (lbl, s) -> `{emit_label lbl}:	.t_floating {emit_string s}\n`)
*** byterun/interp.c.orig	Sun Feb 14 17:48:23 1999
--- byterun/interp.c	Fri Apr  9 02:19:59 1999
***************
*** 170,176 ****
    long extra_args;
    struct longjmp_buffer * initial_external_raise;
    int initial_sp_offset;
!   struct caml__roots_block *initial_local_roots;
    struct longjmp_buffer raise_buf;
    value * modify_dest, modify_newval;
  #ifndef THREADED_CODE
--- 170,178 ----
    long extra_args;
    struct longjmp_buffer * initial_external_raise;
    int initial_sp_offset;
!   /* volatile prevents collapsing initial_local_roots with another
!      local variable; sigsetjmp fools DEC C's liveness analysis */
!   struct caml__roots_block * volatile initial_local_roots;
    struct longjmp_buffer raise_buf;
    value * modify_dest, modify_newval;
  #ifndef THREADED_CODE
*** byterun/intern.c.orig	Mon Oct 26 20:18:00 1998
--- byterun/intern.c	Fri Apr  9 02:21:27 1999
***************
*** 65,82 ****
  #define read8s() Sign_extend(*intern_src++)
  #define read16u() \
    (intern_src += 2, \
!    (intern_src[-2] << 8) + intern_src[-1])
  #define read16s() \
    (intern_src += 2, \
!    (Sign_extend(intern_src[-2]) << 8) + intern_src[-1])
  #define read32u() \
    (intern_src += 4, \
!    (intern_src[-4] << 24) + (intern_src[-3] << 16) + \
!    (intern_src[-2] << 8) + intern_src[-1])
  #define read32s() \
    (intern_src += 4, \
!    (Sign_extend(intern_src[-4]) << 24) + (intern_src[-3] << 16) + \
!    (intern_src[-2] << 8) + intern_src[-1])
  
  #ifdef ARCH_SIXTYFOUR
  static long read64s(void)
--- 65,82 ----
  #define read8s() Sign_extend(*intern_src++)
  #define read16u() \
    (intern_src += 2, \
!    ((unsigned long)intern_src[-2] << 8) + (unsigned long)intern_src[-1])
  #define read16s() \
    (intern_src += 2, \
!    (Sign_extend(intern_src[-2]) << 8) + (long)intern_src[-1])
  #define read32u() \
    (intern_src += 4, \
!    ((unsigned long)intern_src[-4] << 24) + ((unsigned long)intern_src[-3] << 16) + \
!    ((unsigned long)intern_src[-2] << 8) + (unsigned long)intern_src[-1])
  #define read32s() \
    (intern_src += 4, \
!    (Sign_extend(intern_src[-4]) << 24) + ((long)intern_src[-3] << 16) + \
!    ((long)intern_src[-2] << 8) + (long)intern_src[-1])
  
  #ifdef ARCH_SIXTYFOUR
  static long read64s(void)
*** byterun/str.c.orig	Tue Jun 23 18:47:02 1998
--- byterun/str.c	Fri Apr  9 02:32:34 1999
***************
*** 14,19 ****
--- 14,21 ----
  /* Operations on strings */
  
  #include <string.h>
+ #include <ctype.h>
+ #include <locale.h>
  #include "alloc.h"
  #include "fail.h"
  #include "mlvalues.h"
***************
*** 108,127 ****
  value is_printable(value chr) /* ML */
  {
    int c;
-   unsigned char * printable_chars;
  
  #ifdef _WIN32
    printable_chars = printable_chars_iso;
  #else
!   static int iso_charset = -1;
!   if (iso_charset == -1) {
!     char * lc_ctype = (char *) getenv("LC_CTYPE");
!     iso_charset = (lc_ctype != 0 && strcmp(lc_ctype, "iso_8859_1") == 0);
    }
!   printable_chars = iso_charset ? printable_chars_iso : printable_chars_ascii;
! #endif
    c = Int_val(chr);
!   return Val_bool(printable_chars[c >> 3] & (1 << (c & 7)));
  }
  
  value bitvect_test(value bv, value n)       /* ML */
--- 110,134 ----
  value is_printable(value chr) /* ML */
  {
    int c;
  
  #ifdef _WIN32
+   unsigned char * printable_chars;
+ 
    printable_chars = printable_chars_iso;
+   c = Int_val(chr);
+ 
+   return Val_bool(printable_chars[c >> 3] & (1 << (c & 7)));
  #else
!   static int locale_is_set = 0;
! 
!   if (!locale_is_set) {
!     setlocale(LC_CTYPE, "");
!     locale_is_set = 1;
    }
! 
    c = Int_val(chr);
!   return Val_bool(isprint(c));
! #endif
  }
  
  value bitvect_test(value bv, value n)       /* ML */
==================== end of patches ====================