Index: README =================================================================== RCS file: /net/pauillac/caml/repository/csl/README,v retrieving revision 1.22 retrieving revision 1.23 diff -c -r1.22 -r1.23 *** README 1997/11/10 18:20:46 1.22 --- README 1998/02/26 12:46:34 1.23 *************** *** 27,33 **** DecStation 3100 and 5000 under Ultrix 4 HP PA-RISC processors: HP 9000/700 under HPUX 9 and NextStep PowerPC processors: IBM RS6000 and PowerPC workstations under AIX 3.2, ! PowerMacintosh under MkLinux Motorola 680x0 processors: Sun 3 under SunOS Other operating systems for the processors above have not been tested, --- 27,33 ---- DecStation 3100 and 5000 under Ultrix 4 HP PA-RISC processors: HP 9000/700 under HPUX 9 and NextStep PowerPC processors: IBM RS6000 and PowerPC workstations under AIX 3.2, ! PowerMacintosh under MkLinux, LinuxPPC, Rhapsody Motorola 680x0 processors: Sun 3 under SunOS Other operating systems for the processors above have not been tested, Index: configure =================================================================== RCS file: /net/pauillac/caml/repository/csl/configure,v retrieving revision 1.53 retrieving revision 1.56 diff -c -r1.53 -r1.56 *** configure 1997/12/09 09:13:38 1.53 --- configure 1998/03/13 19:59:01 1.56 *************** *** 11,17 **** # # #*********************************************************************# ! # $Id: configure,v 1.53 1997/12/09 09:13:38 xleroy Exp $ bindir=/usr/local/bin libdir=/usr/local/lib/ocaml --- 11,17 ---- # # #*********************************************************************# ! # $Id: configure,v 1.56 1998/03/13 19:59:01 doligez Exp $ bindir=/usr/local/bin libdir=/usr/local/lib/ocaml *************** *** 20,25 **** --- 20,26 ---- host_type=unknown cc='' cclibs='' + mathlib='-lm' x11_include_dir='' x11_lib_dir='' posix_threads=no *************** *** 143,148 **** --- 144,153 ---- # GNU C extensions disabled, but __GNUC__ still defined! bytecccompopts="-fno-defer-pop -Wall -U__GNUC__ -posix" bytecclinkopts="-posix";; + cc,*-*-rhapsody*) + # Almost the same as NeXTStep + bytecccompopts="-fno-defer-pop -Wall -DSHRINKED_GNUC" + mathlib="";; gcc,alpha-*-osf*) bytecccompopts="-fno-defer-pop -Wall" # -taso puts code in lower 4GB *************** *** 160,169 **** bytecclinkopts="-Wl,-woff,84";; esac - echo "BYTECC=$bytecc" >> Makefile - echo "BYTECCCOMPOPTS=$bytecccompopts" >> Makefile - echo "BYTECCLINKOPTS=$bytecclinkopts" >> Makefile - # Configure compiler to use in further tests cc="$bytecc $bytecclinkopts" --- 165,170 ---- *************** *** 269,274 **** --- 270,276 ---- rs6000-*-aix*) arch=power; model=rs6000; system=aix;; powerpc-*-aix*) arch=power; model=ppc; system=aix;; powerpc-*-linux*) arch=power; model=ppc; system=elf;; + powerpc-*-rhapsody*) arch=power; model=ppc; system=rhapsody;; m68k-*-sunos*) arch=m68k; system=sunos;; esac *************** *** 288,293 **** --- 290,296 ---- mips,cc*,ultrix) nativecccompopts=-std;; *,*,nextstep) nativecccompopts="-Wall -U__GNUC__ -posix" nativecclinkopts="-posix";; + *,*,rhapsody) nativecccompopts="-Wall -DSHRINKED_GNUC";; *,gcc*,*) nativecccompopts=-Wall;; esac *************** *** 308,325 **** power,rs6000,aix) asflags='-u -m pwr -w'; asppflags="$asflags";; power,ppc,aix) asflags='-u -m ppc -w'; asppflags="$asflags";; power,*,elf) aspp='gcc'; asppflags='-c';; esac - echo "ARCH=$arch" >> Makefile - echo "MODEL=$model" >> Makefile - echo "SYSTEM=$system" >> Makefile - echo "NATIVECC=$nativecc" >> Makefile - echo "NATIVECCCOMPOPTS=$nativecccompopts" >> Makefile - echo "NATIVECCLINKOPTS=$nativecclinkopts" >> Makefile - echo "ASFLAGS=$asflags" >> Makefile - echo "ASPP=$aspp" >> Makefile - echo "ASPPFLAGS=$asppflags" >> Makefile - # Where is ranlib? if sh ./searchpath ranlib; then --- 311,319 ---- power,rs6000,aix) asflags='-u -m pwr -w'; asppflags="$asflags";; power,ppc,aix) asflags='-u -m ppc -w'; asppflags="$asflags";; power,*,elf) aspp='gcc'; asppflags='-c';; + power,*,rhapsody) ;; esac # Where is ranlib? if sh ./searchpath ranlib; then *************** *** 372,378 **** if sh ./hasgot sigaction sigprocmask; then echo "POSIX signal handling found." ! echo "#define POSIX_SIGNALS" >> s.h else if sh ./runtest signals.c; then echo "Signals have the BSD semantics." --- 366,376 ---- if sh ./hasgot sigaction sigprocmask; then echo "POSIX signal handling found." ! case $host in ! *-*-rhapsody*) echo "But it doesn't work properly." ! echo "#define BSD_SIGNALS" >> s.h;; ! *) echo "#define POSIX_SIGNALS" >> s.h;; ! esac else if sh ./runtest signals.c; then echo "Signals have the BSD semantics." *************** *** 393,398 **** --- 391,401 ---- echo "#define HAS_STRERROR" >> s.h fi + if sh ./hasgot times; then + echo "times() found." + echo "#define HAS_TIMES" >> s.h + fi + # For the terminfo module for libs in "" "-lcurses" "-ltermcap" "-lcurses -ltermcap"; do *************** *** 604,609 **** --- 607,614 ---- if test "$posix_threads" = "yes"; then echo "Threads library supported (using POSIX system threads)." otherlibraries="$otherlibraries systhreads" + bytecccompopts="$bytecccompopts -D_REENTRANT" + nativecccompopts="$nativecccompopts -D_REENTRANT" elif test "$has_select" = "yes" \ && test "$has_setitimer" = "yes" \ && test "$has_gettimeofday" = "yes" \ *************** *** 686,692 **** # Finish generated files ! cclibs="$cclibs -lm" echo "CCLIBS=$cclibs" >> Makefile echo "OTHERLIBRARIES=$otherlibraries" >> Makefile echo "DEBUGGER=$debugger" >> Makefile --- 691,712 ---- # Finish generated files ! cclibs="$cclibs $mathlib" ! ! echo "BYTECC=$bytecc" >> Makefile ! echo "BYTECCCOMPOPTS=$bytecccompopts" >> Makefile ! echo "BYTECCLINKOPTS=$bytecclinkopts" >> Makefile ! ! echo "ARCH=$arch" >> Makefile ! echo "MODEL=$model" >> Makefile ! echo "SYSTEM=$system" >> Makefile ! echo "NATIVECC=$nativecc" >> Makefile ! echo "NATIVECCCOMPOPTS=$nativecccompopts" >> Makefile ! echo "NATIVECCLINKOPTS=$nativecclinkopts" >> Makefile ! echo "ASFLAGS=$asflags" >> Makefile ! echo "ASPP=$aspp" >> Makefile ! echo "ASPPFLAGS=$asppflags" >> Makefile ! echo "CCLIBS=$cclibs" >> Makefile echo "OTHERLIBRARIES=$otherlibraries" >> Makefile echo "DEBUGGER=$debugger" >> Makefile Index: asmcomp/asmlink.ml =================================================================== RCS file: /net/pauillac/caml/repository/csl/asmcomp/asmlink.ml,v retrieving revision 1.25 retrieving revision 1.26 diff -c -r1.25 -r1.26 *** asmcomp/asmlink.ml 1997/07/02 18:14:34 1.25 --- asmcomp/asmlink.ml 1998/01/05 12:43:34 1.26 *************** *** 9,15 **** (* *) (***********************************************************************) ! (* $Id: asmlink.ml,v 1.25 1997/07/02 18:14:34 xleroy Exp $ *) (* Link a set of .cmx/.o files and produce an executable *) --- 9,15 ---- (* *) (***********************************************************************) ! (* $Id: asmlink.ml,v 1.26 1998/01/05 12:43:34 xleroy Exp $ *) (* Link a set of .cmx/.o files and produce an executable *) *************** *** 163,170 **** (fun name -> Asmgen.compile_phrase(Cmmgen.predef_exception name)) Runtimedef.builtin_exceptions; Asmgen.compile_phrase(Cmmgen.global_table name_list); ! Asmgen.compile_phrase(Cmmgen.data_segment_table name_list); ! Asmgen.compile_phrase(Cmmgen.code_segment_table name_list); Asmgen.compile_phrase (Cmmgen.frame_table("startup" :: "system" :: name_list)); Emit.end_assembly(); --- 163,170 ---- (fun name -> Asmgen.compile_phrase(Cmmgen.predef_exception name)) Runtimedef.builtin_exceptions; Asmgen.compile_phrase(Cmmgen.global_table name_list); ! Asmgen.compile_phrase(Cmmgen.data_segment_table ("startup" :: name_list)); ! Asmgen.compile_phrase(Cmmgen.code_segment_table ("startup" :: name_list)); Asmgen.compile_phrase (Cmmgen.frame_table("startup" :: "system" :: name_list)); Emit.end_assembly(); Index: asmcomp/spill.ml =================================================================== RCS file: /net/pauillac/caml/repository/csl/asmcomp/spill.ml,v retrieving revision 1.11 retrieving revision 1.12 diff -c -r1.11 -r1.12 *** asmcomp/spill.ml 1996/04/30 14:43:02 1.11 --- asmcomp/spill.ml 1998/02/13 16:32:32 1.12 *************** *** 9,15 **** (* *) (***********************************************************************) ! (* $Id: spill.ml,v 1.11 1996/04/30 14:43:02 xleroy Exp $ *) (* Insertion of moves to suggest possible spilling / reloading points before register allocation. *) --- 9,15 ---- (* *) (***********************************************************************) ! (* $Id: spill.ml,v 1.12 1998/02/13 16:32:32 xleroy Exp $ *) (* Insertion of moves to suggest possible spilling / reloading points before register allocation. *) *************** *** 87,95 **** let lru_date = ref 1000000 and lru_reg = ref Reg.dummy in Reg.Set.iter (fun r -> ! if Proc.register_class r = cl & ! not (Reg.Set.mem r spilled) & ! r.loc = Unknown then begin try let d = Reg.Map.find r !use_date in if d < !lru_date then begin --- 87,96 ---- let lru_date = ref 1000000 and lru_reg = ref Reg.dummy in Reg.Set.iter (fun r -> ! if Proc.register_class r = cl && ! not (Reg.Set.mem r spilled) && ! r.loc = Unknown ! then begin try let d = Reg.Map.find r !use_date in if d < !lru_date then begin *************** *** 100,107 **** () end) live_regs; ! pressure.(cl) <- pressure.(cl) - 1; ! check_pressure cl (Reg.Set.add !lru_reg spilled) end in check_pressure 0 spilled --- 101,112 ---- () end) live_regs; ! if !lru_reg != Reg.dummy then begin ! pressure.(cl) <- pressure.(cl) - 1; ! check_pressure cl (Reg.Set.add !lru_reg spilled) ! end else ! (* Couldn't find any spillable register, give up for this class *) ! check_pressure (cl+1) spilled end in check_pressure 0 spilled Index: asmcomp/power/arch.ml =================================================================== RCS file: /net/pauillac/caml/repository/csl/asmcomp/power/arch.ml,v retrieving revision 1.1 retrieving revision 1.2 diff -c -r1.1 -r1.2 *** asmcomp/power/arch.ml 1997/07/24 11:49:10 1.1 --- asmcomp/power/arch.ml 1998/03/13 13:57:34 1.2 *************** *** 9,15 **** (* *) (***********************************************************************) ! (* $Id: arch.ml,v 1.1 1997/07/24 11:49:10 xleroy Exp $ *) (* Specific operations for the PowerPC processor *) --- 9,15 ---- (* *) (***********************************************************************) ! (* $Id: arch.ml,v 1.2 1998/03/13 13:57:34 xleroy Exp $ *) (* Specific operations for the PowerPC processor *) *************** *** 80,91 **** | _ -> Misc.fatal_error "wrong $(MODEL)" (* Distinguish between the PowerOpen (AIX, MacOS) TOC-based, ! relative-addressing model and the SVR4 (Solaris, MkLinux) absolute-addressing model. *) let toc = match Config.system with "aix" -> true | "elf" -> false | _ -> Misc.fatal_error "wrong $(SYSTEM)" --- 80,92 ---- | _ -> Misc.fatal_error "wrong $(MODEL)" (* Distinguish between the PowerOpen (AIX, MacOS) TOC-based, ! relative-addressing model and the SVR4 (Solaris, MkLinux, Rhapsody) absolute-addressing model. *) let toc = match Config.system with "aix" -> true | "elf" -> false + | "rhapsody" -> false | _ -> Misc.fatal_error "wrong $(SYSTEM)" Index: asmcomp/power/emit.mlp =================================================================== RCS file: /net/pauillac/caml/repository/csl/asmcomp/power/emit.mlp,v retrieving revision 1.2 retrieving revision 1.6 diff -c -r1.2 -r1.6 *** asmcomp/power/emit.mlp 1997/07/27 09:44:26 1.2 --- asmcomp/power/emit.mlp 1998/03/13 19:31:26 1.6 *************** *** 9,15 **** (* *) (***********************************************************************) ! (* $Id: emit.mlp,v 1.2 1997/07/27 09:44:26 xleroy Exp $ *) (* Emission of PowerPC assembly code *) --- 9,15 ---- (* *) (***********************************************************************) ! (* $Id: emit.mlp,v 1.6 1998/03/13 19:31:26 doligez Exp $ *) (* Emission of PowerPC assembly code *) *************** *** 61,68 **** (* Output a symbol *) ! let emit_symbol s = ! Emitaux.emit_symbol '.' s let emit_codesymbol s = if toc then emit_char '.'; --- 61,71 ---- (* Output a symbol *) ! let emit_symbol = ! match Config.system with ! "aix" | "elf" -> (fun s -> Emitaux.emit_symbol '.' s) ! | "rhapsody" -> (fun s -> emit_char '_'; Emitaux.emit_symbol '$' s) ! | _ -> assert false let emit_codesymbol s = if toc then emit_char '.'; *************** *** 70,76 **** (* Output a label *) ! let label_prefix = if toc then "L.." else ".L" let emit_label lbl = emit_string label_prefix; emit_int lbl --- 73,84 ---- (* Output a label *) ! let label_prefix = ! match Config.system with ! "aix" -> "L.." ! | "elf" -> ".L" ! | "rhapsody" -> "L" ! | _ -> assert false let emit_label lbl = emit_string label_prefix; emit_int lbl *************** *** 78,91 **** (* Section switching *) let data_space = ! if toc ! then " .csect .data[RW]\n" ! else " .section \".data\"\n" let code_space = ! if toc ! then " .csect .text[PR]\n" ! else " .section \".text\"\n" (* Output a pseudo-register *) --- 86,110 ---- (* Section switching *) let data_space = ! match Config.system with ! "aix" -> " .csect .data[RW]\n" ! | "elf" -> " .section \".data\"\n" ! | "rhapsody" -> " .data\n" ! | _ -> assert false let code_space = ! match Config.system with ! "aix" -> " .csect .text[PR]\n" ! | "elf" -> " .section \".text\"\n" ! | "rhapsody" -> " .text\n" ! | _ -> assert false ! ! let rodata_space = ! match Config.system with ! "aix" -> " .csect .data[RW]\n" (* ?? *) ! | "elf" -> " .section \".rodata\"\n" ! | "rhapsody" -> " .const\n" ! | _ -> assert false (* Output a pseudo-register *) *************** *** 94,105 **** Reg r -> emit_string (register_name r) | _ -> fatal_error "Emit.emit_reg" (* Output a stack reference *) let emit_stack r = match r.loc with Stack s -> ! let ofs = slot_offset s (register_class r) in `{emit_int ofs}(1)` | _ -> fatal_error "Emit.emit_stack" (* Split a 32-bit integer constants in two 16-bit halves *) --- 113,139 ---- Reg r -> emit_string (register_name r) | _ -> fatal_error "Emit.emit_reg" + let use_full_regnames = + Config.system = "rhapsody" + + let emit_gpr r = + if use_full_regnames then emit_char 'r'; + emit_int r + + let emit_fpr r = + if use_full_regnames then emit_char 'f'; + emit_int r + + let emit_ccr r = + if use_full_regnames then emit_string "cr"; + emit_int r + (* Output a stack reference *) let emit_stack r = match r.loc with Stack s -> ! let ofs = slot_offset s (register_class r) in `{emit_int ofs}({emit_gpr 1})` | _ -> fatal_error "Emit.emit_stack" (* Split a 32-bit integer constants in two 16-bit halves *) *************** *** 116,124 **** let is_native_immediate n = Nativeint.cmp n 32767 <= 0 && Nativeint.cmp n (-32768) >= 0 (* Output a load or store operation *) ! let emit_symbol_offset s d = emit_symbol s; if d > 0 then `+`; if d <> 0 then emit_int d --- 150,177 ---- let is_native_immediate n = Nativeint.cmp n 32767 <= 0 && Nativeint.cmp n (-32768) >= 0 + (* Output a "upper 16 bits" or "lower 16 bits" operator + (for the absolute addressing mode) *) + + let emit_upper emit_fun arg = + match Config.system with + "elf" -> + emit_fun arg; emit_string "@ha" + | "rhapsody" -> + emit_string "ha16("; emit_fun arg; emit_string ")" + | _ -> assert false + + let emit_lower emit_fun arg = + match Config.system with + "elf" -> + emit_fun arg; emit_string "@l" + | "rhapsody" -> + emit_string "lo16("; emit_fun arg; emit_string ")" + | _ -> assert false + (* Output a load or store operation *) ! let emit_symbol_offset (s, d) = emit_symbol s; if d > 0 then `+`; if d <> 0 then emit_int d *************** *** 127,142 **** match addressing_mode with Ibased(s, d) -> (* Only relevant in the absolute model *) ! ` addis 11, 0, {emit_symbol_offset s d}@ha\n`; ! ` {emit_string instr} {emit_reg arg}, {emit_symbol_offset s d}@l(11)\n` | Iindexed ofs -> if is_immediate ofs then ` {emit_string instr} {emit_reg arg}, {emit_int ofs}({emit_reg addr.(n)})\n` else begin ! ` lis 0, {emit_int(high ofs)}\n`; if low ofs <> 0 then ! ` ori 0, 0, {emit_int(low ofs)}\n`; ! ` {emit_string instr}x {emit_reg arg}, {emit_reg addr.(n)}, 0\n` end | Iindexed2 -> ` {emit_string instr}x {emit_reg arg}, {emit_reg addr.(n)}, {emit_reg addr.(n+1)}\n` --- 180,195 ---- match addressing_mode with Ibased(s, d) -> (* Only relevant in the absolute model *) ! ` addis {emit_gpr 11}, 0, {emit_upper emit_symbol_offset (s,d)}\n`; ! ` {emit_string instr} {emit_reg arg}, {emit_lower emit_symbol_offset (s,d)}({emit_gpr 11})\n` | Iindexed ofs -> if is_immediate ofs then ` {emit_string instr} {emit_reg arg}, {emit_int ofs}({emit_reg addr.(n)})\n` else begin ! ` lis {emit_gpr 0}, {emit_int(high ofs)}\n`; if low ofs <> 0 then ! ` ori {emit_gpr 0}, {emit_gpr 0}, {emit_int(low ofs)}\n`; ! ` {emit_string instr}x {emit_reg arg}, {emit_reg addr.(n)}, {emit_gpr 0}\n` end | Iindexed2 -> ` {emit_string instr}x {emit_reg arg}, {emit_reg addr.(n)}, {emit_reg addr.(n+1)}\n` *************** *** 144,156 **** (* After a comparison, extract the result as 0 or 1 *) let emit_set_comp cmp res = ! ` mfcr 0\n`; let bitnum = match cmp with Ceq | Cne -> 2 | Cgt | Cle -> 1 | Clt | Cge -> 0 in ! ` rlwinm {emit_reg res}, 0, {emit_int(bitnum+1)}, 1\n`; begin match cmp with Cne | Cle | Cge -> ` xori {emit_reg res}, {emit_reg res}, 1\n` | _ -> () --- 197,209 ---- (* After a comparison, extract the result as 0 or 1 *) let emit_set_comp cmp res = ! ` mfcr {emit_gpr 0}\n`; let bitnum = match cmp with Ceq | Cne -> 2 | Cgt | Cle -> 1 | Clt | Cge -> 0 in ! ` rlwinm {emit_reg res}, {emit_gpr 0}, {emit_int(bitnum+1)}, 31, 31\n`; begin match cmp with Cne | Cle | Cge -> ` xori {emit_reg res}, {emit_reg res}, 1\n` | _ -> () *************** *** 231,236 **** --- 284,302 ---- let float_literals = ref ([] : (string * int) list) + (* Record external C functions to be called in a position-independent way + (for Rhapsody) *) + + let pic_externals = (Config.system = "rhapsody") + + let external_functions = ref StringSet.empty + + let emit_external s = + ` .non_lazy_symbol_pointer\n`; + `L{emit_symbol s}$non_lazy_ptr:\n`; + ` .indirect_symbol {emit_symbol s}\n`; + ` .long 0\n` + (* Names for conditional branches after comparisons *) let branch_for_comparison = function *************** *** 338,353 **** end else begin let lbl = new_label() in float_literals := (s, lbl) :: !float_literals; ! ` addis 11, 0, {emit_label lbl}@ha\n`; ! ` lfd {emit_reg i.res.(0)}, {emit_label lbl}@l(11)\n` end | Lop(Iconst_symbol s) -> if toc then begin let lbl = label_symbol s in ` lwz {emit_reg i.res.(0)}, {emit_label lbl}(2) # {emit_symbol s}\n` end else begin ! ` addis {emit_reg i.res.(0)}, 0, {emit_symbol s}@ha\n`; ! ` addi {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, {emit_symbol s}@l\n` end | Lop(Icall_ind) -> if toc then begin --- 404,419 ---- end else begin let lbl = new_label() in float_literals := (s, lbl) :: !float_literals; ! ` addis {emit_gpr 11}, 0, {emit_upper emit_label lbl}\n`; ! ` lfd {emit_reg i.res.(0)}, {emit_lower emit_label lbl}({emit_gpr 11})\n` end | Lop(Iconst_symbol s) -> if toc then begin let lbl = label_symbol s in ` lwz {emit_reg i.res.(0)}, {emit_label lbl}(2) # {emit_symbol s}\n` end else begin ! ` addis {emit_reg i.res.(0)}, 0, {emit_upper emit_symbol s}\n`; ! ` addi {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, {emit_lower emit_symbol s}\n` end | Lop(Icall_ind) -> if toc then begin *************** *** 378,388 **** ` mtctr {emit_reg i.arg.(0)}\n` end; if !contains_calls then begin ! ` lwz 11, {emit_int(n - 4)}(1)\n`; ! ` addi 1, 1, {emit_int n}\n`; ! ` mtlr 11\n` end else begin ! ` addi 1, 1, {emit_int n}\n` end; ` bctr\n` | Lop(Itailcall_imm s) -> --- 444,454 ---- ` mtctr {emit_reg i.arg.(0)}\n` end; if !contains_calls then begin ! ` lwz {emit_gpr 11}, {emit_int(n - 4)}({emit_gpr 1})\n`; ! ` addi {emit_gpr 1}, {emit_gpr 1}, {emit_int n}\n`; ! ` mtlr {emit_gpr 11}\n` end else begin ! ` addi {emit_gpr 1}, {emit_gpr 1}, {emit_int n}\n` end; ` bctr\n` | Lop(Itailcall_imm s) -> *************** *** 391,401 **** else if not toc || StringSet.mem s !defined_functions then begin let n = frame_size() in if !contains_calls then begin ! ` lwz 11, {emit_int(n - 4)}(1)\n`; ! ` addi 1, 1, {emit_int n}\n`; ! ` mtlr 11\n` end else begin ! ` addi 1, 1, {emit_int n}\n` end; ` b {emit_codesymbol s}\n` end else begin --- 457,467 ---- else if not toc || StringSet.mem s !defined_functions then begin let n = frame_size() in if !contains_calls then begin ! ` lwz {emit_gpr 11}, {emit_int(n - 4)}({emit_gpr 1})\n`; ! ` addi {emit_gpr 1}, {emit_gpr 1}, {emit_int n}\n`; ! ` mtlr {emit_gpr 11}\n` end else begin ! ` addi {emit_gpr 1}, {emit_gpr 1}, {emit_int n}\n` end; ` b {emit_codesymbol s}\n` end else begin *************** *** 427,445 **** if toc then begin let lbl = label_symbol s in ` lwz 11, {emit_label lbl}(2) # {emit_symbol s}\n` end else begin ! ` addis 11, 0, {emit_symbol s}@ha\n`; ! ` addi 11, 11, {emit_symbol s}@l\n` end; record_frame i.live; ` bl {emit_codesymbol "caml_c_call"}\n` end else begin ` bl {emit_codesymbol s}\n` end; if toc then ` cror 31, 31, 31\n` (* nop *) | Lop(Istackoffset n) -> ! ` addi 1, 1, {emit_int (-n)}\n`; stack_offset := !stack_offset + n | Lop(Iload(chunk, addr)) -> let loadinstr = --- 493,522 ---- if toc then begin let lbl = label_symbol s in ` lwz 11, {emit_label lbl}(2) # {emit_symbol s}\n` + end else if pic_externals then begin + external_functions := StringSet.add s !external_functions; + ` addis {emit_gpr 11}, 0, ha16(L{emit_symbol s}$non_lazy_ptr)\n`; + ` lwz {emit_gpr 11}, lo16(L{emit_symbol s}$non_lazy_ptr)({emit_gpr 11})\n` end else begin ! ` addis {emit_gpr 11}, 0, {emit_upper emit_symbol s}\n`; ! ` addi {emit_gpr 11}, {emit_gpr 11}, {emit_lower emit_symbol s}\n` end; record_frame i.live; ` bl {emit_codesymbol "caml_c_call"}\n` end else begin + if pic_externals then begin + external_functions := StringSet.add s !external_functions; + ` addis {emit_gpr 11}, 0, ha16(L{emit_symbol s}$non_lazy_ptr)\n`; + ` lwz {emit_gpr 11}, lo16(L{emit_symbol s}$non_lazy_ptr)({emit_gpr 11})\n`; + ` mtlr {emit_gpr 11}\n`; + ` blrl\n` + end else ` bl {emit_codesymbol s}\n` end; if toc then ` cror 31, 31, 31\n` (* nop *) | Lop(Istackoffset n) -> ! ` addi {emit_gpr 1}, {emit_gpr 1}, {emit_int (-n)}\n`; stack_offset := !stack_offset + n | Lop(Iload(chunk, addr)) -> let loadinstr = *************** *** 461,469 **** emit_load_store storeinstr addr i.arg 1 i.arg.(0) | Lop(Ialloc n) -> if !call_gc_label = 0 then call_gc_label := new_label(); ! ` addi 31, 31, {emit_int(-n)}\n`; ! ` cmplw 31, 30\n`; ! ` addi {emit_reg i.res.(0)}, 31, 4\n`; record_frame i.live; ` bltl {emit_label !call_gc_label}\n` | Lop(Iintop Isub) -> (* subf has swapped arguments *) --- 538,546 ---- emit_load_store storeinstr addr i.arg 1 i.arg.(0) | Lop(Ialloc n) -> if !call_gc_label = 0 then call_gc_label := new_label(); ! ` addi {emit_gpr 31}, {emit_gpr 31}, {emit_int(-n)}\n`; ! ` cmplw {emit_gpr 31}, {emit_gpr 30}\n`; ! ` addi {emit_reg i.res.(0)}, {emit_gpr 31}, 4\n`; record_frame i.live; ` bltl {emit_label !call_gc_label}\n` | Lop(Iintop Isub) -> (* subf has swapped arguments *) *************** *** 471,481 **** ` subfc {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n` | Lop(Iintop Imod) -> if powerpc then begin ! ` divw 0, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ! ` mullw 0, 0, {emit_reg i.arg.(1)}\n`; ! ` subfc {emit_reg i.res.(0)}, 0, {emit_reg i.arg.(0)}\n` end else begin ! ` divs 0, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ` mfmq {emit_reg i.res.(0)}\n` end | Lop(Iintop(Icomp cmp)) -> --- 548,558 ---- ` subfc {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n` | Lop(Iintop Imod) -> if powerpc then begin ! ` divw {emit_gpr 0}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ! ` mullw {emit_gpr 0}, {emit_gpr 0}, {emit_reg i.arg.(1)}\n`; ! ` subfc {emit_reg i.res.(0)}, {emit_gpr 0}, {emit_reg i.arg.(0)}\n` end else begin ! ` divs {emit_gpr 0}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ` mfmq {emit_reg i.res.(0)}\n` end | Lop(Iintop(Icomp cmp)) -> *************** *** 500,509 **** ` addze {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` | Lop(Iintop_imm(Imod, n)) -> (* n is guaranteed to be a power of 2 *) let l = Misc.log2 n in ! ` srawi 0, {emit_reg i.arg.(0)}, {emit_int l}\n`; ! ` addze 0, 0\n`; ! ` slwi 0, 0, {emit_int l}\n`; ! ` subfc {emit_reg i.res.(0)}, 0, {emit_reg i.arg.(0)}\n` | Lop(Iintop_imm(Icomp cmp, n)) -> begin match cmp with Isigned c -> --- 577,586 ---- ` addze {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` | Lop(Iintop_imm(Imod, n)) -> (* n is guaranteed to be a power of 2 *) let l = Misc.log2 n in ! ` srawi {emit_gpr 0}, {emit_reg i.arg.(0)}, {emit_int l}\n`; ! ` addze {emit_gpr 0}, {emit_gpr 0}\n`; ! ` slwi {emit_gpr 0}, {emit_gpr 0}, {emit_int l}\n`; ! ` subfc {emit_reg i.res.(0)}, {emit_gpr 0}, {emit_reg i.arg.(0)}\n` | Lop(Iintop_imm(Icomp cmp, n)) -> begin match cmp with Isigned c -> *************** *** 533,563 **** let lbl = new_label() in float_literals := ("4.503601774854144e15", lbl) :: !float_literals; (* That float above also represents 0x4330000080000000 *) ! ` addis 11, 0, {emit_label lbl}@ha\n`; ! ` lfd 0, {emit_label lbl}@l(11)\n` end; ! ` lis 0, 0x4330\n`; ! ` stwu 0, -8(1)\n`; ! ` xoris 0, {emit_reg i.arg.(0)}, 0x8000\n`; ! ` stw 0, 4(1)\n`; ! ` lfd {emit_reg i.res.(0)}, 0(1)\n`; ! ` addi 1, 1, 8\n`; ! ` fsub {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 0\n` | Lop(Iintoffloat) -> ! ` fctiwz 0, {emit_reg i.arg.(0)}\n`; ! ` stfdu 0, -8(1)\n`; ! ` lwz {emit_reg i.res.(0)}, 4(1)\n`; ! ` addi 1, 1, 8\n` | Lop(Ispecific sop) -> let instr = name_for_specific sop in ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n` | Lreloadretaddr -> let n = frame_size() in ! ` lwz 11, {emit_int(n - 4)}(1)\n`; ! ` mtlr 11\n` | Lreturn -> let n = frame_size() in ! ` addi 1, 1, {emit_int n}\n`; ` blr\n` | Llabel lbl -> `{emit_label lbl}:\n` --- 610,640 ---- let lbl = new_label() in float_literals := ("4.503601774854144e15", lbl) :: !float_literals; (* That float above also represents 0x4330000080000000 *) ! ` addis {emit_gpr 11}, 0, {emit_upper emit_label lbl}\n`; ! ` lfd {emit_fpr 0}, {emit_lower emit_label lbl}({emit_gpr 11})\n` end; ! ` lis {emit_gpr 0}, 0x4330\n`; ! ` stwu {emit_gpr 0}, -8({emit_gpr 1})\n`; ! ` xoris {emit_gpr 0}, {emit_reg i.arg.(0)}, 0x8000\n`; ! ` stw {emit_gpr 0}, 4({emit_gpr 1})\n`; ! ` lfd {emit_reg i.res.(0)}, 0({emit_gpr 1})\n`; ! ` addi {emit_gpr 1}, {emit_gpr 1}, 8\n`; ! ` fsub {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, {emit_fpr 0}\n` | Lop(Iintoffloat) -> ! ` fctiwz {emit_fpr 0}, {emit_reg i.arg.(0)}\n`; ! ` stfdu {emit_fpr 0}, -8({emit_gpr 1})\n`; ! ` lwz {emit_reg i.res.(0)}, 4({emit_gpr 1})\n`; ! ` addi {emit_gpr 1}, {emit_gpr 1}, 8\n` | Lop(Ispecific sop) -> let instr = name_for_specific sop in ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n` | Lreloadretaddr -> let n = frame_size() in ! ` lwz {emit_gpr 11}, {emit_int(n - 4)}({emit_gpr 1})\n`; ! ` mtlr {emit_gpr 11}\n` | Lreturn -> let n = frame_size() in ! ` addi {emit_gpr 1}, {emit_gpr 1}, {emit_int n}\n`; ` blr\n` | Llabel lbl -> `{emit_label lbl}:\n` *************** *** 584,590 **** emit_delay dslot; ` {emit_string branch} {emit_label lbl}\n` | Ifloattest(cmp, neg) -> ! ` fcmpu 0, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; (* bit 0 = lt, bit 1 = gt, bit 2 = eq *) let (bitnum, negtst) = match cmp with --- 661,667 ---- emit_delay dslot; ` {emit_string branch} {emit_label lbl}\n` | Ifloattest(cmp, neg) -> ! ` fcmpu {emit_ccr 0}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; (* bit 0 = lt, bit 1 = gt, bit 2 = eq *) let (bitnum, negtst) = match cmp with *************** *** 601,611 **** then ` bf {emit_int bitnum}, {emit_label lbl}\n` else ` bt {emit_int bitnum}, {emit_label lbl}\n` | Ioddtest -> ! ` andi. 0, {emit_reg i.arg.(0)}, 1\n`; emit_delay dslot; ` bne {emit_label lbl}\n` | Ieventest -> ! ` andi. 0, {emit_reg i.arg.(0)}, 1\n`; emit_delay dslot; ` beq {emit_label lbl}\n` end --- 678,688 ---- then ` bf {emit_int bitnum}, {emit_label lbl}\n` else ` bt {emit_int bitnum}, {emit_label lbl}\n` | Ioddtest -> ! ` andi. {emit_gpr 0}, {emit_reg i.arg.(0)}, 1\n`; emit_delay dslot; ` bne {emit_label lbl}\n` | Ieventest -> ! ` andi. {emit_gpr 0}, {emit_reg i.arg.(0)}, 1\n`; emit_delay dslot; ` beq {emit_label lbl}\n` end *************** *** 629,642 **** if toc then begin ` lwz 11, {emit_label !lbl_jumptbl}(2)\n` end else begin ! ` addis 11, 0, {emit_label !lbl_jumptbl}@ha\n`; ! ` addi 11, 11, {emit_label !lbl_jumptbl}@l\n` end; ! ` addi 0, {emit_reg i.arg.(0)}, {emit_int !num_jumptbl_entries}\n`; ! ` slwi 0, 0, 2\n`; ! ` lwzx 0, 11, 0\n`; ! ` add 0, 11, 0\n`; ! ` mtctr 0\n`; ` bctr\n`; for i = 0 to Array.length jumptbl - 1 do jumptbl_entries := jumptbl.(i) :: !jumptbl_entries; --- 706,719 ---- if toc then begin ` lwz 11, {emit_label !lbl_jumptbl}(2)\n` end else begin ! ` addis {emit_gpr 11}, 0, {emit_upper emit_label !lbl_jumptbl}\n`; ! ` addi {emit_gpr 11}, {emit_gpr 11}, {emit_lower emit_label !lbl_jumptbl}\n` end; ! ` addi {emit_gpr 0}, {emit_reg i.arg.(0)}, {emit_int !num_jumptbl_entries}\n`; ! ` slwi {emit_gpr 0}, {emit_gpr 0}, 2\n`; ! ` lwzx {emit_gpr 0}, {emit_gpr 11}, {emit_gpr 0}\n`; ! ` add {emit_gpr 0}, {emit_gpr 11}, {emit_gpr 0}\n`; ! ` mtctr {emit_gpr 0}\n`; ` bctr\n`; for i = 0 to Array.length jumptbl - 1 do jumptbl_entries := jumptbl.(i) :: !jumptbl_entries; *************** *** 646,669 **** ` bl {emit_label lbl}\n` | Lpushtrap -> stack_offset := !stack_offset + trap_frame_size; ! ` mflr 0\n`; ! ` stwu 0, -{emit_int trap_frame_size}(1)\n`; ! ` stw 29, 4(1)\n`; if toc then ! ` stw 2, 20(1)\n`; ! ` mr 29, 1\n` | Lpoptrap -> ! ` lwz 29, 4(1)\n`; ! ` addi 1, 1, {emit_int trap_frame_size}\n`; stack_offset := !stack_offset - trap_frame_size | Lraise -> ! ` lwz 0, 0(29)\n`; ! ` mr 1, 29\n`; ! ` mtlr 0\n`; ! ` lwz 29, 4(1)\n`; if toc then ! ` lwz 2, 20(1)\n`; ! ` addi 1, 1, {emit_int trap_frame_size}\n\n`; ` blr\n` and emit_delay = function --- 723,746 ---- ` bl {emit_label lbl}\n` | Lpushtrap -> stack_offset := !stack_offset + trap_frame_size; ! ` mflr {emit_gpr 0}\n`; ! ` stwu {emit_gpr 0}, -{emit_int trap_frame_size}({emit_gpr 1})\n`; ! ` stw {emit_gpr 29}, 4({emit_gpr 1})\n`; if toc then ! ` stw {emit_gpr 2}, 20({emit_gpr 1})\n`; ! ` mr {emit_gpr 29}, {emit_gpr 1}\n` | Lpoptrap -> ! ` lwz {emit_gpr 29}, 4({emit_gpr 1})\n`; ! ` addi {emit_gpr 1}, {emit_gpr 1}, {emit_int trap_frame_size}\n`; stack_offset := !stack_offset - trap_frame_size | Lraise -> ! ` lwz {emit_gpr 0}, 0({emit_gpr 29})\n`; ! ` mr {emit_gpr 1}, {emit_gpr 29}\n`; ! ` mtlr {emit_gpr 0}\n`; ! ` lwz {emit_gpr 29}, 4({emit_gpr 1})\n`; if toc then ! ` lwz {emit_gpr 2}, 20({emit_gpr 1})\n`; ! ` addi {emit_gpr 1}, {emit_gpr 1}, {emit_int trap_frame_size}\n\n`; ` blr\n` and emit_delay = function *************** *** 722,745 **** call_gc_label := 0; float_literals := []; ` .globl {emit_symbol fundecl.fun_name}\n`; ! if toc then begin ! ` .globl .{emit_symbol fundecl.fun_name}\n`; ! ` .csect {emit_symbol fundecl.fun_name}[DS]\n`; ! `{emit_symbol fundecl.fun_name}:\n`; ! ` .long .{emit_symbol fundecl.fun_name}, TOC[tc0], 0\n` ! end else begin ! ` .type {emit_symbol fundecl.fun_name}, @function\n` end; emit_string code_space; ` .align 2\n`; `{emit_codesymbol fundecl.fun_name}:\n`; let n = frame_size() in if !contains_calls then begin ! ` mflr 0\n`; ! ` addi 1, 1, {emit_int(-n)}\n`; ! ` stw 0, {emit_int(n - 4)}(1)\n` end else ! ` addi 1, 1, {emit_int(-n)}\n`; `{emit_label !tailrec_entry_point}:\n`; emit_all fundecl.fun_body; (* Emit the glue code to call the GC *) --- 799,824 ---- call_gc_label := 0; float_literals := []; ` .globl {emit_symbol fundecl.fun_name}\n`; ! begin match Config.system with ! "aix" -> ! ` .globl .{emit_symbol fundecl.fun_name}\n`; ! ` .csect {emit_symbol fundecl.fun_name}[DS]\n`; ! `{emit_symbol fundecl.fun_name}:\n`; ! ` .long .{emit_symbol fundecl.fun_name}, TOC[tc0], 0\n` ! | "elf" -> ! ` .type {emit_symbol fundecl.fun_name}, @function\n` ! | _ -> () end; emit_string code_space; ` .align 2\n`; `{emit_codesymbol fundecl.fun_name}:\n`; let n = frame_size() in if !contains_calls then begin ! ` mflr {emit_gpr 0}\n`; ! ` addi {emit_gpr 1}, {emit_gpr 1}, {emit_int(-n)}\n`; ! ` stw {emit_gpr 0}, {emit_int(n - 4)}({emit_gpr 1})\n` end else ! ` addi {emit_gpr 1}, {emit_gpr 1}, {emit_int(-n)}\n`; `{emit_label !tailrec_entry_point}:\n`; emit_all fundecl.fun_body; (* Emit the glue code to call the GC *) *************** *** 751,762 **** ` cror 31, 31, 31\n`; (* nop *) ` blr\n` (* Will re-execute the allocation *) end else begin ! ` b caml_call_gc\n` end end; (* Emit the floating-point literals *) if !float_literals <> [] then begin ! ` .section \".rodata\"\n`; ` .align 3\n`; List.iter (fun (f, lbl) -> --- 830,841 ---- ` cror 31, 31, 31\n`; (* nop *) ` blr\n` (* Will re-execute the allocation *) end else begin ! ` b {emit_symbol "caml_call_gc"}\n` end end; (* Emit the floating-point literals *) if !float_literals <> [] then begin ! emit_string rodata_space; ` .align 3\n`; List.iter (fun (f, lbl) -> *************** *** 768,774 **** let declare_global_data s = ` .globl {emit_symbol s}\n`; ! if not toc then ` .type {emit_symbol s}, @object\n` let emit_item = function Cdefine_symbol s -> --- 847,854 ---- let declare_global_data s = ` .globl {emit_symbol s}\n`; ! if Config.system = "elf" then ! ` .type {emit_symbol s}, @object\n` let emit_item = function Cdefine_symbol s -> *************** *** 805,810 **** --- 885,891 ---- Hashtbl.clear symbol_constants; Hashtbl.clear float_constants; defined_functions := StringSet.empty; + external_functions := StringSet.empty; num_jumptbl_entries := 0; jumptbl_entries := []; lbl_jumptbl := 0; *************** *** 826,837 **** let lbl_tbl = new_label() in ` .toc\n`; `{emit_label !lbl_jumptbl}: .tc {emit_label lbl_tbl}[TC], {emit_label lbl_tbl}\n`; - ` .csect .text[PR]\n`; lbl_tbl ! end else begin ! ` .section \".text\"\n`; ! !lbl_jumptbl ! end in `{emit_label lbl_tbl}:\n`; List.iter (fun lbl -> ` .long {emit_label lbl} - {emit_label lbl_tbl}\n`) --- 907,915 ---- let lbl_tbl = new_label() in ` .toc\n`; `{emit_label !lbl_jumptbl}: .tc {emit_label lbl_tbl}[TC], {emit_label lbl_tbl}\n`; lbl_tbl ! end else !lbl_jumptbl in ! emit_string code_space; `{emit_label lbl_tbl}:\n`; List.iter (fun lbl -> ` .long {emit_label lbl} - {emit_label lbl_tbl}\n`) *************** *** 844,849 **** --- 922,930 ---- Hashtbl.iter emit_symbol_constant symbol_constants; Hashtbl.iter emit_float_constant float_constants end; + if pic_externals then + (* Emit the pointers to external functions *) + StringSet.iter emit_external !external_functions; (* Emit the end of the segments *) emit_string code_space; let lbl_end = Compilenv.current_unit_name() ^ "_code_end" in *************** *** 855,860 **** --- 936,942 ---- `{emit_symbol lbl_end}:\n`; ` .long 0\n`; (* Emit the frame descriptors *) + emit_string rodata_space; let lbl = Compilenv.current_unit_name() ^ "_frametable" in declare_global_data lbl; `{emit_symbol lbl}:\n`; Index: asmcomp/power/proc.ml =================================================================== RCS file: /net/pauillac/caml/repository/csl/asmcomp/power/proc.ml,v retrieving revision 1.1 retrieving revision 1.4 diff -c -r1.1 -r1.4 *** asmcomp/power/proc.ml 1997/07/24 11:49:10 1.1 --- asmcomp/power/proc.ml 1998/03/13 19:31:28 1.4 *************** *** 9,15 **** (* *) (***********************************************************************) ! (* $Id: proc.ml,v 1.1 1997/07/24 11:49:10 xleroy Exp $ *) (* Description of the Power PC *) --- 9,15 ---- (* *) (***********************************************************************) ! (* $Id: proc.ml,v 1.4 1998/03/13 19:31:28 doligez Exp $ *) (* Description of the Power PC *) *************** *** 42,58 **** 14 - 31 general purpose, preserved by C *) ! let int_reg_name = [| ! "3"; "4"; "5"; "6"; "7"; "8"; "9"; "10"; ! "14"; "15"; "16"; "17"; "18"; "19"; "20"; "21"; ! "22"; "23"; "24"; "25"; "26"; "27"; "28" ! |] ! let float_reg_name = [| ! "1"; "2"; "3"; "4"; "5"; "6"; "7"; "8"; ! "9"; "10"; "11"; "12"; "13"; "14"; "15"; "16"; ! "17"; "18"; "19"; "20"; "21"; "22"; "23"; "24"; ! "25"; "26"; "27"; "28"; "29"; "30"; "31" |] let num_register_classes = 2 --- 42,68 ---- 14 - 31 general purpose, preserved by C *) ! let int_reg_name = ! if Config.system = "rhapsody" then ! [| "r3"; "r4"; "r5"; "r6"; "r7"; "r8"; "r9"; "r10"; ! "r14"; "r15"; "r16"; "r17"; "r18"; "r19"; "r20"; "r21"; ! "r22"; "r23"; "r24"; "r25"; "r26"; "r27"; "r28" |] ! else ! [| "3"; "4"; "5"; "6"; "7"; "8"; "9"; "10"; ! "14"; "15"; "16"; "17"; "18"; "19"; "20"; "21"; ! "22"; "23"; "24"; "25"; "26"; "27"; "28" |] ! let float_reg_name = ! if Config.system = "rhapsody" then ! [| "f1"; "f2"; "f3"; "f4"; "f5"; "f6"; "f7"; "f8"; ! "f9"; "f10"; "f11"; "f12"; "f13"; "f14"; "f15"; "f16"; ! "f17"; "f18"; "f19"; "f20"; "f21"; "f22"; "f23"; "f24"; ! "f25"; "f26"; "f27"; "f28"; "f29"; "f30"; "f31" |] ! else ! [| "1"; "2"; "3"; "4"; "5"; "6"; "7"; "8"; ! "9"; "10"; "11"; "12"; "13"; "14"; "15"; "16"; ! "17"; "18"; "19"; "20"; "21"; "22"; "23"; "24"; ! "25"; "26"; "27"; "28"; "29"; "30"; "31" |] let num_register_classes = 2 *************** *** 176,185 **** done; (loc, Misc.align !ofs 8) (* Keep stack 8-aligned *) ! let loc_external_arguments arg = ! if toc ! then poweropen_external_conventions 0 7 100 112 arg ! else calling_conventions 0 7 100 107 outgoing 8 arg let extcall_use_push = false --- 186,196 ---- done; (loc, Misc.align !ofs 8) (* Keep stack 8-aligned *) ! let loc_external_arguments = ! match Config.system with ! "aix" | "rhapsody" -> poweropen_external_conventions 0 7 100 112 ! | "elf" -> calling_conventions 0 7 100 107 outgoing 8 ! | _ -> assert false let extcall_use_push = false *************** *** 224,229 **** (* Calling the assembler *) let assemble_file infile outfile = ! let proc = if powerpc then "ppc" else "pwr" in ! Ccomp.command ("as -u -m " ^ proc ^ " -o " ^ outfile ^ " " ^ infile) ! --- 235,246 ---- (* Calling the assembler *) let assemble_file infile outfile = ! match Config.system with ! "aix" -> ! let proc = if powerpc then "ppc" else "pwr" in ! Ccomp.command ("as -u -m " ^ proc ^ " -o " ^ outfile ^ " " ^ infile) ! | "elf" -> ! Ccomp.command ("as -u -m ppc -o " ^ outfile ^ " " ^ infile) ! | "rhapsody" -> ! Ccomp.command ("as -o " ^ outfile ^ " " ^ infile) ! | _ -> assert false Index: byterun/config.h =================================================================== RCS file: /net/pauillac/caml/repository/csl/byterun/config.h,v retrieving revision 1.14 retrieving revision 1.15 diff -c -r1.14 -r1.15 *** byterun/config.h 1997/05/26 17:15:19 1.14 --- byterun/config.h 1998/03/13 19:59:03 1.15 *************** *** 9,15 **** /* */ /***********************************************************************/ ! /* $Id: config.h,v 1.14 1997/05/26 17:15:19 doligez Exp $ */ #ifndef _config_ #define _config_ --- 9,15 ---- /* */ /***********************************************************************/ ! /* $Id: config.h,v 1.15 1998/03/13 19:59:03 doligez Exp $ */ #ifndef _config_ #define _config_ *************** *** 43,49 **** bytecode interpreter (THREADED_CODE defined in config/sm-Mac.h). */ ! #if defined(__GNUC__) && __GNUC__ >= 2 && !defined(DEBUG) #define THREADED_CODE #endif --- 43,49 ---- bytecode interpreter (THREADED_CODE defined in config/sm-Mac.h). */ ! #if defined(__GNUC__) && __GNUC__ >= 2 && !defined(DEBUG) && !defined (SHRINKED_GNUC) #define THREADED_CODE #endif Index: config/auto-aux/config.guess =================================================================== RCS file: /net/pauillac/caml/repository/csl/config/auto-aux/config.guess,v retrieving revision 1.6 retrieving revision 1.7 diff -c -r1.6 -r1.7 *** config/auto-aux/config.guess 1997/12/02 13:04:02 1.6 --- config/auto-aux/config.guess 1998/03/13 19:59:06 1.7 *************** *** 444,449 **** --- 444,452 ---- echo ns32k-sni-sysv fi exit 0 ;; + "Power Macintosh":Rhapsody:*:*) + echo powerpc-apple-rhapsody + exit 0;; esac #echo '(No uname command or uname output not recognized.)' 1>&2 Index: config/auto-aux/config.sub =================================================================== RCS file: /net/pauillac/caml/repository/csl/config/auto-aux/config.sub,v retrieving revision 1.3 retrieving revision 1.4 diff -c -r1.3 -r1.4 *** config/auto-aux/config.sub 1997/12/02 13:04:03 1.3 --- config/auto-aux/config.sub 1998/03/13 19:59:08 1.4 *************** *** 641,647 **** | -hiux* | -386bsd* | -netbsd* | -freebsd* | -riscix* \ | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ ! | -udi* | -eabi* | -lites* | -openbsd* ) # Remember, each alternative MUST END IN *, to match a version number. ;; -sunos5*) --- 641,647 ---- | -hiux* | -386bsd* | -netbsd* | -freebsd* | -riscix* \ | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ ! | -udi* | -eabi* | -lites* | -openbsd* | -rhapsody* ) # Remember, each alternative MUST END IN *, to match a version number. ;; -sunos5*) Index: config/auto-aux/dblalign.c =================================================================== RCS file: /net/pauillac/caml/repository/csl/config/auto-aux/dblalign.c,v retrieving revision 1.5 retrieving revision 1.6 diff -c -r1.5 -r1.6 *** config/auto-aux/dblalign.c 1997/09/02 12:54:17 1.5 --- config/auto-aux/dblalign.c 1998/03/13 19:59:09 1.6 *************** *** 9,15 **** /* */ /***********************************************************************/ ! /* $Id: dblalign.c,v 1.5 1997/09/02 12:54:17 xleroy Exp $ */ #include #include --- 9,15 ---- /* */ /***********************************************************************/ ! /* $Id: dblalign.c,v 1.6 1998/03/13 19:59:09 doligez Exp $ */ #include #include *************** *** 34,40 **** --- 34,42 ---- long n[10]; int res; signal(SIGSEGV, sig_handler); + #ifdef SIGBUS signal(SIGBUS, sig_handler); + #endif if(setjmp(failure) == 0) { access_double((double *) n); access_double((double *) (n+1)); *************** *** 43,49 **** --- 45,53 ---- res = 1; } signal(SIGSEGV, SIG_DFL); + #ifdef SIGBUS signal(SIGBUS, SIG_DFL); + #endif exit(res); } Index: otherlibs/unix/gethost.c =================================================================== RCS file: /net/pauillac/caml/repository/csl/otherlibs/unix/gethost.c,v retrieving revision 1.11 retrieving revision 1.12 diff -c -r1.11 -r1.12 *** otherlibs/unix/gethost.c 1997/09/02 12:54:37 1.11 --- otherlibs/unix/gethost.c 1998/03/13 19:59:11 1.12 *************** *** 9,15 **** /* */ /***********************************************************************/ ! /* $Id: gethost.c,v 1.11 1997/09/02 12:54:37 xleroy Exp $ */ #include #include --- 9,15 ---- /* */ /***********************************************************************/ ! /* $Id: gethost.c,v 1.12 1998/03/13 19:59:11 doligez Exp $ */ #include #include *************** *** 40,57 **** { value res; value name = Val_unit, aliases = Val_unit; ! value addr_list = Val_unit, addr = Val_unit; ! Begin_roots4 (name, aliases, addr_list, addr); name = copy_string((char *)(entry->h_name)); aliases = copy_string_array(entry->h_aliases); entry_h_length = entry->h_length; #ifdef h_addr addr_list = alloc_array(alloc_one_addr, entry->h_addr_list); #else ! addr = alloc_one_addr(entry->h_addr); addr_list = alloc_tuple(1); ! Field(addr_list, 0) = addr; #endif res = alloc_tuple(4); Field(res, 0) = name; --- 40,57 ---- { value res; value name = Val_unit, aliases = Val_unit; ! value addr_list = Val_unit, adr = Val_unit; ! Begin_roots4 (name, aliases, addr_list, adr); name = copy_string((char *)(entry->h_name)); aliases = copy_string_array(entry->h_aliases); entry_h_length = entry->h_length; #ifdef h_addr addr_list = alloc_array(alloc_one_addr, entry->h_addr_list); #else ! adr = alloc_one_addr(entry->h_addr); addr_list = alloc_tuple(1); ! Field(addr_list, 0) = adr; #endif res = alloc_tuple(4); Field(res, 0) = name; *************** *** 64,74 **** value unix_gethostbyaddr(value a) /* ML */ { ! uint32 addr; struct hostent * entry; ! addr = GET_INET_ADDR(a); enter_blocking_section(); ! entry = gethostbyaddr((char *) &addr, 4, AF_INET); leave_blocking_section(); if (entry == (struct hostent *) NULL) raise_not_found(); return alloc_host_entry(entry); --- 64,74 ---- value unix_gethostbyaddr(value a) /* ML */ { ! uint32 adr; struct hostent * entry; ! adr = GET_INET_ADDR(a); enter_blocking_section(); ! entry = gethostbyaddr((char *) &adr, 4, AF_INET); leave_blocking_section(); if (entry == (struct hostent *) NULL) raise_not_found(); return alloc_host_entry(entry); Index: asmrun/power-rhapsody.S =================================================================== *** /dev/null Tue Apr 7 18:15:52 1998 --- asmrun/power-rhapsody.S Fri Mar 13 20:31:30 1998 *************** *** 0 **** --- 1,421 ---- + /*********************************************************************/ + /* */ + /* Objective Caml */ + /* */ + /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ + /* */ + /* Copyright 1996 Institut National de Recherche en Informatique et */ + /* Automatique. Distributed only by permission. */ + /* */ + /*********************************************************************/ + + /* $Id: power-rhapsody.S,v 1.2 1998/03/13 19:31:30 doligez Exp $ */ + + .macro Addrglobal /* reg, glob */ + addis $0, 0, ha16($1) + addi $0, $0, lo16($1) + .endmacro + .macro Loadglobal /* reg,glob,tmp */ + addis $2, 0, ha16($1) + lwz $0, lo16($1)($2) + .endmacro + .macro Storeglobal /* reg,glob,tmp */ + addis $2, 0, ha16($1) + stw $0, lo16($1)($2) + .endmacro + + .text + + /* Invoke the garbage collector. */ + + .globl _caml_call_gc + _caml_call_gc: + /* Set up stack frame */ + stwu r1, -0x1A0(r1) + /* 0x1A0 = 4*32 (int regs) + 8*32 (float regs) + 32 (space for C call) */ + /* Record return address into Caml code */ + mflr r0 + Storeglobal r0, _caml_last_return_address, r11 + /* Record lowest stack address */ + addi r0, r1, 0x1A0 + Storeglobal r0, _caml_bottom_of_stack, r11 + /* Record pointer to register array */ + addi r0, r1, 8*32 + 32 + Storeglobal r0, _caml_gc_regs, r11 + /* Save current allocation pointer for debugging purposes */ + Storeglobal r31, _young_ptr, r11 + /* Save exception pointer (if e.g. a sighandler raises) */ + Storeglobal r29, _caml_exception_pointer, r11 + /* Save all registers used by the code generator */ + addi r11, r1, 8*32 + 32 - 4 + stwu r3, 4(r11) + stwu r4, 4(r11) + stwu r5, 4(r11) + stwu r6, 4(r11) + stwu r7, 4(r11) + stwu r8, 4(r11) + stwu r9, 4(r11) + stwu r10, 4(r11) + stwu r14, 4(r11) + stwu r15, 4(r11) + stwu r16, 4(r11) + stwu r17, 4(r11) + stwu r18, 4(r11) + stwu r19, 4(r11) + stwu r20, 4(r11) + stwu r21, 4(r11) + stwu r22, 4(r11) + stwu r23, 4(r11) + stwu r24, 4(r11) + stwu r25, 4(r11) + stwu r26, 4(r11) + stwu r27, 4(r11) + stwu r28, 4(r11) + addi r11, r1, 32 - 8 + stfdu f1, 8(r11) + stfdu f2, 8(r11) + stfdu f3, 8(r11) + stfdu f4, 8(r11) + stfdu f5, 8(r11) + stfdu f6, 8(r11) + stfdu f7, 8(r11) + stfdu f8, 8(r11) + stfdu f9, 8(r11) + stfdu f10, 8(r11) + stfdu f11, 8(r11) + stfdu f12, 8(r11) + stfdu f13, 8(r11) + stfdu f14, 8(r11) + stfdu f15, 8(r11) + stfdu f16, 8(r11) + stfdu f17, 8(r11) + stfdu f18, 8(r11) + stfdu f19, 8(r11) + stfdu f20, 8(r11) + stfdu f21, 8(r11) + stfdu f22, 8(r11) + stfdu f23, 8(r11) + stfdu f24, 8(r11) + stfdu f25, 8(r11) + stfdu f26, 8(r11) + stfdu f27, 8(r11) + stfdu f28, 8(r11) + stfdu f29, 8(r11) + stfdu f30, 8(r11) + stfdu f31, 8(r11) + /* Call the GC */ + bl _garbage_collection + /* Reload new allocation pointer and allocation limit */ + Loadglobal r31, _young_ptr, r11 + Loadglobal r30, _young_limit, r11 + /* Restore all regs used by the code generator */ + addi r11, r1, 8*32 + 32 - 4 + lwzu r3, 4(r11) + lwzu r4, 4(r11) + lwzu r5, 4(r11) + lwzu r6, 4(r11) + lwzu r7, 4(r11) + lwzu r8, 4(r11) + lwzu r9, 4(r11) + lwzu r10, 4(r11) + lwzu r14, 4(r11) + lwzu r15, 4(r11) + lwzu r16, 4(r11) + lwzu r17, 4(r11) + lwzu r18, 4(r11) + lwzu r19, 4(r11) + lwzu r20, 4(r11) + lwzu r21, 4(r11) + lwzu r22, 4(r11) + lwzu r23, 4(r11) + lwzu r24, 4(r11) + lwzu r25, 4(r11) + lwzu r26, 4(r11) + lwzu r27, 4(r11) + lwzu r28, 4(r11) + addi r11, r1, 32 - 8 + lfdu f1, 8(r11) + lfdu f2, 8(r11) + lfdu f3, 8(r11) + lfdu f4, 8(r11) + lfdu f5, 8(r11) + lfdu f6, 8(r11) + lfdu f7, 8(r11) + lfdu f8, 8(r11) + lfdu f9, 8(r11) + lfdu f10, 8(r11) + lfdu f11, 8(r11) + lfdu f12, 8(r11) + lfdu f13, 8(r11) + lfdu f14, 8(r11) + lfdu f15, 8(r11) + lfdu f16, 8(r11) + lfdu f17, 8(r11) + lfdu f18, 8(r11) + lfdu f19, 8(r11) + lfdu f20, 8(r11) + lfdu f21, 8(r11) + lfdu f22, 8(r11) + lfdu f23, 8(r11) + lfdu f24, 8(r11) + lfdu f25, 8(r11) + lfdu f26, 8(r11) + lfdu f27, 8(r11) + lfdu f28, 8(r11) + lfdu f29, 8(r11) + lfdu f30, 8(r11) + lfdu f31, 8(r11) + /* Return to caller, restarting the allocation */ + Loadglobal r0, _caml_last_return_address, r11 + addic r0, r0, -16 /* Restart the allocation (4 instructions) */ + mtlr r0 + /* Say we are back into Caml code */ + li r12, 0 + Storeglobal r12, _caml_last_return_address, r11 + /* Deallocate stack frame */ + addi r1, r1, 0x1A0 + /* Return */ + blr + + /* Call a C function from Caml */ + + .globl _caml_c_call + _caml_c_call: + /* Save return address */ + mflr r25 + /* Get ready to call C function (address in 11) */ + mtlr r11 + /* Record lowest stack address and return address */ + Storeglobal r1, _caml_bottom_of_stack, r12 + Storeglobal r25, _caml_last_return_address, r12 + /* Make the exception handler and alloc ptr available to the C code */ + Storeglobal r31, _young_ptr, r11 + Storeglobal r29, _caml_exception_pointer, r11 + /* Call the function (address in link register) */ + blrl + /* Restore return address (in 25, preserved by the C function) */ + mtlr r25 + /* Reload allocation pointer and allocation limit*/ + Loadglobal r31, _young_ptr, r11 + Loadglobal r30, _young_limit, r11 + /* Say we are back into Caml code */ + li r12, 0 + Storeglobal r12, _caml_last_return_address, r11 + /* Return to caller */ + blr + + /* Raise an exception from C */ + + .globl _raise_caml_exception + _raise_caml_exception: + /* Reload Caml global registers */ + Loadglobal r1, _caml_exception_pointer, r11 + Loadglobal r31, _young_ptr, r11 + Loadglobal r30, _young_limit, r11 + /* Say we are back into Caml code */ + li r0, 0 + Storeglobal r0, _caml_last_return_address, r11 + /* Pop trap frame */ + lwz r0, 0(r1) + lwz r29, 4(r1) + mtlr r0 + addi r1, r1, 8 + /* Branch to handler */ + blr + + /* Start the Caml program */ + + .globl _caml_start_program + _caml_start_program: + Addrglobal r12, _caml_program + + /* Code shared between caml_start_program and callback */ + L102: + /* Allocate and link stack frame */ + stwu r1, -256(r1) + /* Save return address */ + mflr r0 + stw r0, 256+4(r1) + /* Save all callee-save registers */ + /* GPR 14 at sp+16 ... GPR 31 at sp+84 + FPR 14 at sp+92 ... FPR 31 at sp+228 */ + addi r11, r1, 16-4 + stwu r14, 4(r11) + stwu r15, 4(r11) + stwu r16, 4(r11) + stwu r17, 4(r11) + stwu r18, 4(r11) + stwu r19, 4(r11) + stwu r20, 4(r11) + stwu r21, 4(r11) + stwu r22, 4(r11) + stwu r23, 4(r11) + stwu r24, 4(r11) + stwu r25, 4(r11) + stwu r26, 4(r11) + stwu r27, 4(r11) + stwu r28, 4(r11) + stwu r29, 4(r11) + stwu r30, 4(r11) + stwu r31, 4(r11) + stfdu f14, 8(r11) + stfdu f15, 8(r11) + stfdu f16, 8(r11) + stfdu f17, 8(r11) + stfdu f18, 8(r11) + stfdu f19, 8(r11) + stfdu f20, 8(r11) + stfdu f21, 8(r11) + stfdu f22, 8(r11) + stfdu f23, 8(r11) + stfdu f24, 8(r11) + stfdu f25, 8(r11) + stfdu f26, 8(r11) + stfdu f27, 8(r11) + stfdu f28, 8(r11) + stfdu f29, 8(r11) + stfdu f30, 8(r11) + stfdu f31, 8(r11) + /* Set up a callback link */ + addi r1, r1, -16 + Loadglobal r9, _caml_bottom_of_stack, r11 + Loadglobal r10, _caml_last_return_address, r11 + Loadglobal r11, _caml_gc_regs, r11 + stw r9, 0(r1) + stw r10, 4(r1) + stw r11, 8(r1) + /* Build an exception handler to catch exceptions escaping out of Caml */ + bl L103 + b L104 + L103: + addi r1, r1, -8 + mflr r0 + stw r0, 0(r1) + Loadglobal r11, _caml_exception_pointer, r11 + stw r11, 4(r1) + mr r29, r1 + /* Reload allocation pointers */ + Loadglobal r31, _young_ptr, r11 + Loadglobal r30, _young_limit, r11 + /* Say we are back into Caml code */ + li r0, 0 + Storeglobal r0, _caml_last_return_address, r11 + /* Call the Caml code */ + mtlr r12 + L105: + blrl + /* Pop the trap frame, restoring caml_exception_pointer */ + lwz r9, 4(r1) + Storeglobal r9, _caml_exception_pointer, r11 + addi r1, r1, 8 + /* Pop the callback link, restoring the global variables */ + lwz r9, 0(r1) + lwz r10, 4(r1) + lwz r11, 8(r1) + Storeglobal r9, _caml_bottom_of_stack, r12 + Storeglobal r10, _caml_last_return_address, r12 + Storeglobal r11, _caml_gc_regs, r12 + addi r1, r1, 16 + /* Update allocation pointer */ + Storeglobal r31, _young_ptr, r11 + /* Restore callee-save registers */ + addi r11, r1, 16-4 + lwzu r14, 4(r11) + lwzu r15, 4(r11) + lwzu r16, 4(r11) + lwzu r17, 4(r11) + lwzu r18, 4(r11) + lwzu r19, 4(r11) + lwzu r20, 4(r11) + lwzu r21, 4(r11) + lwzu r22, 4(r11) + lwzu r23, 4(r11) + lwzu r24, 4(r11) + lwzu r25, 4(r11) + lwzu r26, 4(r11) + lwzu r27, 4(r11) + lwzu r28, 4(r11) + lwzu r29, 4(r11) + lwzu r30, 4(r11) + lwzu r31, 4(r11) + lfdu f14, 8(r11) + lfdu f15, 8(r11) + lfdu f16, 8(r11) + lfdu f17, 8(r11) + lfdu f18, 8(r11) + lfdu f19, 8(r11) + lfdu f20, 8(r11) + lfdu f21, 8(r11) + lfdu f22, 8(r11) + lfdu f23, 8(r11) + lfdu f24, 8(r11) + lfdu f25, 8(r11) + lfdu f26, 8(r11) + lfdu f27, 8(r11) + lfdu f28, 8(r11) + lfdu f29, 8(r11) + lfdu f30, 8(r11) + lfdu f31, 8(r11) + /* Reload return address */ + lwz r0, 256+4(r1) + mtlr r0 + /* Return */ + addi r1, r1, 256 + blr + + /* The trap handler: */ + L104: + /* Update caml_exception_pointer and young_ptr */ + Storeglobal r29, _caml_exception_pointer, r11 + Storeglobal r31, _young_ptr, r11 + /* Pop the callback link, restoring the global variables */ + lwz r9, 0(r1) + lwz r10, 4(r1) + lwz r11, 8(r1) + Storeglobal r9, _caml_bottom_of_stack, r12 + Storeglobal r10, _caml_last_return_address, r12 + Storeglobal r11, _caml_gc_regs, r12 + /* Re-raise the exception through mlraise, */ + /* so that local C roots are cleaned up correctly */ + b _mlraise + + /* Callback from C to Caml */ + + .globl _callback + _callback: + /* Initial shuffling of arguments */ + mr r0, r3 /* Closure */ + mr r3, r4 /* Argument */ + mr r4, r0 + lwz r12, 0(r4) /* Code pointer */ + b L102 + + .globl _callback2 + _callback2: + mr r0, r3 /* Closure */ + mr r3, r4 /* First argument */ + mr r4, r5 /* Second argument */ + mr r5, r0 + Addrglobal r12, _caml_apply2 + b L102 + + .globl _callback3 + _callback3: + mr r0, r3 /* Closure */ + mr r3, r4 /* First argument */ + mr r4, r5 /* Second argument */ + mr r5, r6 /* Third argument */ + mr r6, r0 + Addrglobal r12, _caml_apply3 + b L102 + + /* Frame table */ + + .const + .globl _system_frametable + _system_frametable: + .long 1 /* one descriptor */ + .long L105 + 4 /* return address into callback */ + .short -1 /* negative size count => use callback link */ + .short 0 /* no roots here */ +