Files ocaml-3.07.orig/asmcomp/hppa/.emit.mlp.swp and ocaml-3.07/asmcomp/hppa/.emit.mlp.swp differ diff -uNr ocaml-3.07.orig/asmcomp/hppa/emit.mlp ocaml-3.07/asmcomp/hppa/emit.mlp --- ocaml-3.07.orig/asmcomp/hppa/emit.mlp 2004-05-05 11:54:21.000000000 -0700 +++ ocaml-3.07/asmcomp/hppa/emit.mlp 2004-05-08 12:10:48.000000000 -0700 @@ -31,13 +31,13 @@ open Linearize open Emitaux -(* Adaptation to HPUX and NextStep *) +(* Adaptation to HPUX, NextStep and Linux *) -let hpux = +(* let hpux = match Config.system with "hpux" -> true | "nextstep" -> false - | _ -> fatal_error "Emit_hppa.hpux" + | _ -> fatal_error "Emit_hppa.hpux" *) (* Tradeoff between code size and code speed *) @@ -66,14 +66,14 @@ (* Output a label *) -let label_prefix = if hpux then "L$" else "L" +let label_prefix = if Config.system = "hpux" || Config.system = "linux" then "L$" else "L" let emit_label lbl = emit_string label_prefix; emit_int lbl (* Output a symbol *) -let symbol_prefix = if hpux then "" else "_" +let symbol_prefix = if Config.system = "hpux" || Config.system = "linux" then "" else "_" let emit_symbol s = emit_string symbol_prefix; Emitaux.emit_symbol '$' s @@ -87,8 +87,8 @@ (* Output low address / high address prefixes *) -let low_prefix = if hpux then "RR'" else "R\`" -let high_prefix = if hpux then "LR'" else "L\`" +let low_prefix = if Config.system = "hpux" || Config.system = "linux" then "RR%" else "R\`" +let high_prefix = if Config.system = "hpux" || Config.system = "linux" then "LR%" else "L\`" let is_immediate n = (n < 16) && (n >= -16) (* 5 bits *) @@ -99,18 +99,18 @@ let emit_nativeint_high n = emit_string high_prefix; emit_nativeint n let emit_symbol_low s = - if hpux - then `RR'{emit_symbol s}-$global$` + if Config.system = "hpux" || Config.system = "linux" + then `RR%{emit_symbol s}-$global$` else `R\`{emit_symbol s}` let load_symbol_high s = - if hpux - then ` addil LR'{emit_symbol s}-$global$, %r27\n` + if Config.system = "hpux" || Config.system = "linux" + then ` addil LR%{emit_symbol s}-$global$, %r27\n` else ` ldil L\`{emit_symbol s}, %r1\n` let load_symbol_offset_high s ofs = - if hpux - then ` addil LR'{emit_symbol s}-$global$+{emit_int ofs}, %r27\n` + if Config.system = "hpux" || Config.system = "linux" + then ` addil LR%{emit_symbol s}-$global$+{emit_int ofs}, %r27\n` else ` ldil L\`{emit_symbol s}+{emit_int ofs}, %r1\n` (* Record imported and defined symbols *) @@ -120,11 +120,11 @@ let called_symbols = ref StringSet.empty let use_symbol s = - if hpux then used_symbols := StringSet.add s !used_symbols + if Config.system = "hpux" || Config.system = "linux" then used_symbols := StringSet.add s !used_symbols let define_symbol s = defined_symbols := StringSet.add s !defined_symbols let call_symbol s = - if hpux then begin + if Config.system = "hpux" || Config.system = "linux" then begin used_symbols := StringSet.add s !used_symbols; called_symbols := StringSet.add s !called_symbols end @@ -270,7 +270,7 @@ Undex NextStep: alignment = log2 of number of bytes *) let emit_align n = - if hpux + if Config.system = "hpux" || Config.system = "linux" then ` .align {emit_int n}\n` else ` .align {emit_int(Misc.log2 n)}\n` @@ -315,10 +315,10 @@ let float_constants = ref ([] : (int * string) list) let emit_float_constant (lbl, cst) = - if hpux then begin + if Config.system = "hpux" then begin ` .space $TEXT$\n`; ` .subspa $LIT$\n` - end else + end else if Config.system = "nextstep" then ` .literal8\n`; emit_align 8; `{emit_label lbl}: .double {emit_string cst}\n` @@ -341,7 +341,7 @@ let emit_stubs () = ` .text\n`; - emit_align 4; + if Config.system = "linux" then emit_align 8 else emit_align 4; Hashtbl.iter emit_stub stub_label_table (* Describe the registers used to pass arguments to a C function *) @@ -363,7 +363,7 @@ (* Output a function call *) let emit_call s retreg = - if hpux then begin + if Config.system = "hpux" || Config.system = "linux" then begin ` bl {emit_symbol s}, {emit_string retreg}\n`; call_symbol s end else @@ -510,11 +510,11 @@ | Lop(Iextcall(s, alloc)) -> if alloc then begin call_symbol s; - if hpux then begin - ` ldil LR'{emit_symbol s}, %r22\n`; + if Config.system = "hpux" || Config.system = "linux" then begin + ` ldil LR%{emit_symbol s}, %r22\n`; describe_call i.arg; emit_call "caml_c_call" "%r2"; - ` ldo RR'{emit_symbol s}(%r22), %r22\n` (* in delay slot *) + ` ldo RR%{emit_symbol s}(%r22), %r22\n` (* in delay slot *) end else begin ` ldil L\`{emit_symbol s}, %r22\n`; emit_call "caml_c_call" "%r2"; @@ -522,7 +522,7 @@ end; record_frame i.live end else begin - if hpux then describe_call i.arg; + if Config.system = "hpux" || Config.system = "linux" then describe_call i.arg; emit_call s "%r2"; fill_delay_slot dslot end @@ -595,7 +595,7 @@ ` ldws,mb -8(%r30), {emit_reg i.res.(0)}\n` | Lop(Iintop Idiv) -> (* Arguments are assumed to be in %r26 and %r25, result in %r29 *) - if hpux then + if Config.system = "hpux" || Config.system = "linux" then ` bl $$divI, %r31\n` else begin ` ldil L\`$$divI, %r1\n`; @@ -604,7 +604,7 @@ fill_delay_slot dslot | Lop(Iintop Imod) -> (* Arguments are assumed to be in %r26 and %r25, result in %r29 *) - if hpux then + if Config.system = "hpux" || Config.system = "linux" then ` bl $$remI, %r31\n` else begin ` ldil L\`$$remI, %r1\n`; @@ -640,13 +640,19 @@ | Lop(Iintop_imm(Idiv, n)) -> let l = Misc.log2 n in ` comclr,>= {emit_reg i.arg.(0)}, %r0, %r1\n`; - ` zdepi -1, 31, {emit_int l}, %r1\n`; + if not (l = 0) then + ` zdepi -1, 31, {emit_int l}, %r1\n` + else + ` xor %r1, %r1, %r1\n`; ` add {emit_reg i.arg.(0)}, %r1, %r1\n`; ` extrs %r1, {emit_int(31-l)}, {emit_int(32-l)}, {emit_reg i.res.(0)}\n` | Lop(Iintop_imm(Imod, n)) -> let l = Misc.log2 n in ` comclr,>= {emit_reg i.arg.(0)}, %r0, %r1\n`; - ` zdepi -1, 31, {emit_int l}, %r1\n`; + if not (l = 0) then + ` zdepi -1, 31, {emit_int l}, %r1\n` + else + ` xor %r1, %r1, %r1\n`; ` add {emit_reg i.arg.(0)}, %r1, %r1\n`; ` depi 0, 31, {emit_int l}, %r1\n`; ` sub {emit_reg i.arg.(0)}, %r1, {emit_reg i.res.(0)}\n` @@ -969,7 +975,7 @@ define_symbol fundecl.fun_name; range_check_trap := 0; let n = frame_size() in - if hpux then begin + if Config.system = "hpux" then begin ` .code\n`; ` .align 4\n`; ` .export {emit_symbol fundecl.fun_name}, entry, priv_lev=3\n`; @@ -980,6 +986,11 @@ else ` .callinfo frame={emit_int n}, no_calls\n`; ` .entry\n` + end else if Config.system = "linux" then begin + ` .text\n`; + ` .align 8\n`; + ` .globl {emit_symbol fundecl.fun_name}\n`; + `{emit_symbol fundecl.fun_name}:\n`; end else begin ` .text\n`; ` .align 2\n`; @@ -994,7 +1005,7 @@ emit_all fundecl.fun_body; if !range_check_trap > 0 then begin `{emit_label !range_check_trap}:\n`; - if hpux then begin + if Config.system = "hpux" || Config.system = "linux" then begin emit_call "caml_array_bound_error" "%r31"; ` nop\n` end else begin @@ -1002,7 +1013,7 @@ ` ble,n {emit_symbol_low "caml_array_bound_error"}(4, %r1)\n` end end; - if hpux then begin + if Config.system = "hpux"then begin ` .exit\n`; ` .procend\n` end; @@ -1012,7 +1023,7 @@ let declare_global s = define_symbol s; - if hpux + if Config.system = "hpux" then ` .export {emit_symbol s}, data\n` else ` .globl {emit_symbol s}\n` @@ -1037,7 +1048,7 @@ | Cdouble f -> ` .double {emit_string f}\n` | Csymbol_address s -> - if hpux && String.length s >= 5 && String.sub s 0 5 = "caml_" then + if Config.system = "hpux" && String.length s >= 5 && String.sub s 0 5 = "caml_" then ` .import {emit_symbol s}, code\n`; ` .long {emit_symbol s}\n` | Clabel_address lbl -> @@ -1046,7 +1057,7 @@ emit_string_directive " .ascii " s | Cskip n -> if n > 0 then - if hpux then ` .block {emit_int n}\n` + if Config.system = "hpux" then ` .block {emit_int n}\n` else ` .space {emit_int n}\n` | Calign n -> emit_align n @@ -1058,7 +1069,7 @@ (* Beginning / end of an assembly file *) let begin_assembly() = - if hpux then begin + if Config.system = "hpux" then begin ` .space $PRIVATE$\n`; ` .subspa $DATA$,quad=1,align=8,access=31\n`; ` .subspa $BSS$,quad=1,align=8,access=31,zero,sort=82\n`; @@ -1075,29 +1086,29 @@ Hashtbl.clear stub_label_table; let lbl_begin = Compilenv.current_unit_name() ^ "__data_begin" in ` .data\n`; - emit_global lbl_begin; + declare_global lbl_begin; `{emit_symbol lbl_begin}:\n`; let lbl_begin = Compilenv.current_unit_name() ^ "__code_begin" in ` .code\n`; - emit_global lbl_begin; + declare_global lbl_begin; `{emit_symbol lbl_begin}:\n` let end_assembly() = - if not hpux then emit_stubs(); + if not ( Config.system = "hpux" ) then emit_stubs(); ` .code\n`; let lbl_end = Compilenv.current_unit_name() ^ "__code_end" in - emit_global lbl_end; + declare_global lbl_end; `{emit_symbol lbl_end}:\n`; ` .data\n`; let lbl_end = Compilenv.current_unit_name() ^ "__data_end" in - emit_global lbl_end; + declare_global lbl_end; `{emit_symbol lbl_end}:\n`; ` .long 0\n`; let lbl = Compilenv.current_unit_name() ^ "__frametable" in - emit_global lbl; + declare_global lbl; `{emit_symbol lbl}:\n`; ` .long {emit_int (List.length !frame_descriptors)}\n`; List.iter emit_frame !frame_descriptors; frame_descriptors := []; - if hpux then emit_imports() + if Config.system = "hpux" then emit_imports() diff -uNr ocaml-3.07.orig/asmcomp/hppa/proc.ml ocaml-3.07/asmcomp/hppa/proc.ml --- ocaml-3.07.orig/asmcomp/hppa/proc.ml 2004-05-05 11:54:21.000000000 -0700 +++ ocaml-3.07/asmcomp/hppa/proc.ml 2004-05-08 11:31:29.000000000 -0700 @@ -217,7 +217,7 @@ (* Calling the assembler *) let assemble_file infile outfile = - Ccomp.command ("gas -o " ^ Filename.quote outfile ^ " " ^ Filename.quote infile) + Ccomp.command ("as -o " ^ Filename.quote outfile ^ " " ^ Filename.quote infile) open Clflags;; open Config;; diff -uNr ocaml-3.07.orig/asmrun/Makefile ocaml-3.07/asmrun/Makefile --- ocaml-3.07.orig/asmrun/Makefile 2004-05-05 11:54:21.000000000 -0700 +++ ocaml-3.07/asmrun/Makefile 2004-05-08 11:31:29.000000000 -0700 @@ -151,10 +151,10 @@ # For HPUX, we can't use gcc as ASPP because it may have been configured with # the vendor's assembler -hppa.o: hppa.S - gcc -traditional -E -DSYS_$(SYSTEM) -o hppa.s hppa.S - gas -o hppa.o hppa.s || { rm -f hppa.s; exit 2; } - rm -f hppa.s +#hppa.o: hppa.S +# gcc -traditional -E -DSYS_$(SYSTEM) -o hppa.s hppa.S +# gas -o hppa.o hppa.s || { rm -f hppa.s; exit 2; } +# rm -f hppa.s .SUFFIXES: .S .d.o .p.o diff -uNr ocaml-3.07.orig/asmrun/hppa.S ocaml-3.07/asmrun/hppa.S --- ocaml-3.07.orig/asmrun/hppa.S 2004-05-05 11:54:21.000000000 -0700 +++ ocaml-3.07/asmrun/hppa.S 2004-05-08 11:31:29.000000000 -0700 @@ -30,6 +30,20 @@ #define LOWLABEL(x) RR%x #endif +#ifdef SYS_linux +#define G(x) x +#define CODESPACE .text +#define CODE_ALIGN 8 +#define EXPORT_CODE(x) .globl x +#define EXPORT_DATA(x) .globl x +#define STARTPROC +#define ENDPROC +#define LOADHIGH(x) addil LR%x-$global$, %r27 +#define LOW(x) RR%x-$global$ +#define LOADHIGHLABEL(x) ldil LR%x, %r1 +#define LOWLABEL(x) RR%x +#endif + #ifdef SYS_nextstep #define G(x) _##x #define CODESPACE .text @@ -69,6 +83,18 @@ caml_required_size .comm 8 #endif + +#ifdef SYS_linux + .align 8 + .comm G(young_limit), 4 + .comm G(young_ptr), 4 + .comm G(caml_bottom_of_stack), 4 + .comm G(caml_last_return_address), 4 + .comm G(caml_gc_regs), 4 + .comm G(caml_exception_pointer), 4 + .comm G(caml_required_size), 4 +#endif + #ifdef SYS_nextstep .comm G(young_limit), 8 .comm G(young_ptr), 8 @@ -529,7 +555,7 @@ G(caml_array_bound_error): STARTPROC ; Load address of array_bound_error in %r22 -#ifdef SYS_hpux +#if defined(SYS_hpux) || defined(SYS_linux) ldil LR%array_bound_error, %r22 ldo RR%array_bound_error(%r22), %r22 #else diff -uNr ocaml-3.07.orig/byterun/config.h ocaml-3.07/byterun/config.h --- ocaml-3.07.orig/byterun/config.h 2004-05-05 11:54:21.000000000 -0700 +++ ocaml-3.07/byterun/config.h 2004-05-08 11:31:29.000000000 -0700 @@ -50,7 +50,7 @@ typedef ARCH_INT64_TYPE int64; typedef ARCH_UINT64_TYPE uint64; #else -# if ARCH_BIG_ENDIAN +# if defined(ARCH_BIG_ENDIAN) typedef struct { uint32 h, l; } uint64, int64; # else typedef struct { uint32 l, h; } uint64, int64; diff -uNr ocaml-3.07.orig/configure ocaml-3.07/configure --- ocaml-3.07.orig/configure 2004-05-05 11:54:21.000000000 -0700 +++ ocaml-3.07/configure 2004-05-08 11:31:29.000000000 -0700 @@ -401,7 +401,7 @@ # Determine alignment constraints case "$host" in - sparc-*-*) + sparc-*-*|hppa*-*-*) # On Sparc V9 with certain versions of gcc, determination of double # alignment is not reliable (PR#1521), hence force it echo "Doubles must be doubleword-aligned." @@ -421,22 +421,28 @@ esac;; esac -if $int64_native; then - sh ./runtest int64align.c - case $? in - 0) echo "64-bit integers can be word-aligned." - echo "#undef ARCH_ALIGN_INT64" >> m.h;; - 1) echo "64-bit integers must be doubleword-aligned." - echo "#define ARCH_ALIGN_INT64" >> m.h;; - *) echo "Something went wrong during alignment determination for 64-bit integers." - echo "I'm going to assume this architecture has alignment constraints." - echo "That's a safe bet: Objective Caml will work even if" - echo "this architecture has actually no alignment constraints." - echo "#define ARCH_ALIGN_INT64" >> m.h;; - esac -else - echo "#undef ARCH_ALIGN_INT64" >> m.h -fi +case "$host" in + hppa*-*-*) + echo "64-bit integers must be doubleword-aligned." + echo "#define ARCH_ALIGN_INT64" >> m.h;; + *) + if $int64_native; then + sh ./runtest int64align.c + case $? in + 0) echo "64-bit integers can be word-aligned." + echo "#undef ARCH_ALIGN_INT64" >> m.h;; + 1) echo "64-bit integers must be doubleword-aligned." + echo "#define ARCH_ALIGN_INT64" >> m.h;; + *) echo "Something went wrong during alignment determination for 64-bit integers." + echo "I'm going to assume this architecture has alignment constraints." + echo "That's a safe bet: Objective Caml will work even if" + echo "this architecture has actually no alignment constraints." + echo "#define ARCH_ALIGN_INT64" >> m.h;; + esac + else + echo "#undef ARCH_ALIGN_INT64" >> m.h + fi +esac # Check semantics of division and modulus @@ -541,6 +547,7 @@ sparc*-*-solaris2.*) arch=sparc; system=solaris;; sparc*-*-*bsd*) arch=sparc; system=bsd;; sparc*-*-linux*) arch=sparc; system=linux;; + hppa*-*-linux*) arch=hppa; system=linux;; i[3456]86-*-linux*) arch=i386; system=linux_`sh ./runtest elf.c`;; i[3456]86-*-*bsd*) arch=i386; system=bsd_`sh ./runtest elf.c`;; i[3456]86-*-nextstep*) arch=i386; system=nextstep;;