Index: VERSION =================================================================== --- VERSION (.../vendor/ocaml/4.00.0) (revision 78) +++ VERSION (.../trunk/ocamlxarm/3.1) (revision 78) @@ -1,4 +1,4 @@ -4.00.0 +4.00.0+xarm-3.1.7-v7 # The version string is the first line of this file. # It must be in the format described in stdlib/sys.mli Index: asmcomp/schedgen.ml =================================================================== --- asmcomp/schedgen.ml (.../vendor/ocaml/4.00.0) (revision 78) +++ asmcomp/schedgen.ml (.../trunk/ocamlxarm/3.1) (revision 78) @@ -10,11 +10,10 @@ (* *) (***********************************************************************) -(* $Id: schedgen.ml 12179 2012-02-21 17:41:02Z xleroy $ *) +(* $Id$ *) (* Instruction scheduling *) -open Misc open Reg open Mach open Linearize @@ -65,6 +64,33 @@ let add_edge_after son ancestor = add_edge ancestor son 0 +(* Add edges from all instructions that define a pseudoregister [arg] being used + as argument to node [node] (RAW dependencies *) + +let add_RAW_dependencies node arg = + try + let ancestor = Hashtbl.find code_results arg.loc in + add_edge ancestor node ancestor.delay + with Not_found -> + () + +(* Add edges from all instructions that use a pseudoregister [res] that is + defined by node [node] (WAR dependencies). *) + +let add_WAR_dependencies node res = + let ancestors = Hashtbl.find_all code_uses res.loc in + List.iter (add_edge_after node) ancestors + +(* Add edges from all instructions that have already defined a pseudoregister + [res] that is defined by node [node] (WAW dependencies). *) + +let add_WAW_dependencies node res = + try + let ancestor = Hashtbl.find code_results res.loc in + add_edge ancestor node 0 + with Not_found -> + () + (* Compute length of longest path to a result. For leafs of the DAG, see whether their result is used in the instruction immediately following the basic block (a "critical" output). *) @@ -200,10 +226,19 @@ | Lreloadretaddr -> self#reload_retaddr_issue_cycles | _ -> assert false +(* Pseudoregisters destroyed by an instruction *) + +method private destroyed_by_instr instr = + match instr.desc with + | Lop op -> Proc.destroyed_at_oper (Iop op) + | Lreloadretaddr -> [||] + | _ -> assert false + (* Add an instruction to the code dag *) method private add_instruction ready_queue instr = let delay = self#instr_latency instr in + let destroyed = self#destroyed_by_instr instr in let node = { instr = instr; delay = delay; @@ -214,28 +249,17 @@ emitted_ancestors = 0 } in (* Add edges from all instructions that define one of the registers used (RAW dependencies) *) - for i = 0 to Array.length instr.arg - 1 do - try - let ancestor = Hashtbl.find code_results instr.arg.(i).loc in - add_edge ancestor node ancestor.delay - with Not_found -> - () - done; + Array.iter (add_RAW_dependencies node) instr.arg; (* Also add edges from all instructions that use one of the result regs - of this instruction (WAR dependencies). *) - for i = 0 to Array.length instr.res - 1 do - let ancestors = Hashtbl.find_all code_uses instr.res.(i).loc in - List.iter (add_edge_after node) ancestors - done; + of this instruction, or a reg destroyed by this instruction + (WAR dependencies). *) + Array.iter (add_WAR_dependencies node) instr.res; + Array.iter (add_WAR_dependencies node) destroyed; (* PR#5731 *) (* Also add edges from all instructions that have already defined one - of the results of this instruction (WAW dependencies). *) - for i = 0 to Array.length instr.res - 1 do - try - let ancestor = Hashtbl.find code_results instr.res.(i).loc in - add_edge ancestor node 0 - with Not_found -> - () - done; + of the results of this instruction, or a reg destroyed by + this instruction (WAW dependencies). *) + Array.iter (add_WAW_dependencies node) instr.res; + Array.iter (add_WAW_dependencies node) destroyed; (* PR#5731 *) (* If this is a load, add edges from the most recent store viewed so far (if any) and remember the load. Also add edges from the most recent checkbound and forget that checkbound. *) @@ -264,6 +288,9 @@ for i = 0 to Array.length instr.res - 1 do Hashtbl.add code_results instr.res.(i).loc node done; + for i = 0 to Array.length destroyed - 1 do + Hashtbl.add code_results destroyed.(i).loc node (* PR#5731 *) + done; for i = 0 to Array.length instr.arg - 1 do Hashtbl.add code_uses instr.arg.(i).loc node done; Index: asmcomp/arm/arch.ml =================================================================== --- asmcomp/arm/arch.ml (.../vendor/ocaml/4.00.0) (revision 78) +++ asmcomp/arm/arch.ml (.../trunk/ocamlxarm/3.1) (revision 78) @@ -26,6 +26,7 @@ match Config.system with "linux_eabi" -> EABI | "linux_eabihf" -> EABI_VFP + | "macosx" -> EABI_VFP | _ -> assert false let string_of_arch = function @@ -45,15 +46,26 @@ let (arch, fpu, thumb) = let (def_arch, def_fpu, def_thumb) = - begin match abi, Config.model with + begin match abi, Config.system, Config.model with (* Defaults for architecture, FPU and Thumb *) - EABI, "armv5" -> ARMv5, Soft, false - | EABI, "armv5te" -> ARMv5TE, Soft, false - | EABI, "armv6" -> ARMv6, Soft, false - | EABI, "armv6t2" -> ARMv6T2, Soft, false - | EABI, "armv7" -> ARMv7, Soft, false - | EABI, _ -> ARMv4, Soft, false - | EABI_VFP, _ -> ARMv7, VFPv3_D16, true + EABI, ("linux_eabi"|"linux_eabihf"), "armv5" -> + ARMv5, Soft, false + | EABI, ("linux_eabi"|"linux_eabihf"), "armv5te" -> + ARMv5TE, Soft, false + | EABI, ("linux_eabi"|"linux_eabihf"), "armv6" -> + ARMv6, Soft, false + | EABI, ("linux_eabi"|"linux_eabihf"), "armv6t2" -> + ARMv6T2, Soft, false + | EABI, ("linux_eabi"|"linux_eabihf"), "armv7" -> + ARMv7, Soft, false + | EABI_VFP, "macosx", "armv6" -> + ARMv6, VFPv3_D16, false (* Really VFPv2 *) + | EABI_VFP, "macosx", "armv7" -> + ARMv7, VFPv3, true + | EABI, _, _ -> + ARMv4, Soft, false + | EABI_VFP, _, _ -> + ARMv7, VFPv3_D16, true end in (ref def_arch, ref def_fpu, ref def_thumb) Index: asmcomp/arm/emit.mlp =================================================================== --- asmcomp/arm/emit.mlp (.../vendor/ocaml/4.00.0) (revision 78) +++ asmcomp/arm/emit.mlp (.../trunk/ocamlxarm/3.1) (revision 78) @@ -32,23 +32,38 @@ (* Output a label *) let emit_label lbl = - emit_string ".L"; emit_int lbl + let prefix = if Config.system = "macosx" then "L" else ".L" in + emit_string prefix; emit_int lbl let emit_data_label lbl = - emit_string ".Ld"; emit_int lbl + let prefix = if Config.system = "macosx" then "Ld" else ".Ld" in + emit_string prefix; emit_int lbl (* Symbols *) +let symbol_prefix = + match Config.system with + "linux_eabi" | "linux_eabihf" -> "" + | _ -> "_" + let emit_symbol s = - Emitaux.emit_symbol '$' s + emit_string symbol_prefix; Emitaux.emit_symbol '$' s let emit_call s = - if !Clflags.dlcode || !pic_code + let plt = + match Config.system with + "macosx" -> false + | _ -> !Clflags.dlcode || !pic_code in + if plt then `bl {emit_symbol s}(PLT)` else `bl {emit_symbol s}` let emit_jump s = - if !Clflags.dlcode || !pic_code + let plt = + match Config.system with + "linux_eabi" | "linux_eabihf" -> !Clflags.dlcode || !pic_code + | _ -> false in + if plt then `b {emit_symbol s}(PLT)` else `b {emit_symbol s}` @@ -58,6 +73,13 @@ {loc = Reg r} -> emit_string (register_name r) | _ -> fatal_error "Emit_arm.emit_reg" +(* Output the next register after the given pseudo-register *) + +let emit_next_reg r = + match r.loc with + Reg r -> emit_string (register_name(r + 1)) + | _ -> fatal_error "Emit_arm.emit_next_reg" + (* Layout of the stack frame *) let stack_offset = ref 0 @@ -371,7 +393,13 @@ let src = i.arg.(0) and dst = i.res.(0) in if src.loc = dst.loc then 0 else begin begin match (src, dst) with - {loc = Reg _; typ = Float}, {loc = Reg _} -> + {loc = Reg _; typ = Float}, {loc = Reg _; typ = Int|Addr} + when Config.system = "macosx" -> + ` vmov {emit_reg dst}, {emit_next_reg dst}, {emit_reg src}\n` + | {loc = Reg _; typ = Int|Addr}, {loc = Reg _; typ = Float} + when Config.system = "macosx" -> + ` vmov {emit_reg dst}, {emit_reg src}, {emit_next_reg src}\n` + | {loc = Reg _; typ = Float}, {loc = Reg _} -> ` fcpyd {emit_reg dst}, {emit_reg src}\n` | {loc = Reg _}, {loc = Reg _} -> ` mov {emit_reg dst}, {emit_reg src}\n` @@ -750,8 +778,25 @@ (* The Thumb-2 TBH instruction supports only forward branches, so we need to generate appropriate trampolines for all labels that appear before this switch instruction (PR#5623) *) + (* Apple's assembler mishandles (or disagrees about) the + * following: + * + * .short (Lnnn-.)/2+0 + * .short (Lmmm-.)/2+1 + * ... + * I'm replacing it with the following, which should work for + * Apple and Linux (I hope): + * + * Lbbb: + * .short (Lnnn-Lbbb)/2 + * .short (Lmmm-Lbbb)/2 + * ... + * + * JAS Tue Jul 24 08:33:49 PDT 2012 *) let tramtbl = Array.copy jumptbl in + let base = new_label() in ` tbh [pc, {emit_reg i.arg.(0)}, lsl #1]\n`; + `{emit_label base}:\n`; for j = 0 to Array.length tramtbl - 1 do let rec label i = match i.desc with @@ -759,7 +804,7 @@ | Llabel lbl when lbl = tramtbl.(j) -> lbl | _ -> label i.next in tramtbl.(j) <- label i.next; - ` .short ({emit_label tramtbl.(j)}-.)/2+{emit_int j}\n` + ` .short ({emit_label tramtbl.(j)}-{emit_label base})/2\n` done; (* Generate the necessary trampolines *) for j = 0 to Array.length tramtbl - 1 do @@ -849,11 +894,17 @@ ` .text\n`; ` .align 2\n`; ` .globl {emit_symbol fundecl.fun_name}\n`; - if !arch > ARMv6 && !thumb then - ` .thumb\n` - else + if !arch > ARMv6 && !thumb then begin + ` .thumb\n`; + if Config.system = "macosx" then + ` .thumb_func {emit_symbol fundecl.fun_name}\n` + else + ` .type {emit_symbol fundecl.fun_name}, %function\n`; + end else begin ` .arm\n`; - ` .type {emit_symbol fundecl.fun_name}, %function\n`; + if Config.system <> "macosx" then + ` .type {emit_symbol fundecl.fun_name}, %function\n`; + end; `{emit_symbol fundecl.fun_name}:\n`; emit_debug_info fundecl.fun_dbg; cfi_startproc(); @@ -870,8 +921,10 @@ List.iter emit_call_gc !call_gc_sites; List.iter emit_call_bound_error !bound_error_sites; cfi_endproc(); - ` .type {emit_symbol fundecl.fun_name}, %function\n`; - ` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n` + if Config.system <> "macosx" then begin + ` .type {emit_symbol fundecl.fun_name}, %function\n`; + ` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n` + end (* Emission of data *) @@ -900,19 +953,28 @@ let begin_assembly() = reset_debug_info(); ` .syntax unified\n`; - begin match !arch with - | ARMv4 -> ` .arch armv4t\n` - | ARMv5 -> ` .arch armv5t\n` - | ARMv5TE -> ` .arch armv5te\n` - | ARMv6 -> ` .arch armv6\n` - | ARMv6T2 -> ` .arch armv6t2\n` - | ARMv7 -> ` .arch armv7-a\n` - end; - begin match !fpu with - Soft -> ` .fpu softvfp\n` - | VFPv3_D16 -> ` .fpu vfpv3-d16\n` - | VFPv3 -> ` .fpu vfpv3\n` - end; + let arch_pseud_str = + match Config.system, !arch with + | "macosx", ARMv4 -> ".machine armv4t" + | "macosx", ARMv5 -> ".machine armv5" + | "macosx", ARMv5TE -> ".machine armv5" + | "macosx", ARMv6 -> ".machine armv6" + | "macosx", ARMv6T2 -> ".machine armv6" + | "macosx", ARMv7 -> ".machine armv7" + | _, ARMv4 -> ".arch armv4t" + | _, ARMv5 -> ".arch armv5t" + | _, ARMv5TE -> ".arch armv5te" + | _, ARMv6 -> ".arch armv6" + | _, ARMv6T2 -> ".arch armv6t2" + | _, ARMv7 -> ".arch armv7-a" + in + ` {emit_string arch_pseud_str}\n`; + if Config.system <> "macosx" then + begin match !fpu with + Soft -> ` .fpu softvfp\n` + | VFPv3_D16 -> ` .fpu vfpv3-d16\n` + | VFPv3 -> ` .fpu vfpv3\n` + end; `trap_ptr .req r8\n`; `alloc_ptr .req r10\n`; `alloc_limit .req r11\n`; @@ -923,12 +985,18 @@ let lbl_begin = Compilenv.make_symbol (Some "code_begin") in ` .text\n`; ` .globl {emit_symbol lbl_begin}\n`; + if Config.system = "macosx" && !thumb then + ` .thumb_func {emit_symbol lbl_begin}\n` + else (); `{emit_symbol lbl_begin}:\n` let end_assembly () = let lbl_end = Compilenv.make_symbol (Some "code_end") in ` .text\n`; ` .globl {emit_symbol lbl_end}\n`; + if Config.system = "macosx" && !thumb then + ` .thumb_func {emit_symbol lbl_end}\n` + else (); `{emit_symbol lbl_end}:\n`; let lbl_end = Compilenv.make_symbol (Some "data_end") in ` .data\n`; @@ -938,20 +1006,38 @@ let lbl = Compilenv.make_symbol (Some "frametable") in ` .globl {emit_symbol lbl}\n`; `{emit_symbol lbl}:\n`; + let efa_label lbl = begin + if Config.system = "macosx" then begin + if !thumb then + ` .thumb_func {emit_label lbl}\n` + end else begin + ` .type {emit_label lbl}, %function\n` + end; + ` .word {emit_label lbl}\n`; + end in + let efa_label_rel = + if Config.system = "macosx" then + let sylab1 = new_label () in + let sylab2 = ref 99 in + (fun lbl ofs -> + incr sylab2; + `Lofs_{emit_int sylab1}_{emit_int !sylab2} = {emit_label lbl} - . + {emit_int32 ofs}\n`; + ` .word Lofs_{emit_int sylab1}_{emit_int !sylab2}\n`) + else + (fun lbl ofs -> ` .word {emit_label lbl} - . + {emit_int32 ofs}\n`) in emit_frames - { efa_label = (fun lbl -> - ` .type {emit_label lbl}, %function\n`; - ` .word {emit_label lbl}\n`); + { efa_label; efa_16 = (fun n -> ` .short {emit_int n}\n`); efa_32 = (fun n -> ` .long {emit_int32 n}\n`); efa_word = (fun n -> ` .word {emit_int n}\n`); efa_align = (fun n -> ` .align {emit_int(Misc.log2 n)}\n`); - efa_label_rel = (fun lbl ofs -> - ` .word {emit_label lbl} - . + {emit_int32 ofs}\n`); + efa_label_rel; efa_def_label = (fun lbl -> `{emit_label lbl}:\n`); efa_string = (fun s -> emit_string_directive " .asciz " s) }; - ` .type {emit_symbol lbl}, %object\n`; - ` .size {emit_symbol lbl}, .-{emit_symbol lbl}\n`; + if Config.system <> "macosx" then begin + ` .type {emit_symbol lbl}, %object\n`; + ` .size {emit_symbol lbl}, .-{emit_symbol lbl}\n`; + end; begin match Config.system with "linux_eabihf" | "linux_eabi" -> (* Mark stack as non-executable *) Index: asmcomp/arm/proc.ml =================================================================== --- asmcomp/arm/proc.ml (.../vendor/ocaml/4.00.0) (revision 78) +++ asmcomp/arm/proc.ml (.../trunk/ocamlxarm/3.1) (revision 78) @@ -137,6 +137,40 @@ done; (loc, Misc.align !ofs 8) (* keep stack 8-aligned *) +let calling_conventions_intreg first_int last_int make_stack arg = + (* The same as calling_conventions, except that floats are passed in + * pairs of int registers. These are the conventions of iOS. To + * avoid making too many changes, the value is represented as a + * single register (the smaller one). Functions in emit.mlp can tell + * what to do by observing the type. + *) + let loc = Array.create (Array.length arg) Reg.dummy in + let int = ref first_int in + let ofs = ref 0 in + for i = 0 to Array.length arg - 1 do + match arg.(i).typ with + Int | Addr as ty -> + if !int <= last_int then begin + loc.(i) <- phys_reg !int; + incr int + end else begin + loc.(i) <- stack_slot (make_stack !ofs) ty; + ofs := !ofs + size_int + end + | Float -> + assert (abi = EABI_VFP); + assert (!fpu >= VFPv3_D16); + if !int <= last_int - 1 then begin + loc.(i) <- phys_reg !int; + int := !int + 2 + end else begin + ofs := Misc.align !ofs size_float; + loc.(i) <- stack_slot (make_stack !ofs) Float; + ofs := !ofs + size_float + end + done; + (loc, Misc.align !ofs 8) (* keep stack 8-aligned *) + let incoming ofs = Incoming ofs let outgoing ofs = Outgoing ofs let not_supported ofs = fatal_error "Proc.loc_results: cannot call" @@ -154,16 +188,37 @@ let loc_results res = let (loc, _) = calling_conventions 0 7 100 115 not_supported res in loc -(* C calling convention: +(* C calling convention for Linux: first integer args in r0...r3 first float args in d0...d7 (EABI+VFP) remaining args on stack. - Return values in r0...r1 or d0. *) + Return values in r0...r1 or d0 + C calling convention for iOS: + first integer args in r0...r3 + first float args in pairs of regs r0/r1, r1/r2, or r2/r3 + remaining args on stack. + Return values in r0 or r0/r1 for floats. *) + let loc_external_arguments arg = - calling_conventions 0 3 100 107 outgoing arg + if Config.system = "macosx" then + calling_conventions_intreg 0 3 outgoing arg + else + calling_conventions 0 3 100 107 outgoing arg + let loc_external_results res = - let (loc, _) = calling_conventions 0 1 100 100 not_supported res in loc + if Config.system = "macosx" then + let (loc, _) = calling_conventions_intreg 0 1 not_supported res in + if Array.length res < 1 || res.(0).typ <> Float then loc + else + (* If the result is Float, mark as a register pair by changing the + * register name. Code in selection.ml knows to look for it. + * This is hacky but lots of the code seems to depend on the + * result being a single register. + *) + [| { loc.(0) with name = loc.(0).name ^ "+" } |] + else + let (loc, _) = calling_conventions 0 1 100 100 not_supported res in loc let loc_exn_bucket = phys_reg 0 Index: asmcomp/arm/selection.ml =================================================================== --- asmcomp/arm/selection.ml (.../vendor/ocaml/4.00.0) (revision 78) +++ asmcomp/arm/selection.ml (.../trunk/ocamlxarm/3.1) (revision 78) @@ -264,6 +264,57 @@ with Use_default -> super#insert_op_debug op dbg rs rd +(* Here we handle floating returns in iOS, which are in r0/r1 as a pair. + * Proc.loc_external_results can return a fake register that represents + * the pair. We detect it and replace it with two separate registers, + * which allows the liveness analysis to notice that both are in use. + *) +method private loc_external_res_ispair = function + { loc = Reg _; name = name } -> + let l = String.length name in l > 0 && name.[l - 1] = '+' + | _ -> false + + +method insert_debug desc dbg arg res = + (* Here, res.(0) might be a register pair. + *) + let res' = + if Array.length res > 0 && self#loc_external_res_ispair res.(0) then + match res.(0) with + { loc = Reg n } -> [| Proc.phys_reg n; Proc.phys_reg (n + 1) |] + | _ -> res + else res in + super#insert_debug desc dbg arg res' + +method insert_move_args arg loc stacksize = + (* Here we have a register pair as the target if the source is Float + * and the target is a physical register. + *) + if stacksize <> 0 then self#insert (Iop(Istackoffset stacksize)) [||] [||]; + for i = 0 to Array.length arg - 1 do + match arg.(i).typ, loc.(i).loc with + (Float, Reg n) -> + let rpair = [| Proc.phys_reg n; Proc.phys_reg (n + 1) |] in + self#insert (Iop Imove) [|arg.(i)|] rpair + | _ -> + self#insert_move arg.(i) loc.(i) + done + +method insert_move_results loc res stacksize = + (* Here, loc.(0) might be a register pair. + *) + if stacksize <> 0 then + self#insert (Iop(Istackoffset(-stacksize))) [||] [||]; + for i = 0 to Array.length loc - 1 do + if self#loc_external_res_ispair loc.(i) then + match loc.(i) with + { loc = Reg n } -> + let rpair = [| Proc.phys_reg n; Proc.phys_reg (n + 1) |] in + self#insert (Iop Imove) rpair [|res.(i)|] + | _ -> self#insert_move loc.(i) res.(i) + else + self#insert_move loc.(i) res.(i) + done end let fundecl f = (new selector)#emit_fundecl f Index: tools/make-package-macosx =================================================================== --- tools/make-package-macosx (.../vendor/ocaml/4.00.0) (revision 78) +++ tools/make-package-macosx (.../trunk/ocamlxarm/3.1) (revision 78) @@ -17,7 +17,7 @@ cd package-macosx rm -rf ocaml.pkg ocaml-rw.dmg -VERSION=`sed -e 1q ../VERSION` +VERSION=`sed -n -e '1s/-[^-]*$//p' ../VERSION` VERSION_MAJOR=`sed -n -e '1s/^\([0-9]*\)\..*/\1/p' ../VERSION` VERSION_MINOR=`sed -n -e '1s/^[0-9]*\.\([0-9]*\)[.+].*/\1/p' ../VERSION` @@ -46,11 +46,11 @@ CFBundleGetInfoString - OCaml ${VERSION} + OCaml ${VERSION} for iOS CFBundleIdentifier - fr.inria.ocaml + com.psellos.ocamlxarm CFBundleName - OCaml + OCaml for iOS CFBundleShortVersionString ${VERSION} IFMajorVersion @@ -62,7 +62,7 @@ IFPkgFlagAuthorizationAction AdminAuthorization IFPkgFlagDefaultLocation - /usr/local + /usr/local/ocamlxarm IFPkgFlagInstallFat IFPkgFlagIsRequired @@ -85,15 +85,16 @@ # stop here -> | cat >resources/ReadMe.txt < Max_wosize){ Hd_hp (hp) = Make_header (Max_wosize, 0, Caml_blue); #ifdef DEBUG Index: byterun/freelist.c =================================================================== --- byterun/freelist.c (.../vendor/ocaml/4.00.0) (revision 78) +++ byterun/freelist.c (.../trunk/ocamlxarm/3.1) (revision 78) @@ -509,8 +509,11 @@ p: pointer to the first word of the block size: size of the block (in words) do_merge: 1 -> do merge; 0 -> do not merge + color: which color to give to the pieces; if [do_merge] is 1, this + is overridden by the merge code, but we have historically used + [Caml_white]. */ -void caml_make_free_blocks (value *p, mlsize_t size, int do_merge) +void caml_make_free_blocks (value *p, mlsize_t size, int do_merge, int color) { mlsize_t sz; @@ -520,7 +523,7 @@ }else{ sz = size; } - *(header_t *)p = Make_header (Wosize_whsize (sz), 0, Caml_white); + *(header_t *)p = Make_header (Wosize_whsize (sz), 0, color); if (do_merge) caml_fl_merge_block (Bp_hp (p)); size -= sz; p += sz; Index: byterun/freelist.h =================================================================== --- byterun/freelist.h (.../vendor/ocaml/4.00.0) (revision 78) +++ byterun/freelist.h (.../trunk/ocamlxarm/3.1) (revision 78) @@ -29,7 +29,7 @@ void caml_fl_reset (void); char *caml_fl_merge_block (char *); void caml_fl_add_blocks (char *); -void caml_make_free_blocks (value *, mlsize_t, int); +void caml_make_free_blocks (value *, mlsize_t, int, int); void caml_set_allocation_policy (uintnat); Index: byterun/compact.c =================================================================== --- byterun/compact.c (.../vendor/ocaml/4.00.0) (revision 78) +++ byterun/compact.c (.../trunk/ocamlxarm/3.1) (revision 78) @@ -331,7 +331,7 @@ word q = *p; if (Color_hd (q) == Caml_white){ size_t sz = Bhsize_hd (q); - char *newadr = compact_allocate (sz); Assert (newadr <= (char *)p); + char *newadr = compact_allocate (sz); memmove (newadr, p, sz); p += Wsize_bsize (sz); }else{ @@ -384,7 +384,8 @@ while (ch != NULL){ if (Chunk_size (ch) > Chunk_alloc (ch)){ caml_make_free_blocks ((value *) (ch + Chunk_alloc (ch)), - Wsize_bsize (Chunk_size(ch)-Chunk_alloc(ch)), 1); + Wsize_bsize (Chunk_size(ch)-Chunk_alloc(ch)), 1, + Caml_white); } ch = Chunk_next (ch); } @@ -397,7 +398,7 @@ void caml_compact_heap (void) { - uintnat target_size, live; + uintnat target_words, target_size, live; do_compaction (); /* Compaction may fail to shrink the heap to a reasonable size @@ -414,26 +415,33 @@ See PR#5389 */ /* We compute: - freewords = caml_fl_cur_size (exact) - heapsize = caml_heap_size (exact) - live = heap_size - freewords - target_size = live * (1 + caml_percent_free / 100) - = live / 100 * (100 + caml_percent_free) - We add 1 to live/100 to make sure it isn't 0. + freewords = caml_fl_cur_size (exact) + heapwords = Wsize_bsize (caml_heap_size) (exact) + live = heapwords - freewords + wanted = caml_percent_free * (live / 100 + 1) (same as in do_compaction) + target_words = live + wanted + We add one page to make sure a small difference in counting sizes + won't make [do_compaction] keep the second block (and break all sorts + of invariants). We recompact if target_size < heap_size / 2 */ - live = caml_stat_heap_size - Bsize_wsize (caml_fl_cur_size); - target_size = (live / 100 + 1) * (100 + caml_percent_free); - target_size = caml_round_heap_chunk_size (target_size); + live = Wsize_bsize (caml_stat_heap_size) - caml_fl_cur_size; + target_words = live + caml_percent_free * (live / 100 + 1) + + Wsize_bsize (Page_size); + target_size = caml_round_heap_chunk_size (Bsize_wsize (target_words)); if (target_size < caml_stat_heap_size / 2){ char *chunk; - /* round it up to a page size */ + caml_gc_message (0x10, "Recompacting heap (target=%luk)\n", + target_size / 1024); + chunk = caml_alloc_for_heap (target_size); if (chunk == NULL) return; + /* PR#5757: we need to make the new blocks blue, or they won't be + recognized as free by the recompaction. */ caml_make_free_blocks ((value *) chunk, - Wsize_bsize (Chunk_size (chunk)), 0); + Wsize_bsize (Chunk_size (chunk)), 0, Caml_blue); if (caml_page_table_add (In_heap, chunk, chunk + Chunk_size (chunk)) != 0){ caml_free_for_heap (chunk); return; @@ -448,6 +456,7 @@ do_compaction (); Assert (caml_stat_heap_chunks == 1); Assert (Chunk_next (caml_heap_start) == NULL); + Assert (caml_stat_heap_size == Chunk_size (chunk)); } } Index: byterun/major_gc.c =================================================================== --- byterun/major_gc.c (.../vendor/ocaml/4.00.0) (revision 78) +++ byterun/major_gc.c (.../trunk/ocamlxarm/3.1) (revision 78) @@ -496,7 +496,7 @@ caml_fl_init_merge (); caml_make_free_blocks ((value *) caml_heap_start, - Wsize_bsize (caml_stat_heap_size), 1); + Wsize_bsize (caml_stat_heap_size), 1, Caml_white); caml_gc_phase = Phase_idle; gray_vals_size = 2048; gray_vals = (value *) malloc (gray_vals_size * sizeof (value)); Index: testsuite/tests/regression/pr5757/pr5757.ml =================================================================== --- testsuite/tests/regression/pr5757/pr5757.ml (.../vendor/ocaml/4.00.0) (revision 0) +++ testsuite/tests/regression/pr5757/pr5757.ml (.../trunk/ocamlxarm/3.1) (revision 78) @@ -0,0 +1,5 @@ +Random.init 3;; +for i = 0 to 100_000 do + ignore (String.create (Random.int 1_000_000)) +done;; +Printf.printf "hello world\n";; Index: testsuite/tests/regression/pr5757/pr5757.reference =================================================================== --- testsuite/tests/regression/pr5757/pr5757.reference (.../vendor/ocaml/4.00.0) (revision 0) +++ testsuite/tests/regression/pr5757/pr5757.reference (.../trunk/ocamlxarm/3.1) (revision 78) @@ -0,0 +1 @@ +hello world Index: testsuite/tests/regression/pr5757/Makefile =================================================================== --- testsuite/tests/regression/pr5757/Makefile (.../vendor/ocaml/4.00.0) (revision 0) +++ testsuite/tests/regression/pr5757/Makefile (.../trunk/ocamlxarm/3.1) (revision 78) @@ -0,0 +1,4 @@ +MAIN_MODULE=pr5757 + +include ../../../makefiles/Makefile.one +include ../../../makefiles/Makefile.common Index: xarm-build =================================================================== --- xarm-build (.../vendor/ocaml/4.00.0) (revision 0) +++ xarm-build (.../trunk/ocamlxarm/3.1) (revision 78) @@ -0,0 +1,190 @@ +#!/bin/sh +# +# Build OCamlXARM, OCaml cross-compiler for iOS based on OCaml 4.00.0 +# +# Jeffrey Scofield, jeffsco@psellos.com +# +# Copyright (c) 2012 Psellos http://psellos.com/ +# Licensed under the MIT License: +# http://www.opensource.org/licenses/mit-license.php +# +# Page of OCaml-on-iOS resources: http://psellos.com/ocaml/ +# +# Expects one parameter: +# Single big step: all +# Medium steps: phase1 phase2 +# Small steps: config1 build1 config2 build2 + +# We use fancy features of the sed that comes with OS X. For now, +# specify full path. If this becomes a problem, stop using the fancy +# features. +# +SED=/usr/bin/sed + +export PLT=/Applications/Xcode.app/Contents/Developer/Platforms/iPhoneOS.platform +export SDK=/Developer/SDKs/iPhoneOS5.1.sdk +export SIMPLT=/Applications/Xcode.app/Contents/Developer/Platforms/iPhoneSimulator.platform +export SIMSDK=/Developer/SDKs/iPhoneSimulator5.1.sdk +export XARMTARGET=/usr/local/ocamlxarm +export OSXARCH=i386 + +# Small steps +config1 () { + # Configure for building bytecode interpreter to run on Intel OS X. + # But specify ARM architecture for assembly and partial link. + echo 'xarm-build: ----- configure phase 1 -----' + ./configure \ + -bindir $XARMTARGET/v7/bin \ + -libdir $XARMTARGET/v7/lib/ocaml \ + -mandir $XARMTARGET/v7/man/man1 \ + -no-curses \ + -no-tk \ + -no-graph \ + -host i386-apple-darwin11.3.0 \ + -cc "gcc -arch $OSXARCH" \ + -as "$PLT/Developer/usr/bin/llvm-gcc-4.2 -arch armv7 -c" \ + -aspp "$PLT/Developer/usr/bin/llvm-gcc-4.2 -arch armv7 -c" + # Post-modify config/Makefile to select the ARM back end for + # ocamlopt (to generate ARM assembly code). + $SED -i .bak \ + -e '1i\ +# modified by xarm-build for OCamlXARM' \ + -e 's/^ARCH[ ]*=.*/ARCH=arm/' \ + -e 's/^MODEL[ ]*=.*/MODEL=armv7/' \ + -e "s#^PARTIALLD[ ]*=.*#PARTIALLD=$PLT/Developer/usr/bin/ld -r#" \ + config/Makefile + # Post-modify utils/config.ml to tell ocamlopt to create ARM + # binaries for itself. Also tell ocamlc and ocamlopt to use ARM + # architecture when compiling C files. + make utils/config.ml + $SED -i .bak \ + -e 's#let[ ][ ]*mkexe[ ]*=.*#let mkexe ="'"$PLT/Developer/usr/bin/gcc -arch armv7 -isysroot $PLT$SDK"'"#' \ + -e 's#let[ ][ ]*bytecomp_c_compiler[ ]*=.*#let bytecomp_c_compiler ="'"$PLT/Developer/usr/bin/gcc -arch armv7 -isysroot $PLT$SDK"'"#' \ + -e 's#let[ ][ ]*native_c_compiler[ ]*=.*#let native_c_compiler ="'"$PLT/Developer/usr/bin/gcc -arch armv7 -isysroot $PLT$SDK"'"#' \ + utils/config.ml +} + +build1 () { + # Don't assemble asmrun/arm.S for Phase 1 build. Modify Makefile + # temporarily to disable. Be really sure to put back for Phase 2. + echo 'xarm-build: ----- build phase 1 -----' + trap 'mv -f asmrun/Makefile.aside asmrun/Makefile' EXIT + grep -q '^[ ]*ASMOBJS[ ]*=' asmrun/Makefile && \ + mv -f asmrun/Makefile asmrun/Makefile.aside + $SED -e '/^[ ]*ASMOBJS[ ]*=/s/^/#/' \ + asmrun/Makefile.aside > asmrun/Makefile + make world && make opt + mv -f asmrun/Makefile.aside asmrun/Makefile + trap - EXIT + # Save the Phase 1 shared (dynamically loadable) libraries and + # restore them after Phase 2. They're required by some OCaml + # utilities, such as camlp4. + # + # The shared libraries are useful only with the bytecode + # interpreter, which we don't support under iOS. This lets us (just + # barely) fit OCamlXARM into the form of a usual OCaml release. + find . -name '*.so' -exec mv {} {}phase1 \; +} + +config2 () { + # Clean out OS X runtime + echo 'xarm-build: ----- configure phase 2 -----' + cd asmrun; make clean; cd .. + cd stdlib; make clean; cd .. + cd otherlibs/bigarray; make clean; cd ../.. + cd otherlibs/dynlink; make clean; cd ../.. + cd otherlibs/num; make clean; cd ../.. + cd otherlibs/str; make clean; cd ../.. + cd otherlibs/systhreads; make clean; cd ../.. + cd otherlibs/threads; make clean; cd ../.. + cd otherlibs/unix; make clean; cd ../.. + # Reconfigure for iOS environment, using iOS Simulator to test the + # ABI. + ./configure \ + -bindir $XARMTARGET/v7/bin \ + -libdir $XARMTARGET/v7/lib/ocaml \ + -mandir $XARMTARGET/v7/man/man1 \ + -no-curses \ + -no-tk \ + -no-graph \ + -host arm-apple-darwin10.0.0d3 \ + -cc "gcc -arch i386 -isysroot $SIMPLT$SIMSDK" \ + -as "gcc -arch i386 -c" \ + -aspp "gcc -arch i386 -c" \ + -lib "-Wl,-syslibroot,$SIMPLT$SIMSDK" + # Post-modify config/Makefile to specify the real cross-compiling + # toolchain. + $SED -i .bak \ + -e '1i\ +# modified by xarm-build for OCamlXARM' \ + -e "s|^BYTECC[ ]*=.*|BYTECC=$PLT/Developer/usr/bin/gcc -arch armv7 -isysroot $PLT$SDK|" \ + -e "s|^BYTECCLIBS[ ]*=.*|BYTECCLIBS=-Wl,-syslibroot,$PLT$SDK|" \ + -e 's/^ARCH[ ]*=.*/ARCH=arm/' \ + -e 's/^MODEL[ ]*=.*/MODEL=armv7/' \ + -e 's/^SYSTEM[ ]*=.*/SYSTEM=macosx/' \ + -e "s|^NATIVECC[ ]*=.*|NATIVECC=$PLT/Developer/usr/bin/gcc -arch armv7 -isysroot $PLT$SDK|" \ + -e "s|^NATIVECCLIBS[ ]*=.*|NATIVECCLIBS=-Wl,-syslibroot,$PLT$SDK|" \ + -e "s|^ASM[ ]*=.*|ASM=$PLT/Developer/usr/bin/gcc -arch armv7 -c|" \ + -e "s|^ASPP[ ]*=.*|ASPP=$PLT/Developer/usr/bin/gcc -arch armv7 -c|" \ + -e "s|^MKDLL[ ]*=.*|MKDLL=$PLT/Developer/usr/bin/gcc -arch armv7 -isysroot $PLT$SDK -bundle -flat_namespace -undefined suppress|" \ + -e "s|^MKMAINDLL[ ]*=.*|MKMAINDLL=$PLT/Developer/usr/bin/gcc -arch armv7 -isysroot $PLT$SDK -bundle -flat_namespace -undefined suppress|" \ + config/Makefile + # Rebuild ocamlmklib, so libraries work with iOS. + rm myocamlbuild_config.ml + cd tools + make ocamlmklib + cd .. +} + +build2 () { + # Make iOS runtime + echo 'xarm-build: ----- build phase 2 -----' + cd asmrun; make all; cd .. + cd stdlib; make all allopt; cd .. + cd otherlibs/unix; make all allopt; cd ../.. + cd otherlibs/str; make all allopt; cd ../.. + cd otherlibs/num; make all allopt; cd ../.. + cd otherlibs/dynlink; make all allopt; cd ../.. + cd otherlibs/bigarray; make all allopt; cd ../.. + cd otherlibs/systhreads; make all allopt; cd ../.. + cd otherlibs/threads; make all allopt; cd ../.. + # Restore the saved Phase 1 .so files (see above). + find . -name '*.sophase1' -print | \ + while read f; do \ + fso="$(expr "$f" : '\(.*\)sophase1$')so"; mv -f $f $fso; \ + done +} + +# Bigger steps + +phase1 () { + config1 && build1 +} + +phase2 () { + config2 && build2 +} + +all () { + phase1 && phase2 +} + +clean () { + rm -f myocamlbuild_config.ml + make clean +} + +case "$1" in +config1) config1 ;; +build1) build1 ;; +config2) config2 ;; +build2) build2 ;; +phase1) phase1 ;; +phase2) phase2 ;; +all) all ;; +clean) clean ;; +*) echo "usage: $(basename $0) {all|phase1|phase2|config1|build1|config2|build2}" >&2; + echo " $(basename $0) clean" >&2; + exit 1 + ;; +esac Index: asmrun/signals_osdep.h =================================================================== --- asmrun/signals_osdep.h (.../vendor/ocaml/4.00.0) (revision 78) +++ asmrun/signals_osdep.h (.../trunk/ocamlxarm/3.1) (revision 78) @@ -34,7 +34,7 @@ /****************** AMD64, MacOSX */ -#elif defined(TARGET_amd64) && defined (SYS_macosx) +#elif (defined(TARGET_amd64) || (defined(TARGET_arm) && defined(__x86_64))) && defined (SYS_macosx) #define DECLARE_SIGNAL_HANDLER(name) \ static void name(int sig, siginfo_t * info, void * context) @@ -125,7 +125,7 @@ /****************** I386, MacOS X */ -#elif defined(TARGET_i386) && defined(SYS_macosx) +#elif (defined(TARGET_i386) || (defined(TARGET_arm) && defined(__i386))) && defined(SYS_macosx) #define DECLARE_SIGNAL_HANDLER(name) \ static void name(int sig, siginfo_t * info, void * context) Index: asmrun/arm.S =================================================================== --- asmrun/arm.S (.../vendor/ocaml/4.00.0) (revision 78) +++ asmrun/arm.S (.../trunk/ocamlxarm/3.1) (revision 78) @@ -19,6 +19,39 @@ .syntax unified .text + +/* Apple compatibility macros */ +#if defined(SYS_macosx) +#define Glo(s) _##s +#define Loc(s) L##s +#if defined(MODEL_armv6) + .machine armv6 + .macro .funtype + .endm + .macro cbz + cmp $0, #0 + beq $1 + .endm +#else + .machine armv7 + .thumb + .macro .funtype + .thumb_func $0 + .endm +#endif + .macro .type + .endm + .macro .size + .endm +#else +#define Glo(s) s +#define Loc(s) .L##s + .macro .funtype symbol + .type \symbol, %function + .endm +#endif +/* End Apple compatibility macros */ + #if defined(SYS_linux_eabihf) .arch armv7-a .fpu vfpv3-d16 @@ -58,192 +91,192 @@ /* Allocation functions and GC interface */ - .globl caml_system__code_begin -caml_system__code_begin: + .globl Glo(caml_system__code_begin) +Glo(caml_system__code_begin): .align 2 - .globl caml_call_gc - .type caml_call_gc, %function -caml_call_gc: + .globl Glo(caml_call_gc) + .funtype Glo(caml_call_gc) +Glo(caml_call_gc): PROFILE /* Record return address */ - ldr r12, =caml_last_return_address + ldr r12, Loc(Pcaml_last_return_address) str lr, [r12] -.Lcaml_call_gc: +Loc(caml_call_gc): /* Record lowest stack address */ - ldr r12, =caml_bottom_of_stack + ldr r12, Loc(Pcaml_bottom_of_stack) str sp, [r12] /* Save caller floating-point registers on the stack */ vpush {d0-d7} /* Save integer registers and return address on the stack */ push {r0-r7,r12,lr} /* Store pointer to saved integer registers in caml_gc_regs */ - ldr r12, =caml_gc_regs + ldr r12, Loc(Pcaml_gc_regs) str sp, [r12] /* Save current allocation pointer for debugging purposes */ - ldr alloc_limit, =caml_young_ptr + ldr alloc_limit, Loc(Pcaml_young_ptr) str alloc_ptr, [alloc_limit] /* Save trap pointer in case an exception is raised during GC */ - ldr r12, =caml_exception_pointer + ldr r12, Loc(Pcaml_exception_pointer) str trap_ptr, [r12] /* Call the garbage collector */ - bl caml_garbage_collection + bl Glo(caml_garbage_collection) /* Restore integer registers and return address from the stack */ pop {r0-r7,r12,lr} /* Restore floating-point registers from the stack */ vpop {d0-d7} /* Reload new allocation pointer and limit */ /* alloc_limit still points to caml_young_ptr */ - ldr r12, =caml_young_limit + ldr r12, Loc(Pcaml_young_limit) ldr alloc_ptr, [alloc_limit] ldr alloc_limit, [r12] /* Return to caller */ bx lr - .type caml_call_gc, %function - .size caml_call_gc, .-caml_call_gc + .funtype Glo(caml_call_gc) + .size Glo(caml_call_gc), .-Glo(caml_call_gc) .align 2 - .globl caml_alloc1 - .type caml_alloc1, %function -caml_alloc1: + .globl Glo(caml_alloc1) + .funtype Glo(caml_alloc1) +Glo(caml_alloc1): PROFILE -.Lcaml_alloc1: +Loc(caml_alloc1): sub alloc_ptr, alloc_ptr, 8 cmp alloc_ptr, alloc_limit bcc 1f bx lr 1: /* Record return address */ - ldr r7, =caml_last_return_address + ldr r7, Loc(Pcaml_last_return_address) str lr, [r7] /* Call GC (preserves r7) */ - bl .Lcaml_call_gc + bl Loc(caml_call_gc) /* Restore return address */ ldr lr, [r7] /* Try again */ - b .Lcaml_alloc1 - .type caml_alloc1, %function - .size caml_alloc1, .-caml_alloc1 + b Loc(caml_alloc1) + .funtype Glo(caml_alloc1) + .size Glo(caml_alloc1), .-Glo(caml_alloc1) .align 2 - .globl caml_alloc2 - .type caml_alloc2, %function -caml_alloc2: + .globl Glo(caml_alloc2) + .funtype Glo(caml_alloc2) +Glo(caml_alloc2): PROFILE -.Lcaml_alloc2: +Loc(caml_alloc2): sub alloc_ptr, alloc_ptr, 12 cmp alloc_ptr, alloc_limit bcc 1f bx lr 1: /* Record return address */ - ldr r7, =caml_last_return_address + ldr r7, Loc(Pcaml_last_return_address) str lr, [r7] /* Call GC (preserves r7) */ - bl .Lcaml_call_gc + bl Loc(caml_call_gc) /* Restore return address */ ldr lr, [r7] /* Try again */ - b .Lcaml_alloc2 - .type caml_alloc2, %function - .size caml_alloc2, .-caml_alloc2 + b Loc(caml_alloc2) + .funtype Glo(caml_alloc2) + .size Glo(caml_alloc2), .-Glo(caml_alloc2) .align 2 - .globl caml_alloc3 - .type caml_alloc3, %function -caml_alloc3: + .globl Glo(caml_alloc3) + .funtype Glo(caml_alloc3) +Glo(caml_alloc3): PROFILE -.Lcaml_alloc3: +Loc(caml_alloc3): sub alloc_ptr, alloc_ptr, 16 cmp alloc_ptr, alloc_limit bcc 1f bx lr 1: /* Record return address */ - ldr r7, =caml_last_return_address + ldr r7, Loc(Pcaml_last_return_address) str lr, [r7] /* Call GC (preserves r7) */ - bl .Lcaml_call_gc + bl Loc(caml_call_gc) /* Restore return address */ ldr lr, [r7] /* Try again */ - b .Lcaml_alloc3 - .type caml_alloc3, %function - .size caml_alloc3, .-caml_alloc3 + b Loc(caml_alloc3) + .funtype Glo(caml_alloc3) + .size Glo(caml_alloc3), .-Glo(caml_alloc3) .align 2 - .globl caml_allocN - .type caml_allocN, %function -caml_allocN: + .globl Glo(caml_allocN) + .funtype Glo(caml_allocN) +Glo(caml_allocN): PROFILE -.Lcaml_allocN: +Loc(caml_allocN): sub alloc_ptr, alloc_ptr, r7 cmp alloc_ptr, alloc_limit bcc 1f bx lr 1: /* Record return address */ - ldr r12, =caml_last_return_address + ldr r12, Loc(Pcaml_last_return_address) str lr, [r12] /* Call GC (preserves r7) */ - bl .Lcaml_call_gc + bl Loc(caml_call_gc) /* Restore return address */ - ldr r12, =caml_last_return_address + ldr r12, Loc(Pcaml_last_return_address) ldr lr, [r12] /* Try again */ - b .Lcaml_allocN - .type caml_allocN, %function - .size caml_allocN, .-caml_allocN + b Loc(caml_allocN) + .funtype Glo(caml_allocN) + .size Glo(caml_allocN), .-Glo(caml_allocN) /* Call a C function from OCaml */ /* Function to call is in r7 */ .align 2 - .globl caml_c_call - .type caml_c_call, %function -caml_c_call: + .globl Glo(caml_c_call) + .funtype Glo(caml_c_call) +Glo(caml_c_call): PROFILE /* Record lowest stack address and return address */ - ldr r5, =caml_last_return_address - ldr r6, =caml_bottom_of_stack + ldr r5, Loc(Pcaml_last_return_address) + ldr r6, Loc(Pcaml_bottom_of_stack) str lr, [r5] str sp, [r6] /* Preserve return address in callee-save register r4 */ mov r4, lr /* Make the exception handler alloc ptr available to the C code */ - ldr r5, =caml_young_ptr - ldr r6, =caml_exception_pointer + ldr r5, Loc(Pcaml_young_ptr) + ldr r6, Loc(Pcaml_exception_pointer) str alloc_ptr, [r5] str trap_ptr, [r6] /* Call the function */ blx r7 /* Reload alloc ptr and alloc limit */ - ldr r6, =caml_young_limit + ldr r6, Loc(Pcaml_young_limit) ldr alloc_ptr, [r5] /* r5 still points to caml_young_ptr */ ldr alloc_limit, [r6] /* Return */ bx r4 - .type caml_c_call, %function - .size caml_c_call, .-caml_c_call + .funtype Glo(caml_c_call) + .size Glo(caml_c_call), .-Glo(caml_c_call) /* Start the OCaml program */ .align 2 - .globl caml_start_program - .type caml_start_program, %function -caml_start_program: + .globl Glo(caml_start_program) + .funtype Glo(caml_start_program) +Glo(caml_start_program): PROFILE - ldr r12, =caml_program + ldr r12, Loc(Pcaml_program) /* Code shared with caml_callback* */ /* Address of OCaml code to call is in r12 */ /* Arguments to the OCaml code are in r0...r3 */ -.Ljump_to_caml: +Loc(jump_to_caml): /* Save return address and callee-save registers */ vpush {d8-d15} push {r4-r8,r10,r11,lr} /* 8-byte alignment */ /* Setup a callback link on the stack */ sub sp, sp, 4*4 /* 8-byte alignment */ - ldr r4, =caml_bottom_of_stack - ldr r5, =caml_last_return_address - ldr r6, =caml_gc_regs + ldr r4, Loc(Pcaml_bottom_of_stack) + ldr r5, Loc(Pcaml_last_return_address) + ldr r6, Loc(Pcaml_gc_regs) ldr r4, [r4] ldr r5, [r5] ldr r6, [r6] @@ -252,71 +285,71 @@ str r6, [sp, 8] /* Setup a trap frame to catch exceptions escaping the OCaml code */ sub sp, sp, 2*4 - ldr r6, =caml_exception_pointer - ldr r5, =.Ltrap_handler + ldr r6, Loc(Pcaml_exception_pointer) + ldr r5, Loc(Ptrap_handler) ldr r4, [r6] str r4, [sp, 0] str r5, [sp, 4] mov trap_ptr, sp /* Reload allocation pointers */ - ldr r4, =caml_young_ptr + ldr r4, Loc(Pcaml_young_ptr) ldr alloc_ptr, [r4] - ldr r4, =caml_young_limit + ldr r4, Loc(Pcaml_young_limit) ldr alloc_limit, [r4] /* Call the OCaml code */ blx r12 -.Lcaml_retaddr: +Loc(caml_retaddr): /* Pop the trap frame, restoring caml_exception_pointer */ - ldr r4, =caml_exception_pointer + ldr r4, Loc(Pcaml_exception_pointer) ldr r5, [sp, 0] str r5, [r4] add sp, sp, 2*4 /* Pop the callback link, restoring the global variables */ -.Lreturn_result: - ldr r4, =caml_bottom_of_stack +Loc(return_result): + ldr r4, Loc(Pcaml_bottom_of_stack) ldr r5, [sp, 0] str r5, [r4] - ldr r4, =caml_last_return_address + ldr r4, Loc(Pcaml_last_return_address) ldr r5, [sp, 4] str r5, [r4] - ldr r4, =caml_gc_regs + ldr r4, Loc(Pcaml_gc_regs) ldr r5, [sp, 8] str r5, [r4] add sp, sp, 4*4 /* Update allocation pointer */ - ldr r4, =caml_young_ptr + ldr r4, Loc(Pcaml_young_ptr) str alloc_ptr, [r4] /* Reload callee-save registers and return */ pop {r4-r8,r10,r11,lr} vpop {d8-d15} bx lr - .type .Lcaml_retaddr, %function - .size .Lcaml_retaddr, .-.Lcaml_retaddr - .type caml_start_program, %function - .size caml_start_program, .-caml_start_program + .funtype Loc(caml_retaddr) + .size Loc(caml_retaddr), .-Loc(caml_retaddr) + .funtype Glo(caml_start_program) + .size Glo(caml_start_program), .-Glo(caml_start_program) /* The trap handler */ .align 2 -.Ltrap_handler: +Loc(trap_handler): /* Save exception pointer */ - ldr r12, =caml_exception_pointer + ldr r12, Loc(Pcaml_exception_pointer) str trap_ptr, [r12] /* Encode exception bucket as an exception result */ orr r0, r0, 2 /* Return it */ - b .Lreturn_result - .type .Ltrap_handler, %function - .size .Ltrap_handler, .-.Ltrap_handler + b Loc(return_result) + .funtype Loc(trap_handler) + .size Loc(trap_handler), .-Loc(trap_handler) /* Raise an exception from OCaml */ .align 2 - .globl caml_raise_exn -caml_raise_exn: + .globl Glo(caml_raise_exn) +Glo(caml_raise_exn): PROFILE /* Test if backtrace is active */ - ldr r1, =caml_backtrace_active + ldr r1, Loc(Pcaml_backtrace_active) ldr r1, [r1] cbz r1, 1f /* Preserve exception bucket in callee-save register r4 */ @@ -325,86 +358,86 @@ mov r1, lr /* arg2: pc of raise */ mov r2, sp /* arg3: sp of raise */ mov r3, trap_ptr /* arg4: sp of handler */ - bl caml_stash_backtrace + bl Glo(caml_stash_backtrace) /* Restore exception bucket */ mov r0, r4 1: /* Cut stack at current trap handler */ mov sp, trap_ptr /* Pop previous handler and addr of trap, and jump to it */ pop {trap_ptr, pc} - .type caml_raise_exn, %function - .size caml_raise_exn, .-caml_raise_exn + .funtype Glo(caml_raise_exn) + .size Glo(caml_raise_exn), .-Glo(caml_raise_exn) /* Raise an exception from C */ .align 2 - .globl caml_raise_exception - .type caml_raise_exception, %function -caml_raise_exception: + .globl Glo(caml_raise_exception) + .funtype Glo(caml_raise_exception) +Glo(caml_raise_exception): PROFILE /* Reload trap ptr, alloc ptr and alloc limit */ - ldr trap_ptr, =caml_exception_pointer - ldr alloc_ptr, =caml_young_ptr - ldr alloc_limit, =caml_young_limit + ldr trap_ptr, Loc(Pcaml_exception_pointer) + ldr alloc_ptr, Loc(Pcaml_young_ptr) + ldr alloc_limit, Loc(Pcaml_young_limit) ldr trap_ptr, [trap_ptr] ldr alloc_ptr, [alloc_ptr] ldr alloc_limit, [alloc_limit] /* Test if backtrace is active */ - ldr r1, =caml_backtrace_active + ldr r1, Loc(Pcaml_backtrace_active) ldr r1, [r1] cbz r1, 1f /* Preserve exception bucket in callee-save register r4 */ mov r4, r0 - ldr r1, =caml_last_return_address /* arg2: pc of raise */ + ldr r1, Loc(Pcaml_last_return_address) /* arg2: pc of raise */ ldr r1, [r1] - ldr r2, =caml_bottom_of_stack /* arg3: sp of raise */ + ldr r2, Loc(Pcaml_bottom_of_stack) /* arg3: sp of raise */ ldr r2, [r2] mov r3, trap_ptr /* arg4: sp of handler */ - bl caml_stash_backtrace + bl Glo(caml_stash_backtrace) /* Restore exception bucket */ mov r0, r4 1: /* Cut stack at current trap handler */ mov sp, trap_ptr /* Pop previous handler and addr of trap, and jump to it */ pop {trap_ptr, pc} - .type caml_raise_exception, %function - .size caml_raise_exception, .-caml_raise_exception + .funtype Glo(caml_raise_exception) + .size Glo(caml_raise_exception), .-Glo(caml_raise_exception) /* Callback from C to OCaml */ .align 2 - .globl caml_callback_exn - .type caml_callback_exn, %function -caml_callback_exn: + .globl Glo(caml_callback_exn) + .funtype Glo(caml_callback_exn) +Glo(caml_callback_exn): PROFILE /* Initial shuffling of arguments (r0 = closure, r1 = first arg) */ mov r12, r0 mov r0, r1 /* r0 = first arg */ mov r1, r12 /* r1 = closure environment */ ldr r12, [r12] /* code pointer */ - b .Ljump_to_caml - .type caml_callback_exn, %function - .size caml_callback_exn, .-caml_callback_exn + b Loc(jump_to_caml) + .funtype Glo(caml_callback_exn) + .size Glo(caml_callback_exn), .-Glo(caml_callback_exn) .align 2 - .globl caml_callback2_exn - .type caml_callback2_exn, %function -caml_callback2_exn: + .globl Glo(caml_callback2_exn) + .funtype Glo(caml_callback2_exn) +Glo(caml_callback2_exn): PROFILE /* Initial shuffling of arguments (r0 = closure, r1 = arg1, r2 = arg2) */ mov r12, r0 mov r0, r1 /* r0 = first arg */ mov r1, r2 /* r1 = second arg */ mov r2, r12 /* r2 = closure environment */ - ldr r12, =caml_apply2 - b .Ljump_to_caml - .type caml_callback2_exn, %function - .size caml_callback2_exn, .-caml_callback2_exn + ldr r12, Loc(Pcaml_apply2) + b Loc(jump_to_caml) + .funtype Glo(caml_callback2_exn) + .size Glo(caml_callback2_exn), .-Glo(caml_callback2_exn) .align 2 - .globl caml_callback3_exn - .type caml_callback3_exn, %function -caml_callback3_exn: + .globl Glo(caml_callback3_exn) + .funtype Glo(caml_callback3_exn) +Glo(caml_callback3_exn): PROFILE /* Initial shuffling of arguments */ /* (r0 = closure, r1 = arg1, r2 = arg2, r3 = arg3) */ @@ -413,36 +446,65 @@ mov r1, r2 /* r1 = second arg */ mov r2, r3 /* r2 = third arg */ mov r3, r12 /* r3 = closure environment */ - ldr r12, =caml_apply3 - b .Ljump_to_caml - .type caml_callback3_exn, %function - .size caml_callback3_exn, .-caml_callback3_exn + ldr r12, Loc(Pcaml_apply3) + b Loc(jump_to_caml) + .funtype Glo(caml_callback3_exn) + .size Glo(caml_callback3_exn), .-Glo(caml_callback3_exn) .align 2 - .globl caml_ml_array_bound_error - .type caml_ml_array_bound_error, %function -caml_ml_array_bound_error: + .globl Glo(caml_ml_array_bound_error) + .funtype Glo(caml_ml_array_bound_error) +Glo(caml_ml_array_bound_error): PROFILE /* Load address of [caml_array_bound_error] in r7 */ - ldr r7, =caml_array_bound_error + ldr r7, Loc(Pcaml_array_bound_error) /* Call that function */ - b caml_c_call - .type caml_ml_array_bound_error, %function - .size caml_ml_array_bound_error, .-caml_ml_array_bound_error + b Glo(caml_c_call) + .funtype Glo(caml_ml_array_bound_error) + .size Glo(caml_ml_array_bound_error), .-Glo(caml_ml_array_bound_error) - .globl caml_system__code_end -caml_system__code_end: + .globl Glo(caml_system__code_end) +Glo(caml_system__code_end): /* GC roots for callback */ .data .align 2 - .globl caml_system__frametable -caml_system__frametable: + .globl Glo(caml_system__frametable) +Glo(caml_system__frametable): .word 1 /* one descriptor */ - .word .Lcaml_retaddr /* return address into callback */ + .word Loc(caml_retaddr) /* return address into callback */ .short -1 /* negative frame size => use callback link */ .short 0 /* no roots */ .align 2 - .type caml_system__frametable, %object - .size caml_system__frametable, .-caml_system__frametable + .type Glo(caml_system__frametable), %object + .size Glo(caml_system__frametable), .-Glo(caml_system__frametable) + +/* Pool of addresses loaded into registers */ + + .text + .align 2 +Loc(Pcaml_last_return_address): + .long Glo(caml_last_return_address) +Loc(Pcaml_bottom_of_stack): + .long Glo(caml_bottom_of_stack) +Loc(Pcaml_gc_regs): + .long Glo(caml_gc_regs) +Loc(Pcaml_young_ptr): + .long Glo(caml_young_ptr) +Loc(Pcaml_exception_pointer): + .long Glo(caml_exception_pointer) +Loc(Pcaml_young_limit): + .long Glo(caml_young_limit) +Loc(Pcaml_program): + .long Glo(caml_program) +Loc(Ptrap_handler): + .long Loc(trap_handler) +Loc(Pcaml_backtrace_active): + .long Glo(caml_backtrace_active) +Loc(Pcaml_apply2): + .long Glo(caml_apply2) +Loc(Pcaml_apply3): + .long Glo(caml_apply3) +Loc(Pcaml_array_bound_error): + .long Glo(caml_array_bound_error) Index: asmrun/Makefile =================================================================== --- asmrun/Makefile (.../vendor/ocaml/4.00.0) (revision 78) +++ asmrun/Makefile (.../trunk/ocamlxarm/3.1) (revision 78) @@ -172,11 +172,12 @@ .SUFFIXES: .S .d.o .p.o .S.o: - $(ASPP) -DSYS_$(SYSTEM) -o $*.o $*.S || \ + $(ASPP) -DSYS_$(SYSTEM) -DMODEL_$(MODEL) -o $*.o $*.S || \ { echo "If your assembler produced syntax errors, it is probably unhappy with the"; echo "preprocessor. Check your assembler, or try producing $*.o by hand."; exit 2; } .S.p.o: - $(ASPP) -DSYS_$(SYSTEM) $(ASPPPROFFLAGS) -o $*.p.o $*.S + $(ASPP) -DSYS_$(SYSTEM) -DMODEL_$(MODEL) $(ASPPPROFFLAGS) \ + -o $*.p.o $*.S .c.d.o: ln -s -f $*.c $*.d.c