diff --git a/0001-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch b/0001-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch new file mode 100644 index 0000000..8fa0e85 --- /dev/null +++ b/0001-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch @@ -0,0 +1,240 @@ +From 0f3d9e1188a765390ac21b6204c66765c1cad8f0 Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Tue, 29 May 2012 20:40:36 +0100 +Subject: [PATCH 1/7] ocamlbyteinfo, ocamlplugininfo: Useful utilities from + Debian, sent upstream. + +See: +http://git.debian.org/?p=pkg-ocaml-maint/packages/ocaml.git;a=tree;f=debian/ocamlbyteinfo;hb=HEAD +--- + ocamlbyteinfo.ml | 101 ++++++++++++++++++++++++++++++++++++++++++++++++ + ocamlplugininfo.ml | 109 ++++++++++++++++++++++++++++++++++++++++++++++++++++ + 2 files changed, 210 insertions(+) + create mode 100644 ocamlbyteinfo.ml + create mode 100644 ocamlplugininfo.ml + +diff --git a/ocamlbyteinfo.ml b/ocamlbyteinfo.ml +new file mode 100644 +index 0000000..eb9a293 +--- /dev/null ++++ b/ocamlbyteinfo.ml +@@ -0,0 +1,101 @@ ++(***********************************************************************) ++(* *) ++(* Objective Caml *) ++(* *) ++(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) ++(* *) ++(* Copyright 2009 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the GNU Library General Public License, with *) ++(* the special exception on linking described in file ../../LICENSE. *) ++(* *) ++(***********************************************************************) ++ ++(* $Id$ *) ++ ++(* Dumps a bytecode binary file *) ++ ++open Sys ++open Dynlinkaux ++ ++let input_stringlist ic len = ++ let get_string_list sect len = ++ let rec fold s e acc = ++ if e != len then ++ if sect.[e] = '\000' then ++ fold (e+1) (e+1) (String.sub sect s (e-s) :: acc) ++ else fold s (e+1) acc ++ else acc ++ in fold 0 0 [] ++ in ++ let sect = String.create len in ++ let _ = really_input ic sect 0 len in ++ get_string_list sect len ++ ++let print = Printf.printf ++let perr s = ++ Printf.eprintf "%s\n" s; ++ exit(1) ++let p_title title = print "%s:\n" title ++ ++let p_section title format pdata = function ++ | [] -> () ++ | l -> ++ p_title title; ++ List.iter ++ (fun (name, data) -> print format (pdata data) name) ++ l ++ ++let p_list title format = function ++ | [] -> () ++ | l -> ++ p_title title; ++ List.iter ++ (fun name -> print format name) ++ l ++ ++let _ = ++ try ++ let input_name = Sys.argv.(1) in ++ let ic = open_in_bin input_name in ++ Bytesections.read_toc ic; ++ List.iter ++ (fun section -> ++ try ++ let len = Bytesections.seek_section ic section in ++ if len > 0 then match section with ++ | "CRCS" -> ++ p_section ++ "Imported Units" ++ "\t%s\t%s\n" ++ Digest.to_hex ++ (input_value ic : (string * Digest.t) list) ++ | "DLLS" -> ++ p_list ++ "Used Dlls" "\t%s\n" ++ (input_stringlist ic len) ++ | "DLPT" -> ++ p_list ++ "Additional Dll paths" ++ "\t%s\n" ++ (input_stringlist ic len) ++ | "PRIM" -> ++ let prims = (input_stringlist ic len) in ++ print "Uses unsafe features: "; ++ begin match prims with ++ [] -> print "no\n" ++ | l -> print "YES\n"; ++ p_list "Primitives declared in this module" ++ "\t%s\n" ++ l ++ end ++ | _ -> () ++ with Not_found | Failure _ | Invalid_argument _ -> () ++ ) ++ ["CRCS"; "DLLS"; "DLPT"; "PRIM"]; ++ close_in ic ++ with ++ | Sys_error msg -> ++ perr msg ++ | Invalid_argument("index out of bounds") -> ++ perr (Printf.sprintf "Usage: %s filename" Sys.argv.(0)) +diff --git a/ocamlplugininfo.ml b/ocamlplugininfo.ml +new file mode 100644 +index 0000000..e28800f +--- /dev/null ++++ b/ocamlplugininfo.ml +@@ -0,0 +1,109 @@ ++(***********************************************************************) ++(* *) ++(* Objective Caml *) ++(* *) ++(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) ++(* *) ++(* Copyright 2009 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the GNU Library General Public License, with *) ++(* the special exception on linking described in file ../../LICENSE. *) ++(* *) ++(***********************************************************************) ++ ++(* $Id$ *) ++ ++(* Dumps a .cmxs file *) ++ ++open Natdynlink ++open Format ++ ++let file = ++ try ++ Sys.argv.(1) ++ with _ -> begin ++ Printf.eprintf "Usage: %s file.cmxs\n" Sys.argv.(0); ++ exit(1) ++ end ++ ++exception Abnormal_exit ++ ++let error s e = ++ let eprint = Printf.eprintf in ++ let print_exc s = function ++ | End_of_file -> ++ eprint "%s: %s\n" s file ++ | Abnormal_exit -> ++ eprint "%s\n" s ++ | e -> eprint "%s\n" (Printexc.to_string e) ++ in ++ print_exc s e; ++ exit(1) ++ ++let read_in command = ++ let cmd = Printf.sprintf command file in ++ let ic = Unix.open_process_in cmd in ++ try ++ let line = input_line ic in ++ begin match (Unix.close_process_in ic) with ++ | Unix.WEXITED 0 -> Str.split (Str.regexp "[ ]+") line ++ | Unix.WEXITED _ | Unix.WSIGNALED _ | Unix.WSTOPPED _ -> ++ error ++ (Printf.sprintf ++ "Command \"%s\" exited abnormally" ++ cmd ++ ) ++ Abnormal_exit ++ end ++ with e -> error "File is empty" e ++ ++let get_offset adr_off adr_sec = ++ try ++ let adr = List.nth adr_off 4 in ++ let off = List.nth adr_off 5 in ++ let sec = List.hd adr_sec in ++ ++ let (!) x = Int64.of_string ("0x" ^ x) in ++ let (+) = Int64.add in ++ let (-) = Int64.sub in ++ ++ Int64.to_int (!off + !sec - !adr) ++ ++ with Failure _ | Invalid_argument _ -> ++ error ++ "Command output doesn't have the expected format" ++ Abnormal_exit ++ ++let print_infos name crc defines cmi cmx = ++ let print_name_crc (name, crc) = ++ printf "@ %s (%s)" name (Digest.to_hex crc) ++ in ++ let pr_imports ppf imps = List.iter print_name_crc imps in ++ printf "Name: %s@." name; ++ printf "CRC of implementation: %s@." (Digest.to_hex crc); ++ printf "@[Globals defined:"; ++ List.iter (fun s -> printf "@ %s" s) defines; ++ printf "@]@."; ++ printf "@[Interfaces imported:%a@]@." pr_imports cmi; ++ printf "@[Implementations imported:%a@]@." pr_imports cmx ++ ++let _ = ++ let adr_off = read_in "objdump -h %s | grep ' .data '" in ++ let adr_sec = read_in "objdump -T %s | grep ' caml_plugin_header$'" in ++ ++ let ic = open_in file in ++ let _ = seek_in ic (get_offset adr_off adr_sec) in ++ let header = (input_value ic : Natdynlink.dynheader) in ++ if header.magic <> Natdynlink.dyn_magic_number then ++ raise(Error(Natdynlink.Not_a_bytecode_file file)) ++ else begin ++ List.iter ++ (fun ui -> ++ print_infos ++ ui.name ++ ui.crc ++ ui.defines ++ ui.imports_cmi ++ ui.imports_cmx) ++ header.units ++ end +-- +1.7.10 + diff --git a/0002-GNU-config.guess-and-config.sub-replacements.patch b/0002-GNU-config.guess-and-config.sub-replacements.patch new file mode 100644 index 0000000..318422f --- /dev/null +++ b/0002-GNU-config.guess-and-config.sub-replacements.patch @@ -0,0 +1,2583 @@ +From bb6f512f26f2f52a747b2de42da9c0d74a7e0e7e Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Tue, 29 May 2012 20:42:12 +0100 +Subject: [PATCH 2/7] GNU config.guess and config.sub replacements. + +The ones supplied by upstream OCaml are 8 years old. These newer +versions recognize arm properly. +--- + config/gnu/config.guess | 1037 +++++++++++++++++++++++++---------------------- + config/gnu/config.sub | 424 ++++++++++++++----- + 2 files changed, 876 insertions(+), 585 deletions(-) + +diff --git a/config/gnu/config.guess b/config/gnu/config.guess +index d25d58f..8152efd 100755 +--- a/config/gnu/config.guess ++++ b/config/gnu/config.guess +@@ -1,9 +1,10 @@ + #! /bin/sh + # Attempt to guess a canonical system name. + # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +-# 2000, 2001, 2002, 2003 Free Software Foundation, Inc. ++# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, ++# 2011 Free Software Foundation, Inc. + +-timestamp='2004-02-16' ++timestamp='2011-11-11' + + # This file is free software; you can redistribute it and/or modify it + # under the terms of the GNU General Public License as published by +@@ -17,23 +18,25 @@ timestamp='2004-02-16' + # + # You should have received a copy of the GNU General Public License + # along with this program; if not, write to the Free Software +-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ++# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA ++# 02110-1301, USA. + # + # As a special exception to the GNU General Public License, if you + # distribute this file as part of a program that contains a + # configuration script generated by Autoconf, you may include it under + # the same distribution terms that you use for the rest of that program. + +-# Originally written by Per Bothner . +-# Please send patches to . Submit a context +-# diff and a properly formatted ChangeLog entry. ++ ++# Originally written by Per Bothner. Please send patches (context ++# diff format) to and include a ChangeLog ++# entry. + # + # This script attempts to guess a canonical system name similar to + # config.sub. If it succeeds, it prints the system name on stdout, and + # exits with 0. Otherwise, it exits with 1. + # +-# The plan is that this can be called by configure scripts if you +-# don't specify an explicit build system type. ++# You can get the latest version of this script from: ++# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD + + me=`echo "$0" | sed -e 's,.*/,,'` + +@@ -53,8 +56,9 @@ version="\ + GNU config.guess ($timestamp) + + Originally written by Per Bothner. +-Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 +-Free Software Foundation, Inc. ++Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, ++2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free ++Software Foundation, Inc. + + This is free software; see the source for copying conditions. There is NO + warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." +@@ -66,11 +70,11 @@ Try \`$me --help' for more information." + while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) +- echo "$timestamp" ; exit 0 ;; ++ echo "$timestamp" ; exit ;; + --version | -v ) +- echo "$version" ; exit 0 ;; ++ echo "$version" ; exit ;; + --help | --h* | -h ) +- echo "$usage"; exit 0 ;; ++ echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. +@@ -104,7 +108,7 @@ set_cc_for_build=' + trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; + trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; + : ${TMPDIR=/tmp} ; +- { tmp=`(umask 077 && mktemp -d -q "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || ++ { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || + { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || + { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || + { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; +@@ -123,7 +127,7 @@ case $CC_FOR_BUILD,$HOST_CC,$CC in + ;; + ,,*) CC_FOR_BUILD=$CC ;; + ,*,*) CC_FOR_BUILD=$HOST_CC ;; +-esac ;' ++esac ; set_cc_for_build= ;' + + # This is needed to find uname on a Pyramid OSx when run in the BSD universe. + # (ghazi@noc.rutgers.edu 1994-08-24) +@@ -158,6 +162,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + arm*) machine=arm-unknown ;; + sh3el) machine=shl-unknown ;; + sh3eb) machine=sh-unknown ;; ++ sh5el) machine=sh5le-unknown ;; + *) machine=${UNAME_MACHINE_ARCH}-unknown ;; + esac + # The Operating System including object format, if it has switched +@@ -166,7 +171,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + arm*|i386|m68k|ns32k|sh3*|sparc|vax) + eval $set_cc_for_build + if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ +- | grep __ELF__ >/dev/null ++ | grep -q __ELF__ + then + # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). + # Return netbsd for either. FIX? +@@ -176,7 +181,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + fi + ;; + *) +- os=netbsd ++ os=netbsd + ;; + esac + # The OS release +@@ -196,68 +201,32 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + # contains redundant information, the shorter form: + # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. + echo "${machine}-${os}${release}" +- exit 0 ;; +- amd64:OpenBSD:*:*) +- echo x86_64-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- amiga:OpenBSD:*:*) +- echo m68k-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- arc:OpenBSD:*:*) +- echo mipsel-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- cats:OpenBSD:*:*) +- echo arm-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- hp300:OpenBSD:*:*) +- echo m68k-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- mac68k:OpenBSD:*:*) +- echo m68k-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- macppc:OpenBSD:*:*) +- echo powerpc-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- mvme68k:OpenBSD:*:*) +- echo m68k-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- mvme88k:OpenBSD:*:*) +- echo m88k-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- mvmeppc:OpenBSD:*:*) +- echo powerpc-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- pegasos:OpenBSD:*:*) +- echo powerpc-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- pmax:OpenBSD:*:*) +- echo mipsel-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- sgi:OpenBSD:*:*) +- echo mipseb-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- sun3:OpenBSD:*:*) +- echo m68k-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; +- wgrisc:OpenBSD:*:*) +- echo mipsel-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *:OpenBSD:*:*) +- echo ${UNAME_MACHINE}-unknown-openbsd${UNAME_RELEASE} +- exit 0 ;; ++ UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` ++ echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} ++ exit ;; + *:ekkoBSD:*:*) + echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; ++ *:SolidBSD:*:*) ++ echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE} ++ exit ;; + macppc:MirBSD:*:*) +- echo powerppc-unknown-mirbsd${UNAME_RELEASE} +- exit 0 ;; ++ echo powerpc-unknown-mirbsd${UNAME_RELEASE} ++ exit ;; + *:MirBSD:*:*) + echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + alpha:OSF1:*:*) +- if test $UNAME_RELEASE = "V4.0"; then ++ case $UNAME_RELEASE in ++ *4.0) + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` +- fi ++ ;; ++ *5.*) ++ UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` ++ ;; ++ esac + # According to Compaq, /usr/sbin/psrinfo has been available on + # OSF/1 and Tru64 systems produced since 1995. I hope that + # covers most systems running today. This code pipes the CPU +@@ -295,45 +264,52 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + "EV7.9 (21364A)") + UNAME_MACHINE="alphaev79" ;; + esac ++ # A Pn.n version is a patched version. + # A Vn.n version is a released version. + # A Tn.n version is a released field test version. + # A Xn.n version is an unreleased experimental baselevel. + # 1.2 uses "1.2" for uname -r. +- echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` +- exit 0 ;; +- Alpha*:OpenVMS:*:*) +- echo alpha-hp-vms +- exit 0 ;; ++ echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` ++ # Reset EXIT trap before exiting to avoid spurious non-zero exit code. ++ exitcode=$? ++ trap '' 0 ++ exit $exitcode ;; + Alpha\ *:Windows_NT*:*) + # How do we know it's Interix rather than the generic POSIX subsystem? + # Should we change UNAME_MACHINE based on the output of uname instead + # of the specific Alpha model? + echo alpha-pc-interix +- exit 0 ;; ++ exit ;; + 21064:Windows_NT:50:3) + echo alpha-dec-winnt3.5 +- exit 0 ;; ++ exit ;; + Amiga*:UNIX_System_V:4.0:*) + echo m68k-unknown-sysv4 +- exit 0;; ++ exit ;; + *:[Aa]miga[Oo][Ss]:*:*) + echo ${UNAME_MACHINE}-unknown-amigaos +- exit 0 ;; ++ exit ;; + *:[Mm]orph[Oo][Ss]:*:*) + echo ${UNAME_MACHINE}-unknown-morphos +- exit 0 ;; ++ exit ;; + *:OS/390:*:*) + echo i370-ibm-openedition +- exit 0 ;; ++ exit ;; ++ *:z/VM:*:*) ++ echo s390-ibm-zvmoe ++ exit ;; + *:OS400:*:*) +- echo powerpc-ibm-os400 +- exit 0 ;; ++ echo powerpc-ibm-os400 ++ exit ;; + arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) + echo arm-acorn-riscix${UNAME_RELEASE} +- exit 0;; ++ exit ;; ++ arm:riscos:*:*|arm:RISCOS:*:*) ++ echo arm-unknown-riscos ++ exit ;; + SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) + echo hppa1.1-hitachi-hiuxmpp +- exit 0;; ++ exit ;; + Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) + # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. + if test "`(/bin/universe) 2>/dev/null`" = att ; then +@@ -341,32 +317,51 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + else + echo pyramid-pyramid-bsd + fi +- exit 0 ;; ++ exit ;; + NILE*:*:*:dcosx) + echo pyramid-pyramid-svr4 +- exit 0 ;; ++ exit ;; + DRS?6000:unix:4.0:6*) + echo sparc-icl-nx6 +- exit 0 ;; +- DRS?6000:UNIX_SV:4.2*:7*) ++ exit ;; ++ DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) + case `/usr/bin/uname -p` in +- sparc) echo sparc-icl-nx7 && exit 0 ;; ++ sparc) echo sparc-icl-nx7; exit ;; + esac ;; ++ s390x:SunOS:*:*) ++ echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` ++ exit ;; + sun4H:SunOS:5.*:*) + echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` +- exit 0 ;; ++ exit ;; + sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) + echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` +- exit 0 ;; +- i86pc:SunOS:5.*:*) +- echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` +- exit 0 ;; ++ exit ;; ++ i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) ++ echo i386-pc-auroraux${UNAME_RELEASE} ++ exit ;; ++ i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) ++ eval $set_cc_for_build ++ SUN_ARCH="i386" ++ # If there is a compiler, see if it is configured for 64-bit objects. ++ # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. ++ # This test works for both compilers. ++ if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then ++ if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ ++ (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ ++ grep IS_64BIT_ARCH >/dev/null ++ then ++ SUN_ARCH="x86_64" ++ fi ++ fi ++ echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` ++ exit ;; + sun4*:SunOS:6*:*) + # According to config.sub, this is the proper way to canonicalize + # SunOS6. Hard to guess exactly what SunOS6 will be like, but + # it's likely to be more like Solaris than SunOS4. + echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` +- exit 0 ;; ++ exit ;; + sun4*:SunOS:*:*) + case "`/usr/bin/arch -k`" in + Series*|S4*) +@@ -375,10 +370,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + esac + # Japanese Language versions have a version number like `4.1.3-JL'. + echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` +- exit 0 ;; ++ exit ;; + sun3*:SunOS:*:*) + echo m68k-sun-sunos${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + sun*:*:4.2BSD:*) + UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` + test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 +@@ -390,10 +385,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + echo sparc-sun-sunos${UNAME_RELEASE} + ;; + esac +- exit 0 ;; ++ exit ;; + aushp:SunOS:*:*) + echo sparc-auspex-sunos${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + # The situation for MiNT is a little confusing. The machine name + # can be virtually everything (everything which is not + # "atarist" or "atariste" at least should have a processor +@@ -403,41 +398,41 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + # MiNT. But MiNT is downward compatible to TOS, so this should + # be no problem. + atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) +- echo m68k-atari-mint${UNAME_RELEASE} +- exit 0 ;; ++ echo m68k-atari-mint${UNAME_RELEASE} ++ exit ;; + atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) +- echo m68k-atari-mint${UNAME_RELEASE} +- exit 0 ;; ++ echo m68k-atari-mint${UNAME_RELEASE} ++ exit ;; + milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) +- echo m68k-milan-mint${UNAME_RELEASE} +- exit 0 ;; ++ echo m68k-milan-mint${UNAME_RELEASE} ++ exit ;; + hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) +- echo m68k-hades-mint${UNAME_RELEASE} +- exit 0 ;; ++ echo m68k-hades-mint${UNAME_RELEASE} ++ exit ;; + *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) +- echo m68k-unknown-mint${UNAME_RELEASE} +- exit 0 ;; ++ echo m68k-unknown-mint${UNAME_RELEASE} ++ exit ;; + m68k:machten:*:*) + echo m68k-apple-machten${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + powerpc:machten:*:*) + echo powerpc-apple-machten${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + RISC*:Mach:*:*) + echo mips-dec-mach_bsd4.3 +- exit 0 ;; ++ exit ;; + RISC*:ULTRIX:*:*) + echo mips-dec-ultrix${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + VAX*:ULTRIX*:*:*) + echo vax-dec-ultrix${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + 2020:CLIX:*:* | 2430:CLIX:*:*) + echo clipper-intergraph-clix${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + mips:*:*:UMIPS | mips:*:*:RISCos) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c +@@ -461,35 +456,36 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + exit (-1); + } + EOF +- $CC_FOR_BUILD -o $dummy $dummy.c \ +- && $dummy `echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` \ +- && exit 0 ++ $CC_FOR_BUILD -o $dummy $dummy.c && ++ dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` && ++ SYSTEM_NAME=`$dummy $dummyarg` && ++ { echo "$SYSTEM_NAME"; exit; } + echo mips-mips-riscos${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + Motorola:PowerMAX_OS:*:*) + echo powerpc-motorola-powermax +- exit 0 ;; ++ exit ;; + Motorola:*:4.3:PL8-*) + echo powerpc-harris-powermax +- exit 0 ;; ++ exit ;; + Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) + echo powerpc-harris-powermax +- exit 0 ;; ++ exit ;; + Night_Hawk:Power_UNIX:*:*) + echo powerpc-harris-powerunix +- exit 0 ;; ++ exit ;; + m88k:CX/UX:7*:*) + echo m88k-harris-cxux7 +- exit 0 ;; ++ exit ;; + m88k:*:4*:R4*) + echo m88k-motorola-sysv4 +- exit 0 ;; ++ exit ;; + m88k:*:3*:R3*) + echo m88k-motorola-sysv3 +- exit 0 ;; ++ exit ;; + AViiON:dgux:*:*) +- # DG/UX returns AViiON for all architectures +- UNAME_PROCESSOR=`/usr/bin/uname -p` ++ # DG/UX returns AViiON for all architectures ++ UNAME_PROCESSOR=`/usr/bin/uname -p` + if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] + then + if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ +@@ -502,29 +498,29 @@ EOF + else + echo i586-dg-dgux${UNAME_RELEASE} + fi +- exit 0 ;; ++ exit ;; + M88*:DolphinOS:*:*) # DolphinOS (SVR3) + echo m88k-dolphin-sysv3 +- exit 0 ;; ++ exit ;; + M88*:*:R3*:*) + # Delta 88k system running SVR3 + echo m88k-motorola-sysv3 +- exit 0 ;; ++ exit ;; + XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) + echo m88k-tektronix-sysv3 +- exit 0 ;; ++ exit ;; + Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) + echo m68k-tektronix-bsd +- exit 0 ;; ++ exit ;; + *:IRIX*:*:*) + echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` +- exit 0 ;; ++ exit ;; + ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. +- echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id +- exit 0 ;; # Note that: echo "'`uname -s`'" gives 'AIX ' ++ echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id ++ exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' + i*86:AIX:*:*) + echo i386-ibm-aix +- exit 0 ;; ++ exit ;; + ia64:AIX:*:*) + if [ -x /usr/bin/oslevel ] ; then + IBM_REV=`/usr/bin/oslevel` +@@ -532,7 +528,7 @@ EOF + IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} + fi + echo ${UNAME_MACHINE}-ibm-aix${IBM_REV} +- exit 0 ;; ++ exit ;; + *:AIX:2:3) + if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then + eval $set_cc_for_build +@@ -547,15 +543,19 @@ EOF + exit(0); + } + EOF +- $CC_FOR_BUILD -o $dummy $dummy.c && $dummy && exit 0 +- echo rs6000-ibm-aix3.2.5 ++ if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` ++ then ++ echo "$SYSTEM_NAME" ++ else ++ echo rs6000-ibm-aix3.2.5 ++ fi + elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then + echo rs6000-ibm-aix3.2.4 + else + echo rs6000-ibm-aix3.2 + fi +- exit 0 ;; +- *:AIX:*:[45]) ++ exit ;; ++ *:AIX:*:[4567]) + IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` + if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then + IBM_ARCH=rs6000 +@@ -568,28 +568,28 @@ EOF + IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} + fi + echo ${IBM_ARCH}-ibm-aix${IBM_REV} +- exit 0 ;; ++ exit ;; + *:AIX:*:*) + echo rs6000-ibm-aix +- exit 0 ;; ++ exit ;; + ibmrt:4.4BSD:*|romp-ibm:BSD:*) + echo romp-ibm-bsd4.4 +- exit 0 ;; ++ exit ;; + ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and + echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to +- exit 0 ;; # report: romp-ibm BSD 4.3 ++ exit ;; # report: romp-ibm BSD 4.3 + *:BOSX:*:*) + echo rs6000-bull-bosx +- exit 0 ;; ++ exit ;; + DPX/2?00:B.O.S.:*:*) + echo m68k-bull-sysv3 +- exit 0 ;; ++ exit ;; + 9000/[34]??:4.3bsd:1.*:*) + echo m68k-hp-bsd +- exit 0 ;; ++ exit ;; + hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) + echo m68k-hp-bsd4.4 +- exit 0 ;; ++ exit ;; + 9000/[34678]??:HP-UX:*:*) + HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` + case "${UNAME_MACHINE}" in +@@ -598,52 +598,52 @@ EOF + 9000/[678][0-9][0-9]) + if [ -x /usr/bin/getconf ]; then + sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` +- sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` +- case "${sc_cpu_version}" in +- 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 +- 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 +- 532) # CPU_PA_RISC2_0 +- case "${sc_kernel_bits}" in +- 32) HP_ARCH="hppa2.0n" ;; +- 64) HP_ARCH="hppa2.0w" ;; ++ sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` ++ case "${sc_cpu_version}" in ++ 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 ++ 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 ++ 532) # CPU_PA_RISC2_0 ++ case "${sc_kernel_bits}" in ++ 32) HP_ARCH="hppa2.0n" ;; ++ 64) HP_ARCH="hppa2.0w" ;; + '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 +- esac ;; +- esac ++ esac ;; ++ esac + fi + if [ "${HP_ARCH}" = "" ]; then + eval $set_cc_for_build +- sed 's/^ //' << EOF >$dummy.c ++ sed 's/^ //' << EOF >$dummy.c + +- #define _HPUX_SOURCE +- #include +- #include ++ #define _HPUX_SOURCE ++ #include ++ #include + +- int main () +- { +- #if defined(_SC_KERNEL_BITS) +- long bits = sysconf(_SC_KERNEL_BITS); +- #endif +- long cpu = sysconf (_SC_CPU_VERSION); ++ int main () ++ { ++ #if defined(_SC_KERNEL_BITS) ++ long bits = sysconf(_SC_KERNEL_BITS); ++ #endif ++ long cpu = sysconf (_SC_CPU_VERSION); + +- switch (cpu) +- { +- case CPU_PA_RISC1_0: puts ("hppa1.0"); break; +- case CPU_PA_RISC1_1: puts ("hppa1.1"); break; +- case CPU_PA_RISC2_0: +- #if defined(_SC_KERNEL_BITS) +- switch (bits) +- { +- case 64: puts ("hppa2.0w"); break; +- case 32: puts ("hppa2.0n"); break; +- default: puts ("hppa2.0"); break; +- } break; +- #else /* !defined(_SC_KERNEL_BITS) */ +- puts ("hppa2.0"); break; +- #endif +- default: puts ("hppa1.0"); break; +- } +- exit (0); +- } ++ switch (cpu) ++ { ++ case CPU_PA_RISC1_0: puts ("hppa1.0"); break; ++ case CPU_PA_RISC1_1: puts ("hppa1.1"); break; ++ case CPU_PA_RISC2_0: ++ #if defined(_SC_KERNEL_BITS) ++ switch (bits) ++ { ++ case 64: puts ("hppa2.0w"); break; ++ case 32: puts ("hppa2.0n"); break; ++ default: puts ("hppa2.0"); break; ++ } break; ++ #else /* !defined(_SC_KERNEL_BITS) */ ++ puts ("hppa2.0"); break; ++ #endif ++ default: puts ("hppa1.0"); break; ++ } ++ exit (0); ++ } + EOF + (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` + test -z "$HP_ARCH" && HP_ARCH=hppa +@@ -651,9 +651,19 @@ EOF + esac + if [ ${HP_ARCH} = "hppa2.0w" ] + then +- # avoid double evaluation of $set_cc_for_build +- test -n "$CC_FOR_BUILD" || eval $set_cc_for_build +- if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E -) | grep __LP64__ >/dev/null ++ eval $set_cc_for_build ++ ++ # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating ++ # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler ++ # generating 64-bit code. GNU and HP use different nomenclature: ++ # ++ # $ CC_FOR_BUILD=cc ./config.guess ++ # => hppa2.0w-hp-hpux11.23 ++ # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess ++ # => hppa64-hp-hpux11.23 ++ ++ if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | ++ grep -q __LP64__ + then + HP_ARCH="hppa2.0w" + else +@@ -661,11 +671,11 @@ EOF + fi + fi + echo ${HP_ARCH}-hp-hpux${HPUX_REV} +- exit 0 ;; ++ exit ;; + ia64:HP-UX:*:*) + HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` + echo ia64-hp-hpux${HPUX_REV} +- exit 0 ;; ++ exit ;; + 3050*:HI-UX:*:*) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c +@@ -693,224 +703,259 @@ EOF + exit (0); + } + EOF +- $CC_FOR_BUILD -o $dummy $dummy.c && $dummy && exit 0 ++ $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` && ++ { echo "$SYSTEM_NAME"; exit; } + echo unknown-hitachi-hiuxwe2 +- exit 0 ;; ++ exit ;; + 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) + echo hppa1.1-hp-bsd +- exit 0 ;; ++ exit ;; + 9000/8??:4.3bsd:*:*) + echo hppa1.0-hp-bsd +- exit 0 ;; ++ exit ;; + *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) + echo hppa1.0-hp-mpeix +- exit 0 ;; ++ exit ;; + hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) + echo hppa1.1-hp-osf +- exit 0 ;; ++ exit ;; + hp8??:OSF1:*:*) + echo hppa1.0-hp-osf +- exit 0 ;; ++ exit ;; + i*86:OSF1:*:*) + if [ -x /usr/sbin/sysversion ] ; then + echo ${UNAME_MACHINE}-unknown-osf1mk + else + echo ${UNAME_MACHINE}-unknown-osf1 + fi +- exit 0 ;; ++ exit ;; + parisc*:Lites*:*:*) + echo hppa1.1-hp-lites +- exit 0 ;; ++ exit ;; + C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) + echo c1-convex-bsd +- exit 0 ;; ++ exit ;; + C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) + if getsysinfo -f scalar_acc + then echo c32-convex-bsd + else echo c2-convex-bsd + fi +- exit 0 ;; ++ exit ;; + C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) + echo c34-convex-bsd +- exit 0 ;; ++ exit ;; + C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) + echo c38-convex-bsd +- exit 0 ;; ++ exit ;; + C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) + echo c4-convex-bsd +- exit 0 ;; ++ exit ;; + CRAY*Y-MP:*:*:*) + echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' +- exit 0 ;; ++ exit ;; + CRAY*[A-Z]90:*:*:*) + echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ + | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ + -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ + -e 's/\.[^.]*$/.X/' +- exit 0 ;; ++ exit ;; + CRAY*TS:*:*:*) + echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' +- exit 0 ;; ++ exit ;; + CRAY*T3E:*:*:*) + echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' +- exit 0 ;; ++ exit ;; + CRAY*SV1:*:*:*) + echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' +- exit 0 ;; ++ exit ;; + *:UNICOS/mp:*:*) +- echo nv1-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' +- exit 0 ;; ++ echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' ++ exit ;; + F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) + FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` +- FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` +- FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` +- echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" +- exit 0 ;; ++ FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` ++ FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` ++ echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" ++ exit ;; + 5000:UNIX_System_V:4.*:*) +- FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` +- FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` +- echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" +- exit 0 ;; ++ FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` ++ FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` ++ echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" ++ exit ;; + i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) + echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + sparc*:BSD/OS:*:*) + echo sparc-unknown-bsdi${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *:BSD/OS:*:*) + echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *:FreeBSD:*:*) +- # Determine whether the default compiler uses glibc. +- eval $set_cc_for_build +- sed 's/^ //' << EOF >$dummy.c +- #include +- #if __GLIBC__ >= 2 +- LIBC=gnu +- #else +- LIBC= +- #endif +-EOF +- eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^LIBC=` +- # GNU/KFreeBSD systems have a "k" prefix to indicate we are using +- # FreeBSD's kernel, but not the complete OS. +- case ${LIBC} in gnu) kernel_only='k' ;; esac +- echo ${UNAME_MACHINE}-unknown-${kernel_only}freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`${LIBC:+-$LIBC} +- exit 0 ;; ++ UNAME_PROCESSOR=`/usr/bin/uname -p` ++ case ${UNAME_PROCESSOR} in ++ amd64) ++ echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; ++ *) ++ echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; ++ esac ++ exit ;; + i*:CYGWIN*:*) + echo ${UNAME_MACHINE}-pc-cygwin +- exit 0 ;; +- i*:MINGW*:*) ++ exit ;; ++ *:MINGW*:*) + echo ${UNAME_MACHINE}-pc-mingw32 +- exit 0 ;; ++ exit ;; ++ i*:MSYS*:*) ++ echo ${UNAME_MACHINE}-pc-msys ++ exit ;; ++ i*:windows32*:*) ++ # uname -m includes "-pc" on this system. ++ echo ${UNAME_MACHINE}-mingw32 ++ exit ;; + i*:PW*:*) + echo ${UNAME_MACHINE}-pc-pw32 +- exit 0 ;; +- x86:Interix*:[34]*) +- echo i586-pc-interix${UNAME_RELEASE}|sed -e 's/\..*//' +- exit 0 ;; ++ exit ;; ++ *:Interix*:*) ++ case ${UNAME_MACHINE} in ++ x86) ++ echo i586-pc-interix${UNAME_RELEASE} ++ exit ;; ++ authenticamd | genuineintel | EM64T) ++ echo x86_64-unknown-interix${UNAME_RELEASE} ++ exit ;; ++ IA64) ++ echo ia64-unknown-interix${UNAME_RELEASE} ++ exit ;; ++ esac ;; + [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) + echo i${UNAME_MACHINE}-pc-mks +- exit 0 ;; ++ exit ;; ++ 8664:Windows_NT:*) ++ echo x86_64-pc-mks ++ exit ;; + i*:Windows_NT*:* | Pentium*:Windows_NT*:*) + # How do we know it's Interix rather than the generic POSIX subsystem? + # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we + # UNAME_MACHINE based on the output of uname instead of i386? + echo i586-pc-interix +- exit 0 ;; ++ exit ;; + i*:UWIN*:*) + echo ${UNAME_MACHINE}-pc-uwin +- exit 0 ;; ++ exit ;; ++ amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) ++ echo x86_64-unknown-cygwin ++ exit ;; + p*:CYGWIN*:*) + echo powerpcle-unknown-cygwin +- exit 0 ;; ++ exit ;; + prep*:SunOS:5.*:*) + echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` +- exit 0 ;; ++ exit ;; + *:GNU:*:*) + # the GNU system + echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` +- exit 0 ;; ++ exit ;; + *:GNU/*:*:*) + # other systems with GNU libc and userland + echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu +- exit 0 ;; ++ exit ;; + i*86:Minix:*:*) + echo ${UNAME_MACHINE}-pc-minix +- exit 0 ;; ++ exit ;; ++ alpha:Linux:*:*) ++ case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in ++ EV5) UNAME_MACHINE=alphaev5 ;; ++ EV56) UNAME_MACHINE=alphaev56 ;; ++ PCA56) UNAME_MACHINE=alphapca56 ;; ++ PCA57) UNAME_MACHINE=alphapca56 ;; ++ EV6) UNAME_MACHINE=alphaev6 ;; ++ EV67) UNAME_MACHINE=alphaev67 ;; ++ EV68*) UNAME_MACHINE=alphaev68 ;; ++ esac ++ objdump --private-headers /bin/sh | grep -q ld.so.1 ++ if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi ++ echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} ++ exit ;; + arm*:Linux:*:*) ++ eval $set_cc_for_build ++ if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ ++ | grep -q __ARM_EABI__ ++ then ++ echo ${UNAME_MACHINE}-unknown-linux-gnu ++ else ++ if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ ++ | grep -q __ARM_PCS_VFP ++ then ++ echo ${UNAME_MACHINE}-unknown-linux-gnueabi ++ else ++ echo ${UNAME_MACHINE}-unknown-linux-gnueabihf ++ fi ++ fi ++ exit ;; ++ avr32*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu +- exit 0 ;; +- sa110:Linux:*:*) +- echo arm-unknown-linux-gnu +- exit 0 ;; ++ exit ;; + cris:Linux:*:*) + echo cris-axis-linux-gnu +- exit 0 ;; +- ia64:Linux:*:*) +- echo ${UNAME_MACHINE}-unknown-linux-gnu +- exit 0 ;; +- m68*:Linux:*:*) +- echo ${UNAME_MACHINE}-unknown-linux-gnu +- exit 0 ;; +- mips:Linux:*:*) ++ exit ;; ++ crisv32:Linux:*:*) ++ echo crisv32-axis-linux-gnu ++ exit ;; ++ frv:Linux:*:*) ++ echo frv-unknown-linux-gnu ++ exit ;; ++ hexagon:Linux:*:*) ++ echo hexagon-unknown-linux-gnu ++ exit ;; ++ i*86:Linux:*:*) ++ LIBC=gnu + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c +- #undef CPU +- #undef mips +- #undef mipsel +- #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) +- CPU=mipsel +- #else +- #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) +- CPU=mips +- #else +- CPU= +- #endif ++ #ifdef __dietlibc__ ++ LIBC=dietlibc + #endif + EOF +- eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^CPU=` +- test x"${CPU}" != x && echo "${CPU}-unknown-linux-gnu" && exit 0 +- ;; +- mips64:Linux:*:*) ++ eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` ++ echo "${UNAME_MACHINE}-pc-linux-${LIBC}" ++ exit ;; ++ ia64:Linux:*:*) ++ echo ${UNAME_MACHINE}-unknown-linux-gnu ++ exit ;; ++ m32r*:Linux:*:*) ++ echo ${UNAME_MACHINE}-unknown-linux-gnu ++ exit ;; ++ m68*:Linux:*:*) ++ echo ${UNAME_MACHINE}-unknown-linux-gnu ++ exit ;; ++ mips:Linux:*:* | mips64:Linux:*:*) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #undef CPU +- #undef mips64 +- #undef mips64el ++ #undef ${UNAME_MACHINE} ++ #undef ${UNAME_MACHINE}el + #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) +- CPU=mips64el ++ CPU=${UNAME_MACHINE}el + #else + #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) +- CPU=mips64 ++ CPU=${UNAME_MACHINE} + #else + CPU= + #endif + #endif + EOF +- eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^CPU=` +- test x"${CPU}" != x && echo "${CPU}-unknown-linux-gnu" && exit 0 ++ eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` ++ test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } + ;; +- ppc:Linux:*:*) +- echo powerpc-unknown-linux-gnu +- exit 0 ;; +- ppc64:Linux:*:*) +- echo powerpc64-unknown-linux-gnu +- exit 0 ;; +- alpha:Linux:*:*) +- case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in +- EV5) UNAME_MACHINE=alphaev5 ;; +- EV56) UNAME_MACHINE=alphaev56 ;; +- PCA56) UNAME_MACHINE=alphapca56 ;; +- PCA57) UNAME_MACHINE=alphapca56 ;; +- EV6) UNAME_MACHINE=alphaev6 ;; +- EV67) UNAME_MACHINE=alphaev67 ;; +- EV68*) UNAME_MACHINE=alphaev68 ;; +- esac +- objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null +- if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi +- echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} +- exit 0 ;; ++ or32:Linux:*:*) ++ echo or32-unknown-linux-gnu ++ exit ;; ++ padre:Linux:*:*) ++ echo sparc-unknown-linux-gnu ++ exit ;; ++ parisc64:Linux:*:* | hppa64:Linux:*:*) ++ echo hppa64-unknown-linux-gnu ++ exit ;; + parisc:Linux:*:* | hppa:Linux:*:*) + # Look for CPU level + case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in +@@ -918,115 +963,71 @@ EOF + PA8*) echo hppa2.0-unknown-linux-gnu ;; + *) echo hppa-unknown-linux-gnu ;; + esac +- exit 0 ;; +- parisc64:Linux:*:* | hppa64:Linux:*:*) +- echo hppa64-unknown-linux-gnu +- exit 0 ;; ++ exit ;; ++ ppc64:Linux:*:*) ++ echo powerpc64-unknown-linux-gnu ++ exit ;; ++ ppc:Linux:*:*) ++ echo powerpc-unknown-linux-gnu ++ exit ;; + s390:Linux:*:* | s390x:Linux:*:*) + echo ${UNAME_MACHINE}-ibm-linux +- exit 0 ;; ++ exit ;; + sh64*:Linux:*:*) +- echo ${UNAME_MACHINE}-unknown-linux-gnu +- exit 0 ;; ++ echo ${UNAME_MACHINE}-unknown-linux-gnu ++ exit ;; + sh*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu +- exit 0 ;; ++ exit ;; + sparc:Linux:*:* | sparc64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu +- exit 0 ;; ++ exit ;; ++ tile*:Linux:*:*) ++ echo ${UNAME_MACHINE}-unknown-linux-gnu ++ exit ;; ++ vax:Linux:*:*) ++ echo ${UNAME_MACHINE}-dec-linux-gnu ++ exit ;; + x86_64:Linux:*:*) + echo x86_64-unknown-linux-gnu +- exit 0 ;; +- i*86:Linux:*:*) +- # The BFD linker knows what the default object file format is, so +- # first see if it will tell us. cd to the root directory to prevent +- # problems with other programs or directories called `ld' in the path. +- # Set LC_ALL=C to ensure ld outputs messages in English. +- ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ +- | sed -ne '/supported targets:/!d +- s/[ ][ ]*/ /g +- s/.*supported targets: *// +- s/ .*// +- p'` +- case "$ld_supported_targets" in +- elf32-i386) +- TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" +- ;; +- a.out-i386-linux) +- echo "${UNAME_MACHINE}-pc-linux-gnuaout" +- exit 0 ;; +- coff-i386) +- echo "${UNAME_MACHINE}-pc-linux-gnucoff" +- exit 0 ;; +- "") +- # Either a pre-BFD a.out linker (linux-gnuoldld) or +- # one that does not give us useful --help. +- echo "${UNAME_MACHINE}-pc-linux-gnuoldld" +- exit 0 ;; +- esac +- # Determine whether the default compiler is a.out or elf +- eval $set_cc_for_build +- sed 's/^ //' << EOF >$dummy.c +- #include +- #ifdef __ELF__ +- # ifdef __GLIBC__ +- # if __GLIBC__ >= 2 +- LIBC=gnu +- # else +- LIBC=gnulibc1 +- # endif +- # else +- LIBC=gnulibc1 +- # endif +- #else +- #ifdef __INTEL_COMPILER +- LIBC=gnu +- #else +- LIBC=gnuaout +- #endif +- #endif +- #ifdef __dietlibc__ +- LIBC=dietlibc +- #endif +-EOF +- eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^LIBC=` +- test x"${LIBC}" != x && echo "${UNAME_MACHINE}-pc-linux-${LIBC}" && exit 0 +- test x"${TENTATIVE}" != x && echo "${TENTATIVE}" && exit 0 +- ;; ++ exit ;; ++ xtensa*:Linux:*:*) ++ echo ${UNAME_MACHINE}-unknown-linux-gnu ++ exit ;; + i*86:DYNIX/ptx:4*:*) + # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. + # earlier versions are messed up and put the nodename in both + # sysname and nodename. + echo i386-sequent-sysv4 +- exit 0 ;; ++ exit ;; + i*86:UNIX_SV:4.2MP:2.*) +- # Unixware is an offshoot of SVR4, but it has its own version +- # number series starting with 2... +- # I am not positive that other SVR4 systems won't match this, ++ # Unixware is an offshoot of SVR4, but it has its own version ++ # number series starting with 2... ++ # I am not positive that other SVR4 systems won't match this, + # I just have to hope. -- rms. +- # Use sysv4.2uw... so that sysv4* matches it. ++ # Use sysv4.2uw... so that sysv4* matches it. + echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} +- exit 0 ;; ++ exit ;; + i*86:OS/2:*:*) + # If we were able to find `uname', then EMX Unix compatibility + # is probably installed. + echo ${UNAME_MACHINE}-pc-os2-emx +- exit 0 ;; ++ exit ;; + i*86:XTS-300:*:STOP) + echo ${UNAME_MACHINE}-unknown-stop +- exit 0 ;; ++ exit ;; + i*86:atheos:*:*) + echo ${UNAME_MACHINE}-unknown-atheos +- exit 0 ;; +- i*86:syllable:*:*) ++ exit ;; ++ i*86:syllable:*:*) + echo ${UNAME_MACHINE}-pc-syllable +- exit 0 ;; +- i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) ++ exit ;; ++ i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) + echo i386-unknown-lynxos${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + i*86:*DOS:*:*) + echo ${UNAME_MACHINE}-pc-msdosdjgpp +- exit 0 ;; ++ exit ;; + i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*) + UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` + if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then +@@ -1034,15 +1035,16 @@ EOF + else + echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} + fi +- exit 0 ;; +- i*86:*:5:[78]*) ++ exit ;; ++ i*86:*:5:[678]*) ++ # UnixWare 7.x, OpenUNIX and OpenServer 6. + case `/bin/uname -X | grep "^Machine"` in + *486*) UNAME_MACHINE=i486 ;; + *Pentium) UNAME_MACHINE=i586 ;; + *Pent*|*Celeron) UNAME_MACHINE=i686 ;; + esac + echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} +- exit 0 ;; ++ exit ;; + i*86:*:3.2:*) + if test -f /usr/options/cb.name; then + UNAME_REL=`sed -n 's/.*Version //p' /dev/null 2>&1 ; then + echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 + else # Add other i860-SVR4 vendors below as they are discovered. + echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 + fi +- exit 0 ;; ++ exit ;; + mini*:CTIX:SYS*5:*) + # "miniframe" + echo m68010-convergent-sysv +- exit 0 ;; ++ exit ;; + mc68k:UNIX:SYSTEM5:3.51m) + echo m68k-convergent-sysv +- exit 0 ;; ++ exit ;; + M680?0:D-NIX:5.3:*) + echo m68k-diab-dnix +- exit 0 ;; +- M68*:*:R3V[567]*:*) +- test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;; +- 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0) ++ exit ;; ++ M68*:*:R3V[5678]*:*) ++ test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; ++ 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) + OS_REL='' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ +- && echo i486-ncr-sysv4.3${OS_REL} && exit 0 ++ && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ +- && echo i586-ncr-sysv4.3${OS_REL} && exit 0 ;; ++ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; + 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) +- /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ +- && echo i486-ncr-sysv4 && exit 0 ;; ++ /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ ++ && { echo i486-ncr-sysv4; exit; } ;; ++ NCR*:*:4.2:* | MPRAS*:*:4.2:*) ++ OS_REL='.3' ++ test -r /etc/.relid \ ++ && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` ++ /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ ++ && { echo i486-ncr-sysv4.3${OS_REL}; exit; } ++ /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ ++ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ++ /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ ++ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; + m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) + echo m68k-unknown-lynxos${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + mc68030:UNIX_System_V:4.*:*) + echo m68k-atari-sysv4 +- exit 0 ;; ++ exit ;; + TSUNAMI:LynxOS:2.*:*) + echo sparc-unknown-lynxos${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + rs6000:LynxOS:2.*:*) + echo rs6000-unknown-lynxos${UNAME_RELEASE} +- exit 0 ;; +- PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) ++ exit ;; ++ PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) + echo powerpc-unknown-lynxos${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + SM[BE]S:UNIX_SV:*:*) + echo mips-dde-sysv${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + RM*:ReliantUNIX-*:*:*) + echo mips-sni-sysv4 +- exit 0 ;; ++ exit ;; + RM*:SINIX-*:*:*) + echo mips-sni-sysv4 +- exit 0 ;; ++ exit ;; + *:SINIX-*:*:*) + if uname -p 2>/dev/null >/dev/null ; then + UNAME_MACHINE=`(uname -p) 2>/dev/null` +@@ -1134,71 +1149,94 @@ EOF + else + echo ns32k-sni-sysv + fi +- exit 0 ;; +- PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort +- # says +- echo i586-unisys-sysv4 +- exit 0 ;; ++ exit ;; ++ PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort ++ # says ++ echo i586-unisys-sysv4 ++ exit ;; + *:UNIX_System_V:4*:FTX*) + # From Gerald Hewes . + # How about differentiating between stratus architectures? -djm + echo hppa1.1-stratus-sysv4 +- exit 0 ;; ++ exit ;; + *:*:*:FTX*) + # From seanf@swdc.stratus.com. + echo i860-stratus-sysv4 +- exit 0 ;; ++ exit ;; ++ i*86:VOS:*:*) ++ # From Paul.Green@stratus.com. ++ echo ${UNAME_MACHINE}-stratus-vos ++ exit ;; + *:VOS:*:*) + # From Paul.Green@stratus.com. + echo hppa1.1-stratus-vos +- exit 0 ;; ++ exit ;; + mc68*:A/UX:*:*) + echo m68k-apple-aux${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + news*:NEWS-OS:6*:*) + echo mips-sony-newsos6 +- exit 0 ;; ++ exit ;; + R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) + if [ -d /usr/nec ]; then +- echo mips-nec-sysv${UNAME_RELEASE} ++ echo mips-nec-sysv${UNAME_RELEASE} + else +- echo mips-unknown-sysv${UNAME_RELEASE} ++ echo mips-unknown-sysv${UNAME_RELEASE} + fi +- exit 0 ;; ++ exit ;; + BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. + echo powerpc-be-beos +- exit 0 ;; ++ exit ;; + BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. + echo powerpc-apple-beos +- exit 0 ;; ++ exit ;; + BePC:BeOS:*:*) # BeOS running on Intel PC compatible. + echo i586-pc-beos +- exit 0 ;; ++ exit ;; ++ BePC:Haiku:*:*) # Haiku running on Intel PC compatible. ++ echo i586-pc-haiku ++ exit ;; + SX-4:SUPER-UX:*:*) + echo sx4-nec-superux${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + SX-5:SUPER-UX:*:*) + echo sx5-nec-superux${UNAME_RELEASE} +- exit 0 ;; +- osfmach3_ppc:*:*:*) +- echo powerpc-unknown-linux +- exit 0 ;; ++ exit ;; + SX-6:SUPER-UX:*:*) + echo sx6-nec-superux${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; ++ SX-7:SUPER-UX:*:*) ++ echo sx7-nec-superux${UNAME_RELEASE} ++ exit ;; ++ SX-8:SUPER-UX:*:*) ++ echo sx8-nec-superux${UNAME_RELEASE} ++ exit ;; ++ SX-8R:SUPER-UX:*:*) ++ echo sx8r-nec-superux${UNAME_RELEASE} ++ exit ;; + Power*:Rhapsody:*:*) + echo powerpc-apple-rhapsody${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *:Rhapsody:*:*) + echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *:Darwin:*:*) +- case `uname -p` in +- *86) UNAME_PROCESSOR=i686 ;; +- powerpc) UNAME_PROCESSOR=powerpc ;; ++ UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown ++ case $UNAME_PROCESSOR in ++ i386) ++ eval $set_cc_for_build ++ if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then ++ if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ ++ (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ ++ grep IS_64BIT_ARCH >/dev/null ++ then ++ UNAME_PROCESSOR="x86_64" ++ fi ++ fi ;; ++ unknown) UNAME_PROCESSOR=powerpc ;; + esac + echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *:procnto*:*:* | *:QNX:[0123456789]*:*) + UNAME_PROCESSOR=`uname -p` + if test "$UNAME_PROCESSOR" = "x86"; then +@@ -1206,22 +1244,28 @@ EOF + UNAME_MACHINE=pc + fi + echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *:QNX:*:4*) + echo i386-pc-qnx +- exit 0 ;; ++ exit ;; ++ NEO-?:NONSTOP_KERNEL:*:*) ++ echo neo-tandem-nsk${UNAME_RELEASE} ++ exit ;; ++ NSE-?:NONSTOP_KERNEL:*:*) ++ echo nse-tandem-nsk${UNAME_RELEASE} ++ exit ;; + NSR-?:NONSTOP_KERNEL:*:*) + echo nsr-tandem-nsk${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *:NonStop-UX:*:*) + echo mips-compaq-nonstopux +- exit 0 ;; ++ exit ;; + BS2000:POSIX*:*:*) + echo bs2000-siemens-sysv +- exit 0 ;; ++ exit ;; + DS/*:UNIX_System_V:*:*) + echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE} +- exit 0 ;; ++ exit ;; + *:Plan9:*:*) + # "uname -m" is not consistent, so use $cputype instead. 386 + # is converted to i386 for consistency with other x86 +@@ -1232,31 +1276,50 @@ EOF + UNAME_MACHINE="$cputype" + fi + echo ${UNAME_MACHINE}-unknown-plan9 +- exit 0 ;; ++ exit ;; + *:TOPS-10:*:*) + echo pdp10-unknown-tops10 +- exit 0 ;; ++ exit ;; + *:TENEX:*:*) + echo pdp10-unknown-tenex +- exit 0 ;; ++ exit ;; + KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) + echo pdp10-dec-tops20 +- exit 0 ;; ++ exit ;; + XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) + echo pdp10-xkl-tops20 +- exit 0 ;; ++ exit ;; + *:TOPS-20:*:*) + echo pdp10-unknown-tops20 +- exit 0 ;; ++ exit ;; + *:ITS:*:*) + echo pdp10-unknown-its +- exit 0 ;; ++ exit ;; + SEI:*:*:SEIUX) +- echo mips-sei-seiux${UNAME_RELEASE} +- exit 0 ;; ++ echo mips-sei-seiux${UNAME_RELEASE} ++ exit ;; + *:DragonFly:*:*) + echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` +- exit 0 ;; ++ exit ;; ++ *:*VMS:*:*) ++ UNAME_MACHINE=`(uname -p) 2>/dev/null` ++ case "${UNAME_MACHINE}" in ++ A*) echo alpha-dec-vms ; exit ;; ++ I*) echo ia64-dec-vms ; exit ;; ++ V*) echo vax-dec-vms ; exit ;; ++ esac ;; ++ *:XENIX:*:SysV) ++ echo i386-pc-xenix ++ exit ;; ++ i*86:skyos:*:*) ++ echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//' ++ exit ;; ++ i*86:rdos:*:*) ++ echo ${UNAME_MACHINE}-pc-rdos ++ exit ;; ++ i*86:AROS:*:*) ++ echo ${UNAME_MACHINE}-pc-aros ++ exit ;; + esac + + #echo '(No uname command or uname output not recognized.)' 1>&2 +@@ -1279,16 +1342,16 @@ main () + #include + printf ("m68k-sony-newsos%s\n", + #ifdef NEWSOS4 +- "4" ++ "4" + #else +- "" ++ "" + #endif +- ); exit (0); ++ ); exit (0); + #endif + #endif + + #if defined (__arm) && defined (__acorn) && defined (__unix) +- printf ("arm-acorn-riscix"); exit (0); ++ printf ("arm-acorn-riscix\n"); exit (0); + #endif + + #if defined (hp300) && !defined (hpux) +@@ -1296,16 +1359,15 @@ main () + #endif + + #if defined (NeXT) +- char * arch; +- int version; + #if !defined (__ARCHITECTURE__) +- arch = "m68k"; +-#else +- arch = __ARCHITECTURE__; +- if (strcmp(arch, "hppa") == 0) arch = "hppa1.1"; ++#define __ARCHITECTURE__ "m68k" + #endif ++ int version; + version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; +- printf ("%s-next-nextstep%d\n", arch, version); ++ if (version < 4) ++ printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); ++ else ++ printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); + exit (0); + #endif + +@@ -1378,11 +1440,12 @@ main () + } + EOF + +-$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && $dummy && exit 0 ++$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` && ++ { echo "$SYSTEM_NAME"; exit; } + + # Apollos put the system type in the environment. + +-test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit 0; } ++test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; } + + # Convex versions that predate uname can use getsysinfo(1) + +@@ -1391,22 +1454,22 @@ then + case `getsysinfo -f cpu_type` in + c1*) + echo c1-convex-bsd +- exit 0 ;; ++ exit ;; + c2*) + if getsysinfo -f scalar_acc + then echo c32-convex-bsd + else echo c2-convex-bsd + fi +- exit 0 ;; ++ exit ;; + c34*) + echo c34-convex-bsd +- exit 0 ;; ++ exit ;; + c38*) + echo c38-convex-bsd +- exit 0 ;; ++ exit ;; + c4*) + echo c4-convex-bsd +- exit 0 ;; ++ exit ;; + esac + fi + +@@ -1417,7 +1480,9 @@ This script, last modified $timestamp, has failed to recognize + the operating system you are using. It is advised that you + download the most up to date version of the config scripts from + +- ftp://ftp.gnu.org/pub/gnu/config/ ++ http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD ++and ++ http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD + + If the version you run ($0) is already up to date, please + send the following data and any information you think might be +diff --git a/config/gnu/config.sub b/config/gnu/config.sub +index d2e3557..e76eaf4 100755 +--- a/config/gnu/config.sub ++++ b/config/gnu/config.sub +@@ -1,9 +1,10 @@ + #! /bin/sh + # Configuration validation subroutine script. + # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +-# 2000, 2001, 2002, 2003 Free Software Foundation, Inc. ++# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, ++# 2011 Free Software Foundation, Inc. + +-timestamp='2004-02-16' ++timestamp='2011-11-11' + + # This file is (in principle) common to ALL GNU software. + # The presence of a machine in this file suggests that SOME GNU software +@@ -21,22 +22,26 @@ timestamp='2004-02-16' + # + # You should have received a copy of the GNU General Public License + # along with this program; if not, write to the Free Software +-# Foundation, Inc., 59 Temple Place - Suite 330, +-# Boston, MA 02111-1307, USA. +- ++# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA ++# 02110-1301, USA. ++# + # As a special exception to the GNU General Public License, if you + # distribute this file as part of a program that contains a + # configuration script generated by Autoconf, you may include it under + # the same distribution terms that you use for the rest of that program. + ++ + # Please send patches to . Submit a context +-# diff and a properly formatted ChangeLog entry. ++# diff and a properly formatted GNU ChangeLog entry. + # + # Configuration subroutine to validate and canonicalize a configuration type. + # Supply the specified configuration type as an argument. + # If it is invalid, we print an error message on stderr and exit with code 1. + # Otherwise, we print the canonical config type on stdout and succeed. + ++# You can get the latest version of this script from: ++# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD ++ + # This file is supposed to be the same for all GNU packages + # and recognize all the CPU types, system types and aliases + # that are meaningful with *any* GNU software. +@@ -70,8 +75,9 @@ Report bugs and patches to ." + version="\ + GNU config.sub ($timestamp) + +-Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 +-Free Software Foundation, Inc. ++Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, ++2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free ++Software Foundation, Inc. + + This is free software; see the source for copying conditions. There is NO + warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." +@@ -83,11 +89,11 @@ Try \`$me --help' for more information." + while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) +- echo "$timestamp" ; exit 0 ;; ++ echo "$timestamp" ; exit ;; + --version | -v ) +- echo "$version" ; exit 0 ;; ++ echo "$version" ; exit ;; + --help | --h* | -h ) +- echo "$usage"; exit 0 ;; ++ echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. +@@ -99,7 +105,7 @@ while test $# -gt 0 ; do + *local*) + # First pass through any local machine types. + echo $1 +- exit 0;; ++ exit ;; + + * ) + break ;; +@@ -118,8 +124,11 @@ esac + # Here we must recognize all the valid KERNEL-OS combinations. + maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` + case $maybe_os in +- nto-qnx* | linux-gnu* | linux-dietlibc | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | \ +- kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | storm-chaos* | os2-emx* | rtmk-nova*) ++ nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ ++ linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ ++ knetbsd*-gnu* | netbsd*-gnu* | \ ++ kopensolaris*-gnu* | \ ++ storm-chaos* | os2-emx* | rtmk-nova*) + os=-$maybe_os + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` + ;; +@@ -145,10 +154,13 @@ case $os in + -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ + -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ + -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ +- -apple | -axis) ++ -apple | -axis | -knuth | -cray | -microblaze) + os= + basic_machine=$1 + ;; ++ -bluegene*) ++ os=-cnk ++ ;; + -sim | -cisco | -oki | -wec | -winbond) + os= + basic_machine=$1 +@@ -163,13 +175,17 @@ case $os in + os=-chorusos + basic_machine=$1 + ;; +- -chorusrdb) +- os=-chorusrdb ++ -chorusrdb) ++ os=-chorusrdb + basic_machine=$1 +- ;; ++ ;; + -hiux*) + os=-hiuxwe2 + ;; ++ -sco6) ++ os=-sco5v6 ++ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ++ ;; + -sco5) + os=-sco3.2v5 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` +@@ -186,6 +202,10 @@ case $os in + # Don't forget version if it is 3.2v4 or newer. + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; ++ -sco5v6*) ++ # Don't forget version if it is 3.2v4 or newer. ++ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ++ ;; + -sco*) + os=-sco3.2v2 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` +@@ -230,22 +250,32 @@ case $basic_machine in + | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ + | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ + | am33_2.0 \ +- | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr \ ++ | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ ++ | be32 | be64 \ ++ | bfin \ + | c4x | clipper \ + | d10v | d30v | dlx | dsp16xx \ +- | fr30 | frv \ ++ | epiphany \ ++ | fido | fr30 | frv \ + | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ ++ | hexagon \ + | i370 | i860 | i960 | ia64 \ + | ip2k | iq2000 \ +- | m32r | m68000 | m68k | m88k | mcore \ ++ | le32 | le64 \ ++ | lm32 \ ++ | m32c | m32r | m32rle | m68000 | m68k | m88k \ ++ | maxq | mb | microblaze | mcore | mep | metag \ + | mips | mipsbe | mipseb | mipsel | mipsle \ + | mips16 \ + | mips64 | mips64el \ +- | mips64vr | mips64vrel \ ++ | mips64octeon | mips64octeonel \ + | mips64orion | mips64orionel \ ++ | mips64r5900 | mips64r5900el \ ++ | mips64vr | mips64vrel \ + | mips64vr4100 | mips64vr4100el \ + | mips64vr4300 | mips64vr4300el \ + | mips64vr5000 | mips64vr5000el \ ++ | mips64vr5900 | mips64vr5900el \ + | mipsisa32 | mipsisa32el \ + | mipsisa32r2 | mipsisa32r2el \ + | mipsisa64 | mipsisa64el \ +@@ -254,30 +284,63 @@ case $basic_machine in + | mipsisa64sr71k | mipsisa64sr71kel \ + | mipstx39 | mipstx39el \ + | mn10200 | mn10300 \ ++ | moxie \ ++ | mt \ + | msp430 \ ++ | nds32 | nds32le | nds32be \ ++ | nios | nios2 \ + | ns16k | ns32k \ +- | openrisc | or32 \ ++ | open8 \ ++ | or32 \ + | pdp10 | pdp11 | pj | pjl \ +- | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ ++ | powerpc | powerpc64 | powerpc64le | powerpcle \ + | pyramid \ +- | sh | sh[1234] | sh[23]e | sh[34]eb | shbe | shle | sh[1234]le | sh3ele \ ++ | rl78 | rx \ ++ | score \ ++ | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ + | sh64 | sh64le \ +- | sparc | sparc64 | sparc86x | sparclet | sparclite | sparcv9 | sparcv9b \ +- | strongarm \ +- | tahoe | thumb | tic4x | tic80 | tron \ +- | v850 | v850e \ ++ | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ ++ | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ ++ | spu \ ++ | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ ++ | ubicom32 \ ++ | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ + | we32k \ +- | x86 | xscale | xstormy16 | xtensa \ +- | z8k) ++ | x86 | xc16x | xstormy16 | xtensa \ ++ | z8k | z80) + basic_machine=$basic_machine-unknown + ;; +- m6811 | m68hc11 | m6812 | m68hc12) ++ c54x) ++ basic_machine=tic54x-unknown ++ ;; ++ c55x) ++ basic_machine=tic55x-unknown ++ ;; ++ c6x) ++ basic_machine=tic6x-unknown ++ ;; ++ m6811 | m68hc11 | m6812 | m68hc12 | picochip) + # Motorola 68HC11/12. + basic_machine=$basic_machine-unknown + os=-none + ;; + m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) + ;; ++ ms1) ++ basic_machine=mt-unknown ++ ;; ++ ++ strongarm | thumb | xscale) ++ basic_machine=arm-unknown ++ ;; ++ ++ xscaleeb) ++ basic_machine=armeb-unknown ++ ;; ++ ++ xscaleel) ++ basic_machine=armel-unknown ++ ;; + + # We use `pc' rather than `unknown' + # because (1) that's what they normally are, and +@@ -297,28 +360,35 @@ case $basic_machine in + | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ + | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ + | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ +- | avr-* \ +- | bs2000-* \ +- | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ +- | clipper-* | cydra-* \ ++ | avr-* | avr32-* \ ++ | be32-* | be64-* \ ++ | bfin-* | bs2000-* \ ++ | c[123]* | c30-* | [cjt]90-* | c4x-* \ ++ | clipper-* | craynv-* | cydra-* \ + | d10v-* | d30v-* | dlx-* \ + | elxsi-* \ +- | f30[01]-* | f700-* | fr30-* | frv-* | fx80-* \ ++ | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ + | h8300-* | h8500-* \ + | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ ++ | hexagon-* \ + | i*86-* | i860-* | i960-* | ia64-* \ + | ip2k-* | iq2000-* \ +- | m32r-* \ ++ | le32-* | le64-* \ ++ | lm32-* \ ++ | m32c-* | m32r-* | m32rle-* \ + | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ +- | m88110-* | m88k-* | mcore-* \ ++ | m88110-* | m88k-* | maxq-* | mcore-* | metag-* | microblaze-* \ + | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ + | mips16-* \ + | mips64-* | mips64el-* \ +- | mips64vr-* | mips64vrel-* \ ++ | mips64octeon-* | mips64octeonel-* \ + | mips64orion-* | mips64orionel-* \ ++ | mips64r5900-* | mips64r5900el-* \ ++ | mips64vr-* | mips64vrel-* \ + | mips64vr4100-* | mips64vr4100el-* \ + | mips64vr4300-* | mips64vr4300el-* \ + | mips64vr5000-* | mips64vr5000el-* \ ++ | mips64vr5900-* | mips64vr5900el-* \ + | mipsisa32-* | mipsisa32el-* \ + | mipsisa32r2-* | mipsisa32r2el-* \ + | mipsisa64-* | mipsisa64el-* \ +@@ -326,26 +396,39 @@ case $basic_machine in + | mipsisa64sb1-* | mipsisa64sb1el-* \ + | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipstx39-* | mipstx39el-* \ ++ | mmix-* \ ++ | mt-* \ + | msp430-* \ +- | none-* | np1-* | nv1-* | ns16k-* | ns32k-* \ ++ | nds32-* | nds32le-* | nds32be-* \ ++ | nios-* | nios2-* \ ++ | none-* | np1-* | ns16k-* | ns32k-* \ ++ | open8-* \ + | orion-* \ + | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ +- | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ ++ | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ + | pyramid-* \ +- | romp-* | rs6000-* \ +- | sh-* | sh[1234]-* | sh[23]e-* | sh[34]eb-* | shbe-* \ ++ | rl78-* | romp-* | rs6000-* | rx-* \ ++ | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ + | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ +- | sparc-* | sparc64-* | sparc86x-* | sparclet-* | sparclite-* \ +- | sparcv9-* | sparcv9b-* | strongarm-* | sv1-* | sx?-* \ +- | tahoe-* | thumb-* \ ++ | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ ++ | sparclite-* \ ++ | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ ++ | tahoe-* \ + | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ ++ | tile*-* \ + | tron-* \ +- | v850-* | v850e-* | vax-* \ ++ | ubicom32-* \ ++ | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ ++ | vax-* \ + | we32k-* \ +- | x86-* | x86_64-* | xps100-* | xscale-* | xstormy16-* \ +- | xtensa-* \ ++ | x86-* | x86_64-* | xc16x-* | xps100-* \ ++ | xstormy16-* | xtensa*-* \ + | ymp-* \ +- | z8k-*) ++ | z8k-* | z80-*) ++ ;; ++ # Recognize the basic CPU types without company name, with glob match. ++ xtensa*) ++ basic_machine=$basic_machine-unknown + ;; + # Recognize the various machine names and aliases which stand + # for a CPU type and a company and sometimes even an OS. +@@ -363,7 +446,7 @@ case $basic_machine in + basic_machine=a29k-amd + os=-udi + ;; +- abacus) ++ abacus) + basic_machine=abacus-unknown + ;; + adobe68k) +@@ -409,6 +492,10 @@ case $basic_machine in + basic_machine=m68k-apollo + os=-bsd + ;; ++ aros) ++ basic_machine=i386-pc ++ os=-aros ++ ;; + aux) + basic_machine=m68k-apple + os=-aux +@@ -417,10 +504,35 @@ case $basic_machine in + basic_machine=ns32k-sequent + os=-dynix + ;; ++ blackfin) ++ basic_machine=bfin-unknown ++ os=-linux ++ ;; ++ blackfin-*) ++ basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` ++ os=-linux ++ ;; ++ bluegene*) ++ basic_machine=powerpc-ibm ++ os=-cnk ++ ;; ++ c54x-*) ++ basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` ++ ;; ++ c55x-*) ++ basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` ++ ;; ++ c6x-*) ++ basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` ++ ;; + c90) + basic_machine=c90-cray + os=-unicos + ;; ++ cegcc) ++ basic_machine=arm-unknown ++ os=-cegcc ++ ;; + convex-c1) + basic_machine=c1-convex + os=-bsd +@@ -445,16 +557,27 @@ case $basic_machine in + basic_machine=j90-cray + os=-unicos + ;; +- cr16c) +- basic_machine=cr16c-unknown ++ craynv) ++ basic_machine=craynv-cray ++ os=-unicosmp ++ ;; ++ cr16 | cr16-*) ++ basic_machine=cr16-unknown + os=-elf + ;; + crds | unos) + basic_machine=m68k-crds + ;; ++ crisv32 | crisv32-* | etraxfs*) ++ basic_machine=crisv32-axis ++ ;; + cris | cris-* | etrax*) + basic_machine=cris-axis + ;; ++ crx) ++ basic_machine=crx-unknown ++ os=-elf ++ ;; + da30 | da30-*) + basic_machine=m68k-da30 + ;; +@@ -477,6 +600,14 @@ case $basic_machine in + basic_machine=m88k-motorola + os=-sysv3 + ;; ++ dicos) ++ basic_machine=i686-pc ++ os=-dicos ++ ;; ++ djgpp) ++ basic_machine=i586-pc ++ os=-msdosdjgpp ++ ;; + dpx20 | dpx20-*) + basic_machine=rs6000-bull + os=-bosx +@@ -627,6 +758,14 @@ case $basic_machine in + basic_machine=m68k-isi + os=-sysv + ;; ++ m68knommu) ++ basic_machine=m68k-unknown ++ os=-linux ++ ;; ++ m68knommu-*) ++ basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` ++ os=-linux ++ ;; + m88k-omron*) + basic_machine=m88k-omron + ;; +@@ -638,10 +777,17 @@ case $basic_machine in + basic_machine=ns32k-utek + os=-sysv + ;; ++ microblaze) ++ basic_machine=microblaze-xilinx ++ ;; + mingw32) + basic_machine=i386-pc + os=-mingw32 + ;; ++ mingw32ce) ++ basic_machine=arm-unknown ++ os=-mingw32ce ++ ;; + miniframe) + basic_machine=m68000-convergent + ;; +@@ -655,10 +801,6 @@ case $basic_machine in + mips3*) + basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown + ;; +- mmix*) +- basic_machine=mmix-knuth +- os=-mmixware +- ;; + monitor) + basic_machine=m68k-rom68k + os=-coff +@@ -671,10 +813,21 @@ case $basic_machine in + basic_machine=i386-pc + os=-msdos + ;; ++ ms1-*) ++ basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` ++ ;; ++ msys) ++ basic_machine=i386-pc ++ os=-msys ++ ;; + mvs) + basic_machine=i370-ibm + os=-mvs + ;; ++ nacl) ++ basic_machine=le32-unknown ++ os=-nacl ++ ;; + ncr3000) + basic_machine=i486-ncr + os=-sysv4 +@@ -739,9 +892,11 @@ case $basic_machine in + np1) + basic_machine=np1-gould + ;; +- nv1) +- basic_machine=nv1-cray +- os=-unicosmp ++ neo-tandem) ++ basic_machine=neo-tandem ++ ;; ++ nse-tandem) ++ basic_machine=nse-tandem + ;; + nsr-tandem) + basic_machine=nsr-tandem +@@ -750,9 +905,8 @@ case $basic_machine in + basic_machine=hppa1.1-oki + os=-proelf + ;; +- or32 | or32-*) ++ openrisc | openrisc-*) + basic_machine=or32-unknown +- os=-coff + ;; + os400) + basic_machine=powerpc-ibm +@@ -774,6 +928,14 @@ case $basic_machine in + basic_machine=i860-intel + os=-osf + ;; ++ parisc) ++ basic_machine=hppa-unknown ++ os=-linux ++ ;; ++ parisc-*) ++ basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` ++ os=-linux ++ ;; + pbd) + basic_machine=sparc-tti + ;; +@@ -783,6 +945,12 @@ case $basic_machine in + pc532 | pc532-*) + basic_machine=ns32k-pc532 + ;; ++ pc98) ++ basic_machine=i386-pc ++ ;; ++ pc98-*) ++ basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'` ++ ;; + pentium | p5 | k5 | k6 | nexgen | viac3) + basic_machine=i586-pc + ;; +@@ -812,9 +980,10 @@ case $basic_machine in + ;; + power) basic_machine=power-ibm + ;; +- ppc) basic_machine=powerpc-unknown ++ ppc | ppcbe) basic_machine=powerpc-unknown + ;; +- ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ++ ppc-* | ppcbe-*) ++ basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ppcle | powerpclittle | ppc-le | powerpc-little) + basic_machine=powerpcle-unknown +@@ -839,6 +1008,10 @@ case $basic_machine in + basic_machine=i586-unknown + os=-pw32 + ;; ++ rdos) ++ basic_machine=i386-pc ++ os=-rdos ++ ;; + rom68k) + basic_machine=m68k-rom68k + os=-coff +@@ -865,6 +1038,10 @@ case $basic_machine in + sb1el) + basic_machine=mipsisa64sb1el-unknown + ;; ++ sde) ++ basic_machine=mipsisa32-sde ++ os=-elf ++ ;; + sei) + basic_machine=mips-sei + os=-seiux +@@ -876,6 +1053,9 @@ case $basic_machine in + basic_machine=sh-hitachi + os=-hms + ;; ++ sh5el) ++ basic_machine=sh5le-unknown ++ ;; + sh64) + basic_machine=sh64-unknown + ;; +@@ -897,6 +1077,9 @@ case $basic_machine in + basic_machine=i860-stratus + os=-sysv4 + ;; ++ strongarm-* | thumb-*) ++ basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` ++ ;; + sun2) + basic_machine=m68000-sun + ;; +@@ -953,17 +1136,9 @@ case $basic_machine in + basic_machine=t90-cray + os=-unicos + ;; +- tic54x | c54x*) +- basic_machine=tic54x-unknown +- os=-coff +- ;; +- tic55x | c55x*) +- basic_machine=tic55x-unknown +- os=-coff +- ;; +- tic6x | c6x*) +- basic_machine=tic6x-unknown +- os=-coff ++ tile*) ++ basic_machine=$basic_machine-unknown ++ os=-linux-gnu + ;; + tx39) + basic_machine=mipstx39-unknown +@@ -1025,9 +1200,16 @@ case $basic_machine in + basic_machine=hppa1.1-winbond + os=-proelf + ;; ++ xbox) ++ basic_machine=i686-pc ++ os=-mingw32 ++ ;; + xps | xps100) + basic_machine=xps100-honeywell + ;; ++ xscale-* | xscalee[bl]-*) ++ basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` ++ ;; + ymp) + basic_machine=ymp-cray + os=-unicos +@@ -1036,6 +1218,10 @@ case $basic_machine in + basic_machine=z8k-unknown + os=-sim + ;; ++ z80-*-coff) ++ basic_machine=z80-unknown ++ os=-sim ++ ;; + none) + basic_machine=none-none + os=-none +@@ -1055,6 +1241,9 @@ case $basic_machine in + romp) + basic_machine=romp-ibm + ;; ++ mmix) ++ basic_machine=mmix-knuth ++ ;; + rs6000) + basic_machine=rs6000-ibm + ;; +@@ -1071,13 +1260,10 @@ case $basic_machine in + we32k) + basic_machine=we32k-att + ;; +- sh3 | sh4 | sh[34]eb | sh[1234]le | sh[23]ele) ++ sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) + basic_machine=sh-unknown + ;; +- sh64) +- basic_machine=sh64-unknown +- ;; +- sparc | sparcv9 | sparcv9b) ++ sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) + basic_machine=sparc-sun + ;; + cydra) +@@ -1121,9 +1307,12 @@ esac + if [ x"$os" != x"" ] + then + case $os in +- # First match some system type aliases +- # that might get confused with valid system types. ++ # First match some system type aliases ++ # that might get confused with valid system types. + # -solaris* is a basic system type, with this one exception. ++ -auroraux) ++ os=-auroraux ++ ;; + -solaris1 | -solaris1.*) + os=`echo $os | sed -e 's|solaris1|sunos4|'` + ;; +@@ -1144,26 +1333,31 @@ case $os in + # Each alternative MUST END IN A *, to match a version number. + # -sysv* is not here because it comes later, after sysvr4. + -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ +- | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ +- | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ ++ | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ ++ | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ ++ | -sym* | -kopensolaris* \ + | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ +- | -aos* \ ++ | -aos* | -aros* \ + | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ + | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ +- | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* | -openbsd* \ ++ | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ ++ | -openbsd* | -solidbsd* \ + | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ + | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ + | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ + | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ +- | -chorusos* | -chorusrdb* \ +- | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ +- | -mingw32* | -linux-gnu* | -linux-uclibc* | -uxpv* | -beos* | -mpeix* | -udk* \ ++ | -chorusos* | -chorusrdb* | -cegcc* \ ++ | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ ++ | -mingw32* | -linux-gnu* | -linux-android* \ ++ | -linux-newlib* | -linux-uclibc* \ ++ | -uxpv* | -beos* | -mpeix* | -udk* \ + | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ + | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ + | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ + | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ + | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ +- | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly*) ++ | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ ++ | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) + # Remember, each alternative MUST END IN *, to match a version number. + ;; + -qnx*) +@@ -1181,7 +1375,7 @@ case $os in + os=`echo $os | sed -e 's|nto|nto-qnx|'` + ;; + -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ +- | -windows* | -osx | -abug | -netware* | -os9* | -beos* \ ++ | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \ + | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) + ;; + -mac*) +@@ -1202,7 +1396,7 @@ case $os in + -opened*) + os=-openedition + ;; +- -os400*) ++ -os400*) + os=-os400 + ;; + -wince*) +@@ -1251,7 +1445,7 @@ case $os in + -sinix*) + os=-sysv4 + ;; +- -tpf*) ++ -tpf*) + os=-tpf + ;; + -triton*) +@@ -1290,6 +1484,14 @@ case $os in + -kaos*) + os=-kaos + ;; ++ -zvmoe) ++ os=-zvmoe ++ ;; ++ -dicos*) ++ os=-dicos ++ ;; ++ -nacl*) ++ ;; + -none) + ;; + *) +@@ -1312,6 +1514,12 @@ else + # system, and we'll never get to this point. + + case $basic_machine in ++ score-*) ++ os=-elf ++ ;; ++ spu-*) ++ os=-elf ++ ;; + *-acorn) + os=-riscix1.2 + ;; +@@ -1321,9 +1529,18 @@ case $basic_machine in + arm*-semi) + os=-aout + ;; +- c4x-* | tic4x-*) +- os=-coff +- ;; ++ c4x-* | tic4x-*) ++ os=-coff ++ ;; ++ tic54x-*) ++ os=-coff ++ ;; ++ tic55x-*) ++ os=-coff ++ ;; ++ tic6x-*) ++ os=-coff ++ ;; + # This must come before the *-dec entry. + pdp10-*) + os=-tops20 +@@ -1349,6 +1566,9 @@ case $basic_machine in + m68*-cisco) + os=-aout + ;; ++ mep-*) ++ os=-elf ++ ;; + mips*-cisco) + os=-elf + ;; +@@ -1367,9 +1587,15 @@ case $basic_machine in + *-be) + os=-beos + ;; ++ *-haiku) ++ os=-haiku ++ ;; + *-ibm) + os=-aix + ;; ++ *-knuth) ++ os=-mmixware ++ ;; + *-wec) + os=-proelf + ;; +@@ -1472,7 +1698,7 @@ case $basic_machine in + -sunos*) + vendor=sun + ;; +- -aix*) ++ -cnk*|-aix*) + vendor=ibm + ;; + -beos*) +@@ -1535,7 +1761,7 @@ case $basic_machine in + esac + + echo $basic_machine$os +-exit 0 ++exit + + # Local variables: + # eval: (add-hook 'write-file-hooks 'time-stamp) +-- +1.7.10 + diff --git a/0003-Don-t-add-rpaths-to-libraries.patch b/0003-Don-t-add-rpaths-to-libraries.patch new file mode 100644 index 0000000..eedc190 --- /dev/null +++ b/0003-Don-t-add-rpaths-to-libraries.patch @@ -0,0 +1,26 @@ +From 649d2c547fd28c48b52348328cd267854389f45f Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Tue, 29 May 2012 20:43:34 +0100 +Subject: [PATCH 3/7] Don't add rpaths to libraries. + +--- + tools/Makefile.shared | 3 --- + 1 file changed, 3 deletions(-) + +diff --git a/tools/Makefile.shared b/tools/Makefile.shared +index 247575a..05de46c 100644 +--- a/tools/Makefile.shared ++++ b/tools/Makefile.shared +@@ -103,9 +103,6 @@ ocamlmklib.ml: ocamlmklib.mlp ../config/Makefile + sed -e "s|%%BINDIR%%|$(BINDIR)|" \ + -e "s|%%SUPPORTS_SHARED_LIBRARIES%%|$(SUPPORTS_SHARED_LIBRARIES)|" \ + -e "s|%%MKSHAREDLIB%%|$(MKSHAREDLIB)|" \ +- -e "s|%%BYTECCRPATH%%|$(BYTECCRPATH)|" \ +- -e "s|%%NATIVECCRPATH%%|$(NATIVECCRPATH)|" \ +- -e "s|%%MKSHAREDLIBRPATH%%|$(MKSHAREDLIBRPATH)|" \ + -e "s|%%RANLIB%%|$(RANLIB)|" \ + ocamlmklib.mlp >> ocamlmklib.ml + +-- +1.7.10 + diff --git a/0004-configure-Allow-user-defined-C-compiler-flags.patch b/0004-configure-Allow-user-defined-C-compiler-flags.patch new file mode 100644 index 0000000..c209644 --- /dev/null +++ b/0004-configure-Allow-user-defined-C-compiler-flags.patch @@ -0,0 +1,27 @@ +From 0febdfe1698639ce53e6ed8935cdc573be302b49 Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Tue, 29 May 2012 20:44:18 +0100 +Subject: [PATCH 4/7] configure: Allow user defined C compiler flags. + +--- + configure | 4 ++++ + 1 file changed, 4 insertions(+) + +diff --git a/configure b/configure +index 9be5199..d0a6b0f 100755 +--- a/configure ++++ b/configure +@@ -1600,6 +1600,10 @@ case "$buggycc" in + nativecccompopts="$nativecccompopts -fomit-frame-pointer";; + esac + ++# Allow user defined C Compiler flags ++bytecccompopts="$bytecccompopts $CFLAGS" ++nativecccompopts="$nativecccompopts $CFLAGS" ++ + # Finish generated files + + cclibs="$cclibs $mathlib" +-- +1.7.10 + diff --git a/0005-ocamlopt-arm-add-.type-directive-for-code-symbols.patch b/0005-ocamlopt-arm-add-.type-directive-for-code-symbols.patch new file mode 100644 index 0000000..3493142 --- /dev/null +++ b/0005-ocamlopt-arm-add-.type-directive-for-code-symbols.patch @@ -0,0 +1,128 @@ +From e3b5b13c53b62b99c4d6764b52a7269a6fe5b983 Mon Sep 17 00:00:00 2001 +From: Stephane Glondu +Date: Tue, 29 May 2012 20:45:32 +0100 +Subject: [PATCH 5/7] ocamlopt/arm: add .type directive for code symbols + +Bug: http://caml.inria.fr/mantis/view.php?id=5336 +Bug-Ubuntu: https://bugs.launchpad.net/bugs/810402 +Signed-off-by: Stephane Glondu +--- + asmcomp/arm/emit.mlp | 1 + + asmrun/arm.S | 12 ++++++++++++ + 2 files changed, 13 insertions(+) + +diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp +index 2003313..a4b2241 100644 +--- a/asmcomp/arm/emit.mlp ++++ b/asmcomp/arm/emit.mlp +@@ -556,6 +556,7 @@ let fundecl fundecl = + ` .text\n`; + ` .align 2\n`; + ` .global {emit_symbol fundecl.fun_name}\n`; ++ ` .type {emit_symbol fundecl.fun_name}, %function\n`; + `{emit_symbol fundecl.fun_name}:\n`; + let n = frame_size() in + ignore(emit_stack_adjustment "sub" n); +diff --git a/asmrun/arm.S b/asmrun/arm.S +index 164f731..1313e9c 100644 +--- a/asmrun/arm.S ++++ b/asmrun/arm.S +@@ -24,6 +24,7 @@ alloc_limit .req r10 + /* Allocation functions and GC interface */ + + .globl caml_call_gc ++ .type caml_call_gc, %function + caml_call_gc: + /* Record return address and desired size */ + /* Can use alloc_limit as a temporary since it will be reloaded by +@@ -41,6 +42,7 @@ caml_call_gc: + bx lr + + .globl caml_alloc1 ++ .type caml_alloc1, %function + caml_alloc1: + sub alloc_ptr, alloc_ptr, #8 + cmp alloc_ptr, alloc_limit +@@ -54,6 +56,7 @@ caml_alloc1: + b caml_alloc1 + + .globl caml_alloc2 ++ .type caml_alloc2, %function + caml_alloc2: + sub alloc_ptr, alloc_ptr, #12 + cmp alloc_ptr, alloc_limit +@@ -67,6 +70,7 @@ caml_alloc2: + b caml_alloc2 + + .globl caml_alloc3 ++ .type caml_alloc3, %function + caml_alloc3: + sub alloc_ptr, alloc_ptr, #16 + cmp alloc_ptr, alloc_limit +@@ -80,6 +84,7 @@ caml_alloc3: + b caml_alloc3 + + .globl caml_allocN ++ .type caml_allocN, %function + caml_allocN: + sub alloc_ptr, alloc_ptr, r12 + cmp alloc_ptr, alloc_limit +@@ -134,6 +139,7 @@ caml_allocN: + /* Function to call is in r12 */ + + .globl caml_c_call ++ .type caml_c_call, %function + caml_c_call: + /* Preserve return address in callee-save register r4 */ + mov r4, lr +@@ -160,6 +166,7 @@ caml_c_call: + /* Start the Caml program */ + + .globl caml_start_program ++ .type caml_start_program, %function + caml_start_program: + ldr r12, .Lcaml_program + +@@ -235,6 +242,7 @@ caml_start_program: + /* Raise an exception from C */ + + .globl caml_raise_exception ++ .type caml_raise_exception, %function + caml_raise_exception: + /* Reload Caml allocation pointers */ + ldr r12, .Lcaml_young_ptr +@@ -250,6 +258,7 @@ caml_raise_exception: + /* Callback from C to Caml */ + + .globl caml_callback_exn ++ .type caml_callback_exn, %function + caml_callback_exn: + /* Initial shuffling of arguments (r0 = closure, r1 = first arg) */ + mov r12, r0 +@@ -259,6 +268,7 @@ caml_callback_exn: + b .Ljump_to_caml + + .globl caml_callback2_exn ++ .type caml_callback2_exn, %function + caml_callback2_exn: + /* Initial shuffling of arguments (r0 = closure, r1 = arg1, r2 = arg2) */ + mov r12, r0 +@@ -269,6 +279,7 @@ caml_callback2_exn: + b .Ljump_to_caml + + .globl caml_callback3_exn ++ .type caml_callback3_exn, %function + caml_callback3_exn: + /* Initial shuffling of arguments */ + /* (r0 = closure, r1 = arg1, r2 = arg2, r3 = arg3) */ +@@ -281,6 +292,7 @@ caml_callback3_exn: + b .Ljump_to_caml + + .globl caml_ml_array_bound_error ++ .type caml_ml_array_bound_error, %function + caml_ml_array_bound_error: + /* Load address of [caml_array_bound_error] in r12 */ + ldr r12, .Lcaml_array_bound_error +-- +1.7.10 + diff --git a/0006-Add-support-for-ppc64.patch b/0006-Add-support-for-ppc64.patch new file mode 100644 index 0000000..f9b0dde --- /dev/null +++ b/0006-Add-support-for-ppc64.patch @@ -0,0 +1,2136 @@ +From a9648ff01cea44e6892663e97c3c388686b4fcd7 Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Tue, 29 May 2012 20:47:07 +0100 +Subject: [PATCH 6/7] Add support for ppc64. + +Note (1): This patch was rejected upstream because they don't have +appropriate hardware for testing. + +Note (2): Upstream powerpc directory has some support for ppc64, but +only for Macs, and I couldn't get it to work at all with IBM hardware. + +This patch was collaborated on by several people, most notably David +Woodhouse. +--- + asmcomp/power64/arch.ml | 84 ++++ + asmcomp/power64/emit.mlp | 989 +++++++++++++++++++++++++++++++++++++++++ + asmcomp/power64/proc.ml | 245 ++++++++++ + asmcomp/power64/reload.ml | 18 + + asmcomp/power64/scheduling.ml | 66 +++ + asmcomp/power64/selection.ml | 103 +++++ + asmrun/Makefile | 6 + + asmrun/power64-elf.S | 486 ++++++++++++++++++++ + asmrun/stack.h | 9 + + configure | 5 +- + 10 files changed, 2010 insertions(+), 1 deletion(-) + create mode 100644 asmcomp/power64/arch.ml + create mode 100644 asmcomp/power64/emit.mlp + create mode 100644 asmcomp/power64/proc.ml + create mode 100644 asmcomp/power64/reload.ml + create mode 100644 asmcomp/power64/scheduling.ml + create mode 100644 asmcomp/power64/selection.ml + create mode 100644 asmrun/power64-elf.S + +diff --git a/asmcomp/power64/arch.ml b/asmcomp/power64/arch.ml +new file mode 100644 +index 0000000..93b5b18 +--- /dev/null ++++ b/asmcomp/power64/arch.ml +@@ -0,0 +1,84 @@ ++(***********************************************************************) ++(* *) ++(* Objective Caml *) ++(* *) ++(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) ++(* *) ++(* Copyright 1996 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the Q Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* $Id: ocaml-3.11.0-ppc64.patch,v 1.1 2008/11/20 15:30:55 rjones Exp $ *) ++ ++(* Specific operations for the PowerPC processor *) ++ ++open Misc ++open Format ++ ++(* Machine-specific command-line options *) ++ ++let command_line_options = [] ++ ++(* Specific operations *) ++ ++type specific_operation = ++ Imultaddf (* multiply and add *) ++ | Imultsubf (* multiply and subtract *) ++ | Ialloc_far of int (* allocation in large functions *) ++ ++(* Addressing modes *) ++ ++type addressing_mode = ++ Ibased of string * int (* symbol + displ *) ++ | Iindexed of int (* reg + displ *) ++ | Iindexed2 (* reg + reg *) ++ ++(* Sizes, endianness *) ++ ++let big_endian = true ++ ++let size_addr = 8 ++let size_int = 8 ++let size_float = 8 ++ ++(* Operations on addressing modes *) ++ ++let identity_addressing = Iindexed 0 ++ ++let offset_addressing addr delta = ++ match addr with ++ Ibased(s, n) -> Ibased(s, n + delta) ++ | Iindexed n -> Iindexed(n + delta) ++ | Iindexed2 -> assert false ++ ++let num_args_addressing = function ++ Ibased(s, n) -> 0 ++ | Iindexed n -> 1 ++ | Iindexed2 -> 2 ++ ++(* Printing operations and addressing modes *) ++ ++let print_addressing printreg addr ppf arg = ++ match addr with ++ | Ibased(s, n) -> ++ let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in ++ fprintf ppf "\"%s\"%s" s idx ++ | Iindexed n -> ++ let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in ++ fprintf ppf "%a%s" printreg arg.(0) idx ++ | Iindexed2 -> ++ fprintf ppf "%a + %a" printreg arg.(0) printreg arg.(1) ++ ++let print_specific_operation printreg op ppf arg = ++ match op with ++ | Imultaddf -> ++ fprintf ppf "%a *f %a +f %a" ++ printreg arg.(0) printreg arg.(1) printreg arg.(2) ++ | Imultsubf -> ++ fprintf ppf "%a *f %a -f %a" ++ printreg arg.(0) printreg arg.(1) printreg arg.(2) ++ | Ialloc_far n -> ++ fprintf ppf "alloc_far %d" n ++ +diff --git a/asmcomp/power64/emit.mlp b/asmcomp/power64/emit.mlp +new file mode 100644 +index 0000000..95eb193 +--- /dev/null ++++ b/asmcomp/power64/emit.mlp +@@ -0,0 +1,989 @@ ++(***********************************************************************) ++(* *) ++(* Objective Caml *) ++(* *) ++(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) ++(* *) ++(* Copyright 1996 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the Q Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* $Id: ocaml-3.11.0-ppc64.patch,v 1.1 2008/11/20 15:30:55 rjones Exp $ *) ++ ++(* Emission of PowerPC assembly code *) ++ ++module StringSet = Set.Make(struct type t = string let compare = compare end) ++ ++open Location ++open Misc ++open Cmm ++open Arch ++open Proc ++open Reg ++open Mach ++open Linearize ++open Emitaux ++ ++(* Layout of the stack. The stack is kept 16-aligned. *) ++ ++let stack_size_lbl = ref 0 ++let stack_slot_lbl = ref 0 ++let stack_args_size = ref 0 ++let stack_traps_size = ref 0 ++ ++(* We have a stack frame of our own if we call other functions (including ++ use of exceptions, or if we need more than the red zone *) ++let has_stack_frame () = ++ if !contains_calls or (num_stack_slots.(0) + num_stack_slots.(1)) > (288-16)/8 then ++ true ++ else ++ false ++ ++let frame_size_sans_args () = ++ let size = 8 * num_stack_slots.(0) + 8 * num_stack_slots.(1) + 48 in ++ Misc.align size 16 ++ ++let slot_offset loc cls = ++ match loc with ++ Local n -> ++ if cls = 0 ++ then (!stack_slot_lbl, num_stack_slots.(1) * 8 + n * 8) ++ else (!stack_slot_lbl, n * 8) ++ | Incoming n -> ((if has_stack_frame() then !stack_size_lbl else 0), 48 + n) ++ | Outgoing n -> (0, n) ++ ++(* Output a symbol *) ++ ++let emit_symbol = ++ match Config.system with ++ | "elf" | "bsd" -> (fun s -> Emitaux.emit_symbol '.' s) ++ | "rhapsody" -> (fun s -> emit_char '_'; Emitaux.emit_symbol '$' s) ++ | _ -> assert false ++ ++(* Output a label *) ++ ++let label_prefix = ++ match Config.system with ++ | "elf" | "bsd" -> ".L" ++ | "rhapsody" -> "L" ++ | _ -> assert false ++ ++let emit_label lbl = ++ emit_string label_prefix; emit_int lbl ++ ++(* Section switching *) ++ ++let toc_space = ++ match Config.system with ++ | "elf" | "bsd" -> " .section \".toc\",\"aw\"\n" ++ | "rhapsody" -> " .toc\n" ++ | _ -> assert false ++ ++let data_space = ++ match Config.system with ++ | "elf" | "bsd" -> " .section \".data\"\n" ++ | "rhapsody" -> " .data\n" ++ | _ -> assert false ++ ++let code_space = ++ match Config.system with ++ | "elf" | "bsd" -> " .section \".text\"\n" ++ | "rhapsody" -> " .text\n" ++ | _ -> assert false ++ ++let rodata_space = ++ match Config.system with ++ | "elf" | "bsd" -> " .section \".rodata\"\n" ++ | "rhapsody" -> " .const\n" ++ | _ -> assert false ++ ++(* Output a pseudo-register *) ++ ++let emit_reg r = ++ match r.loc with ++ 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 lbl, ofs = slot_offset s (register_class r) in ++ if lbl > 0 then ++ `{emit_label lbl}+`; ++ `{emit_int ofs}({emit_gpr 1})` ++ | _ -> fatal_error "Emit.emit_stack" ++ ++(* Split a 32-bit integer constants in two 16-bit halves *) ++ ++let low n = n land 0xFFFF ++let high n = n asr 16 ++ ++let nativelow n = Nativeint.to_int n land 0xFFFF ++let nativehigh n = Nativeint.to_int (Nativeint.shift_right n 16) ++ ++let is_immediate n = ++ n <= 32767 && n >= -32768 ++ ++let is_native_immediate n = ++ n <= 32767n && n >= -32768n ++ ++ ++type tocentry = ++ TocSymOfs of (string * int) ++ | TocLabel of int ++ | TocInt of nativeint ++ | TocFloat of string ++ ++(* List of all labels in tocref (reverse order) *) ++let tocref_entries = ref [] ++ ++(* Output a TOC reference *) ++ ++let emit_symbol_offset (s, d) = ++ emit_symbol s; ++ if d > 0 then `+`; ++ if d <> 0 then emit_int d ++ ++let emit_tocentry entry = ++ match entry with ++ TocSymOfs(s,d) -> emit_symbol_offset(s,d) ++ | TocInt i -> emit_nativeint i ++ | TocFloat f -> emit_string f ++ | TocLabel lbl -> emit_label lbl ++ ++ let rec tocref_label = function ++ ( [] , content ) -> ++ let lbl = new_label() in ++ tocref_entries := (lbl, content) :: !tocref_entries; ++ lbl ++ | ( (lbl, o_content) :: lst, content) -> ++ if content = o_content then ++ lbl ++ else ++ tocref_label (lst, content) ++ ++let emit_tocref entry = ++ let lbl = tocref_label (!tocref_entries,entry) in ++ emit_label lbl; emit_string "@toc(2) #"; emit_tocentry entry ++ ++ ++(* Output a load or store operation *) ++ ++let valid_offset instr ofs = ++ ofs land 3 = 0 || (instr <> "ld" && instr <> "std") ++ ++let emit_load_store instr addressing_mode addr n arg = ++ match addressing_mode with ++ Ibased(s, d) -> ++ let dd = (d + 0x8000) in (* We can only offset by -0x8000 .. +0x7fff *) ++ let a = (dd land -0x10000) in ++ let b = (dd land 0xffff) - 0x8000 in ++ ` ld {emit_gpr 11}, {emit_tocref (TocSymOfs (s,a))}\n`; ++ ` {emit_string instr} {emit_reg arg}, {emit_int b}({emit_gpr 11})\n` ++ | Iindexed ofs -> ++ if is_immediate ofs && valid_offset instr 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` ++ ++(* 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` ++ | _ -> () ++ end ++ ++(* Record live pointers at call points *) ++ ++type frame_descr = ++ { fd_lbl: int; (* Return address *) ++ fd_frame_size_lbl: int; (* Size of stack frame *) ++ fd_live_offset: (int * int) list } (* Offsets/regs of live addresses *) ++ ++let frame_descriptors = ref([] : frame_descr list) ++ ++let record_frame live = ++ let lbl = new_label() in ++ let live_offset = ref [] in ++ Reg.Set.iter ++ (function ++ {typ = Addr; loc = Reg r} -> ++ live_offset := (0, (r lsl 1) + 1) :: !live_offset ++ | {typ = Addr; loc = Stack s} as reg -> ++ live_offset := slot_offset s (register_class reg) :: !live_offset ++ | _ -> ()) ++ live; ++ frame_descriptors := ++ { fd_lbl = lbl; ++ fd_frame_size_lbl = !stack_size_lbl; (* frame_size *) ++ fd_live_offset = !live_offset } :: !frame_descriptors; ++ `{emit_label lbl}:\n` ++ ++let emit_frame fd = ++ ` .quad {emit_label fd.fd_lbl} + 4\n`; ++ ` .short {emit_label fd.fd_frame_size_lbl}\n`; ++ ` .short {emit_int (List.length fd.fd_live_offset)}\n`; ++ List.iter ++ (fun (lbl,n) -> ++ ` .short `; ++ if lbl > 0 then `{emit_label lbl}+`; ++ `{emit_int n}\n`) ++ fd.fd_live_offset; ++ ` .align 3\n` ++ ++(* Record external C functions to be called in a position-independent way ++ (for MacOSX) *) ++ ++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`; ++ ` .quad 0\n` ++ ++(* Names for conditional branches after comparisons *) ++ ++let branch_for_comparison = function ++ Ceq -> "beq" | Cne -> "bne" ++ | Cle -> "ble" | Cgt -> "bgt" ++ | Cge -> "bge" | Clt -> "blt" ++ ++let name_for_int_comparison = function ++ Isigned cmp -> ("cmpd", branch_for_comparison cmp) ++ | Iunsigned cmp -> ("cmpld", branch_for_comparison cmp) ++ ++(* Names for various instructions *) ++ ++let name_for_intop = function ++ Iadd -> "add" ++ | Imul -> "mulld" ++ | Idiv -> "divd" ++ | Iand -> "and" ++ | Ior -> "or" ++ | Ixor -> "xor" ++ | Ilsl -> "sld" ++ | Ilsr -> "srd" ++ | Iasr -> "srad" ++ | _ -> Misc.fatal_error "Emit.Intop" ++ ++let name_for_intop_imm = function ++ Iadd -> "addi" ++ | Imul -> "mulli" ++ | Iand -> "andi." ++ | Ior -> "ori" ++ | Ixor -> "xori" ++ | Ilsl -> "sldi" ++ | Ilsr -> "srdi" ++ | Iasr -> "sradi" ++ | _ -> Misc.fatal_error "Emit.Intop_imm" ++ ++let name_for_floatop1 = function ++ Inegf -> "fneg" ++ | Iabsf -> "fabs" ++ | _ -> Misc.fatal_error "Emit.Iopf1" ++ ++let name_for_floatop2 = function ++ Iaddf -> "fadd" ++ | Isubf -> "fsub" ++ | Imulf -> "fmul" ++ | Idivf -> "fdiv" ++ | _ -> Misc.fatal_error "Emit.Iopf2" ++ ++let name_for_specific = function ++ Imultaddf -> "fmadd" ++ | Imultsubf -> "fmsub" ++ | _ -> Misc.fatal_error "Emit.Ispecific" ++ ++(* Name of current function *) ++let function_name = ref "" ++(* Entry point for tail recursive calls *) ++let tailrec_entry_point = ref 0 ++(* Names of functions defined in the current file *) ++let defined_functions = ref StringSet.empty ++(* Label of glue code for calling the GC *) ++let call_gc_label = ref 0 ++(* Label of jump table *) ++let lbl_jumptbl = ref 0 ++(* List of all labels in jumptable (reverse order) *) ++let jumptbl_entries = ref [] ++(* Number of jumptable entries *) ++let num_jumptbl_entries = ref 0 ++ ++(* Fixup conditional branches that exceed hardware allowed range *) ++ ++let load_store_size = function ++ Ibased(s, d) -> 2 ++ | Iindexed ofs -> if is_immediate ofs then 1 else 3 ++ | Iindexed2 -> 1 ++ ++let instr_size = function ++ Lend -> 0 ++ | Lop(Imove | Ispill | Ireload) -> 1 ++ | Lop(Iconst_int n) -> if is_native_immediate n then 1 else 2 ++ | Lop(Iconst_float s) -> 2 ++ | Lop(Iconst_symbol s) -> 2 ++ | Lop(Icall_ind) -> 6 ++ | Lop(Icall_imm s) -> 7 ++ | Lop(Itailcall_ind) -> if !contains_calls then 7 else if has_stack_frame() then 5 else 4 ++ | Lop(Itailcall_imm s) -> if s = !function_name then 1 else ++ if !contains_calls then 8 else ++ if has_stack_frame() then 6 else 5 ++ | Lop(Iextcall(s, true)) -> 8 ++ | Lop(Iextcall(s, false)) -> 7 ++ | Lop(Istackoffset n) -> 0 ++ | Lop(Iload(chunk, addr)) -> ++ if chunk = Byte_signed ++ then load_store_size addr + 1 ++ else load_store_size addr ++ | Lop(Istore(chunk, addr)) -> load_store_size addr ++ | Lop(Ialloc n) -> 4 ++ | Lop(Ispecific(Ialloc_far n)) -> 5 ++ | Lop(Iintop Imod) -> 3 ++ | Lop(Iintop(Icomp cmp)) -> 4 ++ | Lop(Iintop op) -> 1 ++ | Lop(Iintop_imm(Idiv, n)) -> 2 ++ | Lop(Iintop_imm(Imod, n)) -> 4 ++ | Lop(Iintop_imm(Icomp cmp, n)) -> 4 ++ | Lop(Iintop_imm(op, n)) -> 1 ++ | Lop(Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf) -> 1 ++ | Lop(Ifloatofint) -> 3 ++ | Lop(Iintoffloat) -> 3 ++ | Lop(Ispecific sop) -> 1 ++ | Lreloadretaddr -> 2 ++ | Lreturn -> if has_stack_frame() then 2 else 1 ++ | Llabel lbl -> 0 ++ | Lbranch lbl -> 1 ++ | Lcondbranch(tst, lbl) -> 2 ++ | Lcondbranch3(lbl0, lbl1, lbl2) -> ++ 1 + (if lbl0 = None then 0 else 1) ++ + (if lbl1 = None then 0 else 1) ++ + (if lbl2 = None then 0 else 1) ++ | Lswitch jumptbl -> 7 ++ | Lsetuptrap lbl -> 1 ++ | Lpushtrap -> 7 ++ | Lpoptrap -> 1 ++ | Lraise -> 6 ++ ++let label_map code = ++ let map = Hashtbl.create 37 in ++ let rec fill_map pc instr = ++ match instr.desc with ++ Lend -> (pc, map) ++ | Llabel lbl -> Hashtbl.add map lbl pc; fill_map pc instr.next ++ | op -> fill_map (pc + instr_size op) instr.next ++ in fill_map 0 code ++ ++let max_branch_offset = 8180 ++(* 14-bit signed offset in words. Remember to cut some slack ++ for multi-word instructions where the branch can be anywhere in ++ the middle. 12 words of slack is plenty. *) ++ ++let branch_overflows map pc_branch lbl_dest = ++ let pc_dest = Hashtbl.find map lbl_dest in ++ let delta = pc_dest - (pc_branch + 1) in ++ delta <= -max_branch_offset || delta >= max_branch_offset ++ ++let opt_branch_overflows map pc_branch opt_lbl_dest = ++ match opt_lbl_dest with ++ None -> false ++ | Some lbl_dest -> branch_overflows map pc_branch lbl_dest ++ ++let fixup_branches codesize map code = ++ let expand_optbranch lbl n arg next = ++ match lbl with ++ None -> next ++ | Some l -> ++ instr_cons (Lcondbranch(Iinttest_imm(Isigned Ceq, n), l)) ++ arg [||] next in ++ let rec fixup did_fix pc instr = ++ match instr.desc with ++ Lend -> did_fix ++ | Lcondbranch(test, lbl) when branch_overflows map pc lbl -> ++ let lbl2 = new_label() in ++ let cont = ++ instr_cons (Lbranch lbl) [||] [||] ++ (instr_cons (Llabel lbl2) [||] [||] instr.next) in ++ instr.desc <- Lcondbranch(invert_test test, lbl2); ++ instr.next <- cont; ++ fixup true (pc + 2) instr.next ++ | Lcondbranch3(lbl0, lbl1, lbl2) ++ when opt_branch_overflows map pc lbl0 ++ || opt_branch_overflows map pc lbl1 ++ || opt_branch_overflows map pc lbl2 -> ++ let cont = ++ expand_optbranch lbl0 0 instr.arg ++ (expand_optbranch lbl1 1 instr.arg ++ (expand_optbranch lbl2 2 instr.arg instr.next)) in ++ instr.desc <- cont.desc; ++ instr.next <- cont.next; ++ fixup true pc instr ++ | Lop(Ialloc n) when codesize - pc >= max_branch_offset -> ++ instr.desc <- Lop(Ispecific(Ialloc_far n)); ++ fixup true (pc + 4) instr.next ++ | op -> ++ fixup did_fix (pc + instr_size op) instr.next ++ in fixup false 0 code ++ ++(* Iterate branch expansion till all conditional branches are OK *) ++ ++let rec branch_normalization code = ++ let (codesize, map) = label_map code in ++ if codesize >= max_branch_offset && fixup_branches codesize map code ++ then branch_normalization code ++ else () ++ ++ ++(* Output the assembly code for an instruction *) ++ ++let rec emit_instr i dslot = ++ match i.desc with ++ Lend -> () ++ | Lop(Imove | Ispill | Ireload) -> ++ let src = i.arg.(0) and dst = i.res.(0) in ++ if src.loc <> dst.loc then begin ++ match (src, dst) with ++ {loc = Reg rs; typ = (Int | Addr)}, {loc = Reg rd} -> ++ ` mr {emit_reg dst}, {emit_reg src}\n` ++ | {loc = Reg rs; typ = Float}, {loc = Reg rd; typ = Float} -> ++ ` fmr {emit_reg dst}, {emit_reg src}\n` ++ | {loc = Reg rs; typ = (Int | Addr)}, {loc = Stack sd} -> ++ ` std {emit_reg src}, {emit_stack dst}\n` ++ | {loc = Reg rs; typ = Float}, {loc = Stack sd} -> ++ ` stfd {emit_reg src}, {emit_stack dst}\n` ++ | {loc = Stack ss; typ = (Int | Addr)}, {loc = Reg rd} -> ++ ` ld {emit_reg dst}, {emit_stack src}\n` ++ | {loc = Stack ss; typ = Float}, {loc = Reg rd} -> ++ ` lfd {emit_reg dst}, {emit_stack src}\n` ++ | (_, _) -> ++ fatal_error "Emit: Imove" ++ end ++ | Lop(Iconst_int n) -> ++ if is_native_immediate n then ++ ` li {emit_reg i.res.(0)}, {emit_nativeint n}\n` ++ else if n >= -0x8000_0000n && n <= 0x7FFF_FFFFn then begin ++ ` lis {emit_reg i.res.(0)}, {emit_int(nativehigh n)}\n`; ++ if nativelow n <> 0 then ++ ` ori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, {emit_int(nativelow n)}\n` ++ end else begin ++ ` ld {emit_reg i.res.(0)}, {emit_tocref (TocInt n)}\n` ++ end ++ | Lop(Iconst_float s) -> ++ ` lfd {emit_reg i.res.(0)}, {emit_tocref (TocFloat s)}\n` ++ | Lop(Iconst_symbol s) -> ++ ` ld {emit_reg i.res.(0)}, {emit_tocref (TocSymOfs (s,0))}\n` ++ | Lop(Icall_ind) -> ++ ` std {emit_gpr 2},40({emit_gpr 1})\n`; ++ ` ld {emit_gpr 2}, 8({emit_reg i.arg.(0)})\n`; ++ ` ld {emit_reg i.arg.(0)}, 0({emit_reg i.arg.(0)})\n`; ++ ` mtctr {emit_reg i.arg.(0)}\n`; ++ record_frame i.live; ++ ` bctrl\n`; ++ ` ld {emit_gpr 2},40({emit_gpr 1})\n` ++ | Lop(Icall_imm s) -> ++ ` ld {emit_gpr 11}, {emit_tocref (TocSymOfs (s,0))}\n`; ++ ` std {emit_gpr 2},40({emit_gpr 1})\n`; ++ ` ld {emit_gpr 2}, 8({emit_gpr 11})\n`; ++ ` ld {emit_gpr 11}, 0({emit_gpr 11})\n`; ++ ` mtctr {emit_gpr 11}\n`; ++ record_frame i.live; ++ ` bctrl\n`; ++ ` ld {emit_gpr 2},40({emit_gpr 1})\n` ++ | Lop(Itailcall_ind) -> ++ ` ld {emit_gpr 2}, 8({emit_reg i.arg.(0)})\n`; ++ ` ld {emit_reg i.arg.(0)}, 0({emit_reg i.arg.(0)})\n`; ++ ` mtctr {emit_reg i.arg.(0)}\n`; ++ if has_stack_frame() then ++ ` ld {emit_gpr 1}, 0({emit_gpr 1})\n`; ++ if !contains_calls then begin ++ ` ld {emit_gpr 11}, 16({emit_gpr 1})\n`; ++ ` mtlr {emit_gpr 11}\n` ++ end; ++ ` bctr\n` ++ | Lop(Itailcall_imm s) -> ++ if s = !function_name then ++ ` b {emit_label !tailrec_entry_point}\n` ++ else begin ++ if has_stack_frame() then ++ ` ld {emit_gpr 1}, 0({emit_gpr 1})\n`; ++ if !contains_calls then begin ++ ` ld {emit_gpr 11}, 16({emit_gpr 1})\n`; ++ ` mtlr {emit_gpr 11}\n` ++ end; ++ ` ld {emit_gpr 11}, {emit_tocref (TocSymOfs (s,0))}\n`; ++ ` ld {emit_gpr 2}, 8({emit_gpr 11})\n`; ++ ` ld {emit_gpr 11}, 0({emit_gpr 11})\n`; ++ ` mtctr {emit_gpr 11}\n`; ++ ` bctr\n` ++ end ++ | Lop(Iextcall(s, alloc)) -> ++ if alloc then begin ++ ` ld {emit_gpr 11}, {emit_tocref (TocSymOfs (s,0))}\n`; ++ ` ld {emit_gpr 12}, {emit_tocref (TocSymOfs ("caml_c_call",0))}\n`; ++ end else ++ ` ld {emit_gpr 12}, {emit_tocref (TocSymOfs (s,0))}\n`; ++ ` std {emit_gpr 2}, 40({emit_gpr 1})\n`; ++ ` ld {emit_gpr 2}, 8({emit_gpr 12})\n`; ++ ` ld {emit_gpr 12}, 0({emit_gpr 12})\n`; ++ ` mtctr {emit_gpr 12}\n`; ++ if alloc then record_frame i.live; ++ ` bctrl\n`; ++ ` ld {emit_gpr 2}, 40({emit_gpr 1})\n` ++ | Lop(Istackoffset n) -> ++ if n > !stack_args_size then ++ stack_args_size := n ++ | Lop(Iload(chunk, addr)) -> ++ let loadinstr = ++ match chunk with ++ Byte_unsigned -> "lbz" ++ | Byte_signed -> "lbz" ++ | Sixteen_unsigned -> "lhz" ++ | Sixteen_signed -> "lha" ++ | Thirtytwo_unsigned -> "lwz" ++ | Thirtytwo_signed -> "lwa" ++ | Word -> "ld" ++ | Single -> "lfs" ++ | Double | Double_u -> "lfd" in ++ emit_load_store loadinstr addr i.arg 0 i.res.(0); ++ if chunk = Byte_signed then ++ ` extsb {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` ++ | Lop(Istore(chunk, addr)) -> ++ let storeinstr = ++ match chunk with ++ Byte_unsigned | Byte_signed -> "stb" ++ | Sixteen_unsigned | Sixteen_signed -> "sth" ++ | Thirtytwo_unsigned | Thirtytwo_signed -> "stw" ++ | Word -> "std" ++ | Single -> "stfs" ++ | Double | Double_u -> "stfd" in ++ 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`; ++ ` cmpld {emit_gpr 31}, {emit_gpr 30}\n`; ++ ` addi {emit_reg i.res.(0)}, {emit_gpr 31}, 8\n`; ++ record_frame i.live; ++ ` bltl {emit_label !call_gc_label}\n` (* Must be 4 insns to restart *) ++ | Lop(Ispecific(Ialloc_far n)) -> ++ if !call_gc_label = 0 then call_gc_label := new_label(); ++ let lbl = new_label() in ++ ` addi {emit_gpr 31}, {emit_gpr 31}, {emit_int(-n)}\n`; ++ ` cmpld {emit_gpr 31}, {emit_gpr 30}\n`; ++ ` bge {emit_label lbl}\n`; ++ record_frame i.live; ++ ` bl {emit_label !call_gc_label}\n`; (* Must be 4 insns to restart *) ++ `{emit_label lbl}: addi {emit_reg i.res.(0)}, {emit_gpr 31}, 4\n` ++ | Lop(Iintop Isub) -> (* subfc has swapped arguments *) ++ ` subfc {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n` ++ | Lop(Iintop Imod) -> ++ ` divd {emit_gpr 0}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ ` mulld {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` ++ | Lop(Iintop(Icomp cmp)) -> ++ begin match cmp with ++ Isigned c -> ++ ` cmpd {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ emit_set_comp c i.res.(0) ++ | Iunsigned c -> ++ ` cmpld {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ emit_set_comp c i.res.(0) ++ end ++ | Lop(Iintop Icheckbound) -> ++ ` tdlle {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` ++ | Lop(Iintop op) -> ++ let instr = name_for_intop op in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` ++ | Lop(Iintop_imm(Isub, n)) -> ++ ` addi {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int(-n)}\n` ++ | Lop(Iintop_imm(Idiv, n)) -> (* n is guaranteed to be a power of 2 *) ++ let l = Misc.log2 n in ++ ` sradi {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int l}\n`; ++ ` 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 ++ ` sradi {emit_gpr 0}, {emit_reg i.arg.(0)}, {emit_int l}\n`; ++ ` addze {emit_gpr 0}, {emit_gpr 0}\n`; ++ ` sldi {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 -> ++ ` cmpdi {emit_reg i.arg.(0)}, {emit_int n}\n`; ++ emit_set_comp c i.res.(0) ++ | Iunsigned c -> ++ ` cmpldi {emit_reg i.arg.(0)}, {emit_int n}\n`; ++ emit_set_comp c i.res.(0) ++ end ++ | Lop(Iintop_imm(Icheckbound, n)) -> ++ ` tdllei {emit_reg i.arg.(0)}, {emit_int n}\n` ++ | Lop(Iintop_imm(op, n)) -> ++ let instr = name_for_intop_imm op in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int n}\n` ++ | Lop(Inegf | Iabsf as op) -> ++ let instr = name_for_floatop1 op in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n` ++ | Lop(Iaddf | Isubf | Imulf | Idivf as op) -> ++ let instr = name_for_floatop2 op in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` ++ | Lop(Ifloatofint) -> ++ let ofs = if has_stack_frame() then 16 else 8 * (2 + num_stack_slots.(0) + num_stack_slots.(1)) in ++ ` std {emit_reg i.arg.(0)}, -{emit_int ofs}({emit_gpr 1})\n`; ++ ` lfd {emit_reg i.res.(0)}, -{emit_int ofs}({emit_gpr 1})\n`; ++ ` fcfid {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` ++ | Lop(Iintoffloat) -> ++ let ofs = if has_stack_frame() then 16 else 8 * (2 + num_stack_slots.(0) + num_stack_slots.(1)) in ++ ` fctidz {emit_fpr 0}, {emit_reg i.arg.(0)}\n`; ++ ` stfd {emit_fpr 0}, -{emit_int ofs}({emit_gpr 1})\n`; ++ ` ld {emit_reg i.res.(0)}, -{emit_int ofs}({emit_gpr 1})\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 -> ++ if has_stack_frame() then begin ++ ` ld {emit_gpr 11}, {emit_label !stack_size_lbl}+16({emit_gpr 1})\n`; ++ ` mtlr {emit_gpr 11}\n` ++ end ++ | Lreturn -> ++ if has_stack_frame() then ++ ` ld {emit_gpr 1}, 0({emit_gpr 1})\n`; ++ ` blr\n` ++ | Llabel lbl -> ++ `{emit_label lbl}:\n` ++ | Lbranch lbl -> ++ ` b {emit_label lbl}\n` ++ | Lcondbranch(tst, lbl) -> ++ begin match tst with ++ Itruetest -> ++ ` cmpdi {emit_reg i.arg.(0)}, 0\n`; ++ emit_delay dslot; ++ ` bne {emit_label lbl}\n` ++ | Ifalsetest -> ++ ` cmpdi {emit_reg i.arg.(0)}, 0\n`; ++ emit_delay dslot; ++ ` beq {emit_label lbl}\n` ++ | Iinttest cmp -> ++ let (comp, branch) = name_for_int_comparison cmp in ++ ` {emit_string comp} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ emit_delay dslot; ++ ` {emit_string branch} {emit_label lbl}\n` ++ | Iinttest_imm(cmp, n) -> ++ let (comp, branch) = name_for_int_comparison cmp in ++ ` {emit_string comp}i {emit_reg i.arg.(0)}, {emit_int n}\n`; ++ 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 ++ Ceq -> (2, neg) ++ | Cne -> (2, not neg) ++ | Cle -> ` cror 3, 0, 2\n`; (* lt or eq *) ++ (3, neg) ++ | Cgt -> (1, neg) ++ | Cge -> ` cror 3, 1, 2\n`; (* gt or eq *) ++ (3, neg) ++ | Clt -> (0, neg) in ++ emit_delay dslot; ++ if negtst ++ 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 ++ | Lcondbranch3(lbl0, lbl1, lbl2) -> ++ ` cmpdi {emit_reg i.arg.(0)}, 1\n`; ++ emit_delay dslot; ++ begin match lbl0 with ++ None -> () ++ | Some lbl -> ` blt {emit_label lbl}\n` ++ end; ++ begin match lbl1 with ++ None -> () ++ | Some lbl -> ` beq {emit_label lbl}\n` ++ end; ++ begin match lbl2 with ++ None -> () ++ | Some lbl -> ` bgt {emit_label lbl}\n` ++ end ++ | Lswitch jumptbl -> ++ if !lbl_jumptbl = 0 then lbl_jumptbl := new_label(); ++ ` ld {emit_gpr 11}, {emit_tocref (TocLabel !lbl_jumptbl)}\n`; ++ ` addi {emit_gpr 0}, {emit_reg i.arg.(0)}, {emit_int !num_jumptbl_entries}\n`; ++ ` sldi {emit_gpr 0}, {emit_gpr 0}, 2\n`; ++ ` lwax {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; ++ incr num_jumptbl_entries ++ done ++ | Lsetuptrap lbl -> ++ ` bl {emit_label lbl}\n`; ++ | Lpushtrap -> ++ stack_traps_size := !stack_traps_size + 32; ++ ` addi {emit_gpr 11}, {emit_gpr 1}, {emit_label !stack_size_lbl}-{emit_int !stack_traps_size}\n`; ++ ` mflr {emit_gpr 0}\n`; ++ ` std {emit_gpr 29}, 0({emit_gpr 11})\n`; ++ ` std {emit_gpr 0}, 8({emit_gpr 11})\n`; ++ ` std {emit_gpr 1}, 16({emit_gpr 11})\n`; ++ ` std {emit_gpr 2}, 24({emit_gpr 11})\n`; ++ ` mr {emit_gpr 29}, {emit_gpr 11}\n` ++ | Lpoptrap -> ++ ` ld {emit_gpr 29}, 0({emit_gpr 29})\n` ++ | Lraise -> ++ ` ld {emit_gpr 0}, 8({emit_gpr 29})\n`; ++ ` ld {emit_gpr 1}, 16({emit_gpr 29})\n`; ++ ` ld {emit_gpr 2}, 24({emit_gpr 29})\n`; ++ ` mtlr {emit_gpr 0}\n`; ++ ` ld {emit_gpr 29}, 0({emit_gpr 29})\n`; ++ ` blr\n` ++ ++and emit_delay = function ++ None -> () ++ | Some i -> emit_instr i None ++ ++(* Checks if a pseudo-instruction expands to instructions ++ that do not branch and do not affect CR0 nor R12. *) ++ ++let is_simple_instr i = ++ match i.desc with ++ Lop op -> ++ begin match op with ++ Icall_imm _ | Icall_ind | Itailcall_imm _ | Itailcall_ind | ++ Iextcall(_, _) -> false ++ | Ialloc(_) -> false ++ | Iintop(Icomp _) -> false ++ | Iintop_imm(Iand, _) -> false ++ | Iintop_imm(Icomp _, _) -> false ++ | _ -> true ++ end ++ | Lreloadretaddr -> true ++ | _ -> false ++ ++let no_interference res arg = ++ try ++ for i = 0 to Array.length arg - 1 do ++ for j = 0 to Array.length res - 1 do ++ if arg.(i).loc = res.(j).loc then raise Exit ++ done ++ done; ++ true ++ with Exit -> ++ false ++ ++(* Emit a sequence of instructions, trying to fill delay slots for branches *) ++ ++let rec emit_all i = ++ match i with ++ {desc = Lend} -> () ++ | {next = {desc = (Lcondbranch(_, _) | Lcondbranch3(_, _, _))}} ++ when is_simple_instr i & no_interference i.res i.next.arg -> ++ emit_instr i.next (Some i); ++ emit_all i.next.next ++ | _ -> ++ emit_instr i None; ++ emit_all i.next ++ ++(* Emission of a function declaration *) ++ ++let fundecl fundecl = ++ function_name := fundecl.fun_name; ++ defined_functions := StringSet.add fundecl.fun_name !defined_functions; ++ tailrec_entry_point := new_label(); ++ if has_stack_frame() then ++ stack_size_lbl := new_label(); ++ stack_slot_lbl := new_label(); ++ stack_args_size := 0; ++ stack_traps_size := 0; ++ call_gc_label := 0; ++ ` .globl {emit_symbol fundecl.fun_name}\n`; ++ begin match Config.system with ++ | "elf" | "bsd" -> ++ ` .section \".opd\",\"aw\"\n`; ++ ` .align 3\n`; ++ ` .type {emit_symbol fundecl.fun_name}, @function\n`; ++ `{emit_symbol fundecl.fun_name}:\n`; ++ ` .quad .L.{emit_symbol fundecl.fun_name},.TOC.@tocbase\n`; ++ ` .previous\n`; ++ ` .align 2\n`; ++ emit_string code_space; ++ `.L.{emit_symbol fundecl.fun_name}:\n` ++ | _ -> ++ ` .align 2\n`; ++ emit_string code_space; ++ `{emit_symbol fundecl.fun_name}:\n` ++ end; ++ if !contains_calls then begin ++ ` mflr {emit_gpr 0}\n`; ++ ` std {emit_gpr 0}, 16({emit_gpr 1})\n` ++ end; ++ if has_stack_frame() then ++ ` stdu {emit_gpr 1}, -{emit_label !stack_size_lbl}({emit_gpr 1})\n`; ++ `{emit_label !tailrec_entry_point}:\n`; ++ branch_normalization fundecl.fun_body; ++ emit_all fundecl.fun_body; ++ ` .size .L.{emit_symbol fundecl.fun_name}, . - .L.{emit_symbol fundecl.fun_name}\n`; ++ if has_stack_frame() then begin ++ ` .set {emit_label !stack_size_lbl},{emit_int (frame_size_sans_args() + !stack_args_size + !stack_traps_size)} # stack size including traps\n`; ++ ` .set {emit_label !stack_slot_lbl},{emit_int (48 + !stack_args_size)} # stack slot offset\n` ++ end else (* leave 8 bytes for float <-> conversions *) ++ ` .set {emit_label !stack_slot_lbl},{emit_int (40-frame_size_sans_args())} # stack slot offset (negative)\n`; ++ ++ (* Emit the glue code to call the GC *) ++ if !call_gc_label > 0 then begin ++ `{emit_label !call_gc_label}:\n`; ++ ` ld {emit_gpr 12}, {emit_tocref (TocSymOfs ("caml_call_gc",0))}\n`; ++ ` ld {emit_gpr 12}, 0({emit_gpr 12})\n`; ++ ` mtctr {emit_gpr 12}\n`; ++ ` bctr\n`; ++ end ++ ++(* Emission of data *) ++ ++let declare_global_data s = ++ ` .globl {emit_symbol s}\n`; ++ if Config.system = "elf" || Config.system = "bsd" then ++ ` .type {emit_symbol s}, @object\n` ++ ++let emit_item = function ++ Cglobal_symbol s -> ++ declare_global_data s ++ | Cdefine_symbol s -> ++ `{emit_symbol s}:\n`; ++ | Cdefine_label lbl -> ++ `{emit_label (lbl + 100000)}:\n` ++ | Cint8 n -> ++ ` .byte {emit_int n}\n` ++ | Cint16 n -> ++ ` .short {emit_int n}\n` ++ | Cint32 n -> ++ ` .long {emit_nativeint n}\n` ++ | Cint n -> ++ ` .quad {emit_nativeint n}\n` ++ | Csingle f -> ++ ` .float 0d{emit_string f}\n` ++ | Cdouble f -> ++ ` .double 0d{emit_string f}\n` ++ | Csymbol_address s -> ++ ` .quad {emit_symbol s}\n` ++ | Clabel_address lbl -> ++ ` .quad {emit_label (lbl + 100000)}\n` ++ | Cstring s -> ++ emit_bytes_directive " .byte " s ++ | Cskip n -> ++ if n > 0 then ` .space {emit_int n}\n` ++ | Calign n -> ++ ` .align {emit_int (Misc.log2 n)}\n` ++ ++let data l = ++ emit_string data_space; ++ List.iter emit_item l ++ ++(* Beginning / end of an assembly file *) ++ ++let begin_assembly() = ++ defined_functions := StringSet.empty; ++ external_functions := StringSet.empty; ++ tocref_entries := []; ++ num_jumptbl_entries := 0; ++ jumptbl_entries := []; ++ lbl_jumptbl := 0; ++ (* Emit the beginning of the segments *) ++ let lbl_begin = Compilenv.make_symbol (Some "data_begin") in ++ emit_string data_space; ++ declare_global_data lbl_begin; ++ `{emit_symbol lbl_begin}:\n`; ++ let lbl_begin = Compilenv.make_symbol (Some "code_begin") in ++ emit_string code_space; ++ declare_global_data lbl_begin; ++ `{emit_symbol lbl_begin}:\n` ++ ++let end_assembly() = ++ (* Emit the jump table *) ++ if !num_jumptbl_entries > 0 then begin ++ emit_string code_space; ++ `{emit_label !lbl_jumptbl}:\n`; ++ List.iter ++ (fun lbl -> ` .long {emit_label lbl} - {emit_label !lbl_jumptbl}\n`) ++ (List.rev !jumptbl_entries); ++ jumptbl_entries := [] ++ end; ++ if !tocref_entries <> [] then begin ++ emit_string toc_space; ++ List.iter ++ (fun (lbl, entry) -> ++ `{emit_label lbl}:\n`; ++ match entry with ++ TocFloat f -> ++ ` .double {emit_tocentry entry}\n` ++ | _ -> ++ ` .tc {emit_label lbl}[TC],{emit_tocentry entry}\n` ++ ) ++ !tocref_entries; ++ tocref_entries := [] ++ 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.make_symbol (Some "code_end") in ++ declare_global_data lbl_end; ++ `{emit_symbol lbl_end}:\n`; ++ ` .long 0\n`; ++ emit_string data_space; ++ let lbl_end = Compilenv.make_symbol (Some "data_end") in ++ declare_global_data lbl_end; ++ `{emit_symbol lbl_end}:\n`; ++ ` .quad 0\n`; ++ (* Emit the frame descriptors *) ++ emit_string rodata_space; ++ let lbl = Compilenv.make_symbol (Some "frametable") in ++ declare_global_data lbl; ++ `{emit_symbol lbl}:\n`; ++ ` .quad {emit_int (List.length !frame_descriptors)}\n`; ++ List.iter emit_frame !frame_descriptors; ++ frame_descriptors := [] +diff --git a/asmcomp/power64/proc.ml b/asmcomp/power64/proc.ml +new file mode 100644 +index 0000000..95bf6c4 +--- /dev/null ++++ b/asmcomp/power64/proc.ml +@@ -0,0 +1,245 @@ ++(***********************************************************************) ++(* *) ++(* Objective Caml *) ++(* *) ++(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) ++(* *) ++(* Copyright 1996 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the Q Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* $Id: ocaml-3.11.0-ppc64.patch,v 1.1 2008/11/20 15:30:55 rjones Exp $ *) ++ ++(* Description of the Power PC *) ++ ++open Misc ++open Cmm ++open Reg ++open Arch ++open Mach ++ ++(* Instruction selection *) ++ ++let word_addressed = false ++ ++(* Registers available for register allocation *) ++ ++(* Integer register map: ++ 0 temporary, null register for some operations ++ 1 stack pointer ++ 2 pointer to table of contents ++ 3 - 10 function arguments and results ++ 11 - 12 temporaries ++ 13 pointer to small data area ++ 14 - 28 general purpose, preserved by C ++ 29 trap pointer ++ 30 allocation limit ++ 31 allocation pointer ++ Floating-point register map: ++ 0 temporary ++ 1 - 13 function arguments and results ++ 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 ++ ++let register_class r = ++ match r.typ with ++ Int -> 0 ++ | Addr -> 0 ++ | Float -> 1 ++ ++let num_available_registers = [| 23; 31 |] ++ ++let first_available_register = [| 0; 100 |] ++ ++let register_name r = ++ if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100) ++ ++let rotate_registers = true ++ ++(* Representation of hard registers by pseudo-registers *) ++ ++let hard_int_reg = ++ let v = Array.create 23 Reg.dummy in ++ for i = 0 to 22 do v.(i) <- Reg.at_location Int (Reg i) done; v ++ ++let hard_float_reg = ++ let v = Array.create 31 Reg.dummy in ++ for i = 0 to 30 do v.(i) <- Reg.at_location Float (Reg(100 + i)) done; v ++ ++let all_phys_regs = ++ Array.append hard_int_reg hard_float_reg ++ ++let phys_reg n = ++ if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100) ++ ++let stack_slot slot ty = ++ Reg.at_location ty (Stack slot) ++ ++(* Calling conventions *) ++ ++let calling_conventions ++ first_int last_int first_float last_float make_stack stack_ofs arg = ++ let loc = Array.create (Array.length arg) Reg.dummy in ++ let int = ref first_int in ++ let float = ref first_float in ++ let ofs = ref stack_ofs 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; ++ end; ++ ofs := !ofs + 8 ++ | Float -> ++ if !float <= last_float then begin ++ loc.(i) <- phys_reg !float; ++ incr float ++ end else begin ++ loc.(i) <- stack_slot (make_stack !ofs) Float; ++ end; ++ ofs := !ofs + 8 ++ done; ++ (loc, Misc.align !ofs 16) ++ (* Keep stack 16-aligned. *) ++ ++let incoming ofs = Incoming ofs ++let outgoing ofs = Outgoing ofs ++let not_supported ofs = fatal_error "Proc.loc_results: cannot call" ++ ++let loc_arguments arg = ++ calling_conventions 0 7 100 112 outgoing 48 arg ++let loc_parameters arg = ++ let (loc, ofs) = calling_conventions 0 7 100 112 incoming 0 arg in loc ++let loc_results res = ++ let (loc, ofs) = calling_conventions 0 7 100 112 not_supported 0 res in loc ++ ++(* C calling conventions under PowerOpen: ++ use GPR 3-10 and FPR 1-13 just like ML calling ++ conventions, but always reserve stack space for all arguments. ++ Also, using a float register automatically reserves two int registers ++ (in 32-bit mode) or one int register (in 64-bit mode). ++ (If we were to call a non-prototyped C function, each float argument ++ would have to go both in a float reg and in the matching pair ++ of integer regs.) ++ ++ C calling conventions under SVR4: ++ use GPR 3-10 and FPR 1-8 just like ML calling conventions. ++ Using a float register does not affect the int registers. ++ Always reserve 8 bytes at bottom of stack, plus whatever is needed ++ to hold the overflow arguments. *) ++ ++let poweropen_external_conventions first_int last_int ++ first_float last_float arg = ++ let loc = Array.create (Array.length arg) Reg.dummy in ++ let int = ref first_int in ++ let float = ref first_float in ++ let ofs = ref 112 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 (Outgoing !ofs) ty; ++ ofs := !ofs + size_int ++ end ++ | Float -> ++ if !float <= last_float then begin ++ loc.(i) <- phys_reg !float; ++ incr float ++ end else begin ++ loc.(i) <- stack_slot (Outgoing !ofs) Float; ++ ofs := !ofs + size_float ++ end; ++ int := !int + 1 ++ done; ++ (loc, Misc.align !ofs 16) (* Keep stack 16-aligned *) ++ ++let loc_external_arguments = ++ match Config.system with ++ | "rhapsody" -> poweropen_external_conventions 0 7 100 112 ++ | "elf" | "bsd" -> calling_conventions 0 7 100 107 outgoing 8 ++ | _ -> assert false ++ ++let extcall_use_push = false ++ ++(* Results are in GPR 3 and FPR 1 *) ++ ++let loc_external_results res = ++ let (loc, ofs) = calling_conventions 0 0 100 100 not_supported 0 res in loc ++ ++(* Exceptions are in GPR 3 *) ++ ++let loc_exn_bucket = phys_reg 0 ++ ++(* Registers destroyed by operations *) ++ ++let destroyed_at_c_call = ++ Array.of_list(List.map phys_reg ++ [0; 1; 2; 3; 4; 5; 6; 7; ++ 100; 101; 102; 103; 104; 105; 106; 107; 108; 109; 110; 111; 112]) ++ ++let destroyed_at_oper = function ++ Iop(Icall_ind | Icall_imm _ | Iextcall(_, true)) -> all_phys_regs ++ | Iop(Iextcall(_, false)) -> destroyed_at_c_call ++ | _ -> [||] ++ ++let destroyed_at_raise = all_phys_regs ++ ++(* Maximal register pressure *) ++ ++let safe_register_pressure = function ++ Iextcall(_, _) -> 15 ++ | _ -> 23 ++ ++let max_register_pressure = function ++ Iextcall(_, _) -> [| 15; 18 |] ++ | _ -> [| 23; 30 |] ++ ++(* Layout of the stack *) ++ ++let num_stack_slots = [| 0; 0 |] ++let contains_calls = ref false ++ ++(* Calling the assembler *) ++ ++let assemble_file infile outfile = ++ let infile = Filename.quote infile ++ and outfile = Filename.quote outfile in ++ match Config.system with ++ | "elf" -> ++ Ccomp.command ("as -u -m ppc64 -o " ^ outfile ^ " " ^ infile) ++ | _ -> assert false ++ ++open Clflags;; ++open Config;; +diff --git a/asmcomp/power64/reload.ml b/asmcomp/power64/reload.ml +new file mode 100644 +index 0000000..42d5d4d +--- /dev/null ++++ b/asmcomp/power64/reload.ml +@@ -0,0 +1,18 @@ ++(***********************************************************************) ++(* *) ++(* Objective Caml *) ++(* *) ++(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) ++(* *) ++(* Copyright 1996 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the Q Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* $Id: ocaml-3.11.0-ppc64.patch,v 1.1 2008/11/20 15:30:55 rjones Exp $ *) ++ ++(* Reloading for the PowerPC *) ++ ++let fundecl f = ++ (new Reloadgen.reload_generic)#fundecl f +diff --git a/asmcomp/power64/scheduling.ml b/asmcomp/power64/scheduling.ml +new file mode 100644 +index 0000000..d73e333 +--- /dev/null ++++ b/asmcomp/power64/scheduling.ml +@@ -0,0 +1,66 @@ ++(***********************************************************************) ++(* *) ++(* Objective Caml *) ++(* *) ++(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) ++(* *) ++(* Copyright 1996 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the Q Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* $Id: ocaml-3.11.0-ppc64.patch,v 1.1 2008/11/20 15:30:55 rjones Exp $ *) ++ ++(* Instruction scheduling for the Power PC *) ++ ++open Arch ++open Mach ++ ++class scheduler = object ++ ++inherit Schedgen.scheduler_generic ++ ++(* Latencies (in cycles). Based roughly on the "common model". *) ++ ++method oper_latency = function ++ Ireload -> 2 ++ | Iload(_, _) -> 2 ++ | Iconst_float _ -> 2 (* turned into a load *) ++ | Iconst_symbol _ -> 1 ++ | Iintop Imul -> 9 ++ | Iintop_imm(Imul, _) -> 5 ++ | Iintop(Idiv | Imod) -> 36 ++ | Iaddf | Isubf -> 4 ++ | Imulf -> 5 ++ | Idivf -> 33 ++ | Ispecific(Imultaddf | Imultsubf) -> 5 ++ | _ -> 1 ++ ++method reload_retaddr_latency = 12 ++ (* If we can have that many cycles between the reloadretaddr and the ++ return, we can expect that the blr branch will be completely folded. *) ++ ++(* Issue cycles. Rough approximations. *) ++ ++method oper_issue_cycles = function ++ Iconst_float _ | Iconst_symbol _ -> 2 ++ | Iload(_, Ibased(_, _)) -> 2 ++ | Istore(_, Ibased(_, _)) -> 2 ++ | Ialloc _ -> 4 ++ | Iintop(Imod) -> 40 (* assuming full stall *) ++ | Iintop(Icomp _) -> 4 ++ | Iintop_imm(Idiv, _) -> 2 ++ | Iintop_imm(Imod, _) -> 4 ++ | Iintop_imm(Icomp _, _) -> 4 ++ | Ifloatofint -> 9 ++ | Iintoffloat -> 4 ++ | _ -> 1 ++ ++method reload_retaddr_issue_cycles = 3 ++ (* load then stalling mtlr *) ++ ++end ++ ++let fundecl f = (new scheduler)#schedule_fundecl f ++ +diff --git a/asmcomp/power64/selection.ml b/asmcomp/power64/selection.ml +new file mode 100644 +index 0000000..afc7649 +--- /dev/null ++++ b/asmcomp/power64/selection.ml +@@ -0,0 +1,103 @@ ++(***********************************************************************) ++(* *) ++(* Objective Caml *) ++(* *) ++(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) ++(* *) ++(* Copyright 1997 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the Q Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* $Id: ocaml-3.11.0-ppc64.patch,v 1.1 2008/11/20 15:30:55 rjones Exp $ *) ++ ++(* Instruction selection for the Power PC processor *) ++ ++open Misc ++open Cmm ++open Reg ++open Arch ++open Mach ++ ++(* Recognition of addressing modes *) ++ ++type addressing_expr = ++ Asymbol of string ++ | Alinear of expression ++ | Aadd of expression * expression ++ ++let rec select_addr = function ++ Cconst_symbol s -> ++ (Asymbol s, 0) ++ | Cop((Caddi | Cadda), [arg; Cconst_int m]) -> ++ let (a, n) = select_addr arg in (a, n + m) ++ | Cop((Caddi | Cadda), [Cconst_int m; arg]) -> ++ let (a, n) = select_addr arg in (a, n + m) ++ | Cop((Caddi | Cadda), [arg1; arg2]) -> ++ begin match (select_addr arg1, select_addr arg2) with ++ ((Alinear e1, n1), (Alinear e2, n2)) -> ++ (Aadd(e1, e2), n1 + n2) ++ | _ -> ++ (Aadd(arg1, arg2), 0) ++ end ++ | exp -> ++ (Alinear exp, 0) ++ ++(* Instruction selection *) ++ ++class selector = object (self) ++ ++inherit Selectgen.selector_generic as super ++ ++method is_immediate n = (n <= 32767) && (n >= -32768) ++ ++method select_addressing exp = ++ match select_addr exp with ++ (Asymbol s, d) -> ++ (Ibased(s, d), Ctuple []) ++ | (Alinear e, d) -> ++ (Iindexed d, e) ++ | (Aadd(e1, e2), d) -> ++ if d = 0 ++ then (Iindexed2, Ctuple[e1; e2]) ++ else (Iindexed d, Cop(Cadda, [e1; e2])) ++ ++method select_operation op args = ++ match (op, args) with ++ (* Prevent the recognition of (x / cst) and (x % cst) when cst is not ++ a power of 2, which do not correspond to an instruction. *) ++ (Cdivi, [arg; Cconst_int n]) when n = 1 lsl (Misc.log2 n) -> ++ (Iintop_imm(Idiv, n), [arg]) ++ | (Cdivi, _) -> ++ (Iintop Idiv, args) ++ | (Cmodi, [arg; Cconst_int n]) when n = 1 lsl (Misc.log2 n) -> ++ (Iintop_imm(Imod, n), [arg]) ++ | (Cmodi, _) -> ++ (Iintop Imod, args) ++ (* The and, or and xor instructions have a different range of immediate ++ operands than the other instructions *) ++ | (Cand, _) -> self#select_logical Iand args ++ | (Cor, _) -> self#select_logical Ior args ++ | (Cxor, _) -> self#select_logical Ixor args ++ (* Recognize mult-add and mult-sub instructions *) ++ | (Caddf, [Cop(Cmulf, [arg1; arg2]); arg3]) -> ++ (Ispecific Imultaddf, [arg1; arg2; arg3]) ++ | (Caddf, [arg3; Cop(Cmulf, [arg1; arg2])]) -> ++ (Ispecific Imultaddf, [arg1; arg2; arg3]) ++ | (Csubf, [Cop(Cmulf, [arg1; arg2]); arg3]) -> ++ (Ispecific Imultsubf, [arg1; arg2; arg3]) ++ | _ -> ++ super#select_operation op args ++ ++method select_logical op = function ++ [arg; Cconst_int n] when n >= 0 && n <= 0xFFFF -> ++ (Iintop_imm(op, n), [arg]) ++ | [Cconst_int n; arg] when n >= 0 && n <= 0xFFFF -> ++ (Iintop_imm(op, n), [arg]) ++ | args -> ++ (Iintop op, args) ++ ++end ++ ++let fundecl f = (new selector)#emit_fundecl f +diff --git a/asmrun/Makefile b/asmrun/Makefile +index efffa33..3525b82 100644 +--- a/asmrun/Makefile ++++ b/asmrun/Makefile +@@ -74,6 +74,12 @@ power.o: power-$(SYSTEM).o + power.p.o: power-$(SYSTEM).o + cp power-$(SYSTEM).o power.p.o + ++power64.o: power64-$(SYSTEM).o ++ cp power64-$(SYSTEM).o power64.o ++ ++power64.p.o: power64-$(SYSTEM).o ++ cp power64-$(SYSTEM).o power64.p.o ++ + main.c: ../byterun/main.c + ln -s ../byterun/main.c main.c + misc.c: ../byterun/misc.c +diff --git a/asmrun/power64-elf.S b/asmrun/power64-elf.S +new file mode 100644 +index 0000000..b2c24d6 +--- /dev/null ++++ b/asmrun/power64-elf.S +@@ -0,0 +1,486 @@ ++/*********************************************************************/ ++/* */ ++/* Objective Caml */ ++/* */ ++/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ ++/* */ ++/* Copyright 1996 Institut National de Recherche en Informatique et */ ++/* en Automatique. All rights reserved. This file is distributed */ ++/* under the terms of the GNU Library General Public License, with */ ++/* the special exception on linking described in file ../LICENSE. */ ++/* */ ++/*********************************************************************/ ++ ++/* $Id: ocaml-3.11.0-ppc64.patch,v 1.1 2008/11/20 15:30:55 rjones Exp $ */ ++ ++#define Addrglobal(reg,glob) \ ++ addis reg, 0, glob@ha; \ ++ addi reg, reg, glob@l ++#define Loadglobal(reg,glob,tmp) \ ++ addis tmp, 0, glob@ha; \ ++ ld reg, glob@l(tmp) ++#define Storeglobal(reg,glob,tmp) \ ++ addis tmp, 0, glob@ha; \ ++ std reg, glob@l(tmp) ++ ++ .section ".text" ++ ++/* Invoke the garbage collector. */ ++ ++ .globl caml_call_gc ++ .type caml_call_gc, @function ++ .section ".opd","aw" ++ .align 3 ++caml_call_gc: ++ .quad .L.caml_call_gc,.TOC.@tocbase ++ .previous ++ .align 2 ++.L.caml_call_gc: ++ /* Set up stack frame */ ++ mflr 0 ++ std 0, 16(1) ++ /* Record return address into Caml code */ ++ Storeglobal(0, caml_last_return_address, 11) ++ /* Record lowest stack address */ ++ Storeglobal(1, caml_bottom_of_stack, 11) ++ /* 0x220 = 8*32 (int regs) + 8*32 (float regs) + 48 (stack frame) */ ++ stdu 1, -0x230(1) ++ /* Record pointer to register array */ ++ addi 0, 1, 8*32 + 48 ++ Storeglobal(0, caml_gc_regs, 11) ++ /* Save current allocation pointer for debugging purposes */ ++ Storeglobal(31, caml_young_ptr, 11) ++ /* Save exception pointer (if e.g. a sighandler raises) */ ++ Storeglobal(29, caml_exception_pointer, 11) ++ /* Save all registers used by the code generator */ ++ addi 11, 1, 8*32 + 48 - 8 ++ stdu 3, 8(11) ++ stdu 4, 8(11) ++ stdu 5, 8(11) ++ stdu 6, 8(11) ++ stdu 7, 8(11) ++ stdu 8, 8(11) ++ stdu 9, 8(11) ++ stdu 10, 8(11) ++ stdu 14, 8(11) ++ stdu 15, 8(11) ++ stdu 16, 8(11) ++ stdu 17, 8(11) ++ stdu 18, 8(11) ++ stdu 19, 8(11) ++ stdu 20, 8(11) ++ stdu 21, 8(11) ++ stdu 22, 8(11) ++ stdu 23, 8(11) ++ stdu 24, 8(11) ++ stdu 25, 8(11) ++ stdu 26, 8(11) ++ stdu 27, 8(11) ++ stdu 28, 8(11) ++ addi 11, 1, 48 - 8 ++ stfdu 1, 8(11) ++ stfdu 2, 8(11) ++ stfdu 3, 8(11) ++ stfdu 4, 8(11) ++ stfdu 5, 8(11) ++ stfdu 6, 8(11) ++ stfdu 7, 8(11) ++ stfdu 8, 8(11) ++ stfdu 9, 8(11) ++ stfdu 10, 8(11) ++ stfdu 11, 8(11) ++ stfdu 12, 8(11) ++ stfdu 13, 8(11) ++ stfdu 14, 8(11) ++ stfdu 15, 8(11) ++ stfdu 16, 8(11) ++ stfdu 17, 8(11) ++ stfdu 18, 8(11) ++ stfdu 19, 8(11) ++ stfdu 20, 8(11) ++ stfdu 21, 8(11) ++ stfdu 22, 8(11) ++ stfdu 23, 8(11) ++ stfdu 24, 8(11) ++ stfdu 25, 8(11) ++ stfdu 26, 8(11) ++ stfdu 27, 8(11) ++ stfdu 28, 8(11) ++ stfdu 29, 8(11) ++ stfdu 30, 8(11) ++ stfdu 31, 8(11) ++ /* Call the GC */ ++ std 2,40(1) ++ Addrglobal(11, caml_garbage_collection) ++ ld 2,8(11) ++ ld 11,0(11) ++ mtlr 11 ++ blrl ++ ld 2,40(1) ++ /* Reload new allocation pointer and allocation limit */ ++ Loadglobal(31, caml_young_ptr, 11) ++ Loadglobal(30, caml_young_limit, 11) ++ /* Restore all regs used by the code generator */ ++ addi 11, 1, 8*32 + 48 - 8 ++ ldu 3, 8(11) ++ ldu 4, 8(11) ++ ldu 5, 8(11) ++ ldu 6, 8(11) ++ ldu 7, 8(11) ++ ldu 8, 8(11) ++ ldu 9, 8(11) ++ ldu 10, 8(11) ++ ldu 14, 8(11) ++ ldu 15, 8(11) ++ ldu 16, 8(11) ++ ldu 17, 8(11) ++ ldu 18, 8(11) ++ ldu 19, 8(11) ++ ldu 20, 8(11) ++ ldu 21, 8(11) ++ ldu 22, 8(11) ++ ldu 23, 8(11) ++ ldu 24, 8(11) ++ ldu 25, 8(11) ++ ldu 26, 8(11) ++ ldu 27, 8(11) ++ ldu 28, 8(11) ++ addi 11, 1, 48 - 8 ++ lfdu 1, 8(11) ++ lfdu 2, 8(11) ++ lfdu 3, 8(11) ++ lfdu 4, 8(11) ++ lfdu 5, 8(11) ++ lfdu 6, 8(11) ++ lfdu 7, 8(11) ++ lfdu 8, 8(11) ++ lfdu 9, 8(11) ++ lfdu 10, 8(11) ++ lfdu 11, 8(11) ++ lfdu 12, 8(11) ++ lfdu 13, 8(11) ++ lfdu 14, 8(11) ++ lfdu 15, 8(11) ++ lfdu 16, 8(11) ++ lfdu 17, 8(11) ++ lfdu 18, 8(11) ++ lfdu 19, 8(11) ++ lfdu 20, 8(11) ++ lfdu 21, 8(11) ++ lfdu 22, 8(11) ++ lfdu 23, 8(11) ++ lfdu 24, 8(11) ++ lfdu 25, 8(11) ++ lfdu 26, 8(11) ++ lfdu 27, 8(11) ++ lfdu 28, 8(11) ++ lfdu 29, 8(11) ++ lfdu 30, 8(11) ++ lfdu 31, 8(11) ++ /* Return to caller, restarting the allocation */ ++ Loadglobal(0, caml_last_return_address, 11) ++ addic 0, 0, -16 /* Restart the allocation (4 instructions) */ ++ mtlr 0 ++ /* Say we are back into Caml code */ ++ li 12, 0 ++ Storeglobal(12, caml_last_return_address, 11) ++ /* Deallocate stack frame */ ++ ld 1, 0(1) ++ /* Return */ ++ blr ++ .size .L.caml_call_gc,.-.L.caml_call_gc ++ ++/* Call a C function from Caml */ ++ ++ .globl caml_c_call ++ .type caml_c_call, @function ++ .section ".opd","aw" ++ .align 3 ++caml_c_call: ++ .quad .L.caml_c_call,.TOC.@tocbase ++ .previous ++ .align 2 ++.L.caml_c_call: ++ .cfi_startproc ++ /* Save return address */ ++ mflr 25 ++ .cfi_register lr,25 ++ /* Get ready to call C function (address in 11) */ ++ ld 2, 8(11) ++ ld 11,0(11) ++ mtlr 11 ++ /* Record lowest stack address and return address */ ++ Storeglobal(1, caml_bottom_of_stack, 12) ++ Storeglobal(25, caml_last_return_address, 12) ++ /* Make the exception handler and alloc ptr available to the C code */ ++ Storeglobal(31, caml_young_ptr, 11) ++ Storeglobal(29, caml_exception_pointer, 11) ++ /* Call the function (address in link register) */ ++ blrl ++ /* Restore return address (in 25, preserved by the C function) */ ++ mtlr 25 ++ /* Reload allocation pointer and allocation limit*/ ++ Loadglobal(31, caml_young_ptr, 11) ++ Loadglobal(30, caml_young_limit, 11) ++ /* Say we are back into Caml code */ ++ li 12, 0 ++ Storeglobal(12, caml_last_return_address, 11) ++ /* Return to caller */ ++ blr ++ .cfi_endproc ++ .size .L.caml_c_call,.-.L.caml_c_call ++ ++/* Raise an exception from C */ ++ ++ .globl caml_raise_exception ++ .type caml_raise_exception, @function ++ .section ".opd","aw" ++ .align 3 ++caml_raise_exception: ++ .quad .L.caml_raise_exception,.TOC.@tocbase ++ .previous ++ .align 2 ++.L.caml_raise_exception: ++ /* Reload Caml global registers */ ++ Loadglobal(29, caml_exception_pointer, 11) ++ Loadglobal(31, caml_young_ptr, 11) ++ Loadglobal(30, caml_young_limit, 11) ++ /* Say we are back into Caml code */ ++ li 0, 0 ++ Storeglobal(0, caml_last_return_address, 11) ++ /* Pop trap frame */ ++ ld 0, 8(29) ++ ld 1, 16(29) ++ mtlr 0 ++ ld 2, 24(29) ++ ld 29, 0(29) ++ /* Branch to handler */ ++ blr ++ .size .L.caml_raise_exception,.-.L.caml_raise_exception ++ ++/* Start the Caml program */ ++ ++ .globl caml_start_program ++ .type caml_start_program, @function ++ .section ".opd","aw" ++ .align 3 ++caml_start_program: ++ .quad .L.caml_start_program,.TOC.@tocbase ++ .previous ++ .align 2 ++.L.caml_start_program: ++ Addrglobal(12, caml_program) ++ ++/* Code shared between caml_start_program and caml_callback */ ++.L102: ++ /* Allocate and link stack frame */ ++ mflr 0 ++ std 0, 16(1) ++ stdu 1, -0x190(1) /* 48 + 8*36(regs) + 32(callback) + 32(exc) */ ++ /* Save return address */ ++ /* Save all callee-save registers */ ++ /* GPR 14 ... GPR 31 then FPR 14 ... FPR 31 starting at sp+16 */ ++ addi 11, 1, 48-8 ++ stdu 14, 8(11) ++ stdu 15, 8(11) ++ stdu 16, 8(11) ++ stdu 17, 8(11) ++ stdu 18, 8(11) ++ stdu 19, 8(11) ++ stdu 20, 8(11) ++ stdu 21, 8(11) ++ stdu 22, 8(11) ++ stdu 23, 8(11) ++ stdu 24, 8(11) ++ stdu 25, 8(11) ++ stdu 26, 8(11) ++ stdu 27, 8(11) ++ stdu 28, 8(11) ++ stdu 29, 8(11) ++ stdu 30, 8(11) ++ stdu 31, 8(11) ++ stfdu 14, 8(11) ++ stfdu 15, 8(11) ++ stfdu 16, 8(11) ++ stfdu 17, 8(11) ++ stfdu 18, 8(11) ++ stfdu 19, 8(11) ++ stfdu 20, 8(11) ++ stfdu 21, 8(11) ++ stfdu 22, 8(11) ++ stfdu 23, 8(11) ++ stfdu 24, 8(11) ++ stfdu 25, 8(11) ++ stfdu 26, 8(11) ++ stfdu 27, 8(11) ++ stfdu 28, 8(11) ++ stfdu 29, 8(11) ++ stfdu 30, 8(11) ++ stfdu 31, 8(11) ++ /* Set up a callback link */ ++ Loadglobal(9, caml_bottom_of_stack, 11) ++ Loadglobal(10, caml_last_return_address, 11) ++ Loadglobal(11, caml_gc_regs, 11) ++ std 9, 0x150(1) ++ std 10, 0x158(1) ++ std 11, 0x160(1) ++ /* Build an exception handler to catch exceptions escaping out of Caml */ ++ bl .L103 ++ b .L104 ++.L103: ++ mflr 0 ++ addi 29, 1, 0x170 /* Alignment */ ++ std 0, 8(29) ++ std 1, 16(29) ++ std 2, 24(29) ++ Loadglobal(11, caml_exception_pointer, 11) ++ std 11, 0(29) ++ /* Reload allocation pointers */ ++ Loadglobal(31, caml_young_ptr, 11) ++ Loadglobal(30, caml_young_limit, 11) ++ /* Say we are back into Caml code */ ++ li 0, 0 ++ Storeglobal(0, caml_last_return_address, 11) ++ /* Call the Caml code */ ++ std 2,40(1) ++ ld 2,8(12) ++ ld 12,0(12) ++ mtlr 12 ++.L105: ++ blrl ++ ld 2,40(1) ++ /* Pop the trap frame, restoring caml_exception_pointer */ ++ ld 9, 0x170(1) ++ Storeglobal(9, caml_exception_pointer, 11) ++ /* Pop the callback link, restoring the global variables */ ++.L106: ++ ld 9, 0x150(1) ++ ld 10, 0x158(1) ++ ld 11, 0x160(1) ++ Storeglobal(9, caml_bottom_of_stack, 12) ++ Storeglobal(10, caml_last_return_address, 12) ++ Storeglobal(11, caml_gc_regs, 12) ++ /* Update allocation pointer */ ++ Storeglobal(31, caml_young_ptr, 11) ++ /* Restore callee-save registers */ ++ addi 11, 1, 48-8 ++ ldu 14, 8(11) ++ ldu 15, 8(11) ++ ldu 16, 8(11) ++ ldu 17, 8(11) ++ ldu 18, 8(11) ++ ldu 19, 8(11) ++ ldu 20, 8(11) ++ ldu 21, 8(11) ++ ldu 22, 8(11) ++ ldu 23, 8(11) ++ ldu 24, 8(11) ++ ldu 25, 8(11) ++ ldu 26, 8(11) ++ ldu 27, 8(11) ++ ldu 28, 8(11) ++ ldu 29, 8(11) ++ ldu 30, 8(11) ++ ldu 31, 8(11) ++ lfdu 14, 8(11) ++ lfdu 15, 8(11) ++ lfdu 16, 8(11) ++ lfdu 17, 8(11) ++ lfdu 18, 8(11) ++ lfdu 19, 8(11) ++ lfdu 20, 8(11) ++ lfdu 21, 8(11) ++ lfdu 22, 8(11) ++ lfdu 23, 8(11) ++ lfdu 24, 8(11) ++ lfdu 25, 8(11) ++ lfdu 26, 8(11) ++ lfdu 27, 8(11) ++ lfdu 28, 8(11) ++ lfdu 29, 8(11) ++ lfdu 30, 8(11) ++ lfdu 31, 8(11) ++ /* Return */ ++ ld 1,0(1) ++ /* Reload return address */ ++ ld 0, 16(1) ++ mtlr 0 ++ blr ++ ++ /* The trap handler: */ ++.L104: ++ /* Update caml_exception_pointer */ ++ Storeglobal(29, caml_exception_pointer, 11) ++ /* Encode exception bucket as an exception result and return it */ ++ ori 3, 3, 2 ++ b .L106 ++ .size .L.caml_start_program,.-.L.caml_start_program ++ ++/* Callback from C to Caml */ ++ ++ .globl caml_callback_exn ++ .type caml_callback_exn, @function ++ .section ".opd","aw" ++ .align 3 ++caml_callback_exn: ++ .quad .L.caml_callback_exn,.TOC.@tocbase ++ .previous ++ .align 2 ++.L.caml_callback_exn: ++ /* Initial shuffling of arguments */ ++ mr 0, 3 /* Closure */ ++ mr 3, 4 /* Argument */ ++ mr 4, 0 ++ ld 12, 0(4) /* Code pointer */ ++ b .L102 ++ .size .L.caml_callback_exn,.-.L.caml_callback_exn ++ ++ ++ .globl caml_callback2_exn ++ .type caml_callback2_exn, @function ++ .section ".opd","aw" ++ .align 3 ++caml_callback2_exn: ++ .quad .L.caml_callback2_exn,.TOC.@tocbase ++ .previous ++ .align 2 ++.L.caml_callback2_exn: ++ mr 0, 3 /* Closure */ ++ mr 3, 4 /* First argument */ ++ mr 4, 5 /* Second argument */ ++ mr 5, 0 ++ Addrglobal(12, caml_apply2) ++ b .L102 ++ .size .L.caml_callback2_exn,.-.L.caml_callback2_exn ++ ++ ++ .globl caml_callback3_exn ++ .type caml_callback3_exn, @function ++ .section ".opd","aw" ++ .align 3 ++caml_callback3_exn: ++ .quad .L.caml_callback3_exn,.TOC.@tocbase ++ .previous ++ .align 2 ++.L.caml_callback3_exn: ++ mr 0, 3 /* Closure */ ++ mr 3, 4 /* First argument */ ++ mr 4, 5 /* Second argument */ ++ mr 5, 6 /* Third argument */ ++ mr 6, 0 ++ Addrglobal(12, caml_apply3) ++ b .L102 ++ .size .L.caml_callback3_exn,.-.L.caml_callback3_exn ++ ++/* Frame table */ ++ ++ .section ".data" ++ .globl caml_system__frametable ++ .type caml_system__frametable, @object ++caml_system__frametable: ++ .quad 1 /* one descriptor */ ++ .quad .L105 + 4 /* return address into callback */ ++ .short -1 /* negative size count => use callback link */ ++ .short 0 /* no roots here */ ++ .align 3 ++ +diff --git a/asmrun/stack.h b/asmrun/stack.h +index c778873..f1d2e6a 100644 +--- a/asmrun/stack.h ++++ b/asmrun/stack.h +@@ -65,6 +65,15 @@ + #define Callback_link(sp) ((struct caml_context *)((sp) + Trap_frame_size)) + #endif + ++#ifdef TARGET_power64 ++#define Saved_return_address(sp) *((intnat *)((sp) +16)) ++#define Already_scanned(sp, retaddr) ((retaddr) & 1) ++#define Mark_scanned(sp, retaddr) (Saved_return_address(sp) = (retaddr) | 1) ++#define Mask_already_scanned(retaddr) ((retaddr) & ~1) ++#define Trap_frame_size 0x150 ++#define Callback_link(sp) ((struct caml_context *)((sp) + Trap_frame_size)) ++#endif ++ + #ifdef TARGET_m68k + #define Saved_return_address(sp) *((intnat *)((sp) - 4)) + #define Callback_link(sp) ((struct caml_context *)((sp) + 8)) +diff --git a/configure b/configure +index d0a6b0f..6ed0a9c 100755 +--- a/configure ++++ b/configure +@@ -685,6 +685,7 @@ case "$host" in + hppa2.0*-*-hpux*) arch=hppa; system=hpux;; + hppa*-*-linux*) arch=hppa; system=linux;; + hppa*-*-gnu*) arch=hppa; system=gnu;; ++ powerpc64-*-linux*) arch=power64; model=ppc64; system=elf;; + powerpc*-*-linux*) arch=power; model=ppc; system=elf;; + powerpc-*-netbsd*) arch=power; model=ppc; system=elf;; + powerpc-*-rhapsody*) arch=power; model=ppc; system=rhapsody;; +@@ -709,7 +710,7 @@ esac + + if $arch64; then + case "$arch,$model" in +- sparc,default|mips,default|hppa,default|power,ppc) ++ sparc,default|mips,default|hppa,default) + arch=none; model=default; system=unknown;; + esac + fi +@@ -772,6 +773,8 @@ case "$arch,$model,$system" in + aspp='as -n32 -O2';; + power,*,elf) as='as -u -m ppc' + aspp='gcc -c';; ++ power64,*,elf) as='as -u -m ppc64' ++ aspp='gcc -c';; + power,*,bsd) as='as' + aspp='gcc -c';; + power,*,rhapsody) as="as -arch $model" +-- +1.7.10 + diff --git a/0007-New-ARM-backend-written-by-Benedikt-Meurer-PR-5433.patch b/0007-New-ARM-backend-written-by-Benedikt-Meurer-PR-5433.patch new file mode 100644 index 0000000..852579a --- /dev/null +++ b/0007-New-ARM-backend-written-by-Benedikt-Meurer-PR-5433.patch @@ -0,0 +1,3096 @@ +From 03318d9e7ef402f137dd100fe31bd01c37c1b94f Mon Sep 17 00:00:00 2001 +From: "Richard W.M. Jones" +Date: Tue, 29 May 2012 20:50:42 +0100 +Subject: [PATCH 7/7] New ARM backend, written by Benedikt Meurer (PR#5433). + +Backported from upstream sources to 3.12.1 by RWMJ. +--- + asmcomp/amd64/selection.ml | 14 +- + asmcomp/arm/arch.ml | 152 +++++++- + asmcomp/arm/emit.mlp | 850 ++++++++++++++++++++++++++++-------------- + asmcomp/arm/proc.ml | 185 ++++++--- + asmcomp/arm/reload.ml | 4 +- + asmcomp/arm/scheduling.ml | 80 ++-- + asmcomp/arm/selection.ml | 343 ++++++++++------- + asmcomp/i386/selection.ml | 14 +- + asmcomp/power/selection.ml | 2 +- + asmcomp/power64/selection.ml | 2 +- + asmcomp/selectgen.ml | 13 +- + asmcomp/selectgen.mli | 2 +- + asmcomp/sparc/selection.ml | 2 +- + asmrun/arm.S | 544 ++++++++++++++++----------- + asmrun/signals_osdep.h | 2 +- + configure | 11 +- + 16 files changed, 1477 insertions(+), 743 deletions(-) + +diff --git a/asmcomp/amd64/selection.ml b/asmcomp/amd64/selection.ml +index f0546cf..5d9f6fa 100644 +--- a/asmcomp/amd64/selection.ml ++++ b/asmcomp/amd64/selection.ml +@@ -121,7 +121,7 @@ method is_immediate n = n <= 0x7FFFFFFF && n >= -0x80000000 + + method is_immediate_natint n = n <= 0x7FFFFFFFn && n >= -0x80000000n + +-method select_addressing exp = ++method select_addressing chunk exp = + let (a, d) = select_addr exp in + (* PR#4625: displacement must be a signed 32-bit immediate *) + if d < -0x8000_0000 || d > 0x7FFF_FFFF +@@ -157,7 +157,7 @@ method! select_operation op args = + match op with + (* Recognize the LEA instruction *) + Caddi | Cadda | Csubi | Csuba -> +- begin match self#select_addressing (Cop(op, args)) with ++ begin match self#select_addressing Word (Cop(op, args)) with + (Iindexed d, _) -> super#select_operation op args + | (Iindexed2 0, _) -> super#select_operation op args + | (addr, arg) -> (Ispecific(Ilea addr), [arg]) +@@ -191,7 +191,7 @@ method! select_operation op args = + begin match args with + [loc; Cop(Caddi, [Cop(Cload _, [loc']); Cconst_int n])] + when loc = loc' && self#is_immediate n -> +- let (addr, arg) = self#select_addressing loc in ++ let (addr, arg) = self#select_addressing Word loc in + (Ispecific(Ioffset_loc(n, addr)), [arg]) + | _ -> + super#select_operation op args +@@ -202,12 +202,12 @@ method! select_operation op args = + + method select_floatarith commutative regular_op mem_op args = + match args with +- [arg1; Cop(Cload (Double|Double_u), [loc2])] -> +- let (addr, arg2) = self#select_addressing loc2 in ++ [arg1; Cop(Cload (Double|Double_u as chunk), [loc2])] -> ++ let (addr, arg2) = self#select_addressing chunk loc2 in + (Ispecific(Ifloatarithmem(mem_op, addr)), + [arg1; arg2]) +- | [Cop(Cload (Double|Double_u), [loc1]); arg2] when commutative -> +- let (addr, arg1) = self#select_addressing loc1 in ++ | [Cop(Cload (Double|Double_u as chunk), [loc1]); arg2] when commutative -> ++ let (addr, arg1) = self#select_addressing chunk loc1 in + (Ispecific(Ifloatarithmem(mem_op, addr)), + [arg2; arg1]) + | [arg1; arg2] -> +diff --git a/asmcomp/arm/arch.ml b/asmcomp/arm/arch.ml +index 998fa4b..c4aca8d 100644 +--- a/asmcomp/arm/arch.ml ++++ b/asmcomp/arm/arch.ml +@@ -1,25 +1,98 @@ + (***********************************************************************) + (* *) +-(* Objective Caml *) ++(* OCaml *) + (* *) +-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) ++(* Benedikt Meurer, University of Siegen *) + (* *) +-(* Copyright 1998 Institut National de Recherche en Informatique et *) +-(* en Automatique. All rights reserved. This file is distributed *) +-(* under the terms of the Q Public License version 1.0. *) ++(* Copyright 1998 Institut National de Recherche en Informatique *) ++(* et en Automatique. Copyright 2012 Benedikt Meurer. All rights *) ++(* reserved. This file is distributed under the terms of the Q *) ++(* Public License version 1.0. *) + (* *) + (***********************************************************************) + +-(* $Id: arch.ml 5304 2002-11-29 15:03:37Z xleroy $ *) ++(* $Id$ *) + + (* Specific operations for the ARM processor *) + + open Misc + open Format + ++type abi = EABI | EABI_VFP ++type arch = ARMv4 | ARMv5 | ARMv5TE | ARMv6 | ARMv6T2 | ARMv7 ++type fpu = Soft | VFPv3_D16 | VFPv3 ++ ++let abi = ++ match Config.system with ++ "linux_eabi" -> EABI ++ | "linux_eabihf" -> EABI_VFP ++ | _ -> assert false ++ ++let string_of_arch = function ++ ARMv4 -> "armv4" ++ | ARMv5 -> "armv5" ++ | ARMv5TE -> "armv5te" ++ | ARMv6 -> "armv6" ++ | ARMv6T2 -> "armv6t2" ++ | ARMv7 -> "armv7" ++ ++let string_of_fpu = function ++ Soft -> "soft" ++ | VFPv3_D16 -> "vfpv3-d16" ++ | VFPv3 -> "vfpv3" ++ + (* Machine-specific command-line options *) + +-let command_line_options = [] ++let (arch, fpu, thumb) = ++ let (def_arch, def_fpu, def_thumb) = ++ begin match abi, 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 ++ end in ++ (ref def_arch, ref def_fpu, ref def_thumb) ++ ++let pic_code = ref false ++ ++let farch spec = ++ arch := (match spec with ++ "armv4" when abi <> EABI_VFP -> ARMv4 ++ | "armv5" when abi <> EABI_VFP -> ARMv5 ++ | "armv5te" when abi <> EABI_VFP -> ARMv5TE ++ | "armv6" when abi <> EABI_VFP -> ARMv6 ++ | "armv6t2" when abi <> EABI_VFP -> ARMv6T2 ++ | "armv7" -> ARMv7 ++ | spec -> raise (Arg.Bad spec)) ++ ++let ffpu spec = ++ fpu := (match spec with ++ "soft" when abi <> EABI_VFP -> Soft ++ | "vfpv3-d16" when abi = EABI_VFP -> VFPv3_D16 ++ | "vfpv3" when abi = EABI_VFP -> VFPv3 ++ | spec -> raise (Arg.Bad spec)) ++ ++let command_line_options = ++ [ "-farch", Arg.String farch, ++ " Select the ARM target architecture" ++ ^ " (default: " ^ (string_of_arch !arch) ^ ")"; ++ "-ffpu", Arg.String ffpu, ++ " Select the floating-point hardware" ++ ^ " (default: " ^ (string_of_fpu !fpu) ^ ")"; ++ "-fPIC", Arg.Set pic_code, ++ " Generate position-independent machine code"; ++ "-fno-PIC", Arg.Clear pic_code, ++ " Generate position-dependent machine code"; ++ "-fthumb", Arg.Set thumb, ++ " Enable Thumb/Thumb-2 code generation" ++ ^ (if !thumb then " (default)" else ""); ++ "-fno-thumb", Arg.Clear thumb, ++ " Disable Thumb/Thumb-2 code generation" ++ ^ (if not !thumb then " (default" else "")] + + (* Addressing modes *) + +@@ -37,6 +110,14 @@ type specific_operation = + Ishiftarith of arith_operation * int + | Ishiftcheckbound of int + | Irevsubimm of int ++ | Imuladd (* multiply and add *) ++ | Imulsub (* multiply and subtract *) ++ | Inegmulf (* floating-point negate and multiply *) ++ | Imuladdf (* floating-point multiply and add *) ++ | Inegmuladdf (* floating-point negate, multiply and add *) ++ | Imulsubf (* floating-point multiply and subtract *) ++ | Inegmulsubf (* floating-point negate, multiply and subtract *) ++ | Isqrtf (* floating-point square root *) + + and arith_operation = + Ishiftadd +@@ -51,6 +132,10 @@ let size_addr = 4 + let size_int = 4 + let size_float = 8 + ++(* Behavior of division *) ++ ++let division_crashes_on_overflow = false ++ + (* Operations on addressing modes *) + + let identity_addressing = Iindexed 0 +@@ -84,3 +169,56 @@ let print_specific_operation printreg op ppf arg = + fprintf ppf "check %a >> %i > %a" printreg arg.(0) n printreg arg.(1) + | Irevsubimm n -> + fprintf ppf "%i %s %a" n "-" printreg arg.(0) ++ | Imuladd -> ++ fprintf ppf "(%a * %a) + %a" ++ printreg arg.(0) ++ printreg arg.(1) ++ printreg arg.(2) ++ | Imulsub -> ++ fprintf ppf "-(%a * %a) + %a" ++ printreg arg.(0) ++ printreg arg.(1) ++ printreg arg.(2) ++ | Inegmulf -> ++ fprintf ppf "-f (%a *f %a)" ++ printreg arg.(0) ++ printreg arg.(1) ++ | Imuladdf -> ++ fprintf ppf "%a +f (%a *f %a)" ++ printreg arg.(0) ++ printreg arg.(1) ++ printreg arg.(2) ++ | Inegmuladdf -> ++ fprintf ppf "%a -f (%a *f %a)" ++ printreg arg.(0) ++ printreg arg.(1) ++ printreg arg.(2) ++ | Imulsubf -> ++ fprintf ppf "(-f %a) +f (%a *f %a)" ++ printreg arg.(0) ++ printreg arg.(1) ++ printreg arg.(2) ++ | Inegmulsubf -> ++ fprintf ppf "(-f %a) -f (%a *f %a)" ++ printreg arg.(0) ++ printreg arg.(1) ++ printreg arg.(2) ++ | Isqrtf -> ++ fprintf ppf "sqrtf %a" ++ printreg arg.(0) ++ ++(* Recognize immediate operands *) ++ ++(* Immediate operands are 8-bit immediate values, zero-extended, ++ and rotated right by 0 ... 30 bits. ++ In Thumb/Thumb-2 mode we utilize 26 ... 30. *) ++ ++let is_immediate n = ++ let n = ref n in ++ let s = ref 0 in ++ let m = if !thumb then 24 else 30 in ++ while (!s <= m && Int32.logand !n 0xffl <> !n) do ++ n := Int32.logor (Int32.shift_right_logical !n 2) (Int32.shift_left !n 30); ++ s := !s + 2 ++ done; ++ !s <= m +diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp +index a4b2241..846ee4a 100644 +--- a/asmcomp/arm/emit.mlp ++++ b/asmcomp/arm/emit.mlp +@@ -1,16 +1,17 @@ + (***********************************************************************) + (* *) +-(* Objective Caml *) ++(* OCaml *) + (* *) +-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) ++(* Benedikt Meurer, University of Siegen *) + (* *) +-(* Copyright 1998 Institut National de Recherche en Informatique et *) +-(* en Automatique. All rights reserved. This file is distributed *) +-(* under the terms of the Q Public License version 1.0. *) ++(* Copyright 1998 Institut National de Recherche en Informatique *) ++(* et en Automatique. Copyright 2012 Benedikt Meurer. All rights *) ++(* reserved. This file is distributed under the terms of the Q *) ++(* Public License version 1.0. *) + (* *) + (***********************************************************************) + +-(* $Id: emit.mlp 10293 2010-04-22 09:33:18Z xleroy $ *) ++(* $Id$ *) + + (* Emission of ARM assembly code *) + +@@ -33,16 +34,28 @@ let fastcode_flag = ref true + let emit_label lbl = + emit_string ".L"; emit_int lbl + +-(* Output a symbol *) ++let emit_data_label lbl = ++ emit_string ".Ld"; emit_int lbl ++ ++(* Symbols *) + + let emit_symbol s = + Emitaux.emit_symbol '$' s + ++let emit_call s = ++ if !Clflags.dlcode || !pic_code ++ then `bl {emit_symbol s}(PLT)` ++ else `bl {emit_symbol s}` ++ ++let emit_jump s = ++ if !Clflags.dlcode || !pic_code ++ then `b {emit_symbol s}(PLT)` ++ else `b {emit_symbol s}` ++ + (* Output a pseudo-register *) + +-let emit_reg r = +- match r.loc with +- | Reg r -> emit_string (register_name r) ++let emit_reg = function ++ {loc = Reg r} -> emit_string (register_name r) + | _ -> fatal_error "Emit_arm.emit_reg" + + (* Layout of the stack frame *) +@@ -53,14 +66,23 @@ let frame_size () = + let sz = + !stack_offset + + 4 * num_stack_slots.(0) + ++ 8 * num_stack_slots.(1) + ++ 8 * num_stack_slots.(2) + + (if !contains_calls then 4 else 0) + in Misc.align sz 8 + + let slot_offset loc cl = + match loc with +- Incoming n -> frame_size() + n +- | Local n -> !stack_offset + n * 4 +- | Outgoing n -> n ++ Incoming n -> ++ assert (n >= 0); ++ frame_size() + n ++ | Local n -> ++ if cl = 0 ++ then !stack_offset + n * 4 ++ else !stack_offset + num_stack_slots.(0) * 4 + n * 8 ++ | Outgoing n -> ++ assert (n >= 0); ++ n + + (* Output a stack reference *) + +@@ -79,20 +101,13 @@ let emit_addressing addr r n = + + (* Record live pointers at call points *) + +-type frame_descr = +- { fd_lbl: int; (* Return address *) +- fd_frame_size: int; (* Size of stack frame *) +- fd_live_offset: int list } (* Offsets/regs of live addresses *) +- +-let frame_descriptors = ref([] : frame_descr list) +- +-let record_frame live = ++let record_frame_label live dbg = + let lbl = new_label() in + let live_offset = ref [] in + Reg.Set.iter + (function + {typ = Addr; loc = Reg r} -> +- live_offset := (r lsl 1) + 1 :: !live_offset ++ live_offset := ((r lsl 1) + 1) :: !live_offset + | {typ = Addr; loc = Stack s} as reg -> + live_offset := slot_offset s (register_class reg) :: !live_offset + | _ -> ()) +@@ -100,18 +115,57 @@ let record_frame live = + frame_descriptors := + { fd_lbl = lbl; + fd_frame_size = frame_size(); +- fd_live_offset = !live_offset } :: !frame_descriptors; +- `{emit_label lbl}:` +- +-let emit_frame fd = +- ` .word {emit_label fd.fd_lbl} + 4\n`; +- ` .short {emit_int fd.fd_frame_size}\n`; +- ` .short {emit_int (List.length fd.fd_live_offset)}\n`; +- List.iter +- (fun n -> +- ` .short {emit_int n}\n`) +- fd.fd_live_offset; +- ` .align 2\n` ++ fd_live_offset = !live_offset; ++ fd_debuginfo = dbg } :: !frame_descriptors; ++ lbl ++ ++let record_frame live dbg = ++ let lbl = record_frame_label live dbg in `{emit_label lbl}:` ++ ++(* Record calls to the GC -- we've moved them out of the way *) ++ ++type gc_call = ++ { gc_lbl: label; (* Entry label *) ++ gc_return_lbl: label; (* Where to branch after GC *) ++ gc_frame_lbl: label } (* Label of frame descriptor *) ++ ++let call_gc_sites = ref ([] : gc_call list) ++ ++let emit_call_gc gc = ++ `{emit_label gc.gc_lbl}: {emit_call "caml_call_gc"}\n`; ++ `{emit_label gc.gc_frame_lbl}: b {emit_label gc.gc_return_lbl}\n` ++ ++(* Record calls to caml_ml_array_bound_error. ++ In debug mode, we maintain one call to caml_ml_array_bound_error ++ per bound check site. Otherwise, we can share a single call. *) ++ ++type bound_error_call = ++ { bd_lbl: label; (* Entry label *) ++ bd_frame_lbl: label } (* Label of frame descriptor *) ++ ++let bound_error_sites = ref ([] : bound_error_call list) ++ ++let bound_error_label dbg = ++ if !Clflags.debug || !bound_error_sites = [] then begin ++ let lbl_bound_error = new_label() in ++ let lbl_frame = record_frame_label Reg.Set.empty dbg in ++ bound_error_sites := ++ { bd_lbl = lbl_bound_error; ++ bd_frame_lbl = lbl_frame } :: !bound_error_sites; ++ lbl_bound_error ++ end else begin ++ let bd = List.hd !bound_error_sites in bd.bd_lbl ++ end ++ ++let emit_call_bound_error bd = ++ `{emit_label bd.bd_lbl}: {emit_call "caml_ml_array_bound_error"}\n`; ++ `{emit_label bd.bd_frame_lbl}:\n` ++ ++(* Negate a comparison *) ++ ++let negate_integer_comparison = function ++ Isigned cmp -> Isigned(negate_comparison cmp) ++ | Iunsigned cmp -> Iunsigned(negate_comparison cmp) + + (* Names of various instructions *) + +@@ -121,22 +175,13 @@ let name_for_comparison = function + | Iunsigned Ceq -> "eq" | Iunsigned Cne -> "ne" | Iunsigned Cle -> "ls" + | Iunsigned Cge -> "cs" | Iunsigned Clt -> "cc" | Iunsigned Cgt -> "hi" + +-let name_for_float_comparison cmp neg = +- match cmp with +- Ceq -> if neg then "ne" else "eq" +- | Cne -> if neg then "eq" else "ne" +- | Cle -> if neg then "hi" else "ls" +- | Cge -> if neg then "lt" else "ge" +- | Clt -> if neg then "pl" else "mi" +- | Cgt -> if neg then "le" else "gt" +- + let name_for_int_operation = function + Iadd -> "add" + | Isub -> "sub" + | Imul -> "mul" +- | Iand -> "and" +- | Ior -> "orr" +- | Ixor -> "eor" ++ | Iand -> "and" ++ | Ior -> "orr" ++ | Ixor -> "eor" + | _ -> assert false + + let name_for_shift_operation = function +@@ -145,60 +190,54 @@ let name_for_shift_operation = function + | Iasr -> "asr" + | _ -> assert false + +-let name_for_shift_int_operation = function +- Ishiftadd -> "add" +- | Ishiftsub -> "sub" +- | Ishiftsubrev -> "rsb" +- +-(* Recognize immediate operands *) +- +-(* Immediate operands are 8-bit immediate values, zero-extended, and rotated +- right by 0, 2, 4, ... 30 bits. +- We check only with 8-bit values shifted left 0 to 24 bits. *) +- +-let rec is_immed n shift = +- shift <= 24 && +- (Nativeint.logand n (Nativeint.shift_left (Nativeint.of_int 0xFF) shift) = n +- || is_immed n (shift + 2)) +- +-let is_immediate n = is_immed n 0 +- + (* General functional to decompose a non-immediate integer constant +- into 8-bit chunks shifted left 0 ... 24 bits *) ++ into 8-bit chunks shifted left 0 ... 30 bits. *) + + let decompose_intconst n fn = + let i = ref n in + let shift = ref 0 in + let ninstr = ref 0 in +- while !i <> 0n do +- if Nativeint.to_int (Nativeint.shift_right !i !shift) land 3 = 0 then ++ while !i <> 0l do ++ if Int32.logand (Int32.shift_right !i !shift) 3l = 0l then + shift := !shift + 2 + else begin +- let mask = Nativeint.shift_left 0xFFn !shift in +- let bits = Nativeint.logand !i mask in +- fn bits; ++ let bits = Int32.logand !i (Int32.shift_left 0xffl !shift) in ++ i := Int32.sub !i bits; + shift := !shift + 8; +- i := Nativeint.sub !i bits; +- incr ninstr ++ incr ninstr; ++ fn bits + end + done; + !ninstr + + (* Load an integer constant into a register *) + +-let emit_intconst r n = +- let nr = Nativeint.lognot n in ++let emit_intconst dst n = ++ let nr = Int32.lognot n in + if is_immediate n then begin +- ` mov {emit_reg r}, #{emit_nativeint n}\n`; 1 ++ (* Use movs here to enable 16-bit T1 encoding *) ++ ` movs {emit_reg dst}, #{emit_int32 n}\n`; 1 + end else if is_immediate nr then begin +- ` mvn {emit_reg r}, #{emit_nativeint nr}\n`; 1 ++ ` mvn {emit_reg dst}, #{emit_int32 nr}\n`; 1 ++ end else if !arch > ARMv6 then begin ++ let nl = Int32.logand 0xffffl n in ++ let nh = Int32.logand 0xffffl (Int32.shift_right_logical n 16) in ++ if nh = 0l then begin ++ ` movw {emit_reg dst}, #{emit_int32 nl}\n`; 1 ++ end else if Int32.logand nl 0xffl = nl then begin ++ ` movs {emit_reg dst}, #{emit_int32 nl}\n`; ++ ` movt {emit_reg dst}, #{emit_int32 nh}\n`; 2 ++ end else begin ++ ` movw {emit_reg dst}, #{emit_int32 nl}\n`; ++ ` movt {emit_reg dst}, #{emit_int32 nh}\n`; 2 ++ end + end else begin + let first = ref true in + decompose_intconst n + (fun bits -> + if !first +- then ` mov {emit_reg r}, #{emit_nativeint bits} @ {emit_nativeint n}\n` +- else ` add {emit_reg r}, {emit_reg r}, #{emit_nativeint bits}\n`; ++ then ` mov {emit_reg dst}, #{emit_int32 bits} @ {emit_int32 n}\n` ++ else ` add {emit_reg dst}, {emit_reg dst}, #{emit_int32 bits}\n`; + first := false) + end + +@@ -206,46 +245,105 @@ let emit_intconst r n = + + let emit_stack_adjustment instr n = + if n <= 0 then 0 else +- decompose_intconst (Nativeint.of_int n) ++ decompose_intconst (Int32.of_int n) + (fun bits -> +- ` {emit_string instr} sp, sp, #{emit_nativeint bits}\n`) ++ ` {emit_string instr} sp, sp, #{emit_int32 bits}\n`) + + (* Name of current function *) + let function_name = ref "" + (* Entry point for tail recursive calls *) + let tailrec_entry_point = ref 0 +-(* Table of symbols referenced *) +-let symbol_constants = (Hashtbl.create 11 : (string, int) Hashtbl.t) +-(* Table of floating-point literals *) +-let float_constants = (Hashtbl.create 11 : (string, int) Hashtbl.t) +-(* Total space (in word) occupied by pending literals *) ++(* Pending floating-point literals *) ++let float_literals = ref ([] : (string * label) list) ++(* Pending relative references to the global offset table *) ++let gotrel_literals = ref ([] : (label * label) list) ++(* Pending symbol literals *) ++let symbol_literals = ref ([] : (string * label) list) ++(* Total space (in words) occupied by pending literals *) + let num_literals = ref 0 + +-(* Label a symbol or float constant *) +-let label_constant tbl s size = ++(* Label a floating-point literal *) ++let float_literal f = + try +- Hashtbl.find tbl s ++ List.assoc f !float_literals + with Not_found -> + let lbl = new_label() in +- Hashtbl.add tbl s lbl; +- num_literals := !num_literals + size; ++ num_literals := !num_literals + 2; ++ float_literals := (f, lbl) :: !float_literals; + lbl + +-(* Emit all pending constants *) +- +-let emit_constants () = +- Hashtbl.iter +- (fun s lbl -> +- `{emit_label lbl}: .word {emit_symbol s}\n`) +- symbol_constants; +- Hashtbl.iter +- (fun s lbl -> +- `{emit_label lbl}: .double {emit_string s}\n`) +- float_constants; +- Hashtbl.clear symbol_constants; +- Hashtbl.clear float_constants; ++(* Label a GOTREL literal *) ++let gotrel_literal l = ++ let lbl = new_label() in ++ num_literals := !num_literals + 1; ++ gotrel_literals := (l, lbl) :: !gotrel_literals; ++ lbl ++ ++(* Label a symbol literal *) ++let symbol_literal s = ++ try ++ List.assoc s !symbol_literals ++ with Not_found -> ++ let lbl = new_label() in ++ num_literals := !num_literals + 1; ++ symbol_literals := (s, lbl) :: !symbol_literals; ++ lbl ++ ++(* Emit all pending literals *) ++let emit_literals() = ++ if !float_literals <> [] then begin ++ ` .align 3\n`; ++ List.iter ++ (fun (f, lbl) -> ++ `{emit_label lbl}: .double {emit_string f}\n`) ++ !float_literals; ++ float_literals := [] ++ end; ++ if !symbol_literals <> [] then begin ++ let offset = if !thumb then 4 else 8 in ++ let suffix = if !pic_code then "(GOT)" else "" in ++ ` .align 2\n`; ++ List.iter ++ (fun (l, lbl) -> ++ `{emit_label lbl}: .word _GLOBAL_OFFSET_TABLE_-({emit_label l}+{emit_int offset})\n`) ++ !gotrel_literals; ++ List.iter ++ (fun (s, lbl) -> ++ `{emit_label lbl}: .word {emit_symbol s}{emit_string suffix}\n`) ++ !symbol_literals; ++ gotrel_literals := []; ++ symbol_literals := [] ++ end; + num_literals := 0 + ++(* Emit code to load the address of a symbol *) ++ ++let emit_load_symbol_addr dst s = ++ if !pic_code then begin ++ let lbl_pic = new_label() in ++ let lbl_got = gotrel_literal lbl_pic in ++ let lbl_sym = symbol_literal s in ++ (* Both r3 and r12 are marked as clobbered in PIC mode (cf. proc.ml), ++ so use r12 as temporary scratch register unless the destination is ++ r12, then we use r3 instead. *) ++ let tmp = if dst.loc = Reg 8 (*r12*) ++ then phys_reg 3 (*r3*) ++ else phys_reg 8 (*r12*) in ++ ` ldr {emit_reg tmp}, {emit_label lbl_got}\n`; ++ ` ldr {emit_reg dst}, {emit_label lbl_sym}\n`; ++ `{emit_label lbl_pic}: add {emit_reg tmp}, pc, {emit_reg tmp}\n`; ++ ` ldr {emit_reg dst}, [{emit_reg tmp}, {emit_reg dst}] @ {emit_symbol s}\n`; ++ 4 ++ end else if !arch > ARMv6 && not !Clflags.dlcode && !fastcode_flag then begin ++ ` movw {emit_reg dst}, #:lower16:{emit_symbol s}\n`; ++ ` movt {emit_reg dst}, #:upper16:{emit_symbol s}\n`; ++ 2 ++ end else begin ++ let lbl = symbol_literal s in ++ ` ldr {emit_reg dst}, {emit_label lbl} @ {emit_symbol s}\n`; ++ 1 ++ end ++ + (* Output the assembly code for an instruction *) + + let emit_instr i = +@@ -254,40 +352,76 @@ let emit_instr i = + | Lop(Imove | Ispill | Ireload) -> + let src = i.arg.(0) and dst = i.res.(0) in + if src.loc = dst.loc then 0 else begin +- match (src, dst) with +- {loc = Reg rs; typ = Int|Addr}, {loc = Reg rd; typ = Int|Addr} -> +- ` mov {emit_reg dst}, {emit_reg src}\n`; 1 +- | {loc = Reg rs; typ = Int|Addr}, {loc = Stack sd} -> +- ` str {emit_reg src}, {emit_stack dst}\n`; 1 +- | {loc = Stack ss; typ = Int|Addr}, {loc = Reg rd} -> +- ` ldr {emit_reg dst}, {emit_stack src}\n`; 1 ++ begin match (src, dst) with ++ {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` ++ | {loc = Reg _; typ = Float}, _ -> ++ ` fstd {emit_reg src}, {emit_stack dst}\n` ++ | {loc = Reg _}, _ -> ++ ` str {emit_reg src}, {emit_stack dst}\n` ++ | {typ = Float}, _ -> ++ ` fldd {emit_reg dst}, {emit_stack src}\n` + | _ -> +- assert false ++ ` ldr {emit_reg dst}, {emit_stack src}\n` ++ end; 1 + end + | Lop(Iconst_int n) -> +- emit_intconst i.res.(0) n +- | Lop(Iconst_float s) -> +- let bits = Int64.bits_of_float (float_of_string s) in +- let high_bits = Int64.to_nativeint (Int64.shift_right_logical bits 32) +- and low_bits = Int64.to_nativeint bits in +- if is_immediate low_bits && is_immediate high_bits then begin +- ` mov {emit_reg i.res.(0)}, #{emit_nativeint low_bits} @ {emit_string s}\n`; +- ` mov {emit_reg i.res.(1)}, #{emit_nativeint high_bits}\n`; +- 2 ++ emit_intconst i.res.(0) (Nativeint.to_int32 n) ++ | Lop(Iconst_float f) when !fpu = Soft -> ++ ` @ {emit_string f}\n`; ++ let bits = Int64.bits_of_float (float_of_string f) in ++ let high_bits = Int64.to_int32 (Int64.shift_right_logical bits 32) ++ and low_bits = Int64.to_int32 bits in ++ if is_immediate low_bits || is_immediate high_bits then begin ++ let ninstr_low = emit_intconst i.res.(0) low_bits ++ and ninstr_high = emit_intconst i.res.(1) high_bits in ++ ninstr_low + ninstr_high + end else begin +- let lbl = label_constant float_constants s 2 in +- ` ldr {emit_reg i.res.(0)}, {emit_label lbl} @ {emit_string s}\n`; ++ let lbl = float_literal f in ++ ` ldr {emit_reg i.res.(0)}, {emit_label lbl}\n`; + ` ldr {emit_reg i.res.(1)}, {emit_label lbl} + 4\n`; + 2 + end ++ | Lop(Iconst_float f) -> ++ let encode imm = ++ let sg = Int64.to_int (Int64.shift_right_logical imm 63) in ++ let ex = Int64.to_int (Int64.shift_right_logical imm 52) in ++ let ex = (ex land 0x7ff) - 1023 in ++ let mn = Int64.logand imm 0xfffffffffffffL in ++ if Int64.logand mn 0xffffffffffffL <> 0L || ex < -3 || ex > 4 ++ then ++ None ++ else begin ++ let mn = Int64.to_int (Int64.shift_right_logical mn 48) in ++ if mn land 0x0f <> mn then ++ None ++ else ++ let ex = ((ex + 3) land 0x07) lxor 0x04 in ++ Some((sg lsl 7) lor (ex lsl 4) lor mn) ++ end in ++ begin match encode (Int64.bits_of_float (float_of_string f)) with ++ None -> ++ let lbl = float_literal f in ++ ` fldd {emit_reg i.res.(0)}, {emit_label lbl} @ {emit_string f}\n` ++ | Some imm8 -> ++ ` fconstd {emit_reg i.res.(0)}, #{emit_int imm8} @ {emit_string f}\n` ++ end; 1 + | Lop(Iconst_symbol s) -> +- let lbl = label_constant symbol_constants s 1 in +- ` ldr {emit_reg i.res.(0)}, {emit_label lbl} @ {emit_symbol s}\n`; 1 ++ emit_load_symbol_addr i.res.(0) s + | Lop(Icall_ind) -> +- ` mov lr, pc\n`; +- `{record_frame i.live} bx {emit_reg i.arg.(0)}\n`; 2 ++ if !arch >= ARMv5 then begin ++ ` blx {emit_reg i.arg.(0)}\n`; ++ `{record_frame i.live i.dbg}\n`; 1 ++ end else begin ++ ` mov lr, pc\n`; ++ ` bx {emit_reg i.arg.(0)}\n`; ++ `{record_frame i.live i.dbg}\n`; 2 ++ end + | Lop(Icall_imm s) -> +- `{record_frame i.live} bl {emit_symbol s}\n`; 1 ++ ` {emit_call s}\n`; ++ `{record_frame i.live i.dbg}\n`; 1 + | Lop(Itailcall_ind) -> + let n = frame_size() in + if !contains_calls then +@@ -303,17 +437,16 @@ let emit_instr i = + if !contains_calls then + ` ldr lr, [sp, #{emit_int (n-4)}]\n`; + let ninstr = emit_stack_adjustment "add" n in +- ` b {emit_symbol s}\n`; ++ ` {emit_jump s}\n`; + 2 + ninstr + end +- | Lop(Iextcall(s, alloc)) -> +- if alloc then begin +- let lbl = label_constant symbol_constants s 1 in +- ` ldr r12, {emit_label lbl} @ {emit_symbol s}\n`; +- `{record_frame i.live} bl caml_c_call\n`; 2 +- end else begin +- ` bl {emit_symbol s}\n`; 1 +- end ++ | Lop(Iextcall(s, false)) -> ++ ` {emit_call s}\n`; 1 ++ | Lop(Iextcall(s, true)) -> ++ let ninstr = emit_load_symbol_addr (phys_reg 7 (* r7 *)) s in ++ ` {emit_call "caml_c_call"}\n`; ++ `{record_frame i.live i.dbg}\n`; ++ 1 + ninstr + | Lop(Istackoffset n) -> + assert (n mod 8 = 0); + let ninstr = +@@ -322,16 +455,28 @@ let emit_instr i = + else emit_stack_adjustment "add" (-n) in + stack_offset := !stack_offset + n; + ninstr +- | Lop(Iload((Double | Double_u), addr)) -> +- let addr' = offset_addressing addr 4 in +- if i.res.(0).loc <> i.arg.(0).loc then begin +- ` ldr {emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n`; +- ` ldr {emit_reg i.res.(1)}, {emit_addressing addr' i.arg 0}\n` +- end else begin +- ` ldr {emit_reg i.res.(1)}, {emit_addressing addr' i.arg 0}\n`; +- ` ldr {emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n` +- end; +- 2 ++ | Lop(Iload(Single, addr)) when !fpu >= VFPv3_D16 -> ++ ` flds s14, {emit_addressing addr i.arg 0}\n`; ++ ` fcvtds {emit_reg i.res.(0)}, s14\n`; 2 ++ | Lop(Iload((Double | Double_u), addr)) when !fpu = Soft -> ++ (* Use LDM or LDRD if possible *) ++ begin match i.res.(0), i.res.(1), addr with ++ {loc = Reg rt}, {loc = Reg rt2}, Iindexed 0 ++ when rt < rt2 -> ++ ` ldm {emit_reg i.arg.(0)}, \{{emit_reg i.res.(0)}, {emit_reg i.res.(1)}}\n`; 1 ++ | {loc = Reg rt}, {loc = Reg rt2}, addr ++ when !arch >= ARMv5TE && rt mod 2 == 0 && rt2 = rt + 1 -> ++ ` ldrd {emit_reg i.res.(0)}, {emit_reg i.res.(1)}, {emit_addressing addr i.arg 0}\n`; 1 ++ | _ -> ++ let addr' = offset_addressing addr 4 in ++ if i.res.(0).loc <> i.arg.(0).loc then begin ++ ` ldr {emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n`; ++ ` ldr {emit_reg i.res.(1)}, {emit_addressing addr' i.arg 0}\n` ++ end else begin ++ ` ldr {emit_reg i.res.(1)}, {emit_addressing addr' i.arg 0}\n`; ++ ` ldr {emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n` ++ end; 2 ++ end + | Lop(Iload(size, addr)) -> + let r = i.res.(0) in + let instr = +@@ -340,65 +485,114 @@ let emit_instr i = + | Byte_signed -> "ldrsb" + | Sixteen_unsigned -> "ldrh" + | Sixteen_signed -> "ldrsh" ++ | Double ++ | Double_u -> "fldd" + | _ (* 32-bit quantities *) -> "ldr" in +- ` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 0}\n`; +- 1 +- | Lop(Istore((Double | Double_u), addr)) -> +- let addr' = offset_addressing addr 4 in +- ` str {emit_reg i.arg.(0)}, {emit_addressing addr i.arg 2}\n`; +- ` str {emit_reg i.arg.(1)}, {emit_addressing addr' i.arg 2}\n`; +- 2 ++ ` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 0}\n`; 1 ++ | Lop(Istore(Single, addr)) when !fpu >= VFPv3_D16 -> ++ ` fcvtsd s14, {emit_reg i.arg.(0)}\n`; ++ ` fsts s14, {emit_addressing addr i.arg 1}\n`; 2 ++ | Lop(Istore((Double | Double_u), addr)) when !fpu = Soft -> ++ (* Use STM or STRD if possible *) ++ begin match i.arg.(0), i.arg.(1), addr with ++ {loc = Reg rt}, {loc = Reg rt2}, Iindexed 0 ++ when rt < rt2 -> ++ ` stm {emit_reg i.arg.(2)}, \{{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}}\n`; 1 ++ | {loc = Reg rt}, {loc = Reg rt2}, addr ++ when !arch >= ARMv5TE && rt mod 2 == 0 && rt2 = rt + 1 -> ++ ` strd {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_addressing addr i.arg 2}\n`; 1 ++ | _ -> ++ let addr' = offset_addressing addr 4 in ++ ` str {emit_reg i.arg.(0)}, {emit_addressing addr i.arg 2}\n`; ++ ` str {emit_reg i.arg.(1)}, {emit_addressing addr' i.arg 2}\n`; 2 ++ end + | Lop(Istore(size, addr)) -> + let r = i.arg.(0) in + let instr = + match size with +- Byte_unsigned | Byte_signed -> "strb" +- | Sixteen_unsigned | Sixteen_signed -> "strh" ++ Byte_unsigned ++ | Byte_signed -> "strb" ++ | Sixteen_unsigned ++ | Sixteen_signed -> "strh" ++ | Double ++ | Double_u -> "fstd" + | _ (* 32-bit quantities *) -> "str" in +- ` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 1}\n`; +- 1 ++ ` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 1}\n`; 1 + | Lop(Ialloc n) -> ++ let lbl_frame = record_frame_label i.live i.dbg in + if !fastcode_flag then begin +- let ni = emit_intconst (phys_reg 8 (*r12*)) (Nativeint.of_int n) in +- ` sub alloc_ptr, alloc_ptr, r12\n`; ++ let lbl_redo = new_label() in ++ `{emit_label lbl_redo}:`; ++ let ninstr = decompose_intconst ++ (Int32.of_int n) ++ (fun i -> ++ ` sub alloc_ptr, alloc_ptr, #{emit_int32 i}\n`) in + ` cmp alloc_ptr, alloc_limit\n`; +- `{record_frame i.live} blcc caml_call_gc\n`; + ` add {emit_reg i.res.(0)}, alloc_ptr, #4\n`; +- 4 + ni +- end else if n = 8 || n = 12 || n = 16 then begin +- `{record_frame i.live} bl caml_alloc{emit_int ((n-4)/4)}\n`; +- ` add {emit_reg i.res.(0)}, alloc_ptr, #4\n`; 2 ++ let lbl_call_gc = new_label() in ++ ` bcc {emit_label lbl_call_gc}\n`; ++ call_gc_sites := ++ { gc_lbl = lbl_call_gc; ++ gc_return_lbl = lbl_redo; ++ gc_frame_lbl = lbl_frame } :: !call_gc_sites; ++ 3 + ninstr + end else begin +- let ni = emit_intconst (phys_reg 8 (*r12*)) (Nativeint.of_int n) in +- `{record_frame i.live} bl caml_allocN\n`; +- ` add {emit_reg i.res.(0)}, alloc_ptr, #4\n`; +- 2 + ni ++ let ninstr = ++ begin match n with ++ 8 -> ` {emit_call "caml_alloc1"}\n`; 1 ++ | 12 -> ` {emit_call "caml_alloc2"}\n`; 1 ++ | 16 -> ` {emit_call "caml_alloc3"}\n`; 1 ++ | _ -> let ninstr = emit_intconst (phys_reg 7) (Int32.of_int n) in ++ ` {emit_call "caml_allocN"}\n`; 1 + ninstr ++ end in ++ `{emit_label lbl_frame}: add {emit_reg i.res.(0)}, alloc_ptr, #4\n`; ++ 1 + ninstr + end + | Lop(Iintop(Ilsl | Ilsr | Iasr as op)) -> + let shift = name_for_shift_operation op in + ` mov {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_string shift} {emit_reg i.arg.(1)}\n`; 1 + | Lop(Iintop(Icomp cmp)) -> +- let comp = name_for_comparison cmp in ++ let compthen = name_for_comparison cmp in ++ let compelse = name_for_comparison (negate_integer_comparison cmp) in + ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; +- ` mov {emit_reg i.res.(0)}, #0\n`; +- ` mov{emit_string comp} {emit_reg i.res.(0)}, #1\n`; 3 +- | Lop(Iintop(Icheckbound)) -> ++ ` ite {emit_string compthen}\n`; ++ ` mov{emit_string compthen} {emit_reg i.res.(0)}, #1\n`; ++ ` mov{emit_string compelse} {emit_reg i.res.(0)}, #0\n`; 4 ++ | Lop(Iintop_imm(Icomp cmp, n)) -> ++ let compthen = name_for_comparison cmp in ++ let compelse = name_for_comparison (negate_integer_comparison cmp) in ++ ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`; ++ ` ite {emit_string compthen}\n`; ++ ` mov{emit_string compthen} {emit_reg i.res.(0)}, #1\n`; ++ ` mov{emit_string compelse} {emit_reg i.res.(0)}, #0\n`; 4 ++ | Lop(Iintop Icheckbound) -> ++ let lbl = bound_error_label i.dbg in + ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; +- ` blls caml_ml_array_bound_error\n`; 2 ++ ` bls {emit_label lbl}\n`; 2 ++ | Lop(Iintop_imm(Icheckbound, n)) -> ++ let lbl = bound_error_label i.dbg in ++ ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`; ++ ` bls {emit_label lbl}\n`; 2 ++ | Lop(Ispecific(Ishiftcheckbound shift)) -> ++ let lbl = bound_error_label i.dbg in ++ ` cmp {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`; ++ ` bcs {emit_label lbl}\n`; 2 + | Lop(Iintop op) -> + let instr = name_for_int_operation op in +- ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; 1 ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; 1 + | Lop(Iintop_imm(Idiv, n)) -> (* n is a power of 2 *) + let l = Misc.log2 n in + let r = i.res.(0) in + ` movs {emit_reg r}, {emit_reg i.arg.(0)}\n`; +- if n <= 256 then ++ if n <= 256 then begin ++ ` it lt\n`; + ` addlt {emit_reg r}, {emit_reg r}, #{emit_int (n-1)}\n` +- else begin ++ end else begin ++ ` itt lt\n`; + ` addlt {emit_reg r}, {emit_reg r}, #{emit_int n}\n`; + ` sublt {emit_reg r}, {emit_reg r}, #1\n` + end; +- ` mov {emit_reg r}, {emit_reg r}, asr #{emit_int l}\n`; 4 ++ ` mov {emit_reg r}, {emit_reg r}, asr #{emit_int l}\n`; 5 + | Lop(Iintop_imm(Imod, n)) -> (* n is a power of 2 *) + let l = Misc.log2 n in + let a = i.arg.(0) in +@@ -409,40 +603,71 @@ let emit_instr i = + ` mov {emit_reg r}, {emit_reg r}, lsr #{emit_int (32-l)}\n`; + ` bpl {emit_label lbl}\n`; + ` cmp {emit_reg r}, #0\n`; ++ ` it ne\n`; + ` subne {emit_reg r}, {emit_reg r}, #{emit_int n}\n`; +- `{emit_label lbl}:\n`; 6 ++ `{emit_label lbl}:\n`; 7 + | Lop(Iintop_imm((Ilsl | Ilsr | Iasr as op), n)) -> + let shift = name_for_shift_operation op in + ` mov {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_string shift} #{emit_int n}\n`; 1 +- | Lop(Iintop_imm(Icomp cmp, n)) -> +- let comp = name_for_comparison cmp in +- ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`; +- ` mov {emit_reg i.res.(0)}, #0\n`; +- ` mov{emit_string comp} {emit_reg i.res.(0)}, #1\n`; 3 +- | Lop(Iintop_imm(Icheckbound, n)) -> +- ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`; +- ` blls caml_ml_array_bound_error\n`; 2 + | Lop(Iintop_imm(op, n)) -> + let instr = name_for_int_operation op in +- ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #{emit_int n}\n`; 1 +- | Lop(Inegf) -> (* argument and result in (r0, r1) *) +- ` eor r1, r1, #0x80000000\n`; 1 +- | Lop(Iabsf) -> (* argument and result in (r0, r1) *) +- ` bic r1, r1, #0x80000000\n`; 1 +- | Lop(Ifloatofint | Iintoffloat | Iaddf | Isubf | Imulf | Idivf) -> +- assert false ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #{emit_int n}\n`; 1 ++ | Lop(Iabsf | Inegf as op) when !fpu = Soft -> ++ let instr = (match op with ++ Iabsf -> "bic" ++ | Inegf -> "eor" ++ | _ -> assert false) in ++ ` {emit_string instr} {emit_reg i.res.(1)}, {emit_reg i.arg.(1)}, #0x80000000\n`; 1 ++ | Lop(Iabsf | Inegf | Ispecific Isqrtf as op) -> ++ let instr = (match op with ++ Iabsf -> "fabsd" ++ | Inegf -> "fnegd" ++ | Ispecific Isqrtf -> "fsqrtd" ++ | _ -> assert false) in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`; 1 ++ | Lop(Ifloatofint) -> ++ ` fmsr s14, {emit_reg i.arg.(0)}\n`; ++ ` fsitod {emit_reg i.res.(0)}, s14\n`; 2 ++ | Lop(Iintoffloat) -> ++ ` ftosizd s14, {emit_reg i.arg.(0)}\n`; ++ ` fmrs {emit_reg i.res.(0)}, s14\n`; 2 ++ | Lop(Iaddf | Isubf | Imulf | Idivf | Ispecific Inegmulf as op) -> ++ let instr = (match op with ++ Iaddf -> "faddd" ++ | Isubf -> "fsubd" ++ | Imulf -> "fmuld" ++ | Idivf -> "fdivd" ++ | Ispecific Inegmulf -> "fnmuld" ++ | _ -> assert false) in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ 1 ++ | Lop(Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf as op)) -> ++ let instr = (match op with ++ Imuladdf -> "fmacd" ++ | Inegmuladdf -> "fnmacd" ++ | Imulsubf -> "fmscd" ++ | Inegmulsubf -> "fnmscd" ++ | _ -> assert false) in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n`; ++ 1 + | Lop(Ispecific(Ishiftarith(op, shift))) -> +- let instr = name_for_shift_int_operation op in +- ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}`; ++ let instr = (match op with ++ Ishiftadd -> "add" ++ | Ishiftsub -> "sub" ++ | Ishiftsubrev -> "rsb") in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}`; + if shift >= 0 + then `, lsl #{emit_int shift}\n` + else `, asr #{emit_int (-shift)}\n`; + 1 +- | Lop(Ispecific(Ishiftcheckbound shift)) -> +- ` cmp {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`; +- ` blcs caml_ml_array_bound_error\n`; 2 + | Lop(Ispecific(Irevsubimm n)) -> + ` rsb {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #{emit_int n}\n`; 1 ++ | Lop(Ispecific(Imuladd | Imulsub as op)) -> ++ let instr = (match op with ++ Imuladd -> "mla" ++ | Imulsub -> "mls" ++ | _ -> assert false) 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`; 1 + | Lreloadretaddr -> + let n = frame_size() in + ` ldr lr, [sp, #{emit_int(n-4)}]\n`; 1 +@@ -458,29 +683,41 @@ let emit_instr i = + begin match tst with + Itruetest -> + ` cmp {emit_reg i.arg.(0)}, #0\n`; +- ` bne {emit_label lbl}\n` ++ ` bne {emit_label lbl}\n`; 2 + | Ifalsetest -> + ` cmp {emit_reg i.arg.(0)}, #0\n`; +- ` beq {emit_label lbl}\n` ++ ` beq {emit_label lbl}\n`; 2 + | Iinttest cmp -> + ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; + let comp = name_for_comparison cmp in +- ` b{emit_string comp} {emit_label lbl}\n` ++ ` b{emit_string comp} {emit_label lbl}\n`; 2 + | Iinttest_imm(cmp, n) -> + ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`; + let comp = name_for_comparison cmp in +- ` b{emit_string comp} {emit_label lbl}\n` ++ ` b{emit_string comp} {emit_label lbl}\n`; 2 + | Ifloattest(cmp, neg) -> +- assert false ++ let comp = (match (cmp, neg) with ++ (Ceq, false) | (Cne, true) -> "eq" ++ | (Cne, false) | (Ceq, true) -> "ne" ++ | (Clt, false) -> "cc" ++ | (Clt, true) -> "cs" ++ | (Cle, false) -> "ls" ++ | (Cle, true) -> "hi" ++ | (Cgt, false) -> "gt" ++ | (Cgt, true) -> "le" ++ | (Cge, false) -> "ge" ++ | (Cge, true) -> "lt") in ++ ` fcmpd {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ ` fmstat\n`; ++ ` b{emit_string comp} {emit_label lbl}\n`; 3 + | Ioddtest -> + ` tst {emit_reg i.arg.(0)}, #1\n`; +- ` bne {emit_label lbl}\n` ++ ` bne {emit_label lbl}\n`; 2 + | Ieventest -> + ` tst {emit_reg i.arg.(0)}, #1\n`; +- ` beq {emit_label lbl}\n` +- end; +- 2 +- | Lcondbranch3(lbl0, lbl1, lbl2) -> ++ ` beq {emit_label lbl}\n`; 2 ++ end ++ | Lcondbranch3(lbl0, lbl1, lbl2) -> + ` cmp {emit_reg i.arg.(0)}, #1\n`; + begin match lbl0 with + None -> () +@@ -495,108 +732,135 @@ let emit_instr i = + | Some lbl -> ` bgt {emit_label lbl}\n` + end; + 4 +- | Lswitch jumptbl -> +- ` ldr pc, [pc, {emit_reg i.arg.(0)}, lsl #2]\n`; +- ` mov r0, r0\n`; (* nop *) +- for i = 0 to Array.length jumptbl - 1 do +- ` .word {emit_label jumptbl.(i)}\n` +- done; +- 2 + Array.length jumptbl ++ | Lswitch jumptbl -> ++ if !arch > ARMv6 && !thumb then begin ++ let lbl = new_label() in ++ ` tbh [pc, {emit_reg i.arg.(0)}]\n`; ++ `{emit_label lbl}:`; ++ for i = 0 to Array.length jumptbl - 1 do ++ ` .short ({emit_label jumptbl.(i)}-{emit_label lbl})/2\n`; ++ done; ++ ` .align 1\n`; ++ 2 + Array.length jumptbl / 2 ++ end else begin ++ if not !pic_code then begin ++ ` ldr pc, [pc, {emit_reg i.arg.(0)}, lsl #2]\n`; ++ ` nop\n`; ++ for i = 0 to Array.length jumptbl - 1 do ++ ` .word {emit_label jumptbl.(i)}\n` ++ done ++ end else begin ++ (* Slightly slower, but position-independent *) ++ ` add pc, pc, {emit_reg i.arg.(0)}, lsl #2\n`; ++ ` nop\n`; ++ for i = 0 to Array.length jumptbl - 1 do ++ ` b {emit_label jumptbl.(i)}\n` ++ done ++ end; ++ 2 + Array.length jumptbl ++ end + | Lsetuptrap lbl -> + ` bl {emit_label lbl}\n`; 1 + | Lpushtrap -> + stack_offset := !stack_offset + 8; +- ` stmfd sp!, \{trap_ptr, lr}\n`; ++ ` push \{trap_ptr, lr}\n`; + ` mov trap_ptr, sp\n`; 2 + | Lpoptrap -> +- ` ldmfd sp!, \{trap_ptr, lr}\n`; ++ ` pop \{trap_ptr, lr}\n`; + stack_offset := !stack_offset - 8; 1 + | Lraise -> +- ` mov sp, trap_ptr\n`; +- ` ldmfd sp!, \{trap_ptr, pc}\n`; 2 ++ if !Clflags.debug then begin ++ ` {emit_call "caml_raise_exn"}\n`; ++ `{record_frame Reg.Set.empty i.dbg}\n`; 1 ++ end else begin ++ ` mov sp, trap_ptr\n`; ++ ` pop \{trap_ptr, pc}\n`; 2 ++ end + + (* Emission of an instruction sequence *) + +-let no_fallthrough = function +- Lop(Itailcall_ind | Itailcall_imm _) -> true +- | Lreturn -> true +- | Lbranch _ -> true +- | Lswitch _ -> true +- | Lraise -> true +- | _ -> false +- + let rec emit_all ninstr i = + if i.desc = Lend then () else begin + let n = emit_instr i in + let ninstr' = ninstr + n in +- let limit = 511 - !num_literals in +- if ninstr' >= limit - 64 && no_fallthrough i.desc then begin +- emit_constants(); ++ (* fldd can address up to +/-1KB, ldr can address up to +/-4KB *) ++ let limit = (if !fpu >= VFPv3_D16 && !float_literals <> [] ++ then 127 ++ else 511) in ++ let limit = limit - !num_literals in ++ if ninstr' >= limit - 64 && not(has_fallthrough i.desc) then begin ++ emit_literals(); + emit_all 0 i.next +- end else +- if ninstr' >= limit then begin ++ end else if !num_literals != 0 && ninstr' >= limit then begin + let lbl = new_label() in + ` b {emit_label lbl}\n`; +- emit_constants(); ++ emit_literals(); + `{emit_label lbl}:\n`; + emit_all 0 i.next + end else + emit_all ninstr' i.next + end + ++(* Emission of the profiling prelude *) ++ ++let emit_profile() = ++ match Config.system with ++ "linux_eabi" | "linux_eabihf" -> ++ ` push \{lr}\n`; ++ ` {emit_call "__gnu_mcount_nc"}\n` ++ | _ -> () ++ + (* Emission of a function declaration *) + + let fundecl fundecl = + function_name := fundecl.fun_name; + fastcode_flag := fundecl.fun_fast; + tailrec_entry_point := new_label(); ++ float_literals := []; ++ gotrel_literals := []; ++ symbol_literals := []; + stack_offset := 0; +- Hashtbl.clear symbol_constants; +- Hashtbl.clear float_constants; ++ call_gc_sites := []; ++ bound_error_sites := []; + ` .text\n`; + ` .align 2\n`; +- ` .global {emit_symbol fundecl.fun_name}\n`; ++ ` .globl {emit_symbol fundecl.fun_name}\n`; ++ if !arch > ARMv6 && !thumb then ++ ` .thumb\n` ++ else ++ ` .arm\n`; + ` .type {emit_symbol fundecl.fun_name}, %function\n`; + `{emit_symbol fundecl.fun_name}:\n`; ++ if !Clflags.gprofile then emit_profile(); + let n = frame_size() in + ignore(emit_stack_adjustment "sub" n); + if !contains_calls then + ` str lr, [sp, #{emit_int(n - 4)}]\n`; + `{emit_label !tailrec_entry_point}:\n`; + emit_all 0 fundecl.fun_body; +- emit_constants() ++ emit_literals(); ++ List.iter emit_call_gc !call_gc_sites; ++ List.iter emit_call_bound_error !bound_error_sites; ++ ` .type {emit_symbol fundecl.fun_name}, %function\n`; ++ ` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n` + + (* Emission of data *) + + let emit_item = function +- Cglobal_symbol s -> +- ` .global {emit_symbol s}\n`; +- | Cdefine_symbol s -> +- `{emit_symbol s}:\n` +- | Cdefine_label lbl -> +- `{emit_label (100000 + lbl)}:\n` +- | Cint8 n -> +- ` .byte {emit_int n}\n` +- | Cint16 n -> +- ` .short {emit_int n}\n` +- | Cint32 n -> +- ` .word {emit_nativeint n}\n` +- | Cint n -> +- ` .word {emit_nativeint n}\n` +- | Csingle f -> +- emit_float32_directive ".long" f +- | Cdouble f -> +- emit_float64_split_directive ".long" f +- | Csymbol_address s -> +- ` .word {emit_symbol s}\n` +- | Clabel_address lbl -> +- ` .word {emit_label (100000 + lbl)}\n` +- | Cstring s -> +- emit_string_directive " .ascii " s +- | Cskip n -> +- if n > 0 then ` .space {emit_int n}\n` +- | Calign n -> +- ` .align {emit_int(Misc.log2 n)}\n` ++ Cglobal_symbol s -> ` .globl {emit_symbol s}\n`; ++ | Cdefine_symbol s -> `{emit_symbol s}:\n` ++ | Cdefine_label lbl -> `{emit_data_label lbl}:\n` ++ | Cint8 n -> ` .byte {emit_int n}\n` ++ | Cint16 n -> ` .short {emit_int n}\n` ++ | Cint32 n -> ` .long {emit_int32 (Nativeint.to_int32 n)}\n` ++ | Cint n -> ` .long {emit_int32 (Nativeint.to_int32 n)}\n` ++ | Csingle f -> ` .single {emit_string f}\n` ++ | Cdouble f -> ` .double {emit_string f}\n` ++ | Csymbol_address s -> ` .word {emit_symbol s}\n` ++ | Clabel_address lbl -> ` .word {emit_data_label lbl}\n` ++ | Cstring s -> emit_string_directive " .ascii " s ++ | Cskip n -> if n > 0 then ` .space {emit_int n}\n` ++ | Calign n -> ` .align {emit_int(Misc.log2 n)}\n` + + let data l = + ` .data\n`; +@@ -605,32 +869,62 @@ let data l = + (* Beginning / end of an assembly file *) + + let begin_assembly() = +- `trap_ptr .req r11\n`; +- `alloc_ptr .req r8\n`; +- `alloc_limit .req r10\n`; ++ ` .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; ++ `trap_ptr .req r8\n`; ++ `alloc_ptr .req r10\n`; ++ `alloc_limit .req r11\n`; + let lbl_begin = Compilenv.make_symbol (Some "data_begin") in + ` .data\n`; +- ` .global {emit_symbol lbl_begin}\n`; ++ ` .globl {emit_symbol lbl_begin}\n`; + `{emit_symbol lbl_begin}:\n`; + let lbl_begin = Compilenv.make_symbol (Some "code_begin") in + ` .text\n`; +- ` .global {emit_symbol lbl_begin}\n`; ++ ` .globl {emit_symbol lbl_begin}\n`; + `{emit_symbol lbl_begin}:\n` + + let end_assembly () = + let lbl_end = Compilenv.make_symbol (Some "code_end") in + ` .text\n`; +- ` .global {emit_symbol lbl_end}\n`; ++ ` .globl {emit_symbol lbl_end}\n`; + `{emit_symbol lbl_end}:\n`; + let lbl_end = Compilenv.make_symbol (Some "data_end") in + ` .data\n`; +- ` .global {emit_symbol lbl_end}\n`; ++ ` .globl {emit_symbol lbl_end}\n`; + `{emit_symbol lbl_end}:\n`; +- ` .word 0\n`; ++ ` .long 0\n`; + let lbl = Compilenv.make_symbol (Some "frametable") in +- ` .data\n`; +- ` .global {emit_symbol lbl}\n`; ++ ` .globl {emit_symbol lbl}\n`; + `{emit_symbol lbl}:\n`; +- ` .word {emit_int (List.length !frame_descriptors)}\n`; +- List.iter emit_frame !frame_descriptors; +- frame_descriptors := [] ++ emit_frames ++ { efa_label = (fun lbl -> ++ ` .type {emit_label lbl}, %function\n`; ++ ` .word {emit_label lbl}\n`); ++ 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_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`; ++ begin match Config.system with ++ "linux_eabihf" | "linux_eabi" -> ++ (* Mark stack as non-executable *) ++ ` .section .note.GNU-stack,\"\",%progbits\n` ++ | _ -> () ++ end +diff --git a/asmcomp/arm/proc.ml b/asmcomp/arm/proc.ml +index e56ac6e..aed2b01 100644 +--- a/asmcomp/arm/proc.ml ++++ b/asmcomp/arm/proc.ml +@@ -1,16 +1,17 @@ + (***********************************************************************) + (* *) +-(* Objective Caml *) ++(* OCaml *) + (* *) +-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) ++(* Benedikt Meurer, University of Siegen *) + (* *) +-(* Copyright 1998 Institut National de Recherche en Informatique et *) +-(* en Automatique. All rights reserved. This file is distributed *) +-(* under the terms of the Q Public License version 1.0. *) ++(* Copyright 1998 Institut National de Recherche en Informatique *) ++(* et en Automatique. Copyright 2012 Benedikt Meurer. All rights *) ++(* reserved. This file is distributed under the terms of the Q *) ++(* Public License version 1.0. *) + (* *) + (***********************************************************************) + +-(* $Id: proc.ml 9252 2009-05-04 13:46:46Z xleroy $ *) ++(* $Id$ *) + + (* Description of the ARM processor *) + +@@ -26,32 +27,56 @@ let word_addressed = false + + (* Registers available for register allocation *) + +-(* Register map: +- r0 - r3 general purpose (not preserved by C) +- r4 - r7 general purpose (preserved) +- r8 allocation pointer (preserved) +- r9 platform register, usually reserved +- r10 allocation limit (preserved) +- r11 trap pointer (preserved) +- r12 general purpose (not preserved by C) +- r13 stack pointer +- r14 return address +- r15 program counter ++(* Integer register map: ++ r0 - r3 general purpose (not preserved) ++ r4 - r7 general purpose (preserved) ++ r8 trap pointer (preserved) ++ r9 platform register, usually reserved ++ r10 allocation pointer (preserved) ++ r11 allocation limit (preserved) ++ r12 intra-procedural scratch register (not preserved) ++ r13 stack pointer ++ r14 return address ++ r15 program counter ++ Floatinng-point register map (VFPv3): ++ d0 - d7 general purpose (not preserved) ++ d8 - d15 general purpose (preserved) ++ d16 - d31 generat purpose (not preserved), VFPv3 only + *) + +-let int_reg_name = [| +- "r0"; "r1"; "r2"; "r3"; "r4"; "r5"; "r6"; "r7"; "r12" +-|] ++let int_reg_name = ++ [| "r0"; "r1"; "r2"; "r3"; "r4"; "r5"; "r6"; "r7"; "r12" |] ++ ++let float_reg_name = ++ [| "d0"; "d1"; "d2"; "d3"; "d4"; "d5"; "d6"; "d7"; ++ "d8"; "d9"; "d10"; "d11"; "d12"; "d13"; "d14"; "d15"; ++ "d16"; "d17"; "d18"; "d19"; "d20"; "d21"; "d22"; "d23"; ++ "d24"; "d25"; "d26"; "d27"; "d28"; "d29"; "d30"; "d31" |] ++ ++(* We have three register classes: ++ 0 for integer registers ++ 1 for VFPv3-D16 ++ 2 for VFPv3 ++ This way we can choose between VFPv3-D16 and VFPv3 ++ at (ocamlopt) runtime using command line switches. ++*) + +-let num_register_classes = 1 ++let num_register_classes = 3 + +-let register_class r = assert (r.typ <> Float); 0 ++let register_class r = ++ match (r.typ, !fpu) with ++ (Int | Addr), _ -> 0 ++ | Float, VFPv3_D16 -> 1 ++ | Float, _ -> 2 + +-let num_available_registers = [| 9 |] ++let num_available_registers = ++ [| 9; 16; 32 |] + +-let first_available_register = [| 0 |] ++let first_available_register = ++ [| 0; 100; 100 |] + +-let register_name r = int_reg_name.(r) ++let register_name r = ++ if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100) + + let rotate_registers = true + +@@ -59,25 +84,34 @@ let rotate_registers = true + + let hard_int_reg = + let v = Array.create 9 Reg.dummy in +- for i = 0 to 8 do v.(i) <- Reg.at_location Int (Reg i) done; ++ for i = 0 to 8 do ++ v.(i) <- Reg.at_location Int (Reg i) ++ done; ++ v ++ ++let hard_float_reg = ++ let v = Array.create 32 Reg.dummy in ++ for i = 0 to 31 do ++ v.(i) <- Reg.at_location Float (Reg(100 + i)) ++ done; + v + +-let all_phys_regs = hard_int_reg ++let all_phys_regs = ++ Array.append hard_int_reg hard_float_reg + +-let phys_reg n = all_phys_regs.(n) ++let phys_reg n = ++ if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100) + + let stack_slot slot ty = +- assert (ty <> Float); + Reg.at_location ty (Stack slot) + + (* Calling conventions *) + +-(* XXX float types have already been expanded into pairs of integers. +- So we cannot align these floats. See if that causes a problem. *) +- +-let calling_conventions first_int last_int make_stack arg = ++let calling_conventions ++ first_int last_int first_float last_float make_stack arg = + let loc = Array.create (Array.length arg) Reg.dummy in + let int = ref first_int in ++ let float = ref first_float in + let ofs = ref 0 in + for i = 0 to Array.length arg - 1 do + match arg.(i).typ with +@@ -90,37 +124,86 @@ let calling_conventions first_int last_int make_stack arg = + ofs := !ofs + size_int + end + | Float -> +- assert false ++ assert (abi = EABI_VFP); ++ assert (!fpu >= VFPv3_D16); ++ if !float <= last_float then begin ++ loc.(i) <- phys_reg !float; ++ incr float ++ 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) ++ (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" + ++(* OCaml calling convention: ++ first integer args in r0...r7 ++ first float args in d0...d15 (EABI+VFP) ++ remaining args on stack. ++ Return values in r0...r7 or d0...d15. *) ++ + let loc_arguments arg = +- calling_conventions 0 7 outgoing arg ++ calling_conventions 0 7 100 115 outgoing arg + let loc_parameters arg = +- let (loc, ofs) = calling_conventions 0 7 incoming arg in loc ++ let (loc, _) = calling_conventions 0 7 100 115 incoming arg in loc + let loc_results res = +- let (loc, ofs) = calling_conventions 0 7 not_supported res in loc ++ let (loc, _) = calling_conventions 0 7 100 115 not_supported res in loc ++ ++(* C calling convention: ++ 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. *) + + let loc_external_arguments arg = +- calling_conventions 0 3 outgoing arg ++ calling_conventions 0 3 100 107 outgoing arg + let loc_external_results res = +- let (loc, ofs) = calling_conventions 0 1 not_supported res in loc ++ let (loc, _) = calling_conventions 0 1 100 100 not_supported res in loc + + let loc_exn_bucket = phys_reg 0 + + (* Registers destroyed by operations *) + +-let destroyed_at_c_call = (* r4-r7 preserved *) +- Array.of_list(List.map phys_reg [0;1;2;3;8]) ++let destroyed_at_alloc = (* r0-r6, d0-d15 preserved *) ++ Array.of_list (List.map ++ phys_reg ++ [7;8; ++ 116;116;118;119;120;121;122;123; ++ 124;125;126;127;128;129;130;131]) ++ ++let destroyed_at_c_call = ++ Array.of_list (List.map ++ phys_reg ++ (match abi with ++ EABI -> (* r4-r7 preserved *) ++ [0;1;2;3;8; ++ 100;101;102;103;104;105;106;107; ++ 108;109;110;111;112;113;114;115; ++ 116;116;118;119;120;121;122;123; ++ 124;125;126;127;128;129;130;131] ++ | EABI_VFP -> (* r4-r7, d8-d15 preserved *) ++ [0;1;2;3;8; ++ 100;101;102;103;104;105;106;107; ++ 116;116;118;119;120;121;122;123; ++ 124;125;126;127;128;129;130;131])) + + let destroyed_at_oper = function +- Iop(Icall_ind | Icall_imm _ | Iextcall(_, true)) -> all_phys_regs +- | Iop(Iextcall(_, false)) -> destroyed_at_c_call +- | Iop(Ialloc(_)) -> [|phys_reg 8|] (* r12 destroyed *) ++ Iop(Icall_ind | Icall_imm _ ) ++ | Iop(Iextcall(_, true)) -> ++ all_phys_regs ++ | Iop(Iextcall(_, false)) -> ++ destroyed_at_c_call ++ | Iop(Ialloc n) -> ++ destroyed_at_alloc ++ | Iop(Iconst_symbol _) when !pic_code -> ++ [|phys_reg 3; phys_reg 8|] (* r3 and r12 destroyed *) ++ | Iop(Iintoffloat | Ifloatofint | Iload(Single, _) | Istore(Single, _)) -> ++ [|phys_reg 107|] (* d7 (s14-s15) destroyed *) + | _ -> [||] + + let destroyed_at_raise = all_phys_regs +@@ -128,15 +211,16 @@ let destroyed_at_raise = all_phys_regs + (* Maximal register pressure *) + + let safe_register_pressure = function +- Iextcall(_, _) -> 4 ++ Iextcall(_, _) -> 5 + | _ -> 9 ++ + let max_register_pressure = function +- Iextcall(_, _) -> [| 4 |] +- | _ -> [| 9 |] ++ Iextcall(_, _) -> [| 5; 9; 9 |] ++ | _ -> [| 9; 16; 32 |] + + (* Layout of the stack *) + +-let num_stack_slots = [| 0 |] ++let num_stack_slots = [| 0; 0; 0 |] + let contains_calls = ref false + + (* Calling the assembler *) +@@ -144,6 +228,3 @@ let contains_calls = ref false + let assemble_file infile outfile = + Ccomp.command (Config.asm ^ " -o " ^ + Filename.quote outfile ^ " " ^ Filename.quote infile) +- +-open Clflags;; +-open Config;; +diff --git a/asmcomp/arm/reload.ml b/asmcomp/arm/reload.ml +index 0917438..c5b137a 100644 +--- a/asmcomp/arm/reload.ml ++++ b/asmcomp/arm/reload.ml +@@ -1,6 +1,6 @@ + (***********************************************************************) + (* *) +-(* Objective Caml *) ++(* OCaml *) + (* *) + (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) + (* *) +@@ -10,7 +10,7 @@ + (* *) + (***********************************************************************) + +-(* $Id: reload.ml 2553 1999-11-17 18:59:06Z xleroy $ *) ++(* $Id$ *) + + (* Reloading for the ARM *) + +diff --git a/asmcomp/arm/scheduling.ml b/asmcomp/arm/scheduling.ml +index 930e1bc..4b47733 100644 +--- a/asmcomp/arm/scheduling.ml ++++ b/asmcomp/arm/scheduling.ml +@@ -1,51 +1,79 @@ + (***********************************************************************) + (* *) +-(* Objective Caml *) ++(* OCaml *) + (* *) +-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) ++(* Benedikt Meurer, University of Siegen *) + (* *) +-(* Copyright 1996 Institut National de Recherche en Informatique et *) +-(* en Automatique. All rights reserved. This file is distributed *) +-(* under the terms of the Q Public License version 1.0. *) ++(* Copyright 1998 Institut National de Recherche en Informatique *) ++(* et en Automatique. Copyright 2012 Benedikt Meurer. All rights *) ++(* reserved. This file is distributed under the terms of the Q *) ++(* Public License version 1.0. *) + (* *) + (***********************************************************************) + +-(* $Id: scheduling.ml 2553 1999-11-17 18:59:06Z xleroy $ *) ++(* $Id$ *) + ++open Arch + open Mach + +-(* Instruction scheduling for the Sparc *) ++(* Instruction scheduling for the ARM *) + +-class scheduler = object ++class scheduler = object(self) + +-inherit Schedgen.scheduler_generic ++inherit Schedgen.scheduler_generic as super + +-(* Scheduling -- based roughly on the Strong ARM *) ++(* Scheduling -- based roughly on the ARM11 (ARMv6) *) + + method oper_latency = function +- Ireload -> 2 +- | Iload(_, _) -> 2 +- | Iconst_symbol _ -> 2 (* turned into a load *) +- | Iconst_float _ -> 2 (* turned into a load *) +- | Iintop(Imul) -> 3 +- | Iintop_imm(Imul, _) -> 3 +- (* No data available for floatops, let's make educated guesses *) +- | Iaddf -> 3 +- | Isubf -> 3 +- | Imulf -> 5 +- | Idivf -> 15 ++ (* Loads have a latency of two cycles in general *) ++ Iconst_symbol _ ++ | Iconst_float _ ++ | Iload(_, _) ++ | Ireload ++ | Ifloatofint (* mcr/mrc count as memory access *) ++ | Iintoffloat -> 2 ++ (* Multiplys have a latency of two cycles *) ++ | Iintop Imul ++ | Ispecific(Imuladd | Imulsub) -> 2 ++ (* VFP instructions *) ++ | Iaddf ++ | Isubf ++ | Idivf ++ | Imulf | Ispecific Inegmulf ++ | Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf) ++ | Ispecific Isqrtf ++ | Inegf | Iabsf when !fpu >= VFPv3_D16 -> 2 ++ (* Everything else *) + | _ -> 1 + +-(* Issue cycles. Rough approximations *) ++method! is_checkbound = function ++ Ispecific(Ishiftcheckbound _) -> true ++ | op -> super#is_checkbound op ++ ++(* Issue cycles. Rough approximations *) + + method oper_issue_cycles = function + Ialloc _ -> 4 +- | Iintop(Icomp _) -> 3 +- | Iintop(Icheckbound) -> 2 +- | Iintop_imm(Idiv, _) -> 4 +- | Iintop_imm(Imod, _) -> 6 ++ | Iintop(Ilsl | Ilsr | Iasr) -> 2 ++ | Iintop(Icomp _) + | Iintop_imm(Icomp _, _) -> 3 ++ | Iintop(Icheckbound) + | Iintop_imm(Icheckbound, _) -> 2 ++ | Ispecific(Ishiftcheckbound _) -> 3 ++ | Iintop_imm(Idiv, _) -> 4 ++ | Iintop_imm(Imod, _) -> 6 ++ | Iintop Imul ++ | Ispecific(Imuladd | Imulsub) -> 2 ++ (* VFP instructions *) ++ | Iaddf ++ | Isubf -> 7 ++ | Imulf ++ | Ispecific Inegmulf -> 9 ++ | Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf) -> 17 ++ | Idivf ++ | Ispecific Isqrtf -> 27 ++ | Inegf | Iabsf | Iconst_float _ when !fpu >= VFPv3_D16 -> 4 ++ (* Everything else *) + | _ -> 1 + + end +diff --git a/asmcomp/arm/selection.ml b/asmcomp/arm/selection.ml +index f09d146..94d0367 100644 +--- a/asmcomp/arm/selection.ml ++++ b/asmcomp/arm/selection.ml +@@ -1,54 +1,77 @@ + (***********************************************************************) + (* *) +-(* Objective Caml *) ++(* OCaml *) + (* *) +-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) ++(* Benedikt Meurer, University of Siegen *) + (* *) +-(* Copyright 1998 Institut National de Recherche en Informatique et *) +-(* en Automatique. All rights reserved. This file is distributed *) +-(* under the terms of the Q Public License version 1.0. *) ++(* Copyright 1998 Institut National de Recherche en Informatique *) ++(* et en Automatique. Copyright 2012 Benedikt Meurer. All rights *) ++(* reserved. This file is distributed under the terms of the Q *) ++(* Public License version 1.0. *) + (* *) + (***********************************************************************) + +-(* $Id: selection.ml 10295 2010-04-22 12:39:40Z xleroy $ *) ++(* $Id$ *) + + (* Instruction selection for the ARM processor *) + +-open Misc +-open Cmm +-open Reg + open Arch +-open Proc ++open Cmm + open Mach ++open Misc ++open Proc ++open Reg + +-(* Immediate operands are 8-bit immediate values, zero-extended, and rotated +- right by 0, 2, 4, ... 30 bits. +- To avoid problems with Caml's 31-bit arithmetic, +- we check only with 8-bit values shifted left 0 to 22 bits. *) +- +-let rec is_immed n shift = +- if shift > 22 then false +- else if n land (0xFF lsl shift) = n then true +- else is_immed n (shift + 2) ++let is_offset chunk n = ++ match chunk with ++ (* VFPv3 load/store have -1020 to 1020 *) ++ Single | Double | Double_u ++ when !fpu >= VFPv3_D16 -> ++ n >= -1020 && n <= 1020 ++ (* ARM load/store byte/word have -4095 to 4095 *) ++ | Byte_unsigned | Byte_signed ++ | Thirtytwo_unsigned | Thirtytwo_signed ++ | Word | Single ++ when not !thumb -> ++ n >= -4095 && n <= 4095 ++ (* Thumb-2 load/store have -255 to 4095 *) ++ | _ when !arch > ARMv6 && !thumb -> ++ n >= -255 && n <= 4095 ++ (* Everything else has -255 to 255 *) ++ | _ -> ++ n >= -255 && n <= 255 + +-(* We have 12-bit + sign byte offsets for word accesses, +- 8-bit + sign word offsets for float accesses, +- and 8-bit + sign byte offsets for bytes and shorts. +- Use lowest common denominator. *) ++let is_intconst = function ++ Cconst_int _ -> true ++ | _ -> false + +-let is_offset n = n < 256 && n > -256 ++(* Special constraints on operand and result registers *) + +-let is_intconst = function Cconst_int n -> true | _ -> false ++exception Use_default + +-(* Soft emulation of float comparisons *) ++let r1 = phys_reg 1 + +-let float_comparison_function = function +- | Ceq -> "__eqdf2" +- | Cne -> "__nedf2" +- | Clt -> "__ltdf2" +- | Cle -> "__ledf2" +- | Cgt -> "__gtdf2" +- | Cge -> "__gedf2" ++let pseudoregs_for_operation op arg res = ++ match op with ++ (* For mul rd,rm,rs and mla rd,rm,rs,ra (pre-ARMv6) the registers rm ++ and rd must be different. We deal with this by pretending that rm ++ is also a result of the mul / mla operation. *) ++ Iintop Imul | Ispecific Imuladd when !arch < ARMv6 -> ++ (arg, [| res.(0); arg.(0) |]) ++ (* Soft-float Iabsf and Inegf: arg.(0) and res.(0) must be the same *) ++ | Iabsf | Inegf when !fpu = Soft -> ++ ([|res.(0); arg.(1)|], res) ++ (* VFPv3 Imuladdf...Inegmulsubf: arg.(0) and res.(0) must be the same *) ++ | Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf) -> ++ let arg' = Array.copy arg in ++ arg'.(0) <- res.(0); ++ (arg', res) ++ (* We use __aeabi_idivmod for Cmodi only, and hence we care only ++ for the remainder in r1, so fix up the destination register. *) ++ | Iextcall("__aeabi_idivmod", false) -> ++ (arg, [|r1|]) ++ (* Other instructions are regular *) ++ | _ -> raise Use_default + + (* Instruction selection *) + class selector = object(self) +@@ -56,23 +79,32 @@ class selector = object(self) + inherit Selectgen.selector_generic as super + + method! regs_for tyv = +- (* Expand floats into pairs of integer registers *) +- let nty = Array.length tyv in +- let rec expand i = +- if i >= nty then [] else begin +- match tyv.(i) with +- | Float -> Int :: Int :: expand (i+1) +- | ty -> ty :: expand (i+1) +- end in +- Reg.createv (Array.of_list (expand 0)) ++ Reg.createv (if !fpu = Soft then begin ++ (* Expand floats into pairs of integer registers *) ++ let rec expand = function ++ [] -> [] ++ | Float :: tyl -> Int :: Int :: expand tyl ++ | ty :: tyl -> ty :: expand tyl in ++ Array.of_list (expand (Array.to_list tyv)) ++ end else begin ++ tyv ++ end) + + method is_immediate n = +- n land 0xFF = n || is_immed n 2 ++ is_immediate (Int32.of_int n) ++ ++method! is_simple_expr = function ++ (* inlined floating-point ops are simple if their arguments are *) ++ | Cop(Cextcall("sqrt", _, _, _), args) when !fpu >= VFPv3_D16 -> ++ List.for_all self#is_simple_expr args ++ | e -> super#is_simple_expr e + +-method select_addressing = function +- Cop(Cadda, [arg; Cconst_int n]) when is_offset n -> ++method select_addressing chunk = function ++ | Cop(Cadda, [arg; Cconst_int n]) ++ when is_offset chunk n -> + (Iindexed n, arg) +- | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])]) when is_offset n -> ++ | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])]) ++ when is_offset chunk n -> + (Iindexed n, Cop(Cadda, [arg1; arg2])) + | arg -> + (Iindexed 0, arg) +@@ -91,109 +123,146 @@ method select_shift_arith op shiftop shiftrevop args = + | [Cop(Casr, [arg1; Cconst_int n]); arg2] + when n > 0 && n < 32 && not(is_intconst arg1) -> + (Ispecific(Ishiftarith(shiftrevop, -n)), [arg2; arg1]) +- | _ -> +- super#select_operation op args ++ | args -> ++ begin match super#select_operation op args with ++ (* Recognize multiply and add *) ++ (Iintop Iadd, [Cop(Cmuli, args); arg3]) ++ | (Iintop Iadd, [arg3; Cop(Cmuli, args)]) as op_args -> ++ begin match self#select_operation Cmuli args with ++ (Iintop Imul, [arg1; arg2]) -> ++ (Ispecific Imuladd, [arg1; arg2; arg3]) ++ | _ -> op_args ++ end ++ (* Recognize multiply and subtract *) ++ | (Iintop Isub, [arg3; Cop(Cmuli, args)]) as op_args ++ when !arch > ARMv6 -> ++ begin match self#select_operation Cmuli args with ++ (Iintop Imul, [arg1; arg2]) -> ++ (Ispecific Imulsub, [arg1; arg2; arg3]) ++ | _ -> op_args ++ end ++ | op_args -> op_args ++ end + + method! select_operation op args = +- match op with +- Cadda | Caddi -> +- begin match args with +- [arg1; Cconst_int n] when n < 0 && self#is_immediate (-n) -> +- (Iintop_imm(Isub, -n), [arg1]) +- | _ -> +- self#select_shift_arith op Ishiftadd Ishiftadd args +- end +- | Csuba | Csubi -> +- begin match args with +- [arg1; Cconst_int n] when n < 0 && self#is_immediate (-n) -> +- (Iintop_imm(Iadd, -n), [arg1]) +- | [Cconst_int n; arg2] when self#is_immediate n -> +- (Ispecific(Irevsubimm n), [arg2]) +- | _ -> +- self#select_shift_arith op Ishiftsub Ishiftsubrev args +- end +- | Cmuli -> (* no multiply immediate *) ++ match (op, args) with ++ (* Recognize special shift arithmetic *) ++ ((Cadda | Caddi), [arg; Cconst_int n]) ++ when n < 0 && self#is_immediate (-n) -> ++ (Iintop_imm(Isub, -n), [arg]) ++ | ((Cadda | Caddi as op), args) -> ++ self#select_shift_arith op Ishiftadd Ishiftadd args ++ | ((Csuba | Csubi), [arg; Cconst_int n]) ++ when n < 0 && self#is_immediate (-n) -> ++ (Iintop_imm(Iadd, -n), [arg]) ++ | ((Csuba | Csubi), [Cconst_int n; arg]) ++ when self#is_immediate n -> ++ (Ispecific(Irevsubimm n), [arg]) ++ | ((Csuba | Csubi as op), args) -> ++ self#select_shift_arith op Ishiftsub Ishiftsubrev args ++ | (Ccheckbound _, [Cop(Clsr, [arg1; Cconst_int n]); arg2]) ++ when n > 0 && n < 32 && not(is_intconst arg2) -> ++ (Ispecific(Ishiftcheckbound n), [arg1; arg2]) ++ (* ARM does not support immediate operands for multiplication *) ++ | (Cmuli, args) -> + (Iintop Imul, args) +- | Cdivi -> +- begin match args with +- [arg1; Cconst_int n] when n = 1 lsl (Misc.log2 n) -> +- (Iintop_imm(Idiv, n), [arg1]) +- | _ -> +- (Iextcall("__divsi3", false), args) +- end +- | Cmodi -> +- begin match args with +- [arg1; Cconst_int n] when n = 1 lsl (Misc.log2 n) -> +- (Iintop_imm(Imod, n), [arg1]) +- | _ -> +- (Iextcall("__modsi3", false), args) +- end +- | Ccheckbound _ -> +- begin match args with +- [Cop(Clsr, [arg1; Cconst_int n]); arg2] +- when n > 0 && n < 32 && not(is_intconst arg2) -> +- (Ispecific(Ishiftcheckbound n), [arg1; arg2]) +- | _ -> +- super#select_operation op args +- end +- (* Turn floating-point operations into library function calls *) +- | Caddf -> (Iextcall("__adddf3", false), args) +- | Csubf -> (Iextcall("__subdf3", false), args) +- | Cmulf -> (Iextcall("__muldf3", false), args) +- | Cdivf -> (Iextcall("__divdf3", false), args) +- | Cfloatofint -> (Iextcall("__floatsidf", false), args) +- | Cintoffloat -> (Iextcall("__fixdfsi", false), args) +- | Ccmpf comp -> +- (Iintop_imm(Icomp(Isigned comp), 0), +- [Cop(Cextcall(float_comparison_function comp, +- typ_int, false, Debuginfo.none), +- args)]) ++ (* Turn integer division/modulus into runtime ABI calls *) ++ | (Cdivi, [arg; Cconst_int n]) ++ when n = 1 lsl Misc.log2 n -> ++ (Iintop_imm(Idiv, n), [arg]) ++ | (Cdivi, args) -> ++ (Iextcall("__aeabi_idiv", false), args) ++ | (Cmodi, [arg; Cconst_int n]) ++ when n = 1 lsl Misc.log2 n -> ++ (Iintop_imm(Imod, n), [arg]) ++ | (Cmodi, args) -> ++ (* See above for fix up of return register *) ++ (Iextcall("__aeabi_idivmod", false), args) ++ (* Turn floating-point operations into runtime ABI calls for softfp *) ++ | (op, args) when !fpu = Soft -> self#select_operation_softfp op args ++ (* Select operations for VFPv3 *) ++ | (op, args) -> self#select_operation_vfpv3 op args ++ ++method private select_operation_softfp op args = ++ match (op, args) with ++ (* Turn floating-point operations into runtime ABI calls *) ++ | (Caddf, args) -> (Iextcall("__aeabi_dadd", false), args) ++ | (Csubf, args) -> (Iextcall("__aeabi_dsub", false), args) ++ | (Cmulf, args) -> (Iextcall("__aeabi_dmul", false), args) ++ | (Cdivf, args) -> (Iextcall("__aeabi_ddiv", false), args) ++ | (Cfloatofint, args) -> (Iextcall("__aeabi_i2d", false), args) ++ | (Cintoffloat, args) -> (Iextcall("__aeabi_d2iz", false), args) ++ | (Ccmpf comp, args) -> ++ let func = (match comp with ++ Cne (* there's no __aeabi_dcmpne *) ++ | Ceq -> "__aeabi_dcmpeq" ++ | Clt -> "__aeabi_dcmplt" ++ | Cle -> "__aeabi_dcmple" ++ | Cgt -> "__aeabi_dcmpgt" ++ | Cge -> "__aeabi_dcmpge") in ++ let comp = (match comp with ++ Cne -> Ceq (* eq 0 => false *) ++ | _ -> Cne (* ne 0 => true *)) in ++ (Iintop_imm(Icomp(Iunsigned comp), 0), ++ [Cop(Cextcall(func, typ_int, false, Debuginfo.none), args)]) + (* Add coercions around loads and stores of 32-bit floats *) +- | Cload Single -> +- (Iextcall("__extendsfdf2", false), [Cop(Cload Word, args)]) +- | Cstore Single -> +- begin match args with +- | [arg1; arg2] -> +- let arg2' = +- Cop(Cextcall("__truncdfsf2", typ_int, false, Debuginfo.none), +- [arg2]) in +- self#select_operation (Cstore Word) [arg1; arg2'] +- | _ -> assert false +- end ++ | (Cload Single, args) -> ++ (Iextcall("__aeabi_f2d", false), [Cop(Cload Word, args)]) ++ | (Cstore Single, [arg1; arg2]) -> ++ let arg2' = ++ Cop(Cextcall("__aeabi_d2f", typ_int, false, Debuginfo.none), ++ [arg2]) in ++ self#select_operation (Cstore Word) [arg1; arg2'] + (* Other operations are regular *) +- | _ -> super#select_operation op args ++ | (op, args) -> super#select_operation op args ++ ++method private select_operation_vfpv3 op args = ++ match (op, args) with ++ (* Recognize floating-point negate and multiply *) ++ (Cnegf, [Cop(Cmulf, args)]) -> ++ (Ispecific Inegmulf, args) ++ (* Recognize floating-point multiply and add *) ++ | (Caddf, [arg; Cop(Cmulf, args)]) ++ | (Caddf, [Cop(Cmulf, args); arg]) -> ++ (Ispecific Imuladdf, arg :: args) ++ (* Recognize floating-point negate, multiply and subtract *) ++ | (Csubf, [Cop(Cnegf, [arg]); Cop(Cmulf, args)]) ++ | (Csubf, [Cop(Cnegf, [Cop(Cmulf, args)]); arg]) -> ++ (Ispecific Inegmulsubf, arg :: args) ++ (* Recognize floating-point negate, multiply and add *) ++ | (Csubf, [arg; Cop(Cmulf, args)]) -> ++ (Ispecific Inegmuladdf, arg :: args) ++ (* Recognize multiply and subtract *) ++ | (Csubf, [Cop(Cmulf, args); arg]) -> ++ (Ispecific Imulsubf, arg :: args) ++ (* Recognize floating-point square root *) ++ | (Cextcall("sqrt", _, false, _), args) -> ++ (Ispecific Isqrtf, args) ++ (* Other operations are regular *) ++ | (op, args) -> super#select_operation op args + + method! select_condition = function +- | Cop(Ccmpf cmp, args) -> +- (Iinttest_imm(Isigned cmp, 0), +- Cop(Cextcall(float_comparison_function cmp, +- typ_int, false, Debuginfo.none), +- args)) ++ (* Turn floating-point comparisons into runtime ABI calls *) ++ Cop(Ccmpf _ as op, args) when !fpu = Soft -> ++ begin match self#select_operation_softfp op args with ++ (Iintop_imm(Icomp(Iunsigned Ceq), 0), [arg]) -> (Ifalsetest, arg) ++ | (Iintop_imm(Icomp(Iunsigned Cne), 0), [arg]) -> (Itruetest, arg) ++ | _ -> assert false ++ end + | expr -> + super#select_condition expr + +-(* Deal with some register irregularities: +- +-1- In mul rd, rm, rs, the registers rm and rd must be different. +- We deal with this by pretending that rm is also a result of the mul +- operation. +- +-2- For Inegf and Iabsf, force arguments and results in (r0, r1); +- this simplifies code generation later. +-*) ++(* Deal with some register constraints *) + + method! insert_op_debug op dbg rs rd = +- match op with +- | Iintop(Imul) -> +- self#insert_debug (Iop op) dbg rs [| rd.(0); rs.(0) |]; rd +- | Iabsf | Inegf -> +- let r = [| phys_reg 0; phys_reg 1 |] in +- self#insert_moves rs r; +- self#insert_debug (Iop op) dbg r r; +- self#insert_moves r rd; +- rd +- | _ -> +- super#insert_op_debug op dbg rs rd ++ try ++ let (rsrc, rdst) = pseudoregs_for_operation op rs rd in ++ self#insert_moves rs rsrc; ++ self#insert_debug (Iop op) dbg rsrc rdst; ++ self#insert_moves rdst rd; ++ rd ++ with Use_default -> ++ super#insert_op_debug op dbg rs rd + + end + +diff --git a/asmcomp/i386/selection.ml b/asmcomp/i386/selection.ml +index 1700bf3..827a63d 100644 +--- a/asmcomp/i386/selection.ml ++++ b/asmcomp/i386/selection.ml +@@ -168,7 +168,7 @@ method! is_simple_expr e = + | _ -> + super#is_simple_expr e + +-method select_addressing exp = ++method select_addressing chunk exp = + match select_addr exp with + (Asymbol s, d) -> + (Ibased(s, d), Ctuple []) +@@ -200,7 +200,7 @@ method! select_operation op args = + match op with + (* Recognize the LEA instruction *) + Caddi | Cadda | Csubi | Csuba -> +- begin match self#select_addressing (Cop(op, args)) with ++ begin match self#select_addressing Word (Cop(op, args)) with + (Iindexed d, _) -> super#select_operation op args + | (Iindexed2 0, _) -> super#select_operation op args + | (addr, arg) -> (Ispecific(Ilea addr), [arg]) +@@ -233,7 +233,7 @@ method! select_operation op args = + begin match args with + [loc; Cop(Caddi, [Cop(Cload _, [loc']); Cconst_int n])] + when loc = loc' -> +- let (addr, arg) = self#select_addressing loc in ++ let (addr, arg) = self#select_addressing Word loc in + (Ispecific(Ioffset_loc(n, addr)), [arg]) + | _ -> + super#select_operation op args +@@ -250,11 +250,11 @@ method! select_operation op args = + method select_floatarith regular_op reversed_op mem_op mem_rev_op args = + match args with + [arg1; Cop(Cload chunk, [loc2])] -> +- let (addr, arg2) = self#select_addressing loc2 in ++ let (addr, arg2) = self#select_addressing chunk loc2 in + (Ispecific(Ifloatarithmem(chunk_double chunk, mem_op, addr)), + [arg1; arg2]) + | [Cop(Cload chunk, [loc1]); arg2] -> +- let (addr, arg1) = self#select_addressing loc1 in ++ let (addr, arg1) = self#select_addressing chunk loc1 in + (Ispecific(Ifloatarithmem(chunk_double chunk, mem_rev_op, addr)), + [arg2; arg1]) + | [arg1; arg2] -> +@@ -295,10 +295,10 @@ method select_push exp = + | Cconst_natpointer n -> (Ispecific(Ipush_int n), Ctuple []) + | Cconst_symbol s -> (Ispecific(Ipush_symbol s), Ctuple []) + | Cop(Cload Word, [loc]) -> +- let (addr, arg) = self#select_addressing loc in ++ let (addr, arg) = self#select_addressing Word loc in + (Ispecific(Ipush_load addr), arg) + | Cop(Cload Double_u, [loc]) -> +- let (addr, arg) = self#select_addressing loc in ++ let (addr, arg) = self#select_addressing Double_u loc in + (Ispecific(Ipush_load_float addr), arg) + | _ -> (Ispecific(Ipush), exp) + +diff --git a/asmcomp/power/selection.ml b/asmcomp/power/selection.ml +index ed15efb..0532d6b 100644 +--- a/asmcomp/power/selection.ml ++++ b/asmcomp/power/selection.ml +@@ -52,7 +52,7 @@ inherit Selectgen.selector_generic as super + + method is_immediate n = (n <= 32767) && (n >= -32768) + +-method select_addressing exp = ++method select_addressing chunk exp = + match select_addr exp with + (Asymbol s, d) -> + (Ibased(s, d), Ctuple []) +diff --git a/asmcomp/power64/selection.ml b/asmcomp/power64/selection.ml +index afc7649..18b5318 100644 +--- a/asmcomp/power64/selection.ml ++++ b/asmcomp/power64/selection.ml +@@ -52,7 +52,7 @@ inherit Selectgen.selector_generic as super + + method is_immediate n = (n <= 32767) && (n >= -32768) + +-method select_addressing exp = ++method select_addressing chunk exp = + match select_addr exp with + (Asymbol s, d) -> + (Ibased(s, d), Ctuple []) +diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml +index 2fc40f7..0bc9efb 100644 +--- a/asmcomp/selectgen.ml ++++ b/asmcomp/selectgen.ml +@@ -204,7 +204,7 @@ method virtual is_immediate : int -> bool + (* Selection of addressing modes *) + + method virtual select_addressing : +- Cmm.expression -> Arch.addressing_mode * Cmm.expression ++ Cmm.memory_chunk -> Cmm.expression -> Arch.addressing_mode * Cmm.expression + + (* Default instruction selection for stores (of words) *) + +@@ -219,10 +219,10 @@ method select_operation op args = + | (Capply(ty, dbg), _) -> (Icall_ind, args) + | (Cextcall(s, ty, alloc, dbg), _) -> (Iextcall(s, alloc), args) + | (Cload chunk, [arg]) -> +- let (addr, eloc) = self#select_addressing arg in ++ let (addr, eloc) = self#select_addressing chunk arg in + (Iload(chunk, addr), [eloc]) + | (Cstore chunk, [arg1; arg2]) -> +- let (addr, eloc) = self#select_addressing arg1 in ++ let (addr, eloc) = self#select_addressing chunk arg1 in + if chunk = Word then begin + let (op, newarg2) = self#select_store addr arg2 in + (op, [newarg2; eloc]) +@@ -366,7 +366,7 @@ method insert_move src dst = + self#insert (Iop Imove) [|src|] [|dst|] + + method insert_moves src dst = +- for i = 0 to Array.length src - 1 do ++ for i = 0 to min (Array.length src) (Array.length dst) - 1 do + self#insert_move src.(i) dst.(i) + done + +@@ -490,9 +490,8 @@ method emit_expr env exp = + let (loc_arg, stack_ofs) = + self#emit_extcall_args env new_args in + let rd = self#regs_for ty in +- let loc_res = Proc.loc_external_results rd in +- self#insert_debug (Iop(Iextcall(lbl, alloc))) dbg +- loc_arg loc_res; ++ let loc_res = self#insert_op_debug (Iextcall(lbl, alloc)) dbg ++ loc_arg (Proc.loc_external_results rd) in + self#insert_move_results loc_res rd stack_ofs; + Some rd + | Ialloc _ -> +diff --git a/asmcomp/selectgen.mli b/asmcomp/selectgen.mli +index ae53cda..69dae6d 100644 +--- a/asmcomp/selectgen.mli ++++ b/asmcomp/selectgen.mli +@@ -26,7 +26,7 @@ class virtual selector_generic : object + (* Must be defined to indicate whether a constant is a suitable + immediate operand to arithmetic instructions *) + method virtual select_addressing : +- Cmm.expression -> Arch.addressing_mode * Cmm.expression ++ Cmm.memory_chunk -> Cmm.expression -> Arch.addressing_mode * Cmm.expression + (* Must be defined to select addressing modes *) + method is_simple_expr: Cmm.expression -> bool + (* Can be overridden to reflect special extcalls known to be pure *) +diff --git a/asmcomp/sparc/selection.ml b/asmcomp/sparc/selection.ml +index 82758dc..c1f30fd 100644 +--- a/asmcomp/sparc/selection.ml ++++ b/asmcomp/sparc/selection.ml +@@ -26,7 +26,7 @@ inherit Selectgen.selector_generic as super + + method is_immediate n = (n <= 4095) && (n >= -4096) + +-method select_addressing = function ++method select_addressing chunk = function + Cconst_symbol s -> + (Ibased(s, 0), Ctuple []) + | Cop(Cadda, [Cconst_symbol s; Cconst_int n]) -> +diff --git a/asmrun/arm.S b/asmrun/arm.S +index 1313e9c..6482956 100644 +--- a/asmrun/arm.S ++++ b/asmrun/arm.S +@@ -1,286 +1,411 @@ + /***********************************************************************/ + /* */ +-/* Objective Caml */ ++/* OCaml */ + /* */ +-/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ ++/* Benedikt Meurer, University of Siegen */ + /* */ +-/* Copyright 1998 Institut National de Recherche en Informatique et */ +-/* en Automatique. All rights reserved. This file is distributed */ +-/* under the terms of the GNU Library General Public License, with */ +-/* the special exception on linking described in file ../LICENSE. */ ++/* Copyright 1998 Institut National de Recherche en Informatique */ ++/* et en Automatique. Copyright 2012 Benedikt Meurer. All rights */ ++/* reserved. This file is distributed under the terms of the GNU */ ++/* Library General Public License, with the special exception on */ ++/* linking described in file ../LICENSE. */ + /* */ + /***********************************************************************/ + +-/* $Id: arm.S 9252 2009-05-04 13:46:46Z xleroy $ */ ++/* $Id$ */ + + /* Asm part of the runtime system, ARM processor */ ++/* Must be preprocessed by cpp */ + +-trap_ptr .req r11 +-alloc_ptr .req r8 +-alloc_limit .req r10 +- ++ .syntax unified + .text ++#if defined(SYS_linux_eabihf) ++ .arch armv7-a ++ .fpu vfpv3-d16 ++ .thumb ++#elif defined(SYS_linux_eabi) ++ .arch armv4t ++ .arm ++ ++ /* Compatibility macros */ ++ .macro blx reg ++ mov lr, pc ++ bx \reg ++ .endm ++ .macro cbz reg, lbl ++ cmp \reg, #0 ++ beq \lbl ++ .endm ++ .macro vpop regs ++ .endm ++ .macro vpush regs ++ .endm ++#endif ++ ++trap_ptr .req r8 ++alloc_ptr .req r10 ++alloc_limit .req r11 ++ ++/* Support for profiling with gprof */ ++ ++#if defined(PROFILING) && (defined(SYS_linux_eabihf) || defined(SYS_linux_eabi)) ++#define PROFILE \ ++ push {lr}; \ ++ bl __gnu_mcount_nc ++#else ++#define PROFILE ++#endif + + /* Allocation functions and GC interface */ + +- .globl caml_call_gc ++ .globl caml_system__code_begin ++caml_system__code_begin: ++ ++ .align 2 ++ .globl caml_call_gc + .type caml_call_gc, %function + caml_call_gc: +- /* Record return address and desired size */ +- /* Can use alloc_limit as a temporary since it will be reloaded by +- invoke_gc */ +- ldr alloc_limit, .Lcaml_last_return_address +- str lr, [alloc_limit, #0] +- ldr alloc_limit, .Lcaml_requested_size +- str r12, [alloc_limit, #0] +- /* Branch to shared GC code */ +- bl .Linvoke_gc +- /* Finish allocation */ +- ldr r12, .Lcaml_requested_size +- ldr r12, [r12, #0] +- sub alloc_ptr, alloc_ptr, r12 ++ PROFILE ++ /* Record return address */ ++ ldr r12, =caml_last_return_address ++ str lr, [r12] ++.Lcaml_call_gc: ++ /* Record lowest stack address */ ++ ldr r12, =caml_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 ++ str sp, [r12] ++ /* Save current allocation pointer for debugging purposes */ ++ ldr alloc_limit, =caml_young_ptr ++ str alloc_ptr, [alloc_limit] ++ /* Save trap pointer in case an exception is raised during GC */ ++ ldr r12, =caml_exception_pointer ++ str trap_ptr, [r12] ++ /* Call the garbage collector */ ++ bl 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 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 + +- .globl caml_alloc1 ++ .align 2 ++ .globl caml_alloc1 + .type caml_alloc1, %function + caml_alloc1: +- sub alloc_ptr, alloc_ptr, #8 ++ PROFILE ++.Lcaml_alloc1: ++ sub alloc_ptr, alloc_ptr, 8 + cmp alloc_ptr, alloc_limit +- movcs pc, lr /* Return if alloc_ptr >= alloc_limit */ +- /* Record return address */ +- ldr r12, .Lcaml_last_return_address +- str lr, [r12, #0] +- /* Invoke GC */ +- bl .Linvoke_gc ++ bcc 1f ++ bx lr ++1: /* Record return address */ ++ ldr r7, =caml_last_return_address ++ str lr, [r7] ++ /* Call GC (preserves r7) */ ++ bl .Lcaml_call_gc ++ /* Restore return address */ ++ ldr lr, [r7] + /* Try again */ +- b caml_alloc1 ++ b .Lcaml_alloc1 ++ .type caml_alloc1, %function ++ .size caml_alloc1, .-caml_alloc1 + +- .globl caml_alloc2 ++ .align 2 ++ .globl caml_alloc2 + .type caml_alloc2, %function + caml_alloc2: +- sub alloc_ptr, alloc_ptr, #12 ++ PROFILE ++.Lcaml_alloc2: ++ sub alloc_ptr, alloc_ptr, 12 + cmp alloc_ptr, alloc_limit +- movcs pc, lr /* Return if alloc_ptr >= alloc_limit */ +- /* Record return address */ +- ldr r12, .Lcaml_last_return_address +- str lr, [r12, #0] +- /* Invoke GC */ +- bl .Linvoke_gc ++ bcc 1f ++ bx lr ++1: /* Record return address */ ++ ldr r7, =caml_last_return_address ++ str lr, [r7] ++ /* Call GC (preserves r7) */ ++ bl .Lcaml_call_gc ++ /* Restore return address */ ++ ldr lr, [r7] + /* Try again */ +- b caml_alloc2 ++ b .Lcaml_alloc2 ++ .type caml_alloc2, %function ++ .size caml_alloc2, .-caml_alloc2 + +- .globl caml_alloc3 ++ .align 2 ++ .globl caml_alloc3 + .type caml_alloc3, %function + caml_alloc3: +- sub alloc_ptr, alloc_ptr, #16 ++ PROFILE ++.Lcaml_alloc3: ++ sub alloc_ptr, alloc_ptr, 16 + cmp alloc_ptr, alloc_limit +- movcs pc, lr /* Return if alloc_ptr >= alloc_limit */ +- /* Record return address */ +- ldr r12, .Lcaml_last_return_address +- str lr, [r12, #0] +- /* Invoke GC */ +- bl .Linvoke_gc ++ bcc 1f ++ bx lr ++1: /* Record return address */ ++ ldr r7, =caml_last_return_address ++ str lr, [r7] ++ /* Call GC (preserves r7) */ ++ bl .Lcaml_call_gc ++ /* Restore return address */ ++ ldr lr, [r7] + /* Try again */ +- b caml_alloc3 ++ b .Lcaml_alloc3 ++ .type caml_alloc3, %function ++ .size caml_alloc3, .-caml_alloc3 + +- .globl caml_allocN ++ .align 2 ++ .globl caml_allocN + .type caml_allocN, %function + caml_allocN: +- sub alloc_ptr, alloc_ptr, r12 ++ PROFILE ++.Lcaml_allocN: ++ sub alloc_ptr, alloc_ptr, r7 + cmp alloc_ptr, alloc_limit +- movcs pc, lr /* Return if alloc_ptr >= alloc_limit */ +- /* Record return address and desired size */ +- /* Can use alloc_limit as a temporary since it will be reloaded by +- invoke_gc */ +- ldr alloc_limit, .Lcaml_last_return_address +- str lr, [alloc_limit, #0] +- ldr alloc_limit, .Lcaml_requested_size +- str r12, [alloc_limit, #0] +- /* Invoke GC */ +- bl .Linvoke_gc ++ bcc 1f ++ bx lr ++1: /* Record return address */ ++ ldr r12, =caml_last_return_address ++ str lr, [r12] ++ /* Call GC (preserves r7) */ ++ bl .Lcaml_call_gc ++ /* Restore return address */ ++ ldr r12, =caml_last_return_address ++ ldr lr, [r12] + /* Try again */ +- ldr r12, .Lcaml_requested_size +- ldr r12, [r12, #0] +- b caml_allocN +- +-/* Shared code to invoke the GC */ +-.Linvoke_gc: +- /* Record lowest stack address */ +- ldr r12, .Lcaml_bottom_of_stack +- str sp, [r12, #0] +- /* Save integer registers and return address on stack */ +- stmfd sp!, {r0,r1,r2,r3,r4,r5,r6,r7,r12,lr} +- /* Store pointer to saved integer registers in caml_gc_regs */ +- ldr r12, .Lcaml_gc_regs +- str sp, [r12, #0] +- /* Save current allocation pointer for debugging purposes */ +- ldr r12, .Lcaml_young_ptr +- str alloc_ptr, [r12, #0] +- /* Save trap pointer in case an exception is raised during GC */ +- ldr r12, .Lcaml_exception_pointer +- str trap_ptr, [r12, #0] +- /* Call the garbage collector */ +- bl caml_garbage_collection +- /* Restore the registers from the stack */ +- ldmfd sp!, {r0,r1,r2,r3,r4,r5,r6,r7,r12} +- /* Reload return address */ +- ldr r12, .Lcaml_last_return_address +- ldr lr, [r12, #0] +- /* Reload new allocation pointer and allocation limit */ +- ldr r12, .Lcaml_young_ptr +- ldr alloc_ptr, [r12, #0] +- ldr r12, .Lcaml_young_limit +- ldr alloc_limit, [r12, #0] +- /* Return to caller */ +- ldr r12, [sp], #4 +- bx r12 ++ b .Lcaml_allocN ++ .type caml_allocN, %function ++ .size caml_allocN, .-caml_allocN + +-/* Call a C function from Caml */ +-/* Function to call is in r12 */ ++/* Call a C function from OCaml */ ++/* Function to call is in r7 */ + +- .globl caml_c_call ++ .align 2 ++ .globl caml_c_call + .type caml_c_call, %function + caml_c_call: ++ PROFILE ++ /* Record lowest stack address and return address */ ++ ldr r5, =caml_last_return_address ++ ldr r6, =caml_bottom_of_stack ++ str lr, [r5] ++ str sp, [r6] + /* Preserve return address in callee-save register r4 */ + mov r4, lr +- /* Record lowest stack address and return address */ +- ldr r5, .Lcaml_last_return_address +- ldr r6, .Lcaml_bottom_of_stack +- str lr, [r5, #0] +- str sp, [r6, #0] +- /* Make the exception handler and alloc ptr available to the C code */ +- ldr r6, .Lcaml_young_ptr +- ldr r7, .Lcaml_exception_pointer +- str alloc_ptr, [r6, #0] +- str trap_ptr, [r7, #0] ++ /* Make the exception handler alloc ptr available to the C code */ ++ ldr r5, =caml_young_ptr ++ ldr r6, =caml_exception_pointer ++ str alloc_ptr, [r5] ++ str trap_ptr, [r6] + /* Call the function */ +- mov lr, pc +- bx r12 ++ blx r7 + /* Reload alloc ptr and alloc limit */ +- ldr r5, .Lcaml_young_limit +- ldr alloc_ptr, [r6, #0] /* r6 still points to caml_young_ptr */ +- ldr alloc_limit, [r5, #0] ++ ldr r6, =caml_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 + +-/* Start the Caml program */ ++/* Start the OCaml program */ + +- .globl caml_start_program ++ .align 2 ++ .globl caml_start_program + .type caml_start_program, %function + caml_start_program: +- ldr r12, .Lcaml_program ++ PROFILE ++ ldr r12, =caml_program + + /* Code shared with caml_callback* */ +-/* Address of Caml code to call is in r12 */ +-/* Arguments to the Caml code are in r0...r3 */ ++/* Address of OCaml code to call is in r12 */ ++/* Arguments to the OCaml code are in r0...r3 */ + + .Ljump_to_caml: + /* Save return address and callee-save registers */ +- stmfd sp!, {r4,r5,r6,r7,r8,r10,r11,lr} /* 8-alignment */ ++ 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-alignment */ +- ldr r4, .Lcaml_bottom_of_stack +- ldr r4, [r4, #0] +- str r4, [sp, #0] +- ldr r4, .Lcaml_last_return_address +- ldr r4, [r4, #0] +- str r4, [sp, #4] +- ldr r4, .Lcaml_gc_regs +- ldr r4, [r4, #0] +- str r4, [sp, #8] +- /* Setup a trap frame to catch exceptions escaping the Caml code */ +- sub sp, sp, #4*2 +- ldr r4, .Lcaml_exception_pointer +- ldr r4, [r4, #0] +- str r4, [sp, #0] +- ldr r4, .LLtrap_handler +- str r4, [sp, #4] ++ 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, [r4] ++ ldr r5, [r5] ++ ldr r6, [r6] ++ str r4, [sp, 0] ++ str r5, [sp, 4] ++ 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 r4, [r6] ++ str r4, [sp, 0] ++ str r5, [sp, 4] + mov trap_ptr, sp + /* Reload allocation pointers */ +- ldr r4, .Lcaml_young_ptr +- ldr alloc_ptr, [r4, #0] +- ldr r4, .Lcaml_young_limit +- ldr alloc_limit, [r4, #0] +- /* Call the Caml code */ +- mov lr, pc +- bx r12 ++ ldr r4, =caml_young_ptr ++ ldr alloc_ptr, [r4] ++ ldr r4, =caml_young_limit ++ ldr alloc_limit, [r4] ++ /* Call the OCaml code */ ++ blx r12 + .Lcaml_retaddr: + /* Pop the trap frame, restoring caml_exception_pointer */ +- ldr r4, .Lcaml_exception_pointer +- ldr r5, [sp, #0] +- str r5, [r4, #0] +- add sp, sp, #2 * 4 ++ ldr r4, =caml_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, .Lcaml_bottom_of_stack +- ldr r5, [sp, #0] +- str r5, [r4, #0] +- ldr r4, .Lcaml_last_return_address +- ldr r5, [sp, #4] +- str r5, [r4, #0] +- ldr r4, .Lcaml_gc_regs +- ldr r5, [sp, #8] +- str r5, [r4, #0] +- add sp, sp, #4*4 ++ ldr r4, =caml_bottom_of_stack ++ ldr r5, [sp, 0] ++ str r5, [r4] ++ ldr r4, =caml_last_return_address ++ ldr r5, [sp, 4] ++ str r5, [r4] ++ ldr r4, =caml_gc_regs ++ ldr r5, [sp, 8] ++ str r5, [r4] ++ add sp, sp, 4*4 + /* Update allocation pointer */ +- ldr r4, .Lcaml_young_ptr +- str alloc_ptr, [r4, #0] ++ ldr r4, =caml_young_ptr ++ str alloc_ptr, [r4] + /* Reload callee-save registers and return */ +- ldmfd sp!, {r4,r5,r6,r7,r8,r10,r11,lr} +- bx lr ++ 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 ++ ++/* The trap handler */ + +- /* The trap handler */ ++ .align 2 + .Ltrap_handler: + /* Save exception pointer */ +- ldr r4, .Lcaml_exception_pointer +- str trap_ptr, [r4, #0] ++ ldr r12, =caml_exception_pointer ++ str trap_ptr, [r12] + /* Encode exception bucket as an exception result */ +- orr r0, r0, #2 ++ orr r0, r0, 2 + /* Return it */ + b .Lreturn_result ++ .type .Ltrap_handler, %function ++ .size .Ltrap_handler, .-.Ltrap_handler ++ ++/* Raise an exception from OCaml */ ++ ++ .align 2 ++ .globl caml_raise_exn ++caml_raise_exn: ++ PROFILE ++ /* Test if backtrace is active */ ++ ldr r1, =caml_backtrace_active ++ ldr r1, [r1] ++ cbz r1, 1f ++ /* Preserve exception bucket in callee-save register r4 */ ++ mov r4, r0 ++ /* Stash the backtrace */ ++ 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 ++ /* 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 + + /* Raise an exception from C */ + +- .globl caml_raise_exception ++ .align 2 ++ .globl caml_raise_exception + .type caml_raise_exception, %function + caml_raise_exception: +- /* Reload Caml allocation pointers */ +- ldr r12, .Lcaml_young_ptr +- ldr alloc_ptr, [r12, #0] +- ldr r12, .Lcaml_young_limit +- ldr alloc_limit, [r12, #0] +- /* Cut stack at current trap handler */ +- ldr r12, .Lcaml_exception_pointer +- ldr sp, [r12, #0] ++ 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, [trap_ptr] ++ ldr alloc_ptr, [alloc_ptr] ++ ldr alloc_limit, [alloc_limit] ++ /* Test if backtrace is active */ ++ ldr r1, =caml_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, [r1] ++ ldr r2, =caml_bottom_of_stack /* arg3: sp of raise */ ++ ldr r2, [r2] ++ mov r3, trap_ptr /* arg4: sp of handler */ ++ bl 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 */ +- ldmfd sp!, {trap_ptr, pc} ++ pop {trap_ptr, pc} ++ .type caml_raise_exception, %function ++ .size caml_raise_exception, .-caml_raise_exception + +-/* Callback from C to Caml */ ++/* Callback from C to OCaml */ + +- .globl caml_callback_exn ++ .align 2 ++ .globl caml_callback_exn + .type caml_callback_exn, %function + 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, #0] /* code pointer */ ++ 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 + +- .globl caml_callback2_exn ++ .align 2 ++ .globl caml_callback2_exn + .type caml_callback2_exn, %function + 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, .Lcaml_apply2 ++ 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 + +- .globl caml_callback3_exn ++ .align 2 ++ .globl caml_callback3_exn + .type caml_callback3_exn, %function + caml_callback3_exn: ++ PROFILE + /* Initial shuffling of arguments */ + /* (r0 = closure, r1 = arg1, r2 = arg2, r3 = arg3) */ + mov r12, r0 +@@ -288,43 +413,36 @@ caml_callback3_exn: + mov r1, r2 /* r1 = second arg */ + mov r2, r3 /* r2 = third arg */ + mov r3, r12 /* r3 = closure environment */ +- ldr r12, .Lcaml_apply3 ++ ldr r12, =caml_apply3 + b .Ljump_to_caml ++ .type caml_callback3_exn, %function ++ .size caml_callback3_exn, .-caml_callback3_exn + +- .globl caml_ml_array_bound_error ++ .align 2 ++ .globl caml_ml_array_bound_error + .type caml_ml_array_bound_error, %function + caml_ml_array_bound_error: +- /* Load address of [caml_array_bound_error] in r12 */ +- ldr r12, .Lcaml_array_bound_error ++ PROFILE ++ /* Load address of [caml_array_bound_error] in r7 */ ++ ldr r7, =caml_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 + +-/* Global references */ +- +-.Lcaml_last_return_address: .word caml_last_return_address +-.Lcaml_bottom_of_stack: .word caml_bottom_of_stack +-.Lcaml_gc_regs: .word caml_gc_regs +-.Lcaml_young_ptr: .word caml_young_ptr +-.Lcaml_young_limit: .word caml_young_limit +-.Lcaml_exception_pointer: .word caml_exception_pointer +-.Lcaml_program: .word caml_program +-.LLtrap_handler: .word .Ltrap_handler +-.Lcaml_apply2: .word caml_apply2 +-.Lcaml_apply3: .word caml_apply3 +-.Lcaml_array_bound_error: .word caml_array_bound_error +-.Lcaml_requested_size: .word caml_requested_size +- +- .data +-caml_requested_size: +- .word 0 ++ .globl caml_system__code_end ++caml_system__code_end: + + /* GC roots for callback */ + + .data +- .globl caml_system__frametable ++ .align 2 ++ .globl caml_system__frametable + caml_system__frametable: + .word 1 /* one descriptor */ + .word .Lcaml_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 +diff --git a/asmrun/signals_osdep.h b/asmrun/signals_osdep.h +index 1e91327..732f3a0 100644 +--- a/asmrun/signals_osdep.h ++++ b/asmrun/signals_osdep.h +@@ -78,7 +78,7 @@ + + /****************** ARM, Linux */ + +-#elif defined(TARGET_arm) && defined (SYS_linux) ++#elif defined(TARGET_arm) && (defined (SYS_linux_eabi) || defined(SYS_linux_eabihf)) + + #include + +diff --git a/configure b/configure +index 6ed0a9c..4e07c92 100755 +--- a/configure ++++ b/configure +@@ -636,6 +636,7 @@ if test $withsharedlibs = "yes"; then + i[345]86-*-netbsd*) natdynlink=true;; + x86_64-*-netbsd*) natdynlink=true;; + i386-*-gnu0.3) natdynlink=true;; ++ arm*-*-linux*) natdynlink=true;; + esac + fi + +@@ -691,8 +692,13 @@ case "$host" in + powerpc-*-rhapsody*) arch=power; model=ppc; system=rhapsody;; + powerpc-*-darwin*) arch=power; system=rhapsody + if $arch64; then model=ppc64; else model=ppc; fi;; +- arm*-*-linux*) arch=arm; system=linux;; +- arm*-*-gnu*) arch=arm; system=gnu;; ++ arm*-*-linux-gnueabihf) arch=arm; system=linux_eabihf;; ++ armv7*-*-linux-gnueabi) arch=arm; model=armv7; system=linux_eabi;; ++ armv6t2*-*-linux-gnueabi) arch=arm; model=armv6t2; system=linux_eabi;; ++ armv6*-*-linux-gnueabi) arch=arm; model=armv6; system=linux_eabi;; ++ armv5te*-*-linux-gnueabi) arch=arm; model=armv5te; system=linux_eabi;; ++ armv5*-*-linux-gnueabi) arch=arm; model=armv5; system=linux_eabi;; ++ arm*-*-linux-gnueabi) arch=arm; system=linux_eabi;; + ia64-*-linux*) arch=ia64; system=linux;; + ia64-*-gnu*) arch=ia64; system=gnu;; + ia64-*-freebsd*) arch=ia64; system=freebsd;; +@@ -804,6 +810,7 @@ case "$arch,$model,$system" in + case "$nativecc" in gcc*) ;; *) cc_profile='-xpg';; esac;; + amd64,*,linux) profiling='prof';; + amd64,*,gnu) profiling='prof';; ++ arm,*,linux*) profiling='prof';; + *) profiling='noprof';; + esac + +-- +1.7.10 + diff --git a/config.guess b/config.guess deleted file mode 100755 index 8152efd..0000000 --- a/config.guess +++ /dev/null @@ -1,1522 +0,0 @@ -#! /bin/sh -# Attempt to guess a canonical system name. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, -# 2011 Free Software Foundation, Inc. - -timestamp='2011-11-11' - -# This file is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - - -# Originally written by Per Bothner. Please send patches (context -# diff format) to and include a ChangeLog -# entry. -# -# This script attempts to guess a canonical system name similar to -# config.sub. If it succeeds, it prints the system name on stdout, and -# exits with 0. Otherwise, it exits with 1. -# -# You can get the latest version of this script from: -# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD - -me=`echo "$0" | sed -e 's,.*/,,'` - -usage="\ -Usage: $0 [OPTION] - -Output the configuration name of the system \`$me' is run on. - -Operation modes: - -h, --help print this help, then exit - -t, --time-stamp print date of last modification, then exit - -v, --version print version number, then exit - -Report bugs and patches to ." - -version="\ -GNU config.guess ($timestamp) - -Originally written by Per Bothner. -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, -2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free -Software Foundation, Inc. - -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." - -help=" -Try \`$me --help' for more information." - -# Parse command line -while test $# -gt 0 ; do - case $1 in - --time-stamp | --time* | -t ) - echo "$timestamp" ; exit ;; - --version | -v ) - echo "$version" ; exit ;; - --help | --h* | -h ) - echo "$usage"; exit ;; - -- ) # Stop option processing - shift; break ;; - - ) # Use stdin as input. - break ;; - -* ) - echo "$me: invalid option $1$help" >&2 - exit 1 ;; - * ) - break ;; - esac -done - -if test $# != 0; then - echo "$me: too many arguments$help" >&2 - exit 1 -fi - -trap 'exit 1' 1 2 15 - -# CC_FOR_BUILD -- compiler used by this script. Note that the use of a -# compiler to aid in system detection is discouraged as it requires -# temporary files to be created and, as you can see below, it is a -# headache to deal with in a portable fashion. - -# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still -# use `HOST_CC' if defined, but it is deprecated. - -# Portable tmp directory creation inspired by the Autoconf team. - -set_cc_for_build=' -trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; -trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; -: ${TMPDIR=/tmp} ; - { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || - { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || - { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || - { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; -dummy=$tmp/dummy ; -tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ; -case $CC_FOR_BUILD,$HOST_CC,$CC in - ,,) echo "int x;" > $dummy.c ; - for c in cc gcc c89 c99 ; do - if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then - CC_FOR_BUILD="$c"; break ; - fi ; - done ; - if test x"$CC_FOR_BUILD" = x ; then - CC_FOR_BUILD=no_compiler_found ; - fi - ;; - ,,*) CC_FOR_BUILD=$CC ;; - ,*,*) CC_FOR_BUILD=$HOST_CC ;; -esac ; set_cc_for_build= ;' - -# This is needed to find uname on a Pyramid OSx when run in the BSD universe. -# (ghazi@noc.rutgers.edu 1994-08-24) -if (test -f /.attbin/uname) >/dev/null 2>&1 ; then - PATH=$PATH:/.attbin ; export PATH -fi - -UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown -UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown -UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown -UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown - -# Note: order is significant - the case branches are not exclusive. - -case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in - *:NetBSD:*:*) - # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, - # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently - # switched to ELF, *-*-netbsd* would select the old - # object file format. This provides both forward - # compatibility and a consistent mechanism for selecting the - # object file format. - # - # Note: NetBSD doesn't particularly care about the vendor - # portion of the name. We always set it to "unknown". - sysctl="sysctl -n hw.machine_arch" - UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \ - /usr/sbin/$sysctl 2>/dev/null || echo unknown)` - case "${UNAME_MACHINE_ARCH}" in - armeb) machine=armeb-unknown ;; - arm*) machine=arm-unknown ;; - sh3el) machine=shl-unknown ;; - sh3eb) machine=sh-unknown ;; - sh5el) machine=sh5le-unknown ;; - *) machine=${UNAME_MACHINE_ARCH}-unknown ;; - esac - # The Operating System including object format, if it has switched - # to ELF recently, or will in the future. - case "${UNAME_MACHINE_ARCH}" in - arm*|i386|m68k|ns32k|sh3*|sparc|vax) - eval $set_cc_for_build - if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep -q __ELF__ - then - # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). - # Return netbsd for either. FIX? - os=netbsd - else - os=netbsdelf - fi - ;; - *) - os=netbsd - ;; - esac - # The OS release - # Debian GNU/NetBSD machines have a different userland, and - # thus, need a distinct triplet. However, they do not need - # kernel version information, so it can be replaced with a - # suitable tag, in the style of linux-gnu. - case "${UNAME_VERSION}" in - Debian*) - release='-gnu' - ;; - *) - release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` - ;; - esac - # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: - # contains redundant information, the shorter form: - # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. - echo "${machine}-${os}${release}" - exit ;; - *:OpenBSD:*:*) - UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` - echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} - exit ;; - *:ekkoBSD:*:*) - echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE} - exit ;; - *:SolidBSD:*:*) - echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE} - exit ;; - macppc:MirBSD:*:*) - echo powerpc-unknown-mirbsd${UNAME_RELEASE} - exit ;; - *:MirBSD:*:*) - echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} - exit ;; - alpha:OSF1:*:*) - case $UNAME_RELEASE in - *4.0) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` - ;; - *5.*) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` - ;; - esac - # According to Compaq, /usr/sbin/psrinfo has been available on - # OSF/1 and Tru64 systems produced since 1995. I hope that - # covers most systems running today. This code pipes the CPU - # types through head -n 1, so we only detect the type of CPU 0. - ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` - case "$ALPHA_CPU_TYPE" in - "EV4 (21064)") - UNAME_MACHINE="alpha" ;; - "EV4.5 (21064)") - UNAME_MACHINE="alpha" ;; - "LCA4 (21066/21068)") - UNAME_MACHINE="alpha" ;; - "EV5 (21164)") - UNAME_MACHINE="alphaev5" ;; - "EV5.6 (21164A)") - UNAME_MACHINE="alphaev56" ;; - "EV5.6 (21164PC)") - UNAME_MACHINE="alphapca56" ;; - "EV5.7 (21164PC)") - UNAME_MACHINE="alphapca57" ;; - "EV6 (21264)") - UNAME_MACHINE="alphaev6" ;; - "EV6.7 (21264A)") - UNAME_MACHINE="alphaev67" ;; - "EV6.8CB (21264C)") - UNAME_MACHINE="alphaev68" ;; - "EV6.8AL (21264B)") - UNAME_MACHINE="alphaev68" ;; - "EV6.8CX (21264D)") - UNAME_MACHINE="alphaev68" ;; - "EV6.9A (21264/EV69A)") - UNAME_MACHINE="alphaev69" ;; - "EV7 (21364)") - UNAME_MACHINE="alphaev7" ;; - "EV7.9 (21364A)") - UNAME_MACHINE="alphaev79" ;; - esac - # A Pn.n version is a patched version. - # A Vn.n version is a released version. - # A Tn.n version is a released field test version. - # A Xn.n version is an unreleased experimental baselevel. - # 1.2 uses "1.2" for uname -r. - echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - # Reset EXIT trap before exiting to avoid spurious non-zero exit code. - exitcode=$? - trap '' 0 - exit $exitcode ;; - Alpha\ *:Windows_NT*:*) - # How do we know it's Interix rather than the generic POSIX subsystem? - # Should we change UNAME_MACHINE based on the output of uname instead - # of the specific Alpha model? - echo alpha-pc-interix - exit ;; - 21064:Windows_NT:50:3) - echo alpha-dec-winnt3.5 - exit ;; - Amiga*:UNIX_System_V:4.0:*) - echo m68k-unknown-sysv4 - exit ;; - *:[Aa]miga[Oo][Ss]:*:*) - echo ${UNAME_MACHINE}-unknown-amigaos - exit ;; - *:[Mm]orph[Oo][Ss]:*:*) - echo ${UNAME_MACHINE}-unknown-morphos - exit ;; - *:OS/390:*:*) - echo i370-ibm-openedition - exit ;; - *:z/VM:*:*) - echo s390-ibm-zvmoe - exit ;; - *:OS400:*:*) - echo powerpc-ibm-os400 - exit ;; - arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) - echo arm-acorn-riscix${UNAME_RELEASE} - exit ;; - arm:riscos:*:*|arm:RISCOS:*:*) - echo arm-unknown-riscos - exit ;; - SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) - echo hppa1.1-hitachi-hiuxmpp - exit ;; - Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) - # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. - if test "`(/bin/universe) 2>/dev/null`" = att ; then - echo pyramid-pyramid-sysv3 - else - echo pyramid-pyramid-bsd - fi - exit ;; - NILE*:*:*:dcosx) - echo pyramid-pyramid-svr4 - exit ;; - DRS?6000:unix:4.0:6*) - echo sparc-icl-nx6 - exit ;; - DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) - case `/usr/bin/uname -p` in - sparc) echo sparc-icl-nx7; exit ;; - esac ;; - s390x:SunOS:*:*) - echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - sun4H:SunOS:5.*:*) - echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) - echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) - echo i386-pc-auroraux${UNAME_RELEASE} - exit ;; - i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) - eval $set_cc_for_build - SUN_ARCH="i386" - # If there is a compiler, see if it is configured for 64-bit objects. - # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. - # This test works for both compilers. - if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then - if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ - (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ - grep IS_64BIT_ARCH >/dev/null - then - SUN_ARCH="x86_64" - fi - fi - echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - sun4*:SunOS:6*:*) - # According to config.sub, this is the proper way to canonicalize - # SunOS6. Hard to guess exactly what SunOS6 will be like, but - # it's likely to be more like Solaris than SunOS4. - echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - sun4*:SunOS:*:*) - case "`/usr/bin/arch -k`" in - Series*|S4*) - UNAME_RELEASE=`uname -v` - ;; - esac - # Japanese Language versions have a version number like `4.1.3-JL'. - echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` - exit ;; - sun3*:SunOS:*:*) - echo m68k-sun-sunos${UNAME_RELEASE} - exit ;; - sun*:*:4.2BSD:*) - UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` - test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 - case "`/bin/arch`" in - sun3) - echo m68k-sun-sunos${UNAME_RELEASE} - ;; - sun4) - echo sparc-sun-sunos${UNAME_RELEASE} - ;; - esac - exit ;; - aushp:SunOS:*:*) - echo sparc-auspex-sunos${UNAME_RELEASE} - exit ;; - # The situation for MiNT is a little confusing. The machine name - # can be virtually everything (everything which is not - # "atarist" or "atariste" at least should have a processor - # > m68000). The system name ranges from "MiNT" over "FreeMiNT" - # to the lowercase version "mint" (or "freemint"). Finally - # the system name "TOS" denotes a system which is actually not - # MiNT. But MiNT is downward compatible to TOS, so this should - # be no problem. - atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} - exit ;; - atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} - exit ;; - *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} - exit ;; - milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint${UNAME_RELEASE} - exit ;; - hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint${UNAME_RELEASE} - exit ;; - *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint${UNAME_RELEASE} - exit ;; - m68k:machten:*:*) - echo m68k-apple-machten${UNAME_RELEASE} - exit ;; - powerpc:machten:*:*) - echo powerpc-apple-machten${UNAME_RELEASE} - exit ;; - RISC*:Mach:*:*) - echo mips-dec-mach_bsd4.3 - exit ;; - RISC*:ULTRIX:*:*) - echo mips-dec-ultrix${UNAME_RELEASE} - exit ;; - VAX*:ULTRIX*:*:*) - echo vax-dec-ultrix${UNAME_RELEASE} - exit ;; - 2020:CLIX:*:* | 2430:CLIX:*:*) - echo clipper-intergraph-clix${UNAME_RELEASE} - exit ;; - mips:*:*:UMIPS | mips:*:*:RISCos) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c -#ifdef __cplusplus -#include /* for printf() prototype */ - int main (int argc, char *argv[]) { -#else - int main (argc, argv) int argc; char *argv[]; { -#endif - #if defined (host_mips) && defined (MIPSEB) - #if defined (SYSTYPE_SYSV) - printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0); - #endif - #if defined (SYSTYPE_SVR4) - printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0); - #endif - #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) - printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0); - #endif - #endif - exit (-1); - } -EOF - $CC_FOR_BUILD -o $dummy $dummy.c && - dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` && - SYSTEM_NAME=`$dummy $dummyarg` && - { echo "$SYSTEM_NAME"; exit; } - echo mips-mips-riscos${UNAME_RELEASE} - exit ;; - Motorola:PowerMAX_OS:*:*) - echo powerpc-motorola-powermax - exit ;; - Motorola:*:4.3:PL8-*) - echo powerpc-harris-powermax - exit ;; - Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) - echo powerpc-harris-powermax - exit ;; - Night_Hawk:Power_UNIX:*:*) - echo powerpc-harris-powerunix - exit ;; - m88k:CX/UX:7*:*) - echo m88k-harris-cxux7 - exit ;; - m88k:*:4*:R4*) - echo m88k-motorola-sysv4 - exit ;; - m88k:*:3*:R3*) - echo m88k-motorola-sysv3 - exit ;; - AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` - if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] - then - if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ - [ ${TARGET_BINARY_INTERFACE}x = x ] - then - echo m88k-dg-dgux${UNAME_RELEASE} - else - echo m88k-dg-dguxbcs${UNAME_RELEASE} - fi - else - echo i586-dg-dgux${UNAME_RELEASE} - fi - exit ;; - M88*:DolphinOS:*:*) # DolphinOS (SVR3) - echo m88k-dolphin-sysv3 - exit ;; - M88*:*:R3*:*) - # Delta 88k system running SVR3 - echo m88k-motorola-sysv3 - exit ;; - XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) - echo m88k-tektronix-sysv3 - exit ;; - Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) - echo m68k-tektronix-bsd - exit ;; - *:IRIX*:*:*) - echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` - exit ;; - ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. - echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id - exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' - i*86:AIX:*:*) - echo i386-ibm-aix - exit ;; - ia64:AIX:*:*) - if [ -x /usr/bin/oslevel ] ; then - IBM_REV=`/usr/bin/oslevel` - else - IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} - fi - echo ${UNAME_MACHINE}-ibm-aix${IBM_REV} - exit ;; - *:AIX:2:3) - if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include - - main() - { - if (!__power_pc()) - exit(1); - puts("powerpc-ibm-aix3.2.5"); - exit(0); - } -EOF - if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` - then - echo "$SYSTEM_NAME" - else - echo rs6000-ibm-aix3.2.5 - fi - elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then - echo rs6000-ibm-aix3.2.4 - else - echo rs6000-ibm-aix3.2 - fi - exit ;; - *:AIX:*:[4567]) - IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` - if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then - IBM_ARCH=rs6000 - else - IBM_ARCH=powerpc - fi - if [ -x /usr/bin/oslevel ] ; then - IBM_REV=`/usr/bin/oslevel` - else - IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} - fi - echo ${IBM_ARCH}-ibm-aix${IBM_REV} - exit ;; - *:AIX:*:*) - echo rs6000-ibm-aix - exit ;; - ibmrt:4.4BSD:*|romp-ibm:BSD:*) - echo romp-ibm-bsd4.4 - exit ;; - ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and - echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to - exit ;; # report: romp-ibm BSD 4.3 - *:BOSX:*:*) - echo rs6000-bull-bosx - exit ;; - DPX/2?00:B.O.S.:*:*) - echo m68k-bull-sysv3 - exit ;; - 9000/[34]??:4.3bsd:1.*:*) - echo m68k-hp-bsd - exit ;; - hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) - echo m68k-hp-bsd4.4 - exit ;; - 9000/[34678]??:HP-UX:*:*) - HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` - case "${UNAME_MACHINE}" in - 9000/31? ) HP_ARCH=m68000 ;; - 9000/[34]?? ) HP_ARCH=m68k ;; - 9000/[678][0-9][0-9]) - if [ -x /usr/bin/getconf ]; then - sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "${sc_cpu_version}" in - 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 - 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "${sc_kernel_bits}" in - 32) HP_ARCH="hppa2.0n" ;; - 64) HP_ARCH="hppa2.0w" ;; - '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 - esac ;; - esac - fi - if [ "${HP_ARCH}" = "" ]; then - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - - #define _HPUX_SOURCE - #include - #include - - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); - - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } -EOF - (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` - test -z "$HP_ARCH" && HP_ARCH=hppa - fi ;; - esac - if [ ${HP_ARCH} = "hppa2.0w" ] - then - eval $set_cc_for_build - - # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating - # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler - # generating 64-bit code. GNU and HP use different nomenclature: - # - # $ CC_FOR_BUILD=cc ./config.guess - # => hppa2.0w-hp-hpux11.23 - # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess - # => hppa64-hp-hpux11.23 - - if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | - grep -q __LP64__ - then - HP_ARCH="hppa2.0w" - else - HP_ARCH="hppa64" - fi - fi - echo ${HP_ARCH}-hp-hpux${HPUX_REV} - exit ;; - ia64:HP-UX:*:*) - HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` - echo ia64-hp-hpux${HPUX_REV} - exit ;; - 3050*:HI-UX:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include - int - main () - { - long cpu = sysconf (_SC_CPU_VERSION); - /* The order matters, because CPU_IS_HP_MC68K erroneously returns - true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct - results, however. */ - if (CPU_IS_PA_RISC (cpu)) - { - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; - case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; - default: puts ("hppa-hitachi-hiuxwe2"); break; - } - } - else if (CPU_IS_HP_MC68K (cpu)) - puts ("m68k-hitachi-hiuxwe2"); - else puts ("unknown-hitachi-hiuxwe2"); - exit (0); - } -EOF - $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` && - { echo "$SYSTEM_NAME"; exit; } - echo unknown-hitachi-hiuxwe2 - exit ;; - 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) - echo hppa1.1-hp-bsd - exit ;; - 9000/8??:4.3bsd:*:*) - echo hppa1.0-hp-bsd - exit ;; - *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) - echo hppa1.0-hp-mpeix - exit ;; - hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) - echo hppa1.1-hp-osf - exit ;; - hp8??:OSF1:*:*) - echo hppa1.0-hp-osf - exit ;; - i*86:OSF1:*:*) - if [ -x /usr/sbin/sysversion ] ; then - echo ${UNAME_MACHINE}-unknown-osf1mk - else - echo ${UNAME_MACHINE}-unknown-osf1 - fi - exit ;; - parisc*:Lites*:*:*) - echo hppa1.1-hp-lites - exit ;; - C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) - echo c1-convex-bsd - exit ;; - C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) - if getsysinfo -f scalar_acc - then echo c32-convex-bsd - else echo c2-convex-bsd - fi - exit ;; - C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) - echo c34-convex-bsd - exit ;; - C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) - echo c38-convex-bsd - exit ;; - C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) - echo c4-convex-bsd - exit ;; - CRAY*Y-MP:*:*:*) - echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*[A-Z]90:*:*:*) - echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ - | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ - -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ - -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*TS:*:*:*) - echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*T3E:*:*:*) - echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*SV1:*:*:*) - echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit ;; - *:UNICOS/mp:*:*) - echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' - exit ;; - F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) - FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; - 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; - i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) - echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} - exit ;; - sparc*:BSD/OS:*:*) - echo sparc-unknown-bsdi${UNAME_RELEASE} - exit ;; - *:BSD/OS:*:*) - echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} - exit ;; - *:FreeBSD:*:*) - UNAME_PROCESSOR=`/usr/bin/uname -p` - case ${UNAME_PROCESSOR} in - amd64) - echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; - *) - echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; - esac - exit ;; - i*:CYGWIN*:*) - echo ${UNAME_MACHINE}-pc-cygwin - exit ;; - *:MINGW*:*) - echo ${UNAME_MACHINE}-pc-mingw32 - exit ;; - i*:MSYS*:*) - echo ${UNAME_MACHINE}-pc-msys - exit ;; - i*:windows32*:*) - # uname -m includes "-pc" on this system. - echo ${UNAME_MACHINE}-mingw32 - exit ;; - i*:PW*:*) - echo ${UNAME_MACHINE}-pc-pw32 - exit ;; - *:Interix*:*) - case ${UNAME_MACHINE} in - x86) - echo i586-pc-interix${UNAME_RELEASE} - exit ;; - authenticamd | genuineintel | EM64T) - echo x86_64-unknown-interix${UNAME_RELEASE} - exit ;; - IA64) - echo ia64-unknown-interix${UNAME_RELEASE} - exit ;; - esac ;; - [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) - echo i${UNAME_MACHINE}-pc-mks - exit ;; - 8664:Windows_NT:*) - echo x86_64-pc-mks - exit ;; - i*:Windows_NT*:* | Pentium*:Windows_NT*:*) - # How do we know it's Interix rather than the generic POSIX subsystem? - # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we - # UNAME_MACHINE based on the output of uname instead of i386? - echo i586-pc-interix - exit ;; - i*:UWIN*:*) - echo ${UNAME_MACHINE}-pc-uwin - exit ;; - amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) - echo x86_64-unknown-cygwin - exit ;; - p*:CYGWIN*:*) - echo powerpcle-unknown-cygwin - exit ;; - prep*:SunOS:5.*:*) - echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit ;; - *:GNU:*:*) - # the GNU system - echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` - exit ;; - *:GNU/*:*:*) - # other systems with GNU libc and userland - echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu - exit ;; - i*86:Minix:*:*) - echo ${UNAME_MACHINE}-pc-minix - exit ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep -q ld.so.1 - if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} - exit ;; - arm*:Linux:*:*) - eval $set_cc_for_build - if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep -q __ARM_EABI__ - then - echo ${UNAME_MACHINE}-unknown-linux-gnu - else - if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep -q __ARM_PCS_VFP - then - echo ${UNAME_MACHINE}-unknown-linux-gnueabi - else - echo ${UNAME_MACHINE}-unknown-linux-gnueabihf - fi - fi - exit ;; - avr32*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - cris:Linux:*:*) - echo cris-axis-linux-gnu - exit ;; - crisv32:Linux:*:*) - echo crisv32-axis-linux-gnu - exit ;; - frv:Linux:*:*) - echo frv-unknown-linux-gnu - exit ;; - hexagon:Linux:*:*) - echo hexagon-unknown-linux-gnu - exit ;; - i*86:Linux:*:*) - LIBC=gnu - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #ifdef __dietlibc__ - LIBC=dietlibc - #endif -EOF - eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` - echo "${UNAME_MACHINE}-pc-linux-${LIBC}" - exit ;; - ia64:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - m32r*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - m68*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - mips:Linux:*:* | mips64:Linux:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #undef CPU - #undef ${UNAME_MACHINE} - #undef ${UNAME_MACHINE}el - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=${UNAME_MACHINE}el - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=${UNAME_MACHINE} - #else - CPU= - #endif - #endif -EOF - eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` - test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } - ;; - or32:Linux:*:*) - echo or32-unknown-linux-gnu - exit ;; - padre:Linux:*:*) - echo sparc-unknown-linux-gnu - exit ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-gnu - exit ;; - parisc:Linux:*:* | hppa:Linux:*:*) - # Look for CPU level - case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in - PA7*) echo hppa1.1-unknown-linux-gnu ;; - PA8*) echo hppa2.0-unknown-linux-gnu ;; - *) echo hppa-unknown-linux-gnu ;; - esac - exit ;; - ppc64:Linux:*:*) - echo powerpc64-unknown-linux-gnu - exit ;; - ppc:Linux:*:*) - echo powerpc-unknown-linux-gnu - exit ;; - s390:Linux:*:* | s390x:Linux:*:*) - echo ${UNAME_MACHINE}-ibm-linux - exit ;; - sh64*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - sh*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - sparc:Linux:*:* | sparc64:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - tile*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - vax:Linux:*:*) - echo ${UNAME_MACHINE}-dec-linux-gnu - exit ;; - x86_64:Linux:*:*) - echo x86_64-unknown-linux-gnu - exit ;; - xtensa*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu - exit ;; - i*86:DYNIX/ptx:4*:*) - # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. - # earlier versions are messed up and put the nodename in both - # sysname and nodename. - echo i386-sequent-sysv4 - exit ;; - i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, - # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. - echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} - exit ;; - i*86:OS/2:*:*) - # If we were able to find `uname', then EMX Unix compatibility - # is probably installed. - echo ${UNAME_MACHINE}-pc-os2-emx - exit ;; - i*86:XTS-300:*:STOP) - echo ${UNAME_MACHINE}-unknown-stop - exit ;; - i*86:atheos:*:*) - echo ${UNAME_MACHINE}-unknown-atheos - exit ;; - i*86:syllable:*:*) - echo ${UNAME_MACHINE}-pc-syllable - exit ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) - echo i386-unknown-lynxos${UNAME_RELEASE} - exit ;; - i*86:*DOS:*:*) - echo ${UNAME_MACHINE}-pc-msdosdjgpp - exit ;; - i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*) - UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` - if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then - echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL} - else - echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} - fi - exit ;; - i*86:*:5:[678]*) - # UnixWare 7.x, OpenUNIX and OpenServer 6. - case `/bin/uname -X | grep "^Machine"` in - *486*) UNAME_MACHINE=i486 ;; - *Pentium) UNAME_MACHINE=i586 ;; - *Pent*|*Celeron) UNAME_MACHINE=i686 ;; - esac - echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} - exit ;; - i*86:*:3.2:*) - if test -f /usr/options/cb.name; then - UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then - UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` - (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 - (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ - && UNAME_MACHINE=i586 - (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ - && UNAME_MACHINE=i686 - (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ - && UNAME_MACHINE=i686 - echo ${UNAME_MACHINE}-pc-sco$UNAME_REL - else - echo ${UNAME_MACHINE}-pc-sysv32 - fi - exit ;; - pc:*:*:*) - # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i586. - # Note: whatever this is, it MUST be the same as what config.sub - # prints for the "djgpp" host, or else GDB configury will decide that - # this is a cross-build. - echo i586-pc-msdosdjgpp - exit ;; - Intel:Mach:3*:*) - echo i386-pc-mach3 - exit ;; - paragon:*:*:*) - echo i860-intel-osf1 - exit ;; - i860:*:4.*:*) # i860-SVR4 - if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then - echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 - else # Add other i860-SVR4 vendors below as they are discovered. - echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 - fi - exit ;; - mini*:CTIX:SYS*5:*) - # "miniframe" - echo m68010-convergent-sysv - exit ;; - mc68k:UNIX:SYSTEM5:3.51m) - echo m68k-convergent-sysv - exit ;; - M680?0:D-NIX:5.3:*) - echo m68k-diab-dnix - exit ;; - M68*:*:R3V[5678]*:*) - test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; - 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) - OS_REL='' - test -r /etc/.relid \ - && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4.3${OS_REL}; exit; } - /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ - && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; - 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; - NCR*:*:4.2:* | MPRAS*:*:4.2:*) - OS_REL='.3' - test -r /etc/.relid \ - && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4.3${OS_REL}; exit; } - /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ - && { echo i586-ncr-sysv4.3${OS_REL}; exit; } - /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ - && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; - m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) - echo m68k-unknown-lynxos${UNAME_RELEASE} - exit ;; - mc68030:UNIX_System_V:4.*:*) - echo m68k-atari-sysv4 - exit ;; - TSUNAMI:LynxOS:2.*:*) - echo sparc-unknown-lynxos${UNAME_RELEASE} - exit ;; - rs6000:LynxOS:2.*:*) - echo rs6000-unknown-lynxos${UNAME_RELEASE} - exit ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) - echo powerpc-unknown-lynxos${UNAME_RELEASE} - exit ;; - SM[BE]S:UNIX_SV:*:*) - echo mips-dde-sysv${UNAME_RELEASE} - exit ;; - RM*:ReliantUNIX-*:*:*) - echo mips-sni-sysv4 - exit ;; - RM*:SINIX-*:*:*) - echo mips-sni-sysv4 - exit ;; - *:SINIX-*:*:*) - if uname -p 2>/dev/null >/dev/null ; then - UNAME_MACHINE=`(uname -p) 2>/dev/null` - echo ${UNAME_MACHINE}-sni-sysv4 - else - echo ns32k-sni-sysv - fi - exit ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says - echo i586-unisys-sysv4 - exit ;; - *:UNIX_System_V:4*:FTX*) - # From Gerald Hewes . - # How about differentiating between stratus architectures? -djm - echo hppa1.1-stratus-sysv4 - exit ;; - *:*:*:FTX*) - # From seanf@swdc.stratus.com. - echo i860-stratus-sysv4 - exit ;; - i*86:VOS:*:*) - # From Paul.Green@stratus.com. - echo ${UNAME_MACHINE}-stratus-vos - exit ;; - *:VOS:*:*) - # From Paul.Green@stratus.com. - echo hppa1.1-stratus-vos - exit ;; - mc68*:A/UX:*:*) - echo m68k-apple-aux${UNAME_RELEASE} - exit ;; - news*:NEWS-OS:6*:*) - echo mips-sony-newsos6 - exit ;; - R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) - if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} - else - echo mips-unknown-sysv${UNAME_RELEASE} - fi - exit ;; - BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. - echo powerpc-be-beos - exit ;; - BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. - echo powerpc-apple-beos - exit ;; - BePC:BeOS:*:*) # BeOS running on Intel PC compatible. - echo i586-pc-beos - exit ;; - BePC:Haiku:*:*) # Haiku running on Intel PC compatible. - echo i586-pc-haiku - exit ;; - SX-4:SUPER-UX:*:*) - echo sx4-nec-superux${UNAME_RELEASE} - exit ;; - SX-5:SUPER-UX:*:*) - echo sx5-nec-superux${UNAME_RELEASE} - exit ;; - SX-6:SUPER-UX:*:*) - echo sx6-nec-superux${UNAME_RELEASE} - exit ;; - SX-7:SUPER-UX:*:*) - echo sx7-nec-superux${UNAME_RELEASE} - exit ;; - SX-8:SUPER-UX:*:*) - echo sx8-nec-superux${UNAME_RELEASE} - exit ;; - SX-8R:SUPER-UX:*:*) - echo sx8r-nec-superux${UNAME_RELEASE} - exit ;; - Power*:Rhapsody:*:*) - echo powerpc-apple-rhapsody${UNAME_RELEASE} - exit ;; - *:Rhapsody:*:*) - echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} - exit ;; - *:Darwin:*:*) - UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown - case $UNAME_PROCESSOR in - i386) - eval $set_cc_for_build - if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then - if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ - (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ - grep IS_64BIT_ARCH >/dev/null - then - UNAME_PROCESSOR="x86_64" - fi - fi ;; - unknown) UNAME_PROCESSOR=powerpc ;; - esac - echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} - exit ;; - *:procnto*:*:* | *:QNX:[0123456789]*:*) - UNAME_PROCESSOR=`uname -p` - if test "$UNAME_PROCESSOR" = "x86"; then - UNAME_PROCESSOR=i386 - UNAME_MACHINE=pc - fi - echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE} - exit ;; - *:QNX:*:4*) - echo i386-pc-qnx - exit ;; - NEO-?:NONSTOP_KERNEL:*:*) - echo neo-tandem-nsk${UNAME_RELEASE} - exit ;; - NSE-?:NONSTOP_KERNEL:*:*) - echo nse-tandem-nsk${UNAME_RELEASE} - exit ;; - NSR-?:NONSTOP_KERNEL:*:*) - echo nsr-tandem-nsk${UNAME_RELEASE} - exit ;; - *:NonStop-UX:*:*) - echo mips-compaq-nonstopux - exit ;; - BS2000:POSIX*:*:*) - echo bs2000-siemens-sysv - exit ;; - DS/*:UNIX_System_V:*:*) - echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE} - exit ;; - *:Plan9:*:*) - # "uname -m" is not consistent, so use $cputype instead. 386 - # is converted to i386 for consistency with other x86 - # operating systems. - if test "$cputype" = "386"; then - UNAME_MACHINE=i386 - else - UNAME_MACHINE="$cputype" - fi - echo ${UNAME_MACHINE}-unknown-plan9 - exit ;; - *:TOPS-10:*:*) - echo pdp10-unknown-tops10 - exit ;; - *:TENEX:*:*) - echo pdp10-unknown-tenex - exit ;; - KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) - echo pdp10-dec-tops20 - exit ;; - XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) - echo pdp10-xkl-tops20 - exit ;; - *:TOPS-20:*:*) - echo pdp10-unknown-tops20 - exit ;; - *:ITS:*:*) - echo pdp10-unknown-its - exit ;; - SEI:*:*:SEIUX) - echo mips-sei-seiux${UNAME_RELEASE} - exit ;; - *:DragonFly:*:*) - echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` - exit ;; - *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` - case "${UNAME_MACHINE}" in - A*) echo alpha-dec-vms ; exit ;; - I*) echo ia64-dec-vms ; exit ;; - V*) echo vax-dec-vms ; exit ;; - esac ;; - *:XENIX:*:SysV) - echo i386-pc-xenix - exit ;; - i*86:skyos:*:*) - echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//' - exit ;; - i*86:rdos:*:*) - echo ${UNAME_MACHINE}-pc-rdos - exit ;; - i*86:AROS:*:*) - echo ${UNAME_MACHINE}-pc-aros - exit ;; -esac - -#echo '(No uname command or uname output not recognized.)' 1>&2 -#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 - -eval $set_cc_for_build -cat >$dummy.c < -# include -#endif -main () -{ -#if defined (sony) -#if defined (MIPSEB) - /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, - I don't know.... */ - printf ("mips-sony-bsd\n"); exit (0); -#else -#include - printf ("m68k-sony-newsos%s\n", -#ifdef NEWSOS4 - "4" -#else - "" -#endif - ); exit (0); -#endif -#endif - -#if defined (__arm) && defined (__acorn) && defined (__unix) - printf ("arm-acorn-riscix\n"); exit (0); -#endif - -#if defined (hp300) && !defined (hpux) - printf ("m68k-hp-bsd\n"); exit (0); -#endif - -#if defined (NeXT) -#if !defined (__ARCHITECTURE__) -#define __ARCHITECTURE__ "m68k" -#endif - int version; - version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; - if (version < 4) - printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); - else - printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); - exit (0); -#endif - -#if defined (MULTIMAX) || defined (n16) -#if defined (UMAXV) - printf ("ns32k-encore-sysv\n"); exit (0); -#else -#if defined (CMU) - printf ("ns32k-encore-mach\n"); exit (0); -#else - printf ("ns32k-encore-bsd\n"); exit (0); -#endif -#endif -#endif - -#if defined (__386BSD__) - printf ("i386-pc-bsd\n"); exit (0); -#endif - -#if defined (sequent) -#if defined (i386) - printf ("i386-sequent-dynix\n"); exit (0); -#endif -#if defined (ns32000) - printf ("ns32k-sequent-dynix\n"); exit (0); -#endif -#endif - -#if defined (_SEQUENT_) - struct utsname un; - - uname(&un); - - if (strncmp(un.version, "V2", 2) == 0) { - printf ("i386-sequent-ptx2\n"); exit (0); - } - if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ - printf ("i386-sequent-ptx1\n"); exit (0); - } - printf ("i386-sequent-ptx\n"); exit (0); - -#endif - -#if defined (vax) -# if !defined (ultrix) -# include -# if defined (BSD) -# if BSD == 43 - printf ("vax-dec-bsd4.3\n"); exit (0); -# else -# if BSD == 199006 - printf ("vax-dec-bsd4.3reno\n"); exit (0); -# else - printf ("vax-dec-bsd\n"); exit (0); -# endif -# endif -# else - printf ("vax-dec-bsd\n"); exit (0); -# endif -# else - printf ("vax-dec-ultrix\n"); exit (0); -# endif -#endif - -#if defined (alliant) && defined (i860) - printf ("i860-alliant-bsd\n"); exit (0); -#endif - - exit (1); -} -EOF - -$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` && - { echo "$SYSTEM_NAME"; exit; } - -# Apollos put the system type in the environment. - -test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; } - -# Convex versions that predate uname can use getsysinfo(1) - -if [ -x /usr/convex/getsysinfo ] -then - case `getsysinfo -f cpu_type` in - c1*) - echo c1-convex-bsd - exit ;; - c2*) - if getsysinfo -f scalar_acc - then echo c32-convex-bsd - else echo c2-convex-bsd - fi - exit ;; - c34*) - echo c34-convex-bsd - exit ;; - c38*) - echo c38-convex-bsd - exit ;; - c4*) - echo c4-convex-bsd - exit ;; - esac -fi - -cat >&2 < in order to provide the needed -information to handle your system. - -config.guess timestamp = $timestamp - -uname -m = `(uname -m) 2>/dev/null || echo unknown` -uname -r = `(uname -r) 2>/dev/null || echo unknown` -uname -s = `(uname -s) 2>/dev/null || echo unknown` -uname -v = `(uname -v) 2>/dev/null || echo unknown` - -/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null` -/bin/uname -X = `(/bin/uname -X) 2>/dev/null` - -hostinfo = `(hostinfo) 2>/dev/null` -/bin/universe = `(/bin/universe) 2>/dev/null` -/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null` -/bin/arch = `(/bin/arch) 2>/dev/null` -/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` -/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` - -UNAME_MACHINE = ${UNAME_MACHINE} -UNAME_RELEASE = ${UNAME_RELEASE} -UNAME_SYSTEM = ${UNAME_SYSTEM} -UNAME_VERSION = ${UNAME_VERSION} -EOF - -exit 1 - -# Local variables: -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "timestamp='" -# time-stamp-format: "%:y-%02m-%02d" -# time-stamp-end: "'" -# End: diff --git a/config.sub b/config.sub deleted file mode 100755 index e76eaf4..0000000 --- a/config.sub +++ /dev/null @@ -1,1771 +0,0 @@ -#! /bin/sh -# Configuration validation subroutine script. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, -# 2011 Free Software Foundation, Inc. - -timestamp='2011-11-11' - -# This file is (in principle) common to ALL GNU software. -# The presence of a machine in this file suggests that SOME GNU software -# can handle that machine. It does not imply ALL GNU software can. -# -# This file is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - - -# Please send patches to . Submit a context -# diff and a properly formatted GNU ChangeLog entry. -# -# Configuration subroutine to validate and canonicalize a configuration type. -# Supply the specified configuration type as an argument. -# If it is invalid, we print an error message on stderr and exit with code 1. -# Otherwise, we print the canonical config type on stdout and succeed. - -# You can get the latest version of this script from: -# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD - -# This file is supposed to be the same for all GNU packages -# and recognize all the CPU types, system types and aliases -# that are meaningful with *any* GNU software. -# Each package is responsible for reporting which valid configurations -# it does not support. The user should be able to distinguish -# a failure to support a valid configuration from a meaningless -# configuration. - -# The goal of this file is to map all the various variations of a given -# machine specification into a single specification in the form: -# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM -# or in some cases, the newer four-part form: -# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM -# It is wrong to echo any other type of specification. - -me=`echo "$0" | sed -e 's,.*/,,'` - -usage="\ -Usage: $0 [OPTION] CPU-MFR-OPSYS - $0 [OPTION] ALIAS - -Canonicalize a configuration name. - -Operation modes: - -h, --help print this help, then exit - -t, --time-stamp print date of last modification, then exit - -v, --version print version number, then exit - -Report bugs and patches to ." - -version="\ -GNU config.sub ($timestamp) - -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, -2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free -Software Foundation, Inc. - -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." - -help=" -Try \`$me --help' for more information." - -# Parse command line -while test $# -gt 0 ; do - case $1 in - --time-stamp | --time* | -t ) - echo "$timestamp" ; exit ;; - --version | -v ) - echo "$version" ; exit ;; - --help | --h* | -h ) - echo "$usage"; exit ;; - -- ) # Stop option processing - shift; break ;; - - ) # Use stdin as input. - break ;; - -* ) - echo "$me: invalid option $1$help" - exit 1 ;; - - *local*) - # First pass through any local machine types. - echo $1 - exit ;; - - * ) - break ;; - esac -done - -case $# in - 0) echo "$me: missing argument$help" >&2 - exit 1;; - 1) ;; - *) echo "$me: too many arguments$help" >&2 - exit 1;; -esac - -# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any). -# Here we must recognize all the valid KERNEL-OS combinations. -maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` -case $maybe_os in - nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ - linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ - knetbsd*-gnu* | netbsd*-gnu* | \ - kopensolaris*-gnu* | \ - storm-chaos* | os2-emx* | rtmk-nova*) - os=-$maybe_os - basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` - ;; - *) - basic_machine=`echo $1 | sed 's/-[^-]*$//'` - if [ $basic_machine != $1 ] - then os=`echo $1 | sed 's/.*-/-/'` - else os=; fi - ;; -esac - -### Let's recognize common machines as not being operating systems so -### that things like config.sub decstation-3100 work. We also -### recognize some manufacturers as not being operating systems, so we -### can provide default operating systems below. -case $os in - -sun*os*) - # Prevent following clause from handling this invalid input. - ;; - -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \ - -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \ - -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \ - -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ - -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ - -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis | -knuth | -cray | -microblaze) - os= - basic_machine=$1 - ;; - -bluegene*) - os=-cnk - ;; - -sim | -cisco | -oki | -wec | -winbond) - os= - basic_machine=$1 - ;; - -scout) - ;; - -wrs) - os=-vxworks - basic_machine=$1 - ;; - -chorusos*) - os=-chorusos - basic_machine=$1 - ;; - -chorusrdb) - os=-chorusrdb - basic_machine=$1 - ;; - -hiux*) - os=-hiuxwe2 - ;; - -sco6) - os=-sco5v6 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco5) - os=-sco3.2v5 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco4) - os=-sco3.2v4 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco3.2.[4-9]*) - os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco3.2v[4-9]*) - # Don't forget version if it is 3.2v4 or newer. - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco5v6*) - # Don't forget version if it is 3.2v4 or newer. - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco*) - os=-sco3.2v2 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -udk*) - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -isc) - os=-isc2.2 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -clix*) - basic_machine=clipper-intergraph - ;; - -isc*) - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -lynx*) - os=-lynxos - ;; - -ptx*) - basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` - ;; - -windowsnt*) - os=`echo $os | sed -e 's/windowsnt/winnt/'` - ;; - -psos*) - os=-psos - ;; - -mint | -mint[0-9]*) - basic_machine=m68k-atari - os=-mint - ;; -esac - -# Decode aliases for certain CPU-COMPANY combinations. -case $basic_machine in - # Recognize the basic CPU types without company name. - # Some are omitted here because they have special meanings below. - 1750a | 580 \ - | a29k \ - | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ - | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ - | am33_2.0 \ - | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ - | be32 | be64 \ - | bfin \ - | c4x | clipper \ - | d10v | d30v | dlx | dsp16xx \ - | epiphany \ - | fido | fr30 | frv \ - | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ - | hexagon \ - | i370 | i860 | i960 | ia64 \ - | ip2k | iq2000 \ - | le32 | le64 \ - | lm32 \ - | m32c | m32r | m32rle | m68000 | m68k | m88k \ - | maxq | mb | microblaze | mcore | mep | metag \ - | mips | mipsbe | mipseb | mipsel | mipsle \ - | mips16 \ - | mips64 | mips64el \ - | mips64octeon | mips64octeonel \ - | mips64orion | mips64orionel \ - | mips64r5900 | mips64r5900el \ - | mips64vr | mips64vrel \ - | mips64vr4100 | mips64vr4100el \ - | mips64vr4300 | mips64vr4300el \ - | mips64vr5000 | mips64vr5000el \ - | mips64vr5900 | mips64vr5900el \ - | mipsisa32 | mipsisa32el \ - | mipsisa32r2 | mipsisa32r2el \ - | mipsisa64 | mipsisa64el \ - | mipsisa64r2 | mipsisa64r2el \ - | mipsisa64sb1 | mipsisa64sb1el \ - | mipsisa64sr71k | mipsisa64sr71kel \ - | mipstx39 | mipstx39el \ - | mn10200 | mn10300 \ - | moxie \ - | mt \ - | msp430 \ - | nds32 | nds32le | nds32be \ - | nios | nios2 \ - | ns16k | ns32k \ - | open8 \ - | or32 \ - | pdp10 | pdp11 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle \ - | pyramid \ - | rl78 | rx \ - | score \ - | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ - | sh64 | sh64le \ - | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ - | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ - | spu \ - | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ - | ubicom32 \ - | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ - | we32k \ - | x86 | xc16x | xstormy16 | xtensa \ - | z8k | z80) - basic_machine=$basic_machine-unknown - ;; - c54x) - basic_machine=tic54x-unknown - ;; - c55x) - basic_machine=tic55x-unknown - ;; - c6x) - basic_machine=tic6x-unknown - ;; - m6811 | m68hc11 | m6812 | m68hc12 | picochip) - # Motorola 68HC11/12. - basic_machine=$basic_machine-unknown - os=-none - ;; - m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) - ;; - ms1) - basic_machine=mt-unknown - ;; - - strongarm | thumb | xscale) - basic_machine=arm-unknown - ;; - - xscaleeb) - basic_machine=armeb-unknown - ;; - - xscaleel) - basic_machine=armel-unknown - ;; - - # We use `pc' rather than `unknown' - # because (1) that's what they normally are, and - # (2) the word "unknown" tends to confuse beginning users. - i*86 | x86_64) - basic_machine=$basic_machine-pc - ;; - # Object if more than one company name word. - *-*-*) - echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 - exit 1 - ;; - # Recognize the basic CPU types with company name. - 580-* \ - | a29k-* \ - | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ - | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ - | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ - | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ - | avr-* | avr32-* \ - | be32-* | be64-* \ - | bfin-* | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* \ - | clipper-* | craynv-* | cydra-* \ - | d10v-* | d30v-* | dlx-* \ - | elxsi-* \ - | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ - | h8300-* | h8500-* \ - | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ - | hexagon-* \ - | i*86-* | i860-* | i960-* | ia64-* \ - | ip2k-* | iq2000-* \ - | le32-* | le64-* \ - | lm32-* \ - | m32c-* | m32r-* | m32rle-* \ - | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | maxq-* | mcore-* | metag-* | microblaze-* \ - | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ - | mips16-* \ - | mips64-* | mips64el-* \ - | mips64octeon-* | mips64octeonel-* \ - | mips64orion-* | mips64orionel-* \ - | mips64r5900-* | mips64r5900el-* \ - | mips64vr-* | mips64vrel-* \ - | mips64vr4100-* | mips64vr4100el-* \ - | mips64vr4300-* | mips64vr4300el-* \ - | mips64vr5000-* | mips64vr5000el-* \ - | mips64vr5900-* | mips64vr5900el-* \ - | mipsisa32-* | mipsisa32el-* \ - | mipsisa32r2-* | mipsisa32r2el-* \ - | mipsisa64-* | mipsisa64el-* \ - | mipsisa64r2-* | mipsisa64r2el-* \ - | mipsisa64sb1-* | mipsisa64sb1el-* \ - | mipsisa64sr71k-* | mipsisa64sr71kel-* \ - | mipstx39-* | mipstx39el-* \ - | mmix-* \ - | mt-* \ - | msp430-* \ - | nds32-* | nds32le-* | nds32be-* \ - | nios-* | nios2-* \ - | none-* | np1-* | ns16k-* | ns32k-* \ - | open8-* \ - | orion-* \ - | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ - | pyramid-* \ - | rl78-* | romp-* | rs6000-* | rx-* \ - | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ - | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ - | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ - | sparclite-* \ - | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ - | tahoe-* \ - | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ - | tile*-* \ - | tron-* \ - | ubicom32-* \ - | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ - | vax-* \ - | we32k-* \ - | x86-* | x86_64-* | xc16x-* | xps100-* \ - | xstormy16-* | xtensa*-* \ - | ymp-* \ - | z8k-* | z80-*) - ;; - # Recognize the basic CPU types without company name, with glob match. - xtensa*) - basic_machine=$basic_machine-unknown - ;; - # Recognize the various machine names and aliases which stand - # for a CPU type and a company and sometimes even an OS. - 386bsd) - basic_machine=i386-unknown - os=-bsd - ;; - 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) - basic_machine=m68000-att - ;; - 3b*) - basic_machine=we32k-att - ;; - a29khif) - basic_machine=a29k-amd - os=-udi - ;; - abacus) - basic_machine=abacus-unknown - ;; - adobe68k) - basic_machine=m68010-adobe - os=-scout - ;; - alliant | fx80) - basic_machine=fx80-alliant - ;; - altos | altos3068) - basic_machine=m68k-altos - ;; - am29k) - basic_machine=a29k-none - os=-bsd - ;; - amd64) - basic_machine=x86_64-pc - ;; - amd64-*) - basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - amdahl) - basic_machine=580-amdahl - os=-sysv - ;; - amiga | amiga-*) - basic_machine=m68k-unknown - ;; - amigaos | amigados) - basic_machine=m68k-unknown - os=-amigaos - ;; - amigaunix | amix) - basic_machine=m68k-unknown - os=-sysv4 - ;; - apollo68) - basic_machine=m68k-apollo - os=-sysv - ;; - apollo68bsd) - basic_machine=m68k-apollo - os=-bsd - ;; - aros) - basic_machine=i386-pc - os=-aros - ;; - aux) - basic_machine=m68k-apple - os=-aux - ;; - balance) - basic_machine=ns32k-sequent - os=-dynix - ;; - blackfin) - basic_machine=bfin-unknown - os=-linux - ;; - blackfin-*) - basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` - os=-linux - ;; - bluegene*) - basic_machine=powerpc-ibm - os=-cnk - ;; - c54x-*) - basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - c55x-*) - basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - c6x-*) - basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - c90) - basic_machine=c90-cray - os=-unicos - ;; - cegcc) - basic_machine=arm-unknown - os=-cegcc - ;; - convex-c1) - basic_machine=c1-convex - os=-bsd - ;; - convex-c2) - basic_machine=c2-convex - os=-bsd - ;; - convex-c32) - basic_machine=c32-convex - os=-bsd - ;; - convex-c34) - basic_machine=c34-convex - os=-bsd - ;; - convex-c38) - basic_machine=c38-convex - os=-bsd - ;; - cray | j90) - basic_machine=j90-cray - os=-unicos - ;; - craynv) - basic_machine=craynv-cray - os=-unicosmp - ;; - cr16 | cr16-*) - basic_machine=cr16-unknown - os=-elf - ;; - crds | unos) - basic_machine=m68k-crds - ;; - crisv32 | crisv32-* | etraxfs*) - basic_machine=crisv32-axis - ;; - cris | cris-* | etrax*) - basic_machine=cris-axis - ;; - crx) - basic_machine=crx-unknown - os=-elf - ;; - da30 | da30-*) - basic_machine=m68k-da30 - ;; - decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) - basic_machine=mips-dec - ;; - decsystem10* | dec10*) - basic_machine=pdp10-dec - os=-tops10 - ;; - decsystem20* | dec20*) - basic_machine=pdp10-dec - os=-tops20 - ;; - delta | 3300 | motorola-3300 | motorola-delta \ - | 3300-motorola | delta-motorola) - basic_machine=m68k-motorola - ;; - delta88) - basic_machine=m88k-motorola - os=-sysv3 - ;; - dicos) - basic_machine=i686-pc - os=-dicos - ;; - djgpp) - basic_machine=i586-pc - os=-msdosdjgpp - ;; - dpx20 | dpx20-*) - basic_machine=rs6000-bull - os=-bosx - ;; - dpx2* | dpx2*-bull) - basic_machine=m68k-bull - os=-sysv3 - ;; - ebmon29k) - basic_machine=a29k-amd - os=-ebmon - ;; - elxsi) - basic_machine=elxsi-elxsi - os=-bsd - ;; - encore | umax | mmax) - basic_machine=ns32k-encore - ;; - es1800 | OSE68k | ose68k | ose | OSE) - basic_machine=m68k-ericsson - os=-ose - ;; - fx2800) - basic_machine=i860-alliant - ;; - genix) - basic_machine=ns32k-ns - ;; - gmicro) - basic_machine=tron-gmicro - os=-sysv - ;; - go32) - basic_machine=i386-pc - os=-go32 - ;; - h3050r* | hiux*) - basic_machine=hppa1.1-hitachi - os=-hiuxwe2 - ;; - h8300hms) - basic_machine=h8300-hitachi - os=-hms - ;; - h8300xray) - basic_machine=h8300-hitachi - os=-xray - ;; - h8500hms) - basic_machine=h8500-hitachi - os=-hms - ;; - harris) - basic_machine=m88k-harris - os=-sysv3 - ;; - hp300-*) - basic_machine=m68k-hp - ;; - hp300bsd) - basic_machine=m68k-hp - os=-bsd - ;; - hp300hpux) - basic_machine=m68k-hp - os=-hpux - ;; - hp3k9[0-9][0-9] | hp9[0-9][0-9]) - basic_machine=hppa1.0-hp - ;; - hp9k2[0-9][0-9] | hp9k31[0-9]) - basic_machine=m68000-hp - ;; - hp9k3[2-9][0-9]) - basic_machine=m68k-hp - ;; - hp9k6[0-9][0-9] | hp6[0-9][0-9]) - basic_machine=hppa1.0-hp - ;; - hp9k7[0-79][0-9] | hp7[0-79][0-9]) - basic_machine=hppa1.1-hp - ;; - hp9k78[0-9] | hp78[0-9]) - # FIXME: really hppa2.0-hp - basic_machine=hppa1.1-hp - ;; - hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) - # FIXME: really hppa2.0-hp - basic_machine=hppa1.1-hp - ;; - hp9k8[0-9][13679] | hp8[0-9][13679]) - basic_machine=hppa1.1-hp - ;; - hp9k8[0-9][0-9] | hp8[0-9][0-9]) - basic_machine=hppa1.0-hp - ;; - hppa-next) - os=-nextstep3 - ;; - hppaosf) - basic_machine=hppa1.1-hp - os=-osf - ;; - hppro) - basic_machine=hppa1.1-hp - os=-proelf - ;; - i370-ibm* | ibm*) - basic_machine=i370-ibm - ;; -# I'm not sure what "Sysv32" means. Should this be sysv3.2? - i*86v32) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv32 - ;; - i*86v4*) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv4 - ;; - i*86v) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv - ;; - i*86sol2) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-solaris2 - ;; - i386mach) - basic_machine=i386-mach - os=-mach - ;; - i386-vsta | vsta) - basic_machine=i386-unknown - os=-vsta - ;; - iris | iris4d) - basic_machine=mips-sgi - case $os in - -irix*) - ;; - *) - os=-irix4 - ;; - esac - ;; - isi68 | isi) - basic_machine=m68k-isi - os=-sysv - ;; - m68knommu) - basic_machine=m68k-unknown - os=-linux - ;; - m68knommu-*) - basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` - os=-linux - ;; - m88k-omron*) - basic_machine=m88k-omron - ;; - magnum | m3230) - basic_machine=mips-mips - os=-sysv - ;; - merlin) - basic_machine=ns32k-utek - os=-sysv - ;; - microblaze) - basic_machine=microblaze-xilinx - ;; - mingw32) - basic_machine=i386-pc - os=-mingw32 - ;; - mingw32ce) - basic_machine=arm-unknown - os=-mingw32ce - ;; - miniframe) - basic_machine=m68000-convergent - ;; - *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*) - basic_machine=m68k-atari - os=-mint - ;; - mips3*-*) - basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'` - ;; - mips3*) - basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown - ;; - monitor) - basic_machine=m68k-rom68k - os=-coff - ;; - morphos) - basic_machine=powerpc-unknown - os=-morphos - ;; - msdos) - basic_machine=i386-pc - os=-msdos - ;; - ms1-*) - basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` - ;; - msys) - basic_machine=i386-pc - os=-msys - ;; - mvs) - basic_machine=i370-ibm - os=-mvs - ;; - nacl) - basic_machine=le32-unknown - os=-nacl - ;; - ncr3000) - basic_machine=i486-ncr - os=-sysv4 - ;; - netbsd386) - basic_machine=i386-unknown - os=-netbsd - ;; - netwinder) - basic_machine=armv4l-rebel - os=-linux - ;; - news | news700 | news800 | news900) - basic_machine=m68k-sony - os=-newsos - ;; - news1000) - basic_machine=m68030-sony - os=-newsos - ;; - news-3600 | risc-news) - basic_machine=mips-sony - os=-newsos - ;; - necv70) - basic_machine=v70-nec - os=-sysv - ;; - next | m*-next ) - basic_machine=m68k-next - case $os in - -nextstep* ) - ;; - -ns2*) - os=-nextstep2 - ;; - *) - os=-nextstep3 - ;; - esac - ;; - nh3000) - basic_machine=m68k-harris - os=-cxux - ;; - nh[45]000) - basic_machine=m88k-harris - os=-cxux - ;; - nindy960) - basic_machine=i960-intel - os=-nindy - ;; - mon960) - basic_machine=i960-intel - os=-mon960 - ;; - nonstopux) - basic_machine=mips-compaq - os=-nonstopux - ;; - np1) - basic_machine=np1-gould - ;; - neo-tandem) - basic_machine=neo-tandem - ;; - nse-tandem) - basic_machine=nse-tandem - ;; - nsr-tandem) - basic_machine=nsr-tandem - ;; - op50n-* | op60c-*) - basic_machine=hppa1.1-oki - os=-proelf - ;; - openrisc | openrisc-*) - basic_machine=or32-unknown - ;; - os400) - basic_machine=powerpc-ibm - os=-os400 - ;; - OSE68000 | ose68000) - basic_machine=m68000-ericsson - os=-ose - ;; - os68k) - basic_machine=m68k-none - os=-os68k - ;; - pa-hitachi) - basic_machine=hppa1.1-hitachi - os=-hiuxwe2 - ;; - paragon) - basic_machine=i860-intel - os=-osf - ;; - parisc) - basic_machine=hppa-unknown - os=-linux - ;; - parisc-*) - basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` - os=-linux - ;; - pbd) - basic_machine=sparc-tti - ;; - pbb) - basic_machine=m68k-tti - ;; - pc532 | pc532-*) - basic_machine=ns32k-pc532 - ;; - pc98) - basic_machine=i386-pc - ;; - pc98-*) - basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentium | p5 | k5 | k6 | nexgen | viac3) - basic_machine=i586-pc - ;; - pentiumpro | p6 | 6x86 | athlon | athlon_*) - basic_machine=i686-pc - ;; - pentiumii | pentium2 | pentiumiii | pentium3) - basic_machine=i686-pc - ;; - pentium4) - basic_machine=i786-pc - ;; - pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) - basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentiumpro-* | p6-* | 6x86-* | athlon-*) - basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) - basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentium4-*) - basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pn) - basic_machine=pn-gould - ;; - power) basic_machine=power-ibm - ;; - ppc | ppcbe) basic_machine=powerpc-unknown - ;; - ppc-* | ppcbe-*) - basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - ppcle | powerpclittle | ppc-le | powerpc-little) - basic_machine=powerpcle-unknown - ;; - ppcle-* | powerpclittle-*) - basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - ppc64) basic_machine=powerpc64-unknown - ;; - ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - ppc64le | powerpc64little | ppc64-le | powerpc64-little) - basic_machine=powerpc64le-unknown - ;; - ppc64le-* | powerpc64little-*) - basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - ps2) - basic_machine=i386-ibm - ;; - pw32) - basic_machine=i586-unknown - os=-pw32 - ;; - rdos) - basic_machine=i386-pc - os=-rdos - ;; - rom68k) - basic_machine=m68k-rom68k - os=-coff - ;; - rm[46]00) - basic_machine=mips-siemens - ;; - rtpc | rtpc-*) - basic_machine=romp-ibm - ;; - s390 | s390-*) - basic_machine=s390-ibm - ;; - s390x | s390x-*) - basic_machine=s390x-ibm - ;; - sa29200) - basic_machine=a29k-amd - os=-udi - ;; - sb1) - basic_machine=mipsisa64sb1-unknown - ;; - sb1el) - basic_machine=mipsisa64sb1el-unknown - ;; - sde) - basic_machine=mipsisa32-sde - os=-elf - ;; - sei) - basic_machine=mips-sei - os=-seiux - ;; - sequent) - basic_machine=i386-sequent - ;; - sh) - basic_machine=sh-hitachi - os=-hms - ;; - sh5el) - basic_machine=sh5le-unknown - ;; - sh64) - basic_machine=sh64-unknown - ;; - sparclite-wrs | simso-wrs) - basic_machine=sparclite-wrs - os=-vxworks - ;; - sps7) - basic_machine=m68k-bull - os=-sysv2 - ;; - spur) - basic_machine=spur-unknown - ;; - st2000) - basic_machine=m68k-tandem - ;; - stratus) - basic_machine=i860-stratus - os=-sysv4 - ;; - strongarm-* | thumb-*) - basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - sun2) - basic_machine=m68000-sun - ;; - sun2os3) - basic_machine=m68000-sun - os=-sunos3 - ;; - sun2os4) - basic_machine=m68000-sun - os=-sunos4 - ;; - sun3os3) - basic_machine=m68k-sun - os=-sunos3 - ;; - sun3os4) - basic_machine=m68k-sun - os=-sunos4 - ;; - sun4os3) - basic_machine=sparc-sun - os=-sunos3 - ;; - sun4os4) - basic_machine=sparc-sun - os=-sunos4 - ;; - sun4sol2) - basic_machine=sparc-sun - os=-solaris2 - ;; - sun3 | sun3-*) - basic_machine=m68k-sun - ;; - sun4) - basic_machine=sparc-sun - ;; - sun386 | sun386i | roadrunner) - basic_machine=i386-sun - ;; - sv1) - basic_machine=sv1-cray - os=-unicos - ;; - symmetry) - basic_machine=i386-sequent - os=-dynix - ;; - t3e) - basic_machine=alphaev5-cray - os=-unicos - ;; - t90) - basic_machine=t90-cray - os=-unicos - ;; - tile*) - basic_machine=$basic_machine-unknown - os=-linux-gnu - ;; - tx39) - basic_machine=mipstx39-unknown - ;; - tx39el) - basic_machine=mipstx39el-unknown - ;; - toad1) - basic_machine=pdp10-xkl - os=-tops20 - ;; - tower | tower-32) - basic_machine=m68k-ncr - ;; - tpf) - basic_machine=s390x-ibm - os=-tpf - ;; - udi29k) - basic_machine=a29k-amd - os=-udi - ;; - ultra3) - basic_machine=a29k-nyu - os=-sym1 - ;; - v810 | necv810) - basic_machine=v810-nec - os=-none - ;; - vaxv) - basic_machine=vax-dec - os=-sysv - ;; - vms) - basic_machine=vax-dec - os=-vms - ;; - vpp*|vx|vx-*) - basic_machine=f301-fujitsu - ;; - vxworks960) - basic_machine=i960-wrs - os=-vxworks - ;; - vxworks68) - basic_machine=m68k-wrs - os=-vxworks - ;; - vxworks29k) - basic_machine=a29k-wrs - os=-vxworks - ;; - w65*) - basic_machine=w65-wdc - os=-none - ;; - w89k-*) - basic_machine=hppa1.1-winbond - os=-proelf - ;; - xbox) - basic_machine=i686-pc - os=-mingw32 - ;; - xps | xps100) - basic_machine=xps100-honeywell - ;; - xscale-* | xscalee[bl]-*) - basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` - ;; - ymp) - basic_machine=ymp-cray - os=-unicos - ;; - z8k-*-coff) - basic_machine=z8k-unknown - os=-sim - ;; - z80-*-coff) - basic_machine=z80-unknown - os=-sim - ;; - none) - basic_machine=none-none - os=-none - ;; - -# Here we handle the default manufacturer of certain CPU types. It is in -# some cases the only manufacturer, in others, it is the most popular. - w89k) - basic_machine=hppa1.1-winbond - ;; - op50n) - basic_machine=hppa1.1-oki - ;; - op60c) - basic_machine=hppa1.1-oki - ;; - romp) - basic_machine=romp-ibm - ;; - mmix) - basic_machine=mmix-knuth - ;; - rs6000) - basic_machine=rs6000-ibm - ;; - vax) - basic_machine=vax-dec - ;; - pdp10) - # there are many clones, so DEC is not a safe bet - basic_machine=pdp10-unknown - ;; - pdp11) - basic_machine=pdp11-dec - ;; - we32k) - basic_machine=we32k-att - ;; - sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) - basic_machine=sh-unknown - ;; - sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) - basic_machine=sparc-sun - ;; - cydra) - basic_machine=cydra-cydrome - ;; - orion) - basic_machine=orion-highlevel - ;; - orion105) - basic_machine=clipper-highlevel - ;; - mac | mpw | mac-mpw) - basic_machine=m68k-apple - ;; - pmac | pmac-mpw) - basic_machine=powerpc-apple - ;; - *-unknown) - # Make sure to match an already-canonicalized machine name. - ;; - *) - echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 - exit 1 - ;; -esac - -# Here we canonicalize certain aliases for manufacturers. -case $basic_machine in - *-digital*) - basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'` - ;; - *-commodore*) - basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'` - ;; - *) - ;; -esac - -# Decode manufacturer-specific aliases for certain operating systems. - -if [ x"$os" != x"" ] -then -case $os in - # First match some system type aliases - # that might get confused with valid system types. - # -solaris* is a basic system type, with this one exception. - -auroraux) - os=-auroraux - ;; - -solaris1 | -solaris1.*) - os=`echo $os | sed -e 's|solaris1|sunos4|'` - ;; - -solaris) - os=-solaris2 - ;; - -svr4*) - os=-sysv4 - ;; - -unixware*) - os=-sysv4.2uw - ;; - -gnu/linux*) - os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` - ;; - # First accept the basic system types. - # The portable systems comes first. - # Each alternative MUST END IN A *, to match a version number. - # -sysv* is not here because it comes later, after sysvr4. - -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ - | -sym* | -kopensolaris* \ - | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* | -aros* \ - | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ - | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ - | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ - | -openbsd* | -solidbsd* \ - | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ - | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ - | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ - | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -chorusos* | -chorusrdb* | -cegcc* \ - | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -linux-android* \ - | -linux-newlib* | -linux-uclibc* \ - | -uxpv* | -beos* | -mpeix* | -udk* \ - | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ - | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ - | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ - | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ - | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ - | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ - | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) - # Remember, each alternative MUST END IN *, to match a version number. - ;; - -qnx*) - case $basic_machine in - x86-* | i*86-*) - ;; - *) - os=-nto$os - ;; - esac - ;; - -nto-qnx*) - ;; - -nto*) - os=`echo $os | sed -e 's|nto|nto-qnx|'` - ;; - -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ - | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \ - | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) - ;; - -mac*) - os=`echo $os | sed -e 's|mac|macos|'` - ;; - -linux-dietlibc) - os=-linux-dietlibc - ;; - -linux*) - os=`echo $os | sed -e 's|linux|linux-gnu|'` - ;; - -sunos5*) - os=`echo $os | sed -e 's|sunos5|solaris2|'` - ;; - -sunos6*) - os=`echo $os | sed -e 's|sunos6|solaris3|'` - ;; - -opened*) - os=-openedition - ;; - -os400*) - os=-os400 - ;; - -wince*) - os=-wince - ;; - -osfrose*) - os=-osfrose - ;; - -osf*) - os=-osf - ;; - -utek*) - os=-bsd - ;; - -dynix*) - os=-bsd - ;; - -acis*) - os=-aos - ;; - -atheos*) - os=-atheos - ;; - -syllable*) - os=-syllable - ;; - -386bsd) - os=-bsd - ;; - -ctix* | -uts*) - os=-sysv - ;; - -nova*) - os=-rtmk-nova - ;; - -ns2 ) - os=-nextstep2 - ;; - -nsk*) - os=-nsk - ;; - # Preserve the version number of sinix5. - -sinix5.*) - os=`echo $os | sed -e 's|sinix|sysv|'` - ;; - -sinix*) - os=-sysv4 - ;; - -tpf*) - os=-tpf - ;; - -triton*) - os=-sysv3 - ;; - -oss*) - os=-sysv3 - ;; - -svr4) - os=-sysv4 - ;; - -svr3) - os=-sysv3 - ;; - -sysvr4) - os=-sysv4 - ;; - # This must come after -sysvr4. - -sysv*) - ;; - -ose*) - os=-ose - ;; - -es1800*) - os=-ose - ;; - -xenix) - os=-xenix - ;; - -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) - os=-mint - ;; - -aros*) - os=-aros - ;; - -kaos*) - os=-kaos - ;; - -zvmoe) - os=-zvmoe - ;; - -dicos*) - os=-dicos - ;; - -nacl*) - ;; - -none) - ;; - *) - # Get rid of the `-' at the beginning of $os. - os=`echo $os | sed 's/[^-]*-//'` - echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2 - exit 1 - ;; -esac -else - -# Here we handle the default operating systems that come with various machines. -# The value should be what the vendor currently ships out the door with their -# machine or put another way, the most popular os provided with the machine. - -# Note that if you're going to try to match "-MANUFACTURER" here (say, -# "-sun"), then you have to tell the case statement up towards the top -# that MANUFACTURER isn't an operating system. Otherwise, code above -# will signal an error saying that MANUFACTURER isn't an operating -# system, and we'll never get to this point. - -case $basic_machine in - score-*) - os=-elf - ;; - spu-*) - os=-elf - ;; - *-acorn) - os=-riscix1.2 - ;; - arm*-rebel) - os=-linux - ;; - arm*-semi) - os=-aout - ;; - c4x-* | tic4x-*) - os=-coff - ;; - tic54x-*) - os=-coff - ;; - tic55x-*) - os=-coff - ;; - tic6x-*) - os=-coff - ;; - # This must come before the *-dec entry. - pdp10-*) - os=-tops20 - ;; - pdp11-*) - os=-none - ;; - *-dec | vax-*) - os=-ultrix4.2 - ;; - m68*-apollo) - os=-domain - ;; - i386-sun) - os=-sunos4.0.2 - ;; - m68000-sun) - os=-sunos3 - # This also exists in the configure program, but was not the - # default. - # os=-sunos4 - ;; - m68*-cisco) - os=-aout - ;; - mep-*) - os=-elf - ;; - mips*-cisco) - os=-elf - ;; - mips*-*) - os=-elf - ;; - or32-*) - os=-coff - ;; - *-tti) # must be before sparc entry or we get the wrong os. - os=-sysv3 - ;; - sparc-* | *-sun) - os=-sunos4.1.1 - ;; - *-be) - os=-beos - ;; - *-haiku) - os=-haiku - ;; - *-ibm) - os=-aix - ;; - *-knuth) - os=-mmixware - ;; - *-wec) - os=-proelf - ;; - *-winbond) - os=-proelf - ;; - *-oki) - os=-proelf - ;; - *-hp) - os=-hpux - ;; - *-hitachi) - os=-hiux - ;; - i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) - os=-sysv - ;; - *-cbm) - os=-amigaos - ;; - *-dg) - os=-dgux - ;; - *-dolphin) - os=-sysv3 - ;; - m68k-ccur) - os=-rtu - ;; - m88k-omron*) - os=-luna - ;; - *-next ) - os=-nextstep - ;; - *-sequent) - os=-ptx - ;; - *-crds) - os=-unos - ;; - *-ns) - os=-genix - ;; - i370-*) - os=-mvs - ;; - *-next) - os=-nextstep3 - ;; - *-gould) - os=-sysv - ;; - *-highlevel) - os=-bsd - ;; - *-encore) - os=-bsd - ;; - *-sgi) - os=-irix - ;; - *-siemens) - os=-sysv4 - ;; - *-masscomp) - os=-rtu - ;; - f30[01]-fujitsu | f700-fujitsu) - os=-uxpv - ;; - *-rom68k) - os=-coff - ;; - *-*bug) - os=-coff - ;; - *-apple) - os=-macos - ;; - *-atari*) - os=-mint - ;; - *) - os=-none - ;; -esac -fi - -# Here we handle the case where we know the os, and the CPU type, but not the -# manufacturer. We pick the logical manufacturer. -vendor=unknown -case $basic_machine in - *-unknown) - case $os in - -riscix*) - vendor=acorn - ;; - -sunos*) - vendor=sun - ;; - -cnk*|-aix*) - vendor=ibm - ;; - -beos*) - vendor=be - ;; - -hpux*) - vendor=hp - ;; - -mpeix*) - vendor=hp - ;; - -hiux*) - vendor=hitachi - ;; - -unos*) - vendor=crds - ;; - -dgux*) - vendor=dg - ;; - -luna*) - vendor=omron - ;; - -genix*) - vendor=ns - ;; - -mvs* | -opened*) - vendor=ibm - ;; - -os400*) - vendor=ibm - ;; - -ptx*) - vendor=sequent - ;; - -tpf*) - vendor=ibm - ;; - -vxsim* | -vxworks* | -windiss*) - vendor=wrs - ;; - -aux*) - vendor=apple - ;; - -hms*) - vendor=hitachi - ;; - -mpw* | -macos*) - vendor=apple - ;; - -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) - vendor=atari - ;; - -vos*) - vendor=stratus - ;; - esac - basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` - ;; -esac - -echo $basic_machine$os -exit - -# Local variables: -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "timestamp='" -# time-stamp-format: "%:y-%02m-%02d" -# time-stamp-end: "'" -# End: diff --git a/debian_patches_0013-ocamlopt-arm-add-.type-directive-for-code-symbols.patch b/debian_patches_0013-ocamlopt-arm-add-.type-directive-for-code-symbols.patch deleted file mode 100644 index a4c0491..0000000 --- a/debian_patches_0013-ocamlopt-arm-add-.type-directive-for-code-symbols.patch +++ /dev/null @@ -1,125 +0,0 @@ -From: Stephane Glondu -Date: Fri, 12 Aug 2011 21:13:17 +0200 -Subject: ocamlopt/arm: add .type directive for code symbols - -Bug: http://caml.inria.fr/mantis/view.php?id=5336 -Bug-Ubuntu: https://bugs.launchpad.net/bugs/810402 -Signed-off-by: Stephane Glondu ---- - asmcomp/arm/emit.mlp | 1 + - asmrun/arm.S | 12 ++++++++++++ - 2 files changed, 13 insertions(+), 0 deletions(-) - -diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp -index 2003313..a4b2241 100644 ---- a/asmcomp/arm/emit.mlp -+++ b/asmcomp/arm/emit.mlp -@@ -556,6 +556,7 @@ let fundecl fundecl = - ` .text\n`; - ` .align 2\n`; - ` .global {emit_symbol fundecl.fun_name}\n`; -+ ` .type {emit_symbol fundecl.fun_name}, %function\n`; - `{emit_symbol fundecl.fun_name}:\n`; - let n = frame_size() in - ignore(emit_stack_adjustment "sub" n); -diff --git a/asmrun/arm.S b/asmrun/arm.S -index 164f731..1313e9c 100644 ---- a/asmrun/arm.S -+++ b/asmrun/arm.S -@@ -24,6 +24,7 @@ alloc_limit .req r10 - /* Allocation functions and GC interface */ - - .globl caml_call_gc -+ .type caml_call_gc, %function - caml_call_gc: - /* Record return address and desired size */ - /* Can use alloc_limit as a temporary since it will be reloaded by -@@ -41,6 +42,7 @@ caml_call_gc: - bx lr - - .globl caml_alloc1 -+ .type caml_alloc1, %function - caml_alloc1: - sub alloc_ptr, alloc_ptr, #8 - cmp alloc_ptr, alloc_limit -@@ -54,6 +56,7 @@ caml_alloc1: - b caml_alloc1 - - .globl caml_alloc2 -+ .type caml_alloc2, %function - caml_alloc2: - sub alloc_ptr, alloc_ptr, #12 - cmp alloc_ptr, alloc_limit -@@ -67,6 +70,7 @@ caml_alloc2: - b caml_alloc2 - - .globl caml_alloc3 -+ .type caml_alloc3, %function - caml_alloc3: - sub alloc_ptr, alloc_ptr, #16 - cmp alloc_ptr, alloc_limit -@@ -80,6 +84,7 @@ caml_alloc3: - b caml_alloc3 - - .globl caml_allocN -+ .type caml_allocN, %function - caml_allocN: - sub alloc_ptr, alloc_ptr, r12 - cmp alloc_ptr, alloc_limit -@@ -134,6 +139,7 @@ caml_allocN: - /* Function to call is in r12 */ - - .globl caml_c_call -+ .type caml_c_call, %function - caml_c_call: - /* Preserve return address in callee-save register r4 */ - mov r4, lr -@@ -160,6 +166,7 @@ caml_c_call: - /* Start the Caml program */ - - .globl caml_start_program -+ .type caml_start_program, %function - caml_start_program: - ldr r12, .Lcaml_program - -@@ -235,6 +242,7 @@ caml_start_program: - /* Raise an exception from C */ - - .globl caml_raise_exception -+ .type caml_raise_exception, %function - caml_raise_exception: - /* Reload Caml allocation pointers */ - ldr r12, .Lcaml_young_ptr -@@ -250,6 +258,7 @@ caml_raise_exception: - /* Callback from C to Caml */ - - .globl caml_callback_exn -+ .type caml_callback_exn, %function - caml_callback_exn: - /* Initial shuffling of arguments (r0 = closure, r1 = first arg) */ - mov r12, r0 -@@ -259,6 +268,7 @@ caml_callback_exn: - b .Ljump_to_caml - - .globl caml_callback2_exn -+ .type caml_callback2_exn, %function - caml_callback2_exn: - /* Initial shuffling of arguments (r0 = closure, r1 = arg1, r2 = arg2) */ - mov r12, r0 -@@ -269,6 +279,7 @@ caml_callback2_exn: - b .Ljump_to_caml - - .globl caml_callback3_exn -+ .type caml_callback3_exn, %function - caml_callback3_exn: - /* Initial shuffling of arguments */ - /* (r0 = closure, r1 = arg1, r2 = arg2, r3 = arg3) */ -@@ -281,6 +292,7 @@ caml_callback3_exn: - b .Ljump_to_caml - - .globl caml_ml_array_bound_error -+ .type caml_ml_array_bound_error, %function - caml_ml_array_bound_error: - /* Load address of [caml_array_bound_error] in r12 */ - ldr r12, .Lcaml_array_bound_error --- diff --git a/ocaml-3.12-ppc.patch b/ocaml-3.12-ppc.patch deleted file mode 100644 index d1bf3dd..0000000 --- a/ocaml-3.12-ppc.patch +++ /dev/null @@ -1,12 +0,0 @@ -diff -up ocaml-3.12.1/asmcomp/power64/selection.ml.ppc_1 ocaml-3.12.1/asmcomp/power64/selection.ml ---- ocaml-3.12.1/asmcomp/power64/selection.ml.ppc_1 2012-05-15 15:28:45.240364647 +0200 -+++ ocaml-3.12.1/asmcomp/power64/selection.ml 2012-05-15 15:28:58.170366764 +0200 -@@ -52,7 +52,7 @@ inherit Selectgen.selector_generic as su - - method is_immediate n = (n <= 32767) && (n >= -32768) - --method select_addressing exp = -+method select_addressing chunk exp = - match select_addr exp with - (Asymbol s, d) -> - (Ibased(s, d), Ctuple []) diff --git a/ocaml-3.12.0-rpath.patch b/ocaml-3.12.0-rpath.patch deleted file mode 100644 index 71e8984..0000000 --- a/ocaml-3.12.0-rpath.patch +++ /dev/null @@ -1,13 +0,0 @@ -diff -ur ocaml-3.12.0.old/tools/Makefile.shared ocaml-3.12.0/tools/Makefile.shared ---- ocaml-3.12.0.old/tools/Makefile.shared 2010-06-07 07:58:41.000000000 +0100 -+++ ocaml-3.12.0/tools/Makefile.shared 2011-01-04 21:56:13.023974253 +0000 -@@ -108,9 +108,6 @@ - sed -e "s|%%BINDIR%%|$(BINDIR)|" \ - -e "s|%%SUPPORTS_SHARED_LIBRARIES%%|$(SUPPORTS_SHARED_LIBRARIES)|" \ - -e "s|%%MKSHAREDLIB%%|$(MKSHAREDLIB)|" \ -- -e "s|%%BYTECCRPATH%%|$(BYTECCRPATH)|" \ -- -e "s|%%NATIVECCRPATH%%|$(NATIVECCRPATH)|" \ -- -e "s|%%MKSHAREDLIBRPATH%%|$(MKSHAREDLIBRPATH)|" \ - -e "s|%%RANLIB%%|$(RANLIB)|" \ - ocamlmklib.mlp >> ocamlmklib.ml - diff --git a/ocaml-3.12.1-merge-the-new-ARM-backend-into-trunk-PR-5433.patch b/ocaml-3.12.1-merge-the-new-ARM-backend-into-trunk-PR-5433.patch deleted file mode 100644 index d9426df..0000000 --- a/ocaml-3.12.1-merge-the-new-ARM-backend-into-trunk-PR-5433.patch +++ /dev/null @@ -1,3043 +0,0 @@ -diff -urN ocaml-3.12.1-noarm/asmcomp/amd64/selection.ml ocaml-3.12.1-arm/asmcomp/amd64/selection.ml ---- ocaml-3.12.1-noarm/asmcomp/amd64/selection.ml 2010-04-08 04:58:41.000000000 +0100 -+++ ocaml-3.12.1-arm/asmcomp/amd64/selection.ml 2012-04-28 12:19:05.173844703 +0100 -@@ -121,7 +121,7 @@ - - method is_immediate_natint n = n <= 0x7FFFFFFFn && n >= -0x80000000n - --method select_addressing exp = -+method select_addressing chunk exp = - let (a, d) = select_addr exp in - (* PR#4625: displacement must be a signed 32-bit immediate *) - if d < -0x8000_0000 || d > 0x7FFF_FFFF -@@ -157,7 +157,7 @@ - match op with - (* Recognize the LEA instruction *) - Caddi | Cadda | Csubi | Csuba -> -- begin match self#select_addressing (Cop(op, args)) with -+ begin match self#select_addressing Word (Cop(op, args)) with - (Iindexed d, _) -> super#select_operation op args - | (Iindexed2 0, _) -> super#select_operation op args - | (addr, arg) -> (Ispecific(Ilea addr), [arg]) -@@ -191,7 +191,7 @@ - begin match args with - [loc; Cop(Caddi, [Cop(Cload _, [loc']); Cconst_int n])] - when loc = loc' && self#is_immediate n -> -- let (addr, arg) = self#select_addressing loc in -+ let (addr, arg) = self#select_addressing Word loc in - (Ispecific(Ioffset_loc(n, addr)), [arg]) - | _ -> - super#select_operation op args -@@ -202,12 +202,12 @@ - - method select_floatarith commutative regular_op mem_op args = - match args with -- [arg1; Cop(Cload (Double|Double_u), [loc2])] -> -- let (addr, arg2) = self#select_addressing loc2 in -+ [arg1; Cop(Cload (Double|Double_u as chunk), [loc2])] -> -+ let (addr, arg2) = self#select_addressing chunk loc2 in - (Ispecific(Ifloatarithmem(mem_op, addr)), - [arg1; arg2]) -- | [Cop(Cload (Double|Double_u), [loc1]); arg2] when commutative -> -- let (addr, arg1) = self#select_addressing loc1 in -+ | [Cop(Cload (Double|Double_u as chunk), [loc1]); arg2] when commutative -> -+ let (addr, arg1) = self#select_addressing chunk loc1 in - (Ispecific(Ifloatarithmem(mem_op, addr)), - [arg2; arg1]) - | [arg1; arg2] -> -diff -urN ocaml-3.12.1-noarm/asmcomp/arm/arch.ml ocaml-3.12.1-arm/asmcomp/arm/arch.ml ---- ocaml-3.12.1-noarm/asmcomp/arm/arch.ml 2002-11-29 15:03:37.000000000 +0000 -+++ ocaml-3.12.1-arm/asmcomp/arm/arch.ml 2012-04-28 09:20:35.016065972 +0100 -@@ -1,25 +1,98 @@ - (***********************************************************************) - (* *) --(* Objective Caml *) -+(* OCaml *) - (* *) --(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -+(* Benedikt Meurer, University of Siegen *) - (* *) --(* Copyright 1998 Institut National de Recherche en Informatique et *) --(* en Automatique. All rights reserved. This file is distributed *) --(* under the terms of the Q Public License version 1.0. *) -+(* Copyright 1998 Institut National de Recherche en Informatique *) -+(* et en Automatique. Copyright 2012 Benedikt Meurer. All rights *) -+(* reserved. This file is distributed under the terms of the Q *) -+(* Public License version 1.0. *) - (* *) - (***********************************************************************) - --(* $Id: arch.ml 5304 2002-11-29 15:03:37Z xleroy $ *) -+(* $Id$ *) - - (* Specific operations for the ARM processor *) - - open Misc - open Format - -+type abi = EABI | EABI_VFP -+type arch = ARMv4 | ARMv5 | ARMv5TE | ARMv6 | ARMv6T2 | ARMv7 -+type fpu = Soft | VFPv3_D16 | VFPv3 -+ -+let abi = -+ match Config.system with -+ "linux_eabi" -> EABI -+ | "linux_eabihf" -> EABI_VFP -+ | _ -> assert false -+ -+let string_of_arch = function -+ ARMv4 -> "armv4" -+ | ARMv5 -> "armv5" -+ | ARMv5TE -> "armv5te" -+ | ARMv6 -> "armv6" -+ | ARMv6T2 -> "armv6t2" -+ | ARMv7 -> "armv7" -+ -+let string_of_fpu = function -+ Soft -> "soft" -+ | VFPv3_D16 -> "vfpv3-d16" -+ | VFPv3 -> "vfpv3" -+ - (* Machine-specific command-line options *) - --let command_line_options = [] -+let (arch, fpu, thumb) = -+ let (def_arch, def_fpu, def_thumb) = -+ begin match abi, 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 -+ end in -+ (ref def_arch, ref def_fpu, ref def_thumb) -+ -+let pic_code = ref false -+ -+let farch spec = -+ arch := (match spec with -+ "armv4" when abi <> EABI_VFP -> ARMv4 -+ | "armv5" when abi <> EABI_VFP -> ARMv5 -+ | "armv5te" when abi <> EABI_VFP -> ARMv5TE -+ | "armv6" when abi <> EABI_VFP -> ARMv6 -+ | "armv6t2" when abi <> EABI_VFP -> ARMv6T2 -+ | "armv7" -> ARMv7 -+ | spec -> raise (Arg.Bad spec)) -+ -+let ffpu spec = -+ fpu := (match spec with -+ "soft" when abi <> EABI_VFP -> Soft -+ | "vfpv3-d16" when abi = EABI_VFP -> VFPv3_D16 -+ | "vfpv3" when abi = EABI_VFP -> VFPv3 -+ | spec -> raise (Arg.Bad spec)) -+ -+let command_line_options = -+ [ "-farch", Arg.String farch, -+ " Select the ARM target architecture" -+ ^ " (default: " ^ (string_of_arch !arch) ^ ")"; -+ "-ffpu", Arg.String ffpu, -+ " Select the floating-point hardware" -+ ^ " (default: " ^ (string_of_fpu !fpu) ^ ")"; -+ "-fPIC", Arg.Set pic_code, -+ " Generate position-independent machine code"; -+ "-fno-PIC", Arg.Clear pic_code, -+ " Generate position-dependent machine code"; -+ "-fthumb", Arg.Set thumb, -+ " Enable Thumb/Thumb-2 code generation" -+ ^ (if !thumb then " (default)" else ""); -+ "-fno-thumb", Arg.Clear thumb, -+ " Disable Thumb/Thumb-2 code generation" -+ ^ (if not !thumb then " (default" else "")] - - (* Addressing modes *) - -@@ -37,6 +110,14 @@ - Ishiftarith of arith_operation * int - | Ishiftcheckbound of int - | Irevsubimm of int -+ | Imuladd (* multiply and add *) -+ | Imulsub (* multiply and subtract *) -+ | Inegmulf (* floating-point negate and multiply *) -+ | Imuladdf (* floating-point multiply and add *) -+ | Inegmuladdf (* floating-point negate, multiply and add *) -+ | Imulsubf (* floating-point multiply and subtract *) -+ | Inegmulsubf (* floating-point negate, multiply and subtract *) -+ | Isqrtf (* floating-point square root *) - - and arith_operation = - Ishiftadd -@@ -51,6 +132,10 @@ - let size_int = 4 - let size_float = 8 - -+(* Behavior of division *) -+ -+let division_crashes_on_overflow = false -+ - (* Operations on addressing modes *) - - let identity_addressing = Iindexed 0 -@@ -84,3 +169,56 @@ - fprintf ppf "check %a >> %i > %a" printreg arg.(0) n printreg arg.(1) - | Irevsubimm n -> - fprintf ppf "%i %s %a" n "-" printreg arg.(0) -+ | Imuladd -> -+ fprintf ppf "(%a * %a) + %a" -+ printreg arg.(0) -+ printreg arg.(1) -+ printreg arg.(2) -+ | Imulsub -> -+ fprintf ppf "-(%a * %a) + %a" -+ printreg arg.(0) -+ printreg arg.(1) -+ printreg arg.(2) -+ | Inegmulf -> -+ fprintf ppf "-f (%a *f %a)" -+ printreg arg.(0) -+ printreg arg.(1) -+ | Imuladdf -> -+ fprintf ppf "%a +f (%a *f %a)" -+ printreg arg.(0) -+ printreg arg.(1) -+ printreg arg.(2) -+ | Inegmuladdf -> -+ fprintf ppf "%a -f (%a *f %a)" -+ printreg arg.(0) -+ printreg arg.(1) -+ printreg arg.(2) -+ | Imulsubf -> -+ fprintf ppf "(-f %a) +f (%a *f %a)" -+ printreg arg.(0) -+ printreg arg.(1) -+ printreg arg.(2) -+ | Inegmulsubf -> -+ fprintf ppf "(-f %a) -f (%a *f %a)" -+ printreg arg.(0) -+ printreg arg.(1) -+ printreg arg.(2) -+ | Isqrtf -> -+ fprintf ppf "sqrtf %a" -+ printreg arg.(0) -+ -+(* Recognize immediate operands *) -+ -+(* Immediate operands are 8-bit immediate values, zero-extended, -+ and rotated right by 0 ... 30 bits. -+ In Thumb/Thumb-2 mode we utilize 26 ... 30. *) -+ -+let is_immediate n = -+ let n = ref n in -+ let s = ref 0 in -+ let m = if !thumb then 24 else 30 in -+ while (!s <= m && Int32.logand !n 0xffl <> !n) do -+ n := Int32.logor (Int32.shift_right_logical !n 2) (Int32.shift_left !n 30); -+ s := !s + 2 -+ done; -+ !s <= m -diff -urN ocaml-3.12.1-noarm/asmcomp/arm/emit.mlp ocaml-3.12.1-arm/asmcomp/arm/emit.mlp ---- ocaml-3.12.1-noarm/asmcomp/arm/emit.mlp 2012-04-27 20:51:07.196775304 +0100 -+++ ocaml-3.12.1-arm/asmcomp/arm/emit.mlp 2012-04-28 09:20:35.037066348 +0100 -@@ -1,16 +1,17 @@ - (***********************************************************************) - (* *) --(* Objective Caml *) -+(* OCaml *) - (* *) --(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -+(* Benedikt Meurer, University of Siegen *) - (* *) --(* Copyright 1998 Institut National de Recherche en Informatique et *) --(* en Automatique. All rights reserved. This file is distributed *) --(* under the terms of the Q Public License version 1.0. *) -+(* Copyright 1998 Institut National de Recherche en Informatique *) -+(* et en Automatique. Copyright 2012 Benedikt Meurer. All rights *) -+(* reserved. This file is distributed under the terms of the Q *) -+(* Public License version 1.0. *) - (* *) - (***********************************************************************) - --(* $Id: emit.mlp 10293 2010-04-22 09:33:18Z xleroy $ *) -+(* $Id$ *) - - (* Emission of ARM assembly code *) - -@@ -33,16 +34,28 @@ - let emit_label lbl = - emit_string ".L"; emit_int lbl - --(* Output a symbol *) -+let emit_data_label lbl = -+ emit_string ".Ld"; emit_int lbl -+ -+(* Symbols *) - - let emit_symbol s = - Emitaux.emit_symbol '$' s - -+let emit_call s = -+ if !Clflags.dlcode || !pic_code -+ then `bl {emit_symbol s}(PLT)` -+ else `bl {emit_symbol s}` -+ -+let emit_jump s = -+ if !Clflags.dlcode || !pic_code -+ then `b {emit_symbol s}(PLT)` -+ else `b {emit_symbol s}` -+ - (* Output a pseudo-register *) - --let emit_reg r = -- match r.loc with -- | Reg r -> emit_string (register_name r) -+let emit_reg = function -+ {loc = Reg r} -> emit_string (register_name r) - | _ -> fatal_error "Emit_arm.emit_reg" - - (* Layout of the stack frame *) -@@ -53,14 +66,23 @@ - let sz = - !stack_offset + - 4 * num_stack_slots.(0) + -+ 8 * num_stack_slots.(1) + -+ 8 * num_stack_slots.(2) + - (if !contains_calls then 4 else 0) - in Misc.align sz 8 - - let slot_offset loc cl = - match loc with -- Incoming n -> frame_size() + n -- | Local n -> !stack_offset + n * 4 -- | Outgoing n -> n -+ Incoming n -> -+ assert (n >= 0); -+ frame_size() + n -+ | Local n -> -+ if cl = 0 -+ then !stack_offset + n * 4 -+ else !stack_offset + num_stack_slots.(0) * 4 + n * 8 -+ | Outgoing n -> -+ assert (n >= 0); -+ n - - (* Output a stack reference *) - -@@ -79,20 +101,13 @@ - - (* Record live pointers at call points *) - --type frame_descr = -- { fd_lbl: int; (* Return address *) -- fd_frame_size: int; (* Size of stack frame *) -- fd_live_offset: int list } (* Offsets/regs of live addresses *) -- --let frame_descriptors = ref([] : frame_descr list) -- --let record_frame live = -+let record_frame_label live dbg = - let lbl = new_label() in - let live_offset = ref [] in - Reg.Set.iter - (function - {typ = Addr; loc = Reg r} -> -- live_offset := (r lsl 1) + 1 :: !live_offset -+ live_offset := ((r lsl 1) + 1) :: !live_offset - | {typ = Addr; loc = Stack s} as reg -> - live_offset := slot_offset s (register_class reg) :: !live_offset - | _ -> ()) -@@ -100,18 +115,57 @@ - frame_descriptors := - { fd_lbl = lbl; - fd_frame_size = frame_size(); -- fd_live_offset = !live_offset } :: !frame_descriptors; -- `{emit_label lbl}:` -+ fd_live_offset = !live_offset; -+ fd_debuginfo = dbg } :: !frame_descriptors; -+ lbl -+ -+let record_frame live dbg = -+ let lbl = record_frame_label live dbg in `{emit_label lbl}:` -+ -+(* Record calls to the GC -- we've moved them out of the way *) -+ -+type gc_call = -+ { gc_lbl: label; (* Entry label *) -+ gc_return_lbl: label; (* Where to branch after GC *) -+ gc_frame_lbl: label } (* Label of frame descriptor *) -+ -+let call_gc_sites = ref ([] : gc_call list) -+ -+let emit_call_gc gc = -+ `{emit_label gc.gc_lbl}: {emit_call "caml_call_gc"}\n`; -+ `{emit_label gc.gc_frame_lbl}: b {emit_label gc.gc_return_lbl}\n` -+ -+(* Record calls to caml_ml_array_bound_error. -+ In debug mode, we maintain one call to caml_ml_array_bound_error -+ per bound check site. Otherwise, we can share a single call. *) -+ -+type bound_error_call = -+ { bd_lbl: label; (* Entry label *) -+ bd_frame_lbl: label } (* Label of frame descriptor *) -+ -+let bound_error_sites = ref ([] : bound_error_call list) -+ -+let bound_error_label dbg = -+ if !Clflags.debug || !bound_error_sites = [] then begin -+ let lbl_bound_error = new_label() in -+ let lbl_frame = record_frame_label Reg.Set.empty dbg in -+ bound_error_sites := -+ { bd_lbl = lbl_bound_error; -+ bd_frame_lbl = lbl_frame } :: !bound_error_sites; -+ lbl_bound_error -+ end else begin -+ let bd = List.hd !bound_error_sites in bd.bd_lbl -+ end - --let emit_frame fd = -- ` .word {emit_label fd.fd_lbl} + 4\n`; -- ` .short {emit_int fd.fd_frame_size}\n`; -- ` .short {emit_int (List.length fd.fd_live_offset)}\n`; -- List.iter -- (fun n -> -- ` .short {emit_int n}\n`) -- fd.fd_live_offset; -- ` .align 2\n` -+let emit_call_bound_error bd = -+ `{emit_label bd.bd_lbl}: {emit_call "caml_ml_array_bound_error"}\n`; -+ `{emit_label bd.bd_frame_lbl}:\n` -+ -+(* Negate a comparison *) -+ -+let negate_integer_comparison = function -+ Isigned cmp -> Isigned(negate_comparison cmp) -+ | Iunsigned cmp -> Iunsigned(negate_comparison cmp) - - (* Names of various instructions *) - -@@ -121,22 +175,13 @@ - | Iunsigned Ceq -> "eq" | Iunsigned Cne -> "ne" | Iunsigned Cle -> "ls" - | Iunsigned Cge -> "cs" | Iunsigned Clt -> "cc" | Iunsigned Cgt -> "hi" - --let name_for_float_comparison cmp neg = -- match cmp with -- Ceq -> if neg then "ne" else "eq" -- | Cne -> if neg then "eq" else "ne" -- | Cle -> if neg then "hi" else "ls" -- | Cge -> if neg then "lt" else "ge" -- | Clt -> if neg then "pl" else "mi" -- | Cgt -> if neg then "le" else "gt" -- - let name_for_int_operation = function - Iadd -> "add" - | Isub -> "sub" - | Imul -> "mul" -- | Iand -> "and" -- | Ior -> "orr" -- | Ixor -> "eor" -+ | Iand -> "and" -+ | Ior -> "orr" -+ | Ixor -> "eor" - | _ -> assert false - - let name_for_shift_operation = function -@@ -145,60 +190,54 @@ - | Iasr -> "asr" - | _ -> assert false - --let name_for_shift_int_operation = function -- Ishiftadd -> "add" -- | Ishiftsub -> "sub" -- | Ishiftsubrev -> "rsb" -- --(* Recognize immediate operands *) -- --(* Immediate operands are 8-bit immediate values, zero-extended, and rotated -- right by 0, 2, 4, ... 30 bits. -- We check only with 8-bit values shifted left 0 to 24 bits. *) -- --let rec is_immed n shift = -- shift <= 24 && -- (Nativeint.logand n (Nativeint.shift_left (Nativeint.of_int 0xFF) shift) = n -- || is_immed n (shift + 2)) -- --let is_immediate n = is_immed n 0 -- - (* General functional to decompose a non-immediate integer constant -- into 8-bit chunks shifted left 0 ... 24 bits *) -+ into 8-bit chunks shifted left 0 ... 30 bits. *) - - let decompose_intconst n fn = - let i = ref n in - let shift = ref 0 in - let ninstr = ref 0 in -- while !i <> 0n do -- if Nativeint.to_int (Nativeint.shift_right !i !shift) land 3 = 0 then -+ while !i <> 0l do -+ if Int32.logand (Int32.shift_right !i !shift) 3l = 0l then - shift := !shift + 2 - else begin -- let mask = Nativeint.shift_left 0xFFn !shift in -- let bits = Nativeint.logand !i mask in -- fn bits; -+ let bits = Int32.logand !i (Int32.shift_left 0xffl !shift) in -+ i := Int32.sub !i bits; - shift := !shift + 8; -- i := Nativeint.sub !i bits; -- incr ninstr -+ incr ninstr; -+ fn bits - end - done; - !ninstr - - (* Load an integer constant into a register *) - --let emit_intconst r n = -- let nr = Nativeint.lognot n in -+let emit_intconst dst n = -+ let nr = Int32.lognot n in - if is_immediate n then begin -- ` mov {emit_reg r}, #{emit_nativeint n}\n`; 1 -+ (* Use movs here to enable 16-bit T1 encoding *) -+ ` movs {emit_reg dst}, #{emit_int32 n}\n`; 1 - end else if is_immediate nr then begin -- ` mvn {emit_reg r}, #{emit_nativeint nr}\n`; 1 -+ ` mvn {emit_reg dst}, #{emit_int32 nr}\n`; 1 -+ end else if !arch > ARMv6 then begin -+ let nl = Int32.logand 0xffffl n in -+ let nh = Int32.logand 0xffffl (Int32.shift_right_logical n 16) in -+ if nh = 0l then begin -+ ` movw {emit_reg dst}, #{emit_int32 nl}\n`; 1 -+ end else if Int32.logand nl 0xffl = nl then begin -+ ` movs {emit_reg dst}, #{emit_int32 nl}\n`; -+ ` movt {emit_reg dst}, #{emit_int32 nh}\n`; 2 -+ end else begin -+ ` movw {emit_reg dst}, #{emit_int32 nl}\n`; -+ ` movt {emit_reg dst}, #{emit_int32 nh}\n`; 2 -+ end - end else begin - let first = ref true in - decompose_intconst n - (fun bits -> - if !first -- then ` mov {emit_reg r}, #{emit_nativeint bits} @ {emit_nativeint n}\n` -- else ` add {emit_reg r}, {emit_reg r}, #{emit_nativeint bits}\n`; -+ then ` mov {emit_reg dst}, #{emit_int32 bits} @ {emit_int32 n}\n` -+ else ` add {emit_reg dst}, {emit_reg dst}, #{emit_int32 bits}\n`; - first := false) - end - -@@ -206,46 +245,105 @@ - - let emit_stack_adjustment instr n = - if n <= 0 then 0 else -- decompose_intconst (Nativeint.of_int n) -+ decompose_intconst (Int32.of_int n) - (fun bits -> -- ` {emit_string instr} sp, sp, #{emit_nativeint bits}\n`) -+ ` {emit_string instr} sp, sp, #{emit_int32 bits}\n`) - - (* Name of current function *) - let function_name = ref "" - (* Entry point for tail recursive calls *) - let tailrec_entry_point = ref 0 --(* Table of symbols referenced *) --let symbol_constants = (Hashtbl.create 11 : (string, int) Hashtbl.t) --(* Table of floating-point literals *) --let float_constants = (Hashtbl.create 11 : (string, int) Hashtbl.t) --(* Total space (in word) occupied by pending literals *) -+(* Pending floating-point literals *) -+let float_literals = ref ([] : (string * label) list) -+(* Pending relative references to the global offset table *) -+let gotrel_literals = ref ([] : (label * label) list) -+(* Pending symbol literals *) -+let symbol_literals = ref ([] : (string * label) list) -+(* Total space (in words) occupied by pending literals *) - let num_literals = ref 0 - --(* Label a symbol or float constant *) --let label_constant tbl s size = -+(* Label a floating-point literal *) -+let float_literal f = - try -- Hashtbl.find tbl s -+ List.assoc f !float_literals - with Not_found -> - let lbl = new_label() in -- Hashtbl.add tbl s lbl; -- num_literals := !num_literals + size; -+ num_literals := !num_literals + 2; -+ float_literals := (f, lbl) :: !float_literals; - lbl - --(* Emit all pending constants *) -+(* Label a GOTREL literal *) -+let gotrel_literal l = -+ let lbl = new_label() in -+ num_literals := !num_literals + 1; -+ gotrel_literals := (l, lbl) :: !gotrel_literals; -+ lbl - --let emit_constants () = -- Hashtbl.iter -- (fun s lbl -> -- `{emit_label lbl}: .word {emit_symbol s}\n`) -- symbol_constants; -- Hashtbl.iter -- (fun s lbl -> -- `{emit_label lbl}: .double {emit_string s}\n`) -- float_constants; -- Hashtbl.clear symbol_constants; -- Hashtbl.clear float_constants; -+(* Label a symbol literal *) -+let symbol_literal s = -+ try -+ List.assoc s !symbol_literals -+ with Not_found -> -+ let lbl = new_label() in -+ num_literals := !num_literals + 1; -+ symbol_literals := (s, lbl) :: !symbol_literals; -+ lbl -+ -+(* Emit all pending literals *) -+let emit_literals() = -+ if !float_literals <> [] then begin -+ ` .align 3\n`; -+ List.iter -+ (fun (f, lbl) -> -+ `{emit_label lbl}: .double {emit_string f}\n`) -+ !float_literals; -+ float_literals := [] -+ end; -+ if !symbol_literals <> [] then begin -+ let offset = if !thumb then 4 else 8 in -+ let suffix = if !pic_code then "(GOT)" else "" in -+ ` .align 2\n`; -+ List.iter -+ (fun (l, lbl) -> -+ `{emit_label lbl}: .word _GLOBAL_OFFSET_TABLE_-({emit_label l}+{emit_int offset})\n`) -+ !gotrel_literals; -+ List.iter -+ (fun (s, lbl) -> -+ `{emit_label lbl}: .word {emit_symbol s}{emit_string suffix}\n`) -+ !symbol_literals; -+ gotrel_literals := []; -+ symbol_literals := [] -+ end; - num_literals := 0 - -+(* Emit code to load the address of a symbol *) -+ -+let emit_load_symbol_addr dst s = -+ if !pic_code then begin -+ let lbl_pic = new_label() in -+ let lbl_got = gotrel_literal lbl_pic in -+ let lbl_sym = symbol_literal s in -+ (* Both r3 and r12 are marked as clobbered in PIC mode (cf. proc.ml), -+ so use r12 as temporary scratch register unless the destination is -+ r12, then we use r3 instead. *) -+ let tmp = if dst.loc = Reg 8 (*r12*) -+ then phys_reg 3 (*r3*) -+ else phys_reg 8 (*r12*) in -+ ` ldr {emit_reg tmp}, {emit_label lbl_got}\n`; -+ ` ldr {emit_reg dst}, {emit_label lbl_sym}\n`; -+ `{emit_label lbl_pic}: add {emit_reg tmp}, pc, {emit_reg tmp}\n`; -+ ` ldr {emit_reg dst}, [{emit_reg tmp}, {emit_reg dst}] @ {emit_symbol s}\n`; -+ 4 -+ end else if !arch > ARMv6 && not !Clflags.dlcode && !fastcode_flag then begin -+ ` movw {emit_reg dst}, #:lower16:{emit_symbol s}\n`; -+ ` movt {emit_reg dst}, #:upper16:{emit_symbol s}\n`; -+ 2 -+ end else begin -+ let lbl = symbol_literal s in -+ ` ldr {emit_reg dst}, {emit_label lbl} @ {emit_symbol s}\n`; -+ 1 -+ end -+ - (* Output the assembly code for an instruction *) - - let emit_instr i = -@@ -254,40 +352,76 @@ - | Lop(Imove | Ispill | Ireload) -> - let src = i.arg.(0) and dst = i.res.(0) in - if src.loc = dst.loc then 0 else begin -- match (src, dst) with -- {loc = Reg rs; typ = Int|Addr}, {loc = Reg rd; typ = Int|Addr} -> -- ` mov {emit_reg dst}, {emit_reg src}\n`; 1 -- | {loc = Reg rs; typ = Int|Addr}, {loc = Stack sd} -> -- ` str {emit_reg src}, {emit_stack dst}\n`; 1 -- | {loc = Stack ss; typ = Int|Addr}, {loc = Reg rd} -> -- ` ldr {emit_reg dst}, {emit_stack src}\n`; 1 -+ begin match (src, dst) with -+ {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` -+ | {loc = Reg _; typ = Float}, _ -> -+ ` fstd {emit_reg src}, {emit_stack dst}\n` -+ | {loc = Reg _}, _ -> -+ ` str {emit_reg src}, {emit_stack dst}\n` -+ | {typ = Float}, _ -> -+ ` fldd {emit_reg dst}, {emit_stack src}\n` - | _ -> -- assert false -+ ` ldr {emit_reg dst}, {emit_stack src}\n` -+ end; 1 - end - | Lop(Iconst_int n) -> -- emit_intconst i.res.(0) n -- | Lop(Iconst_float s) -> -- let bits = Int64.bits_of_float (float_of_string s) in -- let high_bits = Int64.to_nativeint (Int64.shift_right_logical bits 32) -- and low_bits = Int64.to_nativeint bits in -- if is_immediate low_bits && is_immediate high_bits then begin -- ` mov {emit_reg i.res.(0)}, #{emit_nativeint low_bits} @ {emit_string s}\n`; -- ` mov {emit_reg i.res.(1)}, #{emit_nativeint high_bits}\n`; -- 2 -+ emit_intconst i.res.(0) (Nativeint.to_int32 n) -+ | Lop(Iconst_float f) when !fpu = Soft -> -+ ` @ {emit_string f}\n`; -+ let bits = Int64.bits_of_float (float_of_string f) in -+ let high_bits = Int64.to_int32 (Int64.shift_right_logical bits 32) -+ and low_bits = Int64.to_int32 bits in -+ if is_immediate low_bits || is_immediate high_bits then begin -+ let ninstr_low = emit_intconst i.res.(0) low_bits -+ and ninstr_high = emit_intconst i.res.(1) high_bits in -+ ninstr_low + ninstr_high - end else begin -- let lbl = label_constant float_constants s 2 in -- ` ldr {emit_reg i.res.(0)}, {emit_label lbl} @ {emit_string s}\n`; -+ let lbl = float_literal f in -+ ` ldr {emit_reg i.res.(0)}, {emit_label lbl}\n`; - ` ldr {emit_reg i.res.(1)}, {emit_label lbl} + 4\n`; - 2 - end -+ | Lop(Iconst_float f) -> -+ let encode imm = -+ let sg = Int64.to_int (Int64.shift_right_logical imm 63) in -+ let ex = Int64.to_int (Int64.shift_right_logical imm 52) in -+ let ex = (ex land 0x7ff) - 1023 in -+ let mn = Int64.logand imm 0xfffffffffffffL in -+ if Int64.logand mn 0xffffffffffffL <> 0L || ex < -3 || ex > 4 -+ then -+ None -+ else begin -+ let mn = Int64.to_int (Int64.shift_right_logical mn 48) in -+ if mn land 0x0f <> mn then -+ None -+ else -+ let ex = ((ex + 3) land 0x07) lxor 0x04 in -+ Some((sg lsl 7) lor (ex lsl 4) lor mn) -+ end in -+ begin match encode (Int64.bits_of_float (float_of_string f)) with -+ None -> -+ let lbl = float_literal f in -+ ` fldd {emit_reg i.res.(0)}, {emit_label lbl} @ {emit_string f}\n` -+ | Some imm8 -> -+ ` fconstd {emit_reg i.res.(0)}, #{emit_int imm8} @ {emit_string f}\n` -+ end; 1 - | Lop(Iconst_symbol s) -> -- let lbl = label_constant symbol_constants s 1 in -- ` ldr {emit_reg i.res.(0)}, {emit_label lbl} @ {emit_symbol s}\n`; 1 -+ emit_load_symbol_addr i.res.(0) s - | Lop(Icall_ind) -> -- ` mov lr, pc\n`; -- `{record_frame i.live} bx {emit_reg i.arg.(0)}\n`; 2 -+ if !arch >= ARMv5 then begin -+ ` blx {emit_reg i.arg.(0)}\n`; -+ `{record_frame i.live i.dbg}\n`; 1 -+ end else begin -+ ` mov lr, pc\n`; -+ ` bx {emit_reg i.arg.(0)}\n`; -+ `{record_frame i.live i.dbg}\n`; 2 -+ end - | Lop(Icall_imm s) -> -- `{record_frame i.live} bl {emit_symbol s}\n`; 1 -+ ` {emit_call s}\n`; -+ `{record_frame i.live i.dbg}\n`; 1 - | Lop(Itailcall_ind) -> - let n = frame_size() in - if !contains_calls then -@@ -303,17 +437,16 @@ - if !contains_calls then - ` ldr lr, [sp, #{emit_int (n-4)}]\n`; - let ninstr = emit_stack_adjustment "add" n in -- ` b {emit_symbol s}\n`; -+ ` {emit_jump s}\n`; - 2 + ninstr - end -- | Lop(Iextcall(s, alloc)) -> -- if alloc then begin -- let lbl = label_constant symbol_constants s 1 in -- ` ldr r12, {emit_label lbl} @ {emit_symbol s}\n`; -- `{record_frame i.live} bl caml_c_call\n`; 2 -- end else begin -- ` bl {emit_symbol s}\n`; 1 -- end -+ | Lop(Iextcall(s, false)) -> -+ ` {emit_call s}\n`; 1 -+ | Lop(Iextcall(s, true)) -> -+ let ninstr = emit_load_symbol_addr (phys_reg 7 (* r7 *)) s in -+ ` {emit_call "caml_c_call"}\n`; -+ `{record_frame i.live i.dbg}\n`; -+ 1 + ninstr - | Lop(Istackoffset n) -> - assert (n mod 8 = 0); - let ninstr = -@@ -322,16 +455,28 @@ - else emit_stack_adjustment "add" (-n) in - stack_offset := !stack_offset + n; - ninstr -- | Lop(Iload((Double | Double_u), addr)) -> -- let addr' = offset_addressing addr 4 in -- if i.res.(0).loc <> i.arg.(0).loc then begin -- ` ldr {emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n`; -- ` ldr {emit_reg i.res.(1)}, {emit_addressing addr' i.arg 0}\n` -- end else begin -- ` ldr {emit_reg i.res.(1)}, {emit_addressing addr' i.arg 0}\n`; -- ` ldr {emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n` -- end; -- 2 -+ | Lop(Iload(Single, addr)) when !fpu >= VFPv3_D16 -> -+ ` flds s14, {emit_addressing addr i.arg 0}\n`; -+ ` fcvtds {emit_reg i.res.(0)}, s14\n`; 2 -+ | Lop(Iload((Double | Double_u), addr)) when !fpu = Soft -> -+ (* Use LDM or LDRD if possible *) -+ begin match i.res.(0), i.res.(1), addr with -+ {loc = Reg rt}, {loc = Reg rt2}, Iindexed 0 -+ when rt < rt2 -> -+ ` ldm {emit_reg i.arg.(0)}, \{{emit_reg i.res.(0)}, {emit_reg i.res.(1)}}\n`; 1 -+ | {loc = Reg rt}, {loc = Reg rt2}, addr -+ when !arch >= ARMv5TE && rt mod 2 == 0 && rt2 = rt + 1 -> -+ ` ldrd {emit_reg i.res.(0)}, {emit_reg i.res.(1)}, {emit_addressing addr i.arg 0}\n`; 1 -+ | _ -> -+ let addr' = offset_addressing addr 4 in -+ if i.res.(0).loc <> i.arg.(0).loc then begin -+ ` ldr {emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n`; -+ ` ldr {emit_reg i.res.(1)}, {emit_addressing addr' i.arg 0}\n` -+ end else begin -+ ` ldr {emit_reg i.res.(1)}, {emit_addressing addr' i.arg 0}\n`; -+ ` ldr {emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n` -+ end; 2 -+ end - | Lop(Iload(size, addr)) -> - let r = i.res.(0) in - let instr = -@@ -340,65 +485,114 @@ - | Byte_signed -> "ldrsb" - | Sixteen_unsigned -> "ldrh" - | Sixteen_signed -> "ldrsh" -+ | Double -+ | Double_u -> "fldd" - | _ (* 32-bit quantities *) -> "ldr" in -- ` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 0}\n`; -- 1 -- | Lop(Istore((Double | Double_u), addr)) -> -- let addr' = offset_addressing addr 4 in -- ` str {emit_reg i.arg.(0)}, {emit_addressing addr i.arg 2}\n`; -- ` str {emit_reg i.arg.(1)}, {emit_addressing addr' i.arg 2}\n`; -- 2 -+ ` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 0}\n`; 1 -+ | Lop(Istore(Single, addr)) when !fpu >= VFPv3_D16 -> -+ ` fcvtsd s14, {emit_reg i.arg.(0)}\n`; -+ ` fsts s14, {emit_addressing addr i.arg 1}\n`; 2 -+ | Lop(Istore((Double | Double_u), addr)) when !fpu = Soft -> -+ (* Use STM or STRD if possible *) -+ begin match i.arg.(0), i.arg.(1), addr with -+ {loc = Reg rt}, {loc = Reg rt2}, Iindexed 0 -+ when rt < rt2 -> -+ ` stm {emit_reg i.arg.(2)}, \{{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}}\n`; 1 -+ | {loc = Reg rt}, {loc = Reg rt2}, addr -+ when !arch >= ARMv5TE && rt mod 2 == 0 && rt2 = rt + 1 -> -+ ` strd {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_addressing addr i.arg 2}\n`; 1 -+ | _ -> -+ let addr' = offset_addressing addr 4 in -+ ` str {emit_reg i.arg.(0)}, {emit_addressing addr i.arg 2}\n`; -+ ` str {emit_reg i.arg.(1)}, {emit_addressing addr' i.arg 2}\n`; 2 -+ end - | Lop(Istore(size, addr)) -> - let r = i.arg.(0) in - let instr = - match size with -- Byte_unsigned | Byte_signed -> "strb" -- | Sixteen_unsigned | Sixteen_signed -> "strh" -+ Byte_unsigned -+ | Byte_signed -> "strb" -+ | Sixteen_unsigned -+ | Sixteen_signed -> "strh" -+ | Double -+ | Double_u -> "fstd" - | _ (* 32-bit quantities *) -> "str" in -- ` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 1}\n`; -- 1 -+ ` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 1}\n`; 1 - | Lop(Ialloc n) -> -+ let lbl_frame = record_frame_label i.live i.dbg in - if !fastcode_flag then begin -- let ni = emit_intconst (phys_reg 8 (*r12*)) (Nativeint.of_int n) in -- ` sub alloc_ptr, alloc_ptr, r12\n`; -+ let lbl_redo = new_label() in -+ `{emit_label lbl_redo}:`; -+ let ninstr = decompose_intconst -+ (Int32.of_int n) -+ (fun i -> -+ ` sub alloc_ptr, alloc_ptr, #{emit_int32 i}\n`) in - ` cmp alloc_ptr, alloc_limit\n`; -- `{record_frame i.live} blcc caml_call_gc\n`; - ` add {emit_reg i.res.(0)}, alloc_ptr, #4\n`; -- 4 + ni -- end else if n = 8 || n = 12 || n = 16 then begin -- `{record_frame i.live} bl caml_alloc{emit_int ((n-4)/4)}\n`; -- ` add {emit_reg i.res.(0)}, alloc_ptr, #4\n`; 2 -+ let lbl_call_gc = new_label() in -+ ` bcc {emit_label lbl_call_gc}\n`; -+ call_gc_sites := -+ { gc_lbl = lbl_call_gc; -+ gc_return_lbl = lbl_redo; -+ gc_frame_lbl = lbl_frame } :: !call_gc_sites; -+ 3 + ninstr - end else begin -- let ni = emit_intconst (phys_reg 8 (*r12*)) (Nativeint.of_int n) in -- `{record_frame i.live} bl caml_allocN\n`; -- ` add {emit_reg i.res.(0)}, alloc_ptr, #4\n`; -- 2 + ni -+ let ninstr = -+ begin match n with -+ 8 -> ` {emit_call "caml_alloc1"}\n`; 1 -+ | 12 -> ` {emit_call "caml_alloc2"}\n`; 1 -+ | 16 -> ` {emit_call "caml_alloc3"}\n`; 1 -+ | _ -> let ninstr = emit_intconst (phys_reg 7) (Int32.of_int n) in -+ ` {emit_call "caml_allocN"}\n`; 1 + ninstr -+ end in -+ `{emit_label lbl_frame}: add {emit_reg i.res.(0)}, alloc_ptr, #4\n`; -+ 1 + ninstr - end - | Lop(Iintop(Ilsl | Ilsr | Iasr as op)) -> - let shift = name_for_shift_operation op in - ` mov {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_string shift} {emit_reg i.arg.(1)}\n`; 1 - | Lop(Iintop(Icomp cmp)) -> -- let comp = name_for_comparison cmp in -+ let compthen = name_for_comparison cmp in -+ let compelse = name_for_comparison (negate_integer_comparison cmp) in - ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; -- ` mov {emit_reg i.res.(0)}, #0\n`; -- ` mov{emit_string comp} {emit_reg i.res.(0)}, #1\n`; 3 -- | Lop(Iintop(Icheckbound)) -> -+ ` ite {emit_string compthen}\n`; -+ ` mov{emit_string compthen} {emit_reg i.res.(0)}, #1\n`; -+ ` mov{emit_string compelse} {emit_reg i.res.(0)}, #0\n`; 4 -+ | Lop(Iintop_imm(Icomp cmp, n)) -> -+ let compthen = name_for_comparison cmp in -+ let compelse = name_for_comparison (negate_integer_comparison cmp) in -+ ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`; -+ ` ite {emit_string compthen}\n`; -+ ` mov{emit_string compthen} {emit_reg i.res.(0)}, #1\n`; -+ ` mov{emit_string compelse} {emit_reg i.res.(0)}, #0\n`; 4 -+ | Lop(Iintop Icheckbound) -> -+ let lbl = bound_error_label i.dbg in - ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; -- ` blls caml_ml_array_bound_error\n`; 2 -+ ` bls {emit_label lbl}\n`; 2 -+ | Lop(Iintop_imm(Icheckbound, n)) -> -+ let lbl = bound_error_label i.dbg in -+ ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`; -+ ` bls {emit_label lbl}\n`; 2 -+ | Lop(Ispecific(Ishiftcheckbound shift)) -> -+ let lbl = bound_error_label i.dbg in -+ ` cmp {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`; -+ ` bcs {emit_label lbl}\n`; 2 - | Lop(Iintop op) -> - let instr = name_for_int_operation op in -- ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; 1 -+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; 1 - | Lop(Iintop_imm(Idiv, n)) -> (* n is a power of 2 *) - let l = Misc.log2 n in - let r = i.res.(0) in - ` movs {emit_reg r}, {emit_reg i.arg.(0)}\n`; -- if n <= 256 then -+ if n <= 256 then begin -+ ` it lt\n`; - ` addlt {emit_reg r}, {emit_reg r}, #{emit_int (n-1)}\n` -- else begin -+ end else begin -+ ` itt lt\n`; - ` addlt {emit_reg r}, {emit_reg r}, #{emit_int n}\n`; - ` sublt {emit_reg r}, {emit_reg r}, #1\n` - end; -- ` mov {emit_reg r}, {emit_reg r}, asr #{emit_int l}\n`; 4 -+ ` mov {emit_reg r}, {emit_reg r}, asr #{emit_int l}\n`; 5 - | Lop(Iintop_imm(Imod, n)) -> (* n is a power of 2 *) - let l = Misc.log2 n in - let a = i.arg.(0) in -@@ -409,40 +603,71 @@ - ` mov {emit_reg r}, {emit_reg r}, lsr #{emit_int (32-l)}\n`; - ` bpl {emit_label lbl}\n`; - ` cmp {emit_reg r}, #0\n`; -+ ` it ne\n`; - ` subne {emit_reg r}, {emit_reg r}, #{emit_int n}\n`; -- `{emit_label lbl}:\n`; 6 -+ `{emit_label lbl}:\n`; 7 - | Lop(Iintop_imm((Ilsl | Ilsr | Iasr as op), n)) -> - let shift = name_for_shift_operation op in - ` mov {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_string shift} #{emit_int n}\n`; 1 -- | Lop(Iintop_imm(Icomp cmp, n)) -> -- let comp = name_for_comparison cmp in -- ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`; -- ` mov {emit_reg i.res.(0)}, #0\n`; -- ` mov{emit_string comp} {emit_reg i.res.(0)}, #1\n`; 3 -- | Lop(Iintop_imm(Icheckbound, n)) -> -- ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`; -- ` blls caml_ml_array_bound_error\n`; 2 - | Lop(Iintop_imm(op, n)) -> - let instr = name_for_int_operation op in -- ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #{emit_int n}\n`; 1 -- | Lop(Inegf) -> (* argument and result in (r0, r1) *) -- ` eor r1, r1, #0x80000000\n`; 1 -- | Lop(Iabsf) -> (* argument and result in (r0, r1) *) -- ` bic r1, r1, #0x80000000\n`; 1 -- | Lop(Ifloatofint | Iintoffloat | Iaddf | Isubf | Imulf | Idivf) -> -- assert false -+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #{emit_int n}\n`; 1 -+ | Lop(Iabsf | Inegf as op) when !fpu = Soft -> -+ let instr = (match op with -+ Iabsf -> "bic" -+ | Inegf -> "eor" -+ | _ -> assert false) in -+ ` {emit_string instr} {emit_reg i.res.(1)}, {emit_reg i.arg.(1)}, #0x80000000\n`; 1 -+ | Lop(Iabsf | Inegf | Ispecific Isqrtf as op) -> -+ let instr = (match op with -+ Iabsf -> "fabsd" -+ | Inegf -> "fnegd" -+ | Ispecific Isqrtf -> "fsqrtd" -+ | _ -> assert false) in -+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`; 1 -+ | Lop(Ifloatofint) -> -+ ` fmsr s14, {emit_reg i.arg.(0)}\n`; -+ ` fsitod {emit_reg i.res.(0)}, s14\n`; 2 -+ | Lop(Iintoffloat) -> -+ ` ftosizd s14, {emit_reg i.arg.(0)}\n`; -+ ` fmrs {emit_reg i.res.(0)}, s14\n`; 2 -+ | Lop(Iaddf | Isubf | Imulf | Idivf | Ispecific Inegmulf as op) -> -+ let instr = (match op with -+ Iaddf -> "faddd" -+ | Isubf -> "fsubd" -+ | Imulf -> "fmuld" -+ | Idivf -> "fdivd" -+ | Ispecific Inegmulf -> "fnmuld" -+ | _ -> assert false) in -+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; -+ 1 -+ | Lop(Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf as op)) -> -+ let instr = (match op with -+ Imuladdf -> "fmacd" -+ | Inegmuladdf -> "fnmacd" -+ | Imulsubf -> "fmscd" -+ | Inegmulsubf -> "fnmscd" -+ | _ -> assert false) in -+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n`; -+ 1 - | Lop(Ispecific(Ishiftarith(op, shift))) -> -- let instr = name_for_shift_int_operation op in -- ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}`; -+ let instr = (match op with -+ Ishiftadd -> "add" -+ | Ishiftsub -> "sub" -+ | Ishiftsubrev -> "rsb") in -+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}`; - if shift >= 0 - then `, lsl #{emit_int shift}\n` - else `, asr #{emit_int (-shift)}\n`; - 1 -- | Lop(Ispecific(Ishiftcheckbound shift)) -> -- ` cmp {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`; -- ` blcs caml_ml_array_bound_error\n`; 2 - | Lop(Ispecific(Irevsubimm n)) -> - ` rsb {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #{emit_int n}\n`; 1 -+ | Lop(Ispecific(Imuladd | Imulsub as op)) -> -+ let instr = (match op with -+ Imuladd -> "mla" -+ | Imulsub -> "mls" -+ | _ -> assert false) 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`; 1 - | Lreloadretaddr -> - let n = frame_size() in - ` ldr lr, [sp, #{emit_int(n-4)}]\n`; 1 -@@ -458,29 +683,41 @@ - begin match tst with - Itruetest -> - ` cmp {emit_reg i.arg.(0)}, #0\n`; -- ` bne {emit_label lbl}\n` -+ ` bne {emit_label lbl}\n`; 2 - | Ifalsetest -> - ` cmp {emit_reg i.arg.(0)}, #0\n`; -- ` beq {emit_label lbl}\n` -+ ` beq {emit_label lbl}\n`; 2 - | Iinttest cmp -> - ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; - let comp = name_for_comparison cmp in -- ` b{emit_string comp} {emit_label lbl}\n` -+ ` b{emit_string comp} {emit_label lbl}\n`; 2 - | Iinttest_imm(cmp, n) -> - ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`; - let comp = name_for_comparison cmp in -- ` b{emit_string comp} {emit_label lbl}\n` -+ ` b{emit_string comp} {emit_label lbl}\n`; 2 - | Ifloattest(cmp, neg) -> -- assert false -+ let comp = (match (cmp, neg) with -+ (Ceq, false) | (Cne, true) -> "eq" -+ | (Cne, false) | (Ceq, true) -> "ne" -+ | (Clt, false) -> "cc" -+ | (Clt, true) -> "cs" -+ | (Cle, false) -> "ls" -+ | (Cle, true) -> "hi" -+ | (Cgt, false) -> "gt" -+ | (Cgt, true) -> "le" -+ | (Cge, false) -> "ge" -+ | (Cge, true) -> "lt") in -+ ` fcmpd {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; -+ ` fmstat\n`; -+ ` b{emit_string comp} {emit_label lbl}\n`; 3 - | Ioddtest -> - ` tst {emit_reg i.arg.(0)}, #1\n`; -- ` bne {emit_label lbl}\n` -+ ` bne {emit_label lbl}\n`; 2 - | Ieventest -> - ` tst {emit_reg i.arg.(0)}, #1\n`; -- ` beq {emit_label lbl}\n` -- end; -- 2 -- | Lcondbranch3(lbl0, lbl1, lbl2) -> -+ ` beq {emit_label lbl}\n`; 2 -+ end -+ | Lcondbranch3(lbl0, lbl1, lbl2) -> - ` cmp {emit_reg i.arg.(0)}, #1\n`; - begin match lbl0 with - None -> () -@@ -495,108 +732,135 @@ - | Some lbl -> ` bgt {emit_label lbl}\n` - end; - 4 -- | Lswitch jumptbl -> -- ` ldr pc, [pc, {emit_reg i.arg.(0)}, lsl #2]\n`; -- ` mov r0, r0\n`; (* nop *) -- for i = 0 to Array.length jumptbl - 1 do -- ` .word {emit_label jumptbl.(i)}\n` -- done; -- 2 + Array.length jumptbl -+ | Lswitch jumptbl -> -+ if !arch > ARMv6 && !thumb then begin -+ let lbl = new_label() in -+ ` tbh [pc, {emit_reg i.arg.(0)}]\n`; -+ `{emit_label lbl}:`; -+ for i = 0 to Array.length jumptbl - 1 do -+ ` .short ({emit_label jumptbl.(i)}-{emit_label lbl})/2\n`; -+ done; -+ ` .align 1\n`; -+ 2 + Array.length jumptbl / 2 -+ end else begin -+ if not !pic_code then begin -+ ` ldr pc, [pc, {emit_reg i.arg.(0)}, lsl #2]\n`; -+ ` nop\n`; -+ for i = 0 to Array.length jumptbl - 1 do -+ ` .word {emit_label jumptbl.(i)}\n` -+ done -+ end else begin -+ (* Slightly slower, but position-independent *) -+ ` add pc, pc, {emit_reg i.arg.(0)}, lsl #2\n`; -+ ` nop\n`; -+ for i = 0 to Array.length jumptbl - 1 do -+ ` b {emit_label jumptbl.(i)}\n` -+ done -+ end; -+ 2 + Array.length jumptbl -+ end - | Lsetuptrap lbl -> - ` bl {emit_label lbl}\n`; 1 - | Lpushtrap -> - stack_offset := !stack_offset + 8; -- ` stmfd sp!, \{trap_ptr, lr}\n`; -+ ` push \{trap_ptr, lr}\n`; - ` mov trap_ptr, sp\n`; 2 - | Lpoptrap -> -- ` ldmfd sp!, \{trap_ptr, lr}\n`; -+ ` pop \{trap_ptr, lr}\n`; - stack_offset := !stack_offset - 8; 1 - | Lraise -> -- ` mov sp, trap_ptr\n`; -- ` ldmfd sp!, \{trap_ptr, pc}\n`; 2 -+ if !Clflags.debug then begin -+ ` {emit_call "caml_raise_exn"}\n`; -+ `{record_frame Reg.Set.empty i.dbg}\n`; 1 -+ end else begin -+ ` mov sp, trap_ptr\n`; -+ ` pop \{trap_ptr, pc}\n`; 2 -+ end - - (* Emission of an instruction sequence *) - --let no_fallthrough = function -- Lop(Itailcall_ind | Itailcall_imm _) -> true -- | Lreturn -> true -- | Lbranch _ -> true -- | Lswitch _ -> true -- | Lraise -> true -- | _ -> false -- - let rec emit_all ninstr i = - if i.desc = Lend then () else begin - let n = emit_instr i in - let ninstr' = ninstr + n in -- let limit = 511 - !num_literals in -- if ninstr' >= limit - 64 && no_fallthrough i.desc then begin -- emit_constants(); -+ (* fldd can address up to +/-1KB, ldr can address up to +/-4KB *) -+ let limit = (if !fpu >= VFPv3_D16 && !float_literals <> [] -+ then 127 -+ else 511) in -+ let limit = limit - !num_literals in -+ if ninstr' >= limit - 64 && not(has_fallthrough i.desc) then begin -+ emit_literals(); - emit_all 0 i.next -- end else -- if ninstr' >= limit then begin -+ end else if !num_literals != 0 && ninstr' >= limit then begin - let lbl = new_label() in - ` b {emit_label lbl}\n`; -- emit_constants(); -+ emit_literals(); - `{emit_label lbl}:\n`; - emit_all 0 i.next - end else - emit_all ninstr' i.next - end - -+(* Emission of the profiling prelude *) -+ -+let emit_profile() = -+ match Config.system with -+ "linux_eabi" | "linux_eabihf" -> -+ ` push \{lr}\n`; -+ ` {emit_call "__gnu_mcount_nc"}\n` -+ | _ -> () -+ - (* Emission of a function declaration *) - - let fundecl fundecl = - function_name := fundecl.fun_name; - fastcode_flag := fundecl.fun_fast; - tailrec_entry_point := new_label(); -+ float_literals := []; -+ gotrel_literals := []; -+ symbol_literals := []; - stack_offset := 0; -- Hashtbl.clear symbol_constants; -- Hashtbl.clear float_constants; -+ call_gc_sites := []; -+ bound_error_sites := []; - ` .text\n`; - ` .align 2\n`; -- ` .global {emit_symbol fundecl.fun_name}\n`; -+ ` .globl {emit_symbol fundecl.fun_name}\n`; -+ if !arch > ARMv6 && !thumb then -+ ` .thumb\n` -+ else -+ ` .arm\n`; - ` .type {emit_symbol fundecl.fun_name}, %function\n`; - `{emit_symbol fundecl.fun_name}:\n`; -+ if !Clflags.gprofile then emit_profile(); - let n = frame_size() in - ignore(emit_stack_adjustment "sub" n); - if !contains_calls then - ` str lr, [sp, #{emit_int(n - 4)}]\n`; - `{emit_label !tailrec_entry_point}:\n`; - emit_all 0 fundecl.fun_body; -- emit_constants() -+ emit_literals(); -+ List.iter emit_call_gc !call_gc_sites; -+ List.iter emit_call_bound_error !bound_error_sites; -+ ` .type {emit_symbol fundecl.fun_name}, %function\n`; -+ ` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n` - - (* Emission of data *) - - let emit_item = function -- Cglobal_symbol s -> -- ` .global {emit_symbol s}\n`; -- | Cdefine_symbol s -> -- `{emit_symbol s}:\n` -- | Cdefine_label lbl -> -- `{emit_label (100000 + lbl)}:\n` -- | Cint8 n -> -- ` .byte {emit_int n}\n` -- | Cint16 n -> -- ` .short {emit_int n}\n` -- | Cint32 n -> -- ` .word {emit_nativeint n}\n` -- | Cint n -> -- ` .word {emit_nativeint n}\n` -- | Csingle f -> -- emit_float32_directive ".long" f -- | Cdouble f -> -- emit_float64_split_directive ".long" f -- | Csymbol_address s -> -- ` .word {emit_symbol s}\n` -- | Clabel_address lbl -> -- ` .word {emit_label (100000 + lbl)}\n` -- | Cstring s -> -- emit_string_directive " .ascii " s -- | Cskip n -> -- if n > 0 then ` .space {emit_int n}\n` -- | Calign n -> -- ` .align {emit_int(Misc.log2 n)}\n` -+ Cglobal_symbol s -> ` .globl {emit_symbol s}\n`; -+ | Cdefine_symbol s -> `{emit_symbol s}:\n` -+ | Cdefine_label lbl -> `{emit_data_label lbl}:\n` -+ | Cint8 n -> ` .byte {emit_int n}\n` -+ | Cint16 n -> ` .short {emit_int n}\n` -+ | Cint32 n -> ` .long {emit_int32 (Nativeint.to_int32 n)}\n` -+ | Cint n -> ` .long {emit_int32 (Nativeint.to_int32 n)}\n` -+ | Csingle f -> ` .single {emit_string f}\n` -+ | Cdouble f -> ` .double {emit_string f}\n` -+ | Csymbol_address s -> ` .word {emit_symbol s}\n` -+ | Clabel_address lbl -> ` .word {emit_data_label lbl}\n` -+ | Cstring s -> emit_string_directive " .ascii " s -+ | Cskip n -> if n > 0 then ` .space {emit_int n}\n` -+ | Calign n -> ` .align {emit_int(Misc.log2 n)}\n` - - let data l = - ` .data\n`; -@@ -605,32 +869,62 @@ - (* Beginning / end of an assembly file *) - - let begin_assembly() = -- `trap_ptr .req r11\n`; -- `alloc_ptr .req r8\n`; -- `alloc_limit .req r10\n`; -+ ` .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; -+ `trap_ptr .req r8\n`; -+ `alloc_ptr .req r10\n`; -+ `alloc_limit .req r11\n`; - let lbl_begin = Compilenv.make_symbol (Some "data_begin") in - ` .data\n`; -- ` .global {emit_symbol lbl_begin}\n`; -+ ` .globl {emit_symbol lbl_begin}\n`; - `{emit_symbol lbl_begin}:\n`; - let lbl_begin = Compilenv.make_symbol (Some "code_begin") in - ` .text\n`; -- ` .global {emit_symbol lbl_begin}\n`; -+ ` .globl {emit_symbol lbl_begin}\n`; - `{emit_symbol lbl_begin}:\n` - - let end_assembly () = - let lbl_end = Compilenv.make_symbol (Some "code_end") in - ` .text\n`; -- ` .global {emit_symbol lbl_end}\n`; -+ ` .globl {emit_symbol lbl_end}\n`; - `{emit_symbol lbl_end}:\n`; - let lbl_end = Compilenv.make_symbol (Some "data_end") in - ` .data\n`; -- ` .global {emit_symbol lbl_end}\n`; -+ ` .globl {emit_symbol lbl_end}\n`; - `{emit_symbol lbl_end}:\n`; -- ` .word 0\n`; -+ ` .long 0\n`; - let lbl = Compilenv.make_symbol (Some "frametable") in -- ` .data\n`; -- ` .global {emit_symbol lbl}\n`; -+ ` .globl {emit_symbol lbl}\n`; - `{emit_symbol lbl}:\n`; -- ` .word {emit_int (List.length !frame_descriptors)}\n`; -- List.iter emit_frame !frame_descriptors; -- frame_descriptors := [] -+ emit_frames -+ { efa_label = (fun lbl -> -+ ` .type {emit_label lbl}, %function\n`; -+ ` .word {emit_label lbl}\n`); -+ 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_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`; -+ begin match Config.system with -+ "linux_eabihf" | "linux_eabi" -> -+ (* Mark stack as non-executable *) -+ ` .section .note.GNU-stack,\"\",%progbits\n` -+ | _ -> () -+ end -diff -urN ocaml-3.12.1-noarm/asmcomp/arm/proc.ml ocaml-3.12.1-arm/asmcomp/arm/proc.ml ---- ocaml-3.12.1-noarm/asmcomp/arm/proc.ml 2009-05-04 14:46:46.000000000 +0100 -+++ ocaml-3.12.1-arm/asmcomp/arm/proc.ml 2012-04-28 09:20:35.055066672 +0100 -@@ -1,16 +1,17 @@ - (***********************************************************************) - (* *) --(* Objective Caml *) -+(* OCaml *) - (* *) --(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -+(* Benedikt Meurer, University of Siegen *) - (* *) --(* Copyright 1998 Institut National de Recherche en Informatique et *) --(* en Automatique. All rights reserved. This file is distributed *) --(* under the terms of the Q Public License version 1.0. *) -+(* Copyright 1998 Institut National de Recherche en Informatique *) -+(* et en Automatique. Copyright 2012 Benedikt Meurer. All rights *) -+(* reserved. This file is distributed under the terms of the Q *) -+(* Public License version 1.0. *) - (* *) - (***********************************************************************) - --(* $Id: proc.ml 9252 2009-05-04 13:46:46Z xleroy $ *) -+(* $Id$ *) - - (* Description of the ARM processor *) - -@@ -26,32 +27,56 @@ - - (* Registers available for register allocation *) - --(* Register map: -- r0 - r3 general purpose (not preserved by C) -- r4 - r7 general purpose (preserved) -- r8 allocation pointer (preserved) -- r9 platform register, usually reserved -- r10 allocation limit (preserved) -- r11 trap pointer (preserved) -- r12 general purpose (not preserved by C) -- r13 stack pointer -- r14 return address -- r15 program counter -+(* Integer register map: -+ r0 - r3 general purpose (not preserved) -+ r4 - r7 general purpose (preserved) -+ r8 trap pointer (preserved) -+ r9 platform register, usually reserved -+ r10 allocation pointer (preserved) -+ r11 allocation limit (preserved) -+ r12 intra-procedural scratch register (not preserved) -+ r13 stack pointer -+ r14 return address -+ r15 program counter -+ Floatinng-point register map (VFPv3): -+ d0 - d7 general purpose (not preserved) -+ d8 - d15 general purpose (preserved) -+ d16 - d31 generat purpose (not preserved), VFPv3 only - *) - --let int_reg_name = [| -- "r0"; "r1"; "r2"; "r3"; "r4"; "r5"; "r6"; "r7"; "r12" --|] -+let int_reg_name = -+ [| "r0"; "r1"; "r2"; "r3"; "r4"; "r5"; "r6"; "r7"; "r12" |] - --let num_register_classes = 1 -+let float_reg_name = -+ [| "d0"; "d1"; "d2"; "d3"; "d4"; "d5"; "d6"; "d7"; -+ "d8"; "d9"; "d10"; "d11"; "d12"; "d13"; "d14"; "d15"; -+ "d16"; "d17"; "d18"; "d19"; "d20"; "d21"; "d22"; "d23"; -+ "d24"; "d25"; "d26"; "d27"; "d28"; "d29"; "d30"; "d31" |] -+ -+(* We have three register classes: -+ 0 for integer registers -+ 1 for VFPv3-D16 -+ 2 for VFPv3 -+ This way we can choose between VFPv3-D16 and VFPv3 -+ at (ocamlopt) runtime using command line switches. -+*) -+ -+let num_register_classes = 3 - --let register_class r = assert (r.typ <> Float); 0 -+let register_class r = -+ match (r.typ, !fpu) with -+ (Int | Addr), _ -> 0 -+ | Float, VFPv3_D16 -> 1 -+ | Float, _ -> 2 - --let num_available_registers = [| 9 |] -+let num_available_registers = -+ [| 9; 16; 32 |] - --let first_available_register = [| 0 |] -+let first_available_register = -+ [| 0; 100; 100 |] - --let register_name r = int_reg_name.(r) -+let register_name r = -+ if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100) - - let rotate_registers = true - -@@ -59,25 +84,34 @@ - - let hard_int_reg = - let v = Array.create 9 Reg.dummy in -- for i = 0 to 8 do v.(i) <- Reg.at_location Int (Reg i) done; -+ for i = 0 to 8 do -+ v.(i) <- Reg.at_location Int (Reg i) -+ done; - v - --let all_phys_regs = hard_int_reg -+let hard_float_reg = -+ let v = Array.create 32 Reg.dummy in -+ for i = 0 to 31 do -+ v.(i) <- Reg.at_location Float (Reg(100 + i)) -+ done; -+ v -+ -+let all_phys_regs = -+ Array.append hard_int_reg hard_float_reg - --let phys_reg n = all_phys_regs.(n) -+let phys_reg n = -+ if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100) - - let stack_slot slot ty = -- assert (ty <> Float); - Reg.at_location ty (Stack slot) - - (* Calling conventions *) - --(* XXX float types have already been expanded into pairs of integers. -- So we cannot align these floats. See if that causes a problem. *) -- --let calling_conventions first_int last_int make_stack arg = -+let calling_conventions -+ first_int last_int first_float last_float make_stack arg = - let loc = Array.create (Array.length arg) Reg.dummy in - let int = ref first_int in -+ let float = ref first_float in - let ofs = ref 0 in - for i = 0 to Array.length arg - 1 do - match arg.(i).typ with -@@ -90,37 +124,86 @@ - ofs := !ofs + size_int - end - | Float -> -- assert false -+ assert (abi = EABI_VFP); -+ assert (!fpu >= VFPv3_D16); -+ if !float <= last_float then begin -+ loc.(i) <- phys_reg !float; -+ incr float -+ 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) -+ (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" - -+(* OCaml calling convention: -+ first integer args in r0...r7 -+ first float args in d0...d15 (EABI+VFP) -+ remaining args on stack. -+ Return values in r0...r7 or d0...d15. *) -+ - let loc_arguments arg = -- calling_conventions 0 7 outgoing arg -+ calling_conventions 0 7 100 115 outgoing arg - let loc_parameters arg = -- let (loc, ofs) = calling_conventions 0 7 incoming arg in loc -+ let (loc, _) = calling_conventions 0 7 100 115 incoming arg in loc - let loc_results res = -- let (loc, ofs) = calling_conventions 0 7 not_supported res in loc -+ let (loc, _) = calling_conventions 0 7 100 115 not_supported res in loc -+ -+(* C calling convention: -+ 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. *) - - let loc_external_arguments arg = -- calling_conventions 0 3 outgoing arg -+ calling_conventions 0 3 100 107 outgoing arg - let loc_external_results res = -- let (loc, ofs) = calling_conventions 0 1 not_supported res in loc -+ let (loc, _) = calling_conventions 0 1 100 100 not_supported res in loc - - let loc_exn_bucket = phys_reg 0 - - (* Registers destroyed by operations *) - --let destroyed_at_c_call = (* r4-r7 preserved *) -- Array.of_list(List.map phys_reg [0;1;2;3;8]) -+let destroyed_at_alloc = (* r0-r6, d0-d15 preserved *) -+ Array.of_list (List.map -+ phys_reg -+ [7;8; -+ 116;116;118;119;120;121;122;123; -+ 124;125;126;127;128;129;130;131]) -+ -+let destroyed_at_c_call = -+ Array.of_list (List.map -+ phys_reg -+ (match abi with -+ EABI -> (* r4-r7 preserved *) -+ [0;1;2;3;8; -+ 100;101;102;103;104;105;106;107; -+ 108;109;110;111;112;113;114;115; -+ 116;116;118;119;120;121;122;123; -+ 124;125;126;127;128;129;130;131] -+ | EABI_VFP -> (* r4-r7, d8-d15 preserved *) -+ [0;1;2;3;8; -+ 100;101;102;103;104;105;106;107; -+ 116;116;118;119;120;121;122;123; -+ 124;125;126;127;128;129;130;131])) - - let destroyed_at_oper = function -- Iop(Icall_ind | Icall_imm _ | Iextcall(_, true)) -> all_phys_regs -- | Iop(Iextcall(_, false)) -> destroyed_at_c_call -- | Iop(Ialloc(_)) -> [|phys_reg 8|] (* r12 destroyed *) -+ Iop(Icall_ind | Icall_imm _ ) -+ | Iop(Iextcall(_, true)) -> -+ all_phys_regs -+ | Iop(Iextcall(_, false)) -> -+ destroyed_at_c_call -+ | Iop(Ialloc n) -> -+ destroyed_at_alloc -+ | Iop(Iconst_symbol _) when !pic_code -> -+ [|phys_reg 3; phys_reg 8|] (* r3 and r12 destroyed *) -+ | Iop(Iintoffloat | Ifloatofint | Iload(Single, _) | Istore(Single, _)) -> -+ [|phys_reg 107|] (* d7 (s14-s15) destroyed *) - | _ -> [||] - - let destroyed_at_raise = all_phys_regs -@@ -128,15 +211,16 @@ - (* Maximal register pressure *) - - let safe_register_pressure = function -- Iextcall(_, _) -> 4 -+ Iextcall(_, _) -> 5 - | _ -> 9 -+ - let max_register_pressure = function -- Iextcall(_, _) -> [| 4 |] -- | _ -> [| 9 |] -+ Iextcall(_, _) -> [| 5; 9; 9 |] -+ | _ -> [| 9; 16; 32 |] - - (* Layout of the stack *) - --let num_stack_slots = [| 0 |] -+let num_stack_slots = [| 0; 0; 0 |] - let contains_calls = ref false - - (* Calling the assembler *) -@@ -144,6 +228,3 @@ - let assemble_file infile outfile = - Ccomp.command (Config.asm ^ " -o " ^ - Filename.quote outfile ^ " " ^ Filename.quote infile) -- --open Clflags;; --open Config;; -diff -urN ocaml-3.12.1-noarm/asmcomp/arm/reload.ml ocaml-3.12.1-arm/asmcomp/arm/reload.ml ---- ocaml-3.12.1-noarm/asmcomp/arm/reload.ml 1999-11-17 18:59:06.000000000 +0000 -+++ ocaml-3.12.1-arm/asmcomp/arm/reload.ml 2012-04-28 09:20:35.060066764 +0100 -@@ -1,6 +1,6 @@ - (***********************************************************************) - (* *) --(* Objective Caml *) -+(* OCaml *) - (* *) - (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) - (* *) -@@ -10,7 +10,7 @@ - (* *) - (***********************************************************************) - --(* $Id: reload.ml 2553 1999-11-17 18:59:06Z xleroy $ *) -+(* $Id$ *) - - (* Reloading for the ARM *) - -diff -urN ocaml-3.12.1-noarm/asmcomp/arm/scheduling.ml ocaml-3.12.1-arm/asmcomp/arm/scheduling.ml ---- ocaml-3.12.1-noarm/asmcomp/arm/scheduling.ml 1999-11-17 18:59:06.000000000 +0000 -+++ ocaml-3.12.1-arm/asmcomp/arm/scheduling.ml 2012-04-28 09:20:35.065066855 +0100 -@@ -1,51 +1,79 @@ - (***********************************************************************) - (* *) --(* Objective Caml *) -+(* OCaml *) - (* *) --(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -+(* Benedikt Meurer, University of Siegen *) - (* *) --(* Copyright 1996 Institut National de Recherche en Informatique et *) --(* en Automatique. All rights reserved. This file is distributed *) --(* under the terms of the Q Public License version 1.0. *) -+(* Copyright 1998 Institut National de Recherche en Informatique *) -+(* et en Automatique. Copyright 2012 Benedikt Meurer. All rights *) -+(* reserved. This file is distributed under the terms of the Q *) -+(* Public License version 1.0. *) - (* *) - (***********************************************************************) - --(* $Id: scheduling.ml 2553 1999-11-17 18:59:06Z xleroy $ *) -+(* $Id$ *) - -+open Arch - open Mach - --(* Instruction scheduling for the Sparc *) -+(* Instruction scheduling for the ARM *) - --class scheduler = object -+class scheduler = object(self) - --inherit Schedgen.scheduler_generic -+inherit Schedgen.scheduler_generic as super - --(* Scheduling -- based roughly on the Strong ARM *) -+(* Scheduling -- based roughly on the ARM11 (ARMv6) *) - - method oper_latency = function -- Ireload -> 2 -- | Iload(_, _) -> 2 -- | Iconst_symbol _ -> 2 (* turned into a load *) -- | Iconst_float _ -> 2 (* turned into a load *) -- | Iintop(Imul) -> 3 -- | Iintop_imm(Imul, _) -> 3 -- (* No data available for floatops, let's make educated guesses *) -- | Iaddf -> 3 -- | Isubf -> 3 -- | Imulf -> 5 -- | Idivf -> 15 -+ (* Loads have a latency of two cycles in general *) -+ Iconst_symbol _ -+ | Iconst_float _ -+ | Iload(_, _) -+ | Ireload -+ | Ifloatofint (* mcr/mrc count as memory access *) -+ | Iintoffloat -> 2 -+ (* Multiplys have a latency of two cycles *) -+ | Iintop Imul -+ | Ispecific(Imuladd | Imulsub) -> 2 -+ (* VFP instructions *) -+ | Iaddf -+ | Isubf -+ | Idivf -+ | Imulf | Ispecific Inegmulf -+ | Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf) -+ | Ispecific Isqrtf -+ | Inegf | Iabsf when !fpu >= VFPv3_D16 -> 2 -+ (* Everything else *) - | _ -> 1 - --(* Issue cycles. Rough approximations *) -+method! is_checkbound = function -+ Ispecific(Ishiftcheckbound _) -> true -+ | op -> super#is_checkbound op -+ -+(* Issue cycles. Rough approximations *) - - method oper_issue_cycles = function - Ialloc _ -> 4 -- | Iintop(Icomp _) -> 3 -- | Iintop(Icheckbound) -> 2 -- | Iintop_imm(Idiv, _) -> 4 -- | Iintop_imm(Imod, _) -> 6 -+ | Iintop(Ilsl | Ilsr | Iasr) -> 2 -+ | Iintop(Icomp _) - | Iintop_imm(Icomp _, _) -> 3 -+ | Iintop(Icheckbound) - | Iintop_imm(Icheckbound, _) -> 2 -+ | Ispecific(Ishiftcheckbound _) -> 3 -+ | Iintop_imm(Idiv, _) -> 4 -+ | Iintop_imm(Imod, _) -> 6 -+ | Iintop Imul -+ | Ispecific(Imuladd | Imulsub) -> 2 -+ (* VFP instructions *) -+ | Iaddf -+ | Isubf -> 7 -+ | Imulf -+ | Ispecific Inegmulf -> 9 -+ | Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf) -> 17 -+ | Idivf -+ | Ispecific Isqrtf -> 27 -+ | Inegf | Iabsf | Iconst_float _ when !fpu >= VFPv3_D16 -> 4 -+ (* Everything else *) - | _ -> 1 - - end -diff -urN ocaml-3.12.1-noarm/asmcomp/arm/selection.ml ocaml-3.12.1-arm/asmcomp/arm/selection.ml ---- ocaml-3.12.1-noarm/asmcomp/arm/selection.ml 2010-04-22 13:39:40.000000000 +0100 -+++ ocaml-3.12.1-arm/asmcomp/arm/selection.ml 2012-04-28 09:20:35.171068774 +0100 -@@ -1,54 +1,77 @@ - (***********************************************************************) - (* *) --(* Objective Caml *) -+(* OCaml *) - (* *) --(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -+(* Benedikt Meurer, University of Siegen *) - (* *) --(* Copyright 1998 Institut National de Recherche en Informatique et *) --(* en Automatique. All rights reserved. This file is distributed *) --(* under the terms of the Q Public License version 1.0. *) -+(* Copyright 1998 Institut National de Recherche en Informatique *) -+(* et en Automatique. Copyright 2012 Benedikt Meurer. All rights *) -+(* reserved. This file is distributed under the terms of the Q *) -+(* Public License version 1.0. *) - (* *) - (***********************************************************************) - --(* $Id: selection.ml 10295 2010-04-22 12:39:40Z xleroy $ *) -+(* $Id$ *) - - (* Instruction selection for the ARM processor *) - --open Misc --open Cmm --open Reg - open Arch --open Proc -+open Cmm - open Mach -+open Misc -+open Proc -+open Reg - --(* Immediate operands are 8-bit immediate values, zero-extended, and rotated -- right by 0, 2, 4, ... 30 bits. -- To avoid problems with Caml's 31-bit arithmetic, -- we check only with 8-bit values shifted left 0 to 22 bits. *) -- --let rec is_immed n shift = -- if shift > 22 then false -- else if n land (0xFF lsl shift) = n then true -- else is_immed n (shift + 2) -- --(* We have 12-bit + sign byte offsets for word accesses, -- 8-bit + sign word offsets for float accesses, -- and 8-bit + sign byte offsets for bytes and shorts. -- Use lowest common denominator. *) -- --let is_offset n = n < 256 && n > -256 -- --let is_intconst = function Cconst_int n -> true | _ -> false -- --(* Soft emulation of float comparisons *) -- --let float_comparison_function = function -- | Ceq -> "__eqdf2" -- | Cne -> "__nedf2" -- | Clt -> "__ltdf2" -- | Cle -> "__ledf2" -- | Cgt -> "__gtdf2" -- | Cge -> "__gedf2" -+let is_offset chunk n = -+ match chunk with -+ (* VFPv3 load/store have -1020 to 1020 *) -+ Single | Double | Double_u -+ when !fpu >= VFPv3_D16 -> -+ n >= -1020 && n <= 1020 -+ (* ARM load/store byte/word have -4095 to 4095 *) -+ | Byte_unsigned | Byte_signed -+ | Thirtytwo_unsigned | Thirtytwo_signed -+ | Word | Single -+ when not !thumb -> -+ n >= -4095 && n <= 4095 -+ (* Thumb-2 load/store have -255 to 4095 *) -+ | _ when !arch > ARMv6 && !thumb -> -+ n >= -255 && n <= 4095 -+ (* Everything else has -255 to 255 *) -+ | _ -> -+ n >= -255 && n <= 255 -+ -+let is_intconst = function -+ Cconst_int _ -> true -+ | _ -> false -+ -+(* Special constraints on operand and result registers *) -+ -+exception Use_default -+ -+let r1 = phys_reg 1 -+ -+let pseudoregs_for_operation op arg res = -+ match op with -+ (* For mul rd,rm,rs and mla rd,rm,rs,ra (pre-ARMv6) the registers rm -+ and rd must be different. We deal with this by pretending that rm -+ is also a result of the mul / mla operation. *) -+ Iintop Imul | Ispecific Imuladd when !arch < ARMv6 -> -+ (arg, [| res.(0); arg.(0) |]) -+ (* Soft-float Iabsf and Inegf: arg.(0) and res.(0) must be the same *) -+ | Iabsf | Inegf when !fpu = Soft -> -+ ([|res.(0); arg.(1)|], res) -+ (* VFPv3 Imuladdf...Inegmulsubf: arg.(0) and res.(0) must be the same *) -+ | Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf) -> -+ let arg' = Array.copy arg in -+ arg'.(0) <- res.(0); -+ (arg', res) -+ (* We use __aeabi_idivmod for Cmodi only, and hence we care only -+ for the remainder in r1, so fix up the destination register. *) -+ | Iextcall("__aeabi_idivmod", false) -> -+ (arg, [|r1|]) -+ (* Other instructions are regular *) -+ | _ -> raise Use_default - - (* Instruction selection *) - class selector = object(self) -@@ -56,23 +79,32 @@ - inherit Selectgen.selector_generic as super - - method! regs_for tyv = -- (* Expand floats into pairs of integer registers *) -- let nty = Array.length tyv in -- let rec expand i = -- if i >= nty then [] else begin -- match tyv.(i) with -- | Float -> Int :: Int :: expand (i+1) -- | ty -> ty :: expand (i+1) -- end in -- Reg.createv (Array.of_list (expand 0)) -+ Reg.createv (if !fpu = Soft then begin -+ (* Expand floats into pairs of integer registers *) -+ let rec expand = function -+ [] -> [] -+ | Float :: tyl -> Int :: Int :: expand tyl -+ | ty :: tyl -> ty :: expand tyl in -+ Array.of_list (expand (Array.to_list tyv)) -+ end else begin -+ tyv -+ end) - - method is_immediate n = -- n land 0xFF = n || is_immed n 2 -+ is_immediate (Int32.of_int n) - --method select_addressing = function -- Cop(Cadda, [arg; Cconst_int n]) when is_offset n -> -+method! is_simple_expr = function -+ (* inlined floating-point ops are simple if their arguments are *) -+ | Cop(Cextcall("sqrt", _, _, _), args) when !fpu >= VFPv3_D16 -> -+ List.for_all self#is_simple_expr args -+ | e -> super#is_simple_expr e -+ -+method select_addressing chunk = function -+ | Cop(Cadda, [arg; Cconst_int n]) -+ when is_offset chunk n -> - (Iindexed n, arg) -- | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])]) when is_offset n -> -+ | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])]) -+ when is_offset chunk n -> - (Iindexed n, Cop(Cadda, [arg1; arg2])) - | arg -> - (Iindexed 0, arg) -@@ -91,109 +123,146 @@ - | [Cop(Casr, [arg1; Cconst_int n]); arg2] - when n > 0 && n < 32 && not(is_intconst arg1) -> - (Ispecific(Ishiftarith(shiftrevop, -n)), [arg2; arg1]) -- | _ -> -- super#select_operation op args -+ | args -> -+ begin match super#select_operation op args with -+ (* Recognize multiply and add *) -+ (Iintop Iadd, [Cop(Cmuli, args); arg3]) -+ | (Iintop Iadd, [arg3; Cop(Cmuli, args)]) as op_args -> -+ begin match self#select_operation Cmuli args with -+ (Iintop Imul, [arg1; arg2]) -> -+ (Ispecific Imuladd, [arg1; arg2; arg3]) -+ | _ -> op_args -+ end -+ (* Recognize multiply and subtract *) -+ | (Iintop Isub, [arg3; Cop(Cmuli, args)]) as op_args -+ when !arch > ARMv6 -> -+ begin match self#select_operation Cmuli args with -+ (Iintop Imul, [arg1; arg2]) -> -+ (Ispecific Imulsub, [arg1; arg2; arg3]) -+ | _ -> op_args -+ end -+ | op_args -> op_args -+ end - - method! select_operation op args = -- match op with -- Cadda | Caddi -> -- begin match args with -- [arg1; Cconst_int n] when n < 0 && self#is_immediate (-n) -> -- (Iintop_imm(Isub, -n), [arg1]) -- | _ -> -- self#select_shift_arith op Ishiftadd Ishiftadd args -- end -- | Csuba | Csubi -> -- begin match args with -- [arg1; Cconst_int n] when n < 0 && self#is_immediate (-n) -> -- (Iintop_imm(Iadd, -n), [arg1]) -- | [Cconst_int n; arg2] when self#is_immediate n -> -- (Ispecific(Irevsubimm n), [arg2]) -- | _ -> -- self#select_shift_arith op Ishiftsub Ishiftsubrev args -- end -- | Cmuli -> (* no multiply immediate *) -+ match (op, args) with -+ (* Recognize special shift arithmetic *) -+ ((Cadda | Caddi), [arg; Cconst_int n]) -+ when n < 0 && self#is_immediate (-n) -> -+ (Iintop_imm(Isub, -n), [arg]) -+ | ((Cadda | Caddi as op), args) -> -+ self#select_shift_arith op Ishiftadd Ishiftadd args -+ | ((Csuba | Csubi), [arg; Cconst_int n]) -+ when n < 0 && self#is_immediate (-n) -> -+ (Iintop_imm(Iadd, -n), [arg]) -+ | ((Csuba | Csubi), [Cconst_int n; arg]) -+ when self#is_immediate n -> -+ (Ispecific(Irevsubimm n), [arg]) -+ | ((Csuba | Csubi as op), args) -> -+ self#select_shift_arith op Ishiftsub Ishiftsubrev args -+ | (Ccheckbound _, [Cop(Clsr, [arg1; Cconst_int n]); arg2]) -+ when n > 0 && n < 32 && not(is_intconst arg2) -> -+ (Ispecific(Ishiftcheckbound n), [arg1; arg2]) -+ (* ARM does not support immediate operands for multiplication *) -+ | (Cmuli, args) -> - (Iintop Imul, args) -- | Cdivi -> -- begin match args with -- [arg1; Cconst_int n] when n = 1 lsl (Misc.log2 n) -> -- (Iintop_imm(Idiv, n), [arg1]) -- | _ -> -- (Iextcall("__divsi3", false), args) -- end -- | Cmodi -> -- begin match args with -- [arg1; Cconst_int n] when n = 1 lsl (Misc.log2 n) -> -- (Iintop_imm(Imod, n), [arg1]) -- | _ -> -- (Iextcall("__modsi3", false), args) -- end -- | Ccheckbound _ -> -- begin match args with -- [Cop(Clsr, [arg1; Cconst_int n]); arg2] -- when n > 0 && n < 32 && not(is_intconst arg2) -> -- (Ispecific(Ishiftcheckbound n), [arg1; arg2]) -- | _ -> -- super#select_operation op args -- end -- (* Turn floating-point operations into library function calls *) -- | Caddf -> (Iextcall("__adddf3", false), args) -- | Csubf -> (Iextcall("__subdf3", false), args) -- | Cmulf -> (Iextcall("__muldf3", false), args) -- | Cdivf -> (Iextcall("__divdf3", false), args) -- | Cfloatofint -> (Iextcall("__floatsidf", false), args) -- | Cintoffloat -> (Iextcall("__fixdfsi", false), args) -- | Ccmpf comp -> -- (Iintop_imm(Icomp(Isigned comp), 0), -- [Cop(Cextcall(float_comparison_function comp, -- typ_int, false, Debuginfo.none), -- args)]) -+ (* Turn integer division/modulus into runtime ABI calls *) -+ | (Cdivi, [arg; Cconst_int n]) -+ when n = 1 lsl Misc.log2 n -> -+ (Iintop_imm(Idiv, n), [arg]) -+ | (Cdivi, args) -> -+ (Iextcall("__aeabi_idiv", false), args) -+ | (Cmodi, [arg; Cconst_int n]) -+ when n = 1 lsl Misc.log2 n -> -+ (Iintop_imm(Imod, n), [arg]) -+ | (Cmodi, args) -> -+ (* See above for fix up of return register *) -+ (Iextcall("__aeabi_idivmod", false), args) -+ (* Turn floating-point operations into runtime ABI calls for softfp *) -+ | (op, args) when !fpu = Soft -> self#select_operation_softfp op args -+ (* Select operations for VFPv3 *) -+ | (op, args) -> self#select_operation_vfpv3 op args -+ -+method private select_operation_softfp op args = -+ match (op, args) with -+ (* Turn floating-point operations into runtime ABI calls *) -+ | (Caddf, args) -> (Iextcall("__aeabi_dadd", false), args) -+ | (Csubf, args) -> (Iextcall("__aeabi_dsub", false), args) -+ | (Cmulf, args) -> (Iextcall("__aeabi_dmul", false), args) -+ | (Cdivf, args) -> (Iextcall("__aeabi_ddiv", false), args) -+ | (Cfloatofint, args) -> (Iextcall("__aeabi_i2d", false), args) -+ | (Cintoffloat, args) -> (Iextcall("__aeabi_d2iz", false), args) -+ | (Ccmpf comp, args) -> -+ let func = (match comp with -+ Cne (* there's no __aeabi_dcmpne *) -+ | Ceq -> "__aeabi_dcmpeq" -+ | Clt -> "__aeabi_dcmplt" -+ | Cle -> "__aeabi_dcmple" -+ | Cgt -> "__aeabi_dcmpgt" -+ | Cge -> "__aeabi_dcmpge") in -+ let comp = (match comp with -+ Cne -> Ceq (* eq 0 => false *) -+ | _ -> Cne (* ne 0 => true *)) in -+ (Iintop_imm(Icomp(Iunsigned comp), 0), -+ [Cop(Cextcall(func, typ_int, false, Debuginfo.none), args)]) - (* Add coercions around loads and stores of 32-bit floats *) -- | Cload Single -> -- (Iextcall("__extendsfdf2", false), [Cop(Cload Word, args)]) -- | Cstore Single -> -- begin match args with -- | [arg1; arg2] -> -- let arg2' = -- Cop(Cextcall("__truncdfsf2", typ_int, false, Debuginfo.none), -- [arg2]) in -- self#select_operation (Cstore Word) [arg1; arg2'] -- | _ -> assert false -- end -+ | (Cload Single, args) -> -+ (Iextcall("__aeabi_f2d", false), [Cop(Cload Word, args)]) -+ | (Cstore Single, [arg1; arg2]) -> -+ let arg2' = -+ Cop(Cextcall("__aeabi_d2f", typ_int, false, Debuginfo.none), -+ [arg2]) in -+ self#select_operation (Cstore Word) [arg1; arg2'] -+ (* Other operations are regular *) -+ | (op, args) -> super#select_operation op args -+ -+method private select_operation_vfpv3 op args = -+ match (op, args) with -+ (* Recognize floating-point negate and multiply *) -+ (Cnegf, [Cop(Cmulf, args)]) -> -+ (Ispecific Inegmulf, args) -+ (* Recognize floating-point multiply and add *) -+ | (Caddf, [arg; Cop(Cmulf, args)]) -+ | (Caddf, [Cop(Cmulf, args); arg]) -> -+ (Ispecific Imuladdf, arg :: args) -+ (* Recognize floating-point negate, multiply and subtract *) -+ | (Csubf, [Cop(Cnegf, [arg]); Cop(Cmulf, args)]) -+ | (Csubf, [Cop(Cnegf, [Cop(Cmulf, args)]); arg]) -> -+ (Ispecific Inegmulsubf, arg :: args) -+ (* Recognize floating-point negate, multiply and add *) -+ | (Csubf, [arg; Cop(Cmulf, args)]) -> -+ (Ispecific Inegmuladdf, arg :: args) -+ (* Recognize multiply and subtract *) -+ | (Csubf, [Cop(Cmulf, args); arg]) -> -+ (Ispecific Imulsubf, arg :: args) -+ (* Recognize floating-point square root *) -+ | (Cextcall("sqrt", _, false, _), args) -> -+ (Ispecific Isqrtf, args) - (* Other operations are regular *) -- | _ -> super#select_operation op args -+ | (op, args) -> super#select_operation op args - - method! select_condition = function -- | Cop(Ccmpf cmp, args) -> -- (Iinttest_imm(Isigned cmp, 0), -- Cop(Cextcall(float_comparison_function cmp, -- typ_int, false, Debuginfo.none), -- args)) -+ (* Turn floating-point comparisons into runtime ABI calls *) -+ Cop(Ccmpf _ as op, args) when !fpu = Soft -> -+ begin match self#select_operation_softfp op args with -+ (Iintop_imm(Icomp(Iunsigned Ceq), 0), [arg]) -> (Ifalsetest, arg) -+ | (Iintop_imm(Icomp(Iunsigned Cne), 0), [arg]) -> (Itruetest, arg) -+ | _ -> assert false -+ end - | expr -> - super#select_condition expr - --(* Deal with some register irregularities: -- --1- In mul rd, rm, rs, the registers rm and rd must be different. -- We deal with this by pretending that rm is also a result of the mul -- operation. -- --2- For Inegf and Iabsf, force arguments and results in (r0, r1); -- this simplifies code generation later. --*) -+(* Deal with some register constraints *) - - method! insert_op_debug op dbg rs rd = -- match op with -- | Iintop(Imul) -> -- self#insert_debug (Iop op) dbg rs [| rd.(0); rs.(0) |]; rd -- | Iabsf | Inegf -> -- let r = [| phys_reg 0; phys_reg 1 |] in -- self#insert_moves rs r; -- self#insert_debug (Iop op) dbg r r; -- self#insert_moves r rd; -- rd -- | _ -> -- super#insert_op_debug op dbg rs rd -+ try -+ let (rsrc, rdst) = pseudoregs_for_operation op rs rd in -+ self#insert_moves rs rsrc; -+ self#insert_debug (Iop op) dbg rsrc rdst; -+ self#insert_moves rdst rd; -+ rd -+ with Use_default -> -+ super#insert_op_debug op dbg rs rd - - end - -diff -urN ocaml-3.12.1-noarm/asmcomp/i386/selection.ml ocaml-3.12.1-arm/asmcomp/i386/selection.ml ---- ocaml-3.12.1-noarm/asmcomp/i386/selection.ml 2010-04-08 04:58:41.000000000 +0100 -+++ ocaml-3.12.1-arm/asmcomp/i386/selection.ml 2012-04-28 12:19:05.529851563 +0100 -@@ -168,7 +168,7 @@ - | _ -> - super#is_simple_expr e - --method select_addressing exp = -+method select_addressing chunk exp = - match select_addr exp with - (Asymbol s, d) -> - (Ibased(s, d), Ctuple []) -@@ -200,7 +200,7 @@ - match op with - (* Recognize the LEA instruction *) - Caddi | Cadda | Csubi | Csuba -> -- begin match self#select_addressing (Cop(op, args)) with -+ begin match self#select_addressing Word (Cop(op, args)) with - (Iindexed d, _) -> super#select_operation op args - | (Iindexed2 0, _) -> super#select_operation op args - | (addr, arg) -> (Ispecific(Ilea addr), [arg]) -@@ -233,7 +233,7 @@ - begin match args with - [loc; Cop(Caddi, [Cop(Cload _, [loc']); Cconst_int n])] - when loc = loc' -> -- let (addr, arg) = self#select_addressing loc in -+ let (addr, arg) = self#select_addressing Word loc in - (Ispecific(Ioffset_loc(n, addr)), [arg]) - | _ -> - super#select_operation op args -@@ -250,11 +250,11 @@ - method select_floatarith regular_op reversed_op mem_op mem_rev_op args = - match args with - [arg1; Cop(Cload chunk, [loc2])] -> -- let (addr, arg2) = self#select_addressing loc2 in -+ let (addr, arg2) = self#select_addressing chunk loc2 in - (Ispecific(Ifloatarithmem(chunk_double chunk, mem_op, addr)), - [arg1; arg2]) - | [Cop(Cload chunk, [loc1]); arg2] -> -- let (addr, arg1) = self#select_addressing loc1 in -+ let (addr, arg1) = self#select_addressing chunk loc1 in - (Ispecific(Ifloatarithmem(chunk_double chunk, mem_rev_op, addr)), - [arg2; arg1]) - | [arg1; arg2] -> -@@ -295,10 +295,10 @@ - | Cconst_natpointer n -> (Ispecific(Ipush_int n), Ctuple []) - | Cconst_symbol s -> (Ispecific(Ipush_symbol s), Ctuple []) - | Cop(Cload Word, [loc]) -> -- let (addr, arg) = self#select_addressing loc in -+ let (addr, arg) = self#select_addressing Word loc in - (Ispecific(Ipush_load addr), arg) - | Cop(Cload Double_u, [loc]) -> -- let (addr, arg) = self#select_addressing loc in -+ let (addr, arg) = self#select_addressing Double_u loc in - (Ispecific(Ipush_load_float addr), arg) - | _ -> (Ispecific(Ipush), exp) - -diff -urN ocaml-3.12.1-noarm/asmcomp/power/selection.ml ocaml-3.12.1-arm/asmcomp/power/selection.ml ---- ocaml-3.12.1-noarm/asmcomp/power/selection.ml 2010-04-22 13:51:06.000000000 +0100 -+++ ocaml-3.12.1-arm/asmcomp/power/selection.ml 2012-04-28 12:19:05.537851684 +0100 -@@ -52,7 +52,7 @@ - - method is_immediate n = (n <= 32767) && (n >= -32768) - --method select_addressing exp = -+method select_addressing chunk exp = - match select_addr exp with - (Asymbol s, d) -> - (Ibased(s, d), Ctuple []) -diff -urN ocaml-3.12.1-noarm/asmcomp/selectgen.ml ocaml-3.12.1-arm/asmcomp/selectgen.ml ---- ocaml-3.12.1-noarm/asmcomp/selectgen.ml 2010-09-02 14:29:21.000000000 +0100 -+++ ocaml-3.12.1-arm/asmcomp/selectgen.ml 2012-04-28 12:19:05.538851709 +0100 -@@ -204,7 +204,7 @@ - (* Selection of addressing modes *) - - method virtual select_addressing : -- Cmm.expression -> Arch.addressing_mode * Cmm.expression -+ Cmm.memory_chunk -> Cmm.expression -> Arch.addressing_mode * Cmm.expression - - (* Default instruction selection for stores (of words) *) - -@@ -219,10 +219,10 @@ - | (Capply(ty, dbg), _) -> (Icall_ind, args) - | (Cextcall(s, ty, alloc, dbg), _) -> (Iextcall(s, alloc), args) - | (Cload chunk, [arg]) -> -- let (addr, eloc) = self#select_addressing arg in -+ let (addr, eloc) = self#select_addressing chunk arg in - (Iload(chunk, addr), [eloc]) - | (Cstore chunk, [arg1; arg2]) -> -- let (addr, eloc) = self#select_addressing arg1 in -+ let (addr, eloc) = self#select_addressing chunk arg1 in - if chunk = Word then begin - let (op, newarg2) = self#select_store addr arg2 in - (op, [newarg2; eloc]) -@@ -366,7 +366,7 @@ - self#insert (Iop Imove) [|src|] [|dst|] - - method insert_moves src dst = -- for i = 0 to Array.length src - 1 do -+ for i = 0 to min (Array.length src) (Array.length dst) - 1 do - self#insert_move src.(i) dst.(i) - done - -@@ -490,9 +490,8 @@ - let (loc_arg, stack_ofs) = - self#emit_extcall_args env new_args in - let rd = self#regs_for ty in -- let loc_res = Proc.loc_external_results rd in -- self#insert_debug (Iop(Iextcall(lbl, alloc))) dbg -- loc_arg loc_res; -+ let loc_res = self#insert_op_debug (Iextcall(lbl, alloc)) dbg -+ loc_arg (Proc.loc_external_results rd) in - self#insert_move_results loc_res rd stack_ofs; - Some rd - | Ialloc _ -> -diff -urN ocaml-3.12.1-noarm/asmcomp/selectgen.mli ocaml-3.12.1-arm/asmcomp/selectgen.mli ---- ocaml-3.12.1-noarm/asmcomp/selectgen.mli 2010-05-21 13:00:49.000000000 +0100 -+++ ocaml-3.12.1-arm/asmcomp/selectgen.mli 2012-04-28 12:19:05.539851737 +0100 -@@ -26,7 +26,7 @@ - (* Must be defined to indicate whether a constant is a suitable - immediate operand to arithmetic instructions *) - method virtual select_addressing : -- Cmm.expression -> Arch.addressing_mode * Cmm.expression -+ Cmm.memory_chunk -> Cmm.expression -> Arch.addressing_mode * Cmm.expression - (* Must be defined to select addressing modes *) - method is_simple_expr: Cmm.expression -> bool - (* Can be overridden to reflect special extcalls known to be pure *) -diff -urN ocaml-3.12.1-noarm/asmcomp/sparc/selection.ml ocaml-3.12.1-arm/asmcomp/sparc/selection.ml ---- ocaml-3.12.1-noarm/asmcomp/sparc/selection.ml 2010-04-22 13:51:06.000000000 +0100 -+++ ocaml-3.12.1-arm/asmcomp/sparc/selection.ml 2012-04-28 12:19:05.540851767 +0100 -@@ -26,7 +26,7 @@ - - method is_immediate n = (n <= 4095) && (n >= -4096) - --method select_addressing = function -+method select_addressing chunk = function - Cconst_symbol s -> - (Ibased(s, 0), Ctuple []) - | Cop(Cadda, [Cconst_symbol s; Cconst_int n]) -> -diff -urN ocaml-3.12.1-noarm/asmrun/arm.S ocaml-3.12.1-arm/asmrun/arm.S ---- ocaml-3.12.1-noarm/asmrun/arm.S 2012-04-27 20:51:07.197775311 +0100 -+++ ocaml-3.12.1-arm/asmrun/arm.S 2012-04-28 13:39:34.463111027 +0100 -@@ -1,286 +1,411 @@ - /***********************************************************************/ - /* */ --/* Objective Caml */ -+/* OCaml */ - /* */ --/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -+/* Benedikt Meurer, University of Siegen */ - /* */ --/* Copyright 1998 Institut National de Recherche en Informatique et */ --/* en Automatique. All rights reserved. This file is distributed */ --/* under the terms of the GNU Library General Public License, with */ --/* the special exception on linking described in file ../LICENSE. */ -+/* Copyright 1998 Institut National de Recherche en Informatique */ -+/* et en Automatique. Copyright 2012 Benedikt Meurer. All rights */ -+/* reserved. This file is distributed under the terms of the GNU */ -+/* Library General Public License, with the special exception on */ -+/* linking described in file ../LICENSE. */ - /* */ - /***********************************************************************/ - --/* $Id: arm.S 9252 2009-05-04 13:46:46Z xleroy $ */ -+/* $Id$ */ - - /* Asm part of the runtime system, ARM processor */ -+/* Must be preprocessed by cpp */ - --trap_ptr .req r11 --alloc_ptr .req r8 --alloc_limit .req r10 -- -+ .syntax unified - .text -+#if defined(SYS_linux_eabihf) -+ .arch armv7-a -+ .fpu vfpv3-d16 -+ .thumb -+#elif defined(SYS_linux_eabi) -+ .arch armv4t -+ .arm -+ -+ /* Compatibility macros */ -+ .macro blx reg -+ mov lr, pc -+ bx \reg -+ .endm -+ .macro cbz reg, lbl -+ cmp \reg, #0 -+ beq \lbl -+ .endm -+ .macro vpop regs -+ .endm -+ .macro vpush regs -+ .endm -+#endif -+ -+trap_ptr .req r8 -+alloc_ptr .req r10 -+alloc_limit .req r11 -+ -+/* Support for profiling with gprof */ -+ -+#if defined(PROFILING) && (defined(SYS_linux_eabihf) || defined(SYS_linux_eabi)) -+#define PROFILE \ -+ push {lr}; \ -+ bl __gnu_mcount_nc -+#else -+#define PROFILE -+#endif - - /* Allocation functions and GC interface */ - -- .globl caml_call_gc -+ .globl caml_system__code_begin -+caml_system__code_begin: -+ -+ .align 2 -+ .globl caml_call_gc - .type caml_call_gc, %function - caml_call_gc: -- /* Record return address and desired size */ -- /* Can use alloc_limit as a temporary since it will be reloaded by -- invoke_gc */ -- ldr alloc_limit, .Lcaml_last_return_address -- str lr, [alloc_limit, #0] -- ldr alloc_limit, .Lcaml_requested_size -- str r12, [alloc_limit, #0] -- /* Branch to shared GC code */ -- bl .Linvoke_gc -- /* Finish allocation */ -- ldr r12, .Lcaml_requested_size -- ldr r12, [r12, #0] -- sub alloc_ptr, alloc_ptr, r12 -+ PROFILE -+ /* Record return address */ -+ ldr r12, =caml_last_return_address -+ str lr, [r12] -+.Lcaml_call_gc: -+ /* Record lowest stack address */ -+ ldr r12, =caml_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 -+ str sp, [r12] -+ /* Save current allocation pointer for debugging purposes */ -+ ldr alloc_limit, =caml_young_ptr -+ str alloc_ptr, [alloc_limit] -+ /* Save trap pointer in case an exception is raised during GC */ -+ ldr r12, =caml_exception_pointer -+ str trap_ptr, [r12] -+ /* Call the garbage collector */ -+ bl 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 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 - -- .globl caml_alloc1 -+ .align 2 -+ .globl caml_alloc1 - .type caml_alloc1, %function - caml_alloc1: -- sub alloc_ptr, alloc_ptr, #8 -+ PROFILE -+.Lcaml_alloc1: -+ sub alloc_ptr, alloc_ptr, 8 - cmp alloc_ptr, alloc_limit -- movcs pc, lr /* Return if alloc_ptr >= alloc_limit */ -- /* Record return address */ -- ldr r12, .Lcaml_last_return_address -- str lr, [r12, #0] -- /* Invoke GC */ -- bl .Linvoke_gc -+ bcc 1f -+ bx lr -+1: /* Record return address */ -+ ldr r7, =caml_last_return_address -+ str lr, [r7] -+ /* Call GC (preserves r7) */ -+ bl .Lcaml_call_gc -+ /* Restore return address */ -+ ldr lr, [r7] - /* Try again */ -- b caml_alloc1 -+ b .Lcaml_alloc1 -+ .type caml_alloc1, %function -+ .size caml_alloc1, .-caml_alloc1 - -- .globl caml_alloc2 -+ .align 2 -+ .globl caml_alloc2 - .type caml_alloc2, %function - caml_alloc2: -- sub alloc_ptr, alloc_ptr, #12 -+ PROFILE -+.Lcaml_alloc2: -+ sub alloc_ptr, alloc_ptr, 12 - cmp alloc_ptr, alloc_limit -- movcs pc, lr /* Return if alloc_ptr >= alloc_limit */ -- /* Record return address */ -- ldr r12, .Lcaml_last_return_address -- str lr, [r12, #0] -- /* Invoke GC */ -- bl .Linvoke_gc -+ bcc 1f -+ bx lr -+1: /* Record return address */ -+ ldr r7, =caml_last_return_address -+ str lr, [r7] -+ /* Call GC (preserves r7) */ -+ bl .Lcaml_call_gc -+ /* Restore return address */ -+ ldr lr, [r7] - /* Try again */ -- b caml_alloc2 -+ b .Lcaml_alloc2 -+ .type caml_alloc2, %function -+ .size caml_alloc2, .-caml_alloc2 - -- .globl caml_alloc3 -+ .align 2 -+ .globl caml_alloc3 - .type caml_alloc3, %function - caml_alloc3: -- sub alloc_ptr, alloc_ptr, #16 -+ PROFILE -+.Lcaml_alloc3: -+ sub alloc_ptr, alloc_ptr, 16 - cmp alloc_ptr, alloc_limit -- movcs pc, lr /* Return if alloc_ptr >= alloc_limit */ -- /* Record return address */ -- ldr r12, .Lcaml_last_return_address -- str lr, [r12, #0] -- /* Invoke GC */ -- bl .Linvoke_gc -+ bcc 1f -+ bx lr -+1: /* Record return address */ -+ ldr r7, =caml_last_return_address -+ str lr, [r7] -+ /* Call GC (preserves r7) */ -+ bl .Lcaml_call_gc -+ /* Restore return address */ -+ ldr lr, [r7] - /* Try again */ -- b caml_alloc3 -+ b .Lcaml_alloc3 -+ .type caml_alloc3, %function -+ .size caml_alloc3, .-caml_alloc3 - -- .globl caml_allocN -+ .align 2 -+ .globl caml_allocN - .type caml_allocN, %function - caml_allocN: -- sub alloc_ptr, alloc_ptr, r12 -+ PROFILE -+.Lcaml_allocN: -+ sub alloc_ptr, alloc_ptr, r7 - cmp alloc_ptr, alloc_limit -- movcs pc, lr /* Return if alloc_ptr >= alloc_limit */ -- /* Record return address and desired size */ -- /* Can use alloc_limit as a temporary since it will be reloaded by -- invoke_gc */ -- ldr alloc_limit, .Lcaml_last_return_address -- str lr, [alloc_limit, #0] -- ldr alloc_limit, .Lcaml_requested_size -- str r12, [alloc_limit, #0] -- /* Invoke GC */ -- bl .Linvoke_gc -+ bcc 1f -+ bx lr -+1: /* Record return address */ -+ ldr r12, =caml_last_return_address -+ str lr, [r12] -+ /* Call GC (preserves r7) */ -+ bl .Lcaml_call_gc -+ /* Restore return address */ -+ ldr r12, =caml_last_return_address -+ ldr lr, [r12] - /* Try again */ -- ldr r12, .Lcaml_requested_size -- ldr r12, [r12, #0] -- b caml_allocN -- --/* Shared code to invoke the GC */ --.Linvoke_gc: -- /* Record lowest stack address */ -- ldr r12, .Lcaml_bottom_of_stack -- str sp, [r12, #0] -- /* Save integer registers and return address on stack */ -- stmfd sp!, {r0,r1,r2,r3,r4,r5,r6,r7,r12,lr} -- /* Store pointer to saved integer registers in caml_gc_regs */ -- ldr r12, .Lcaml_gc_regs -- str sp, [r12, #0] -- /* Save current allocation pointer for debugging purposes */ -- ldr r12, .Lcaml_young_ptr -- str alloc_ptr, [r12, #0] -- /* Save trap pointer in case an exception is raised during GC */ -- ldr r12, .Lcaml_exception_pointer -- str trap_ptr, [r12, #0] -- /* Call the garbage collector */ -- bl caml_garbage_collection -- /* Restore the registers from the stack */ -- ldmfd sp!, {r0,r1,r2,r3,r4,r5,r6,r7,r12} -- /* Reload return address */ -- ldr r12, .Lcaml_last_return_address -- ldr lr, [r12, #0] -- /* Reload new allocation pointer and allocation limit */ -- ldr r12, .Lcaml_young_ptr -- ldr alloc_ptr, [r12, #0] -- ldr r12, .Lcaml_young_limit -- ldr alloc_limit, [r12, #0] -- /* Return to caller */ -- ldr r12, [sp], #4 -- bx r12 -+ b .Lcaml_allocN -+ .type caml_allocN, %function -+ .size caml_allocN, .-caml_allocN - --/* Call a C function from Caml */ --/* Function to call is in r12 */ -+/* Call a C function from OCaml */ -+/* Function to call is in r7 */ - -- .globl caml_c_call -+ .align 2 -+ .globl caml_c_call - .type caml_c_call, %function - caml_c_call: -+ PROFILE -+ /* Record lowest stack address and return address */ -+ ldr r5, =caml_last_return_address -+ ldr r6, =caml_bottom_of_stack -+ str lr, [r5] -+ str sp, [r6] - /* Preserve return address in callee-save register r4 */ - mov r4, lr -- /* Record lowest stack address and return address */ -- ldr r5, .Lcaml_last_return_address -- ldr r6, .Lcaml_bottom_of_stack -- str lr, [r5, #0] -- str sp, [r6, #0] -- /* Make the exception handler and alloc ptr available to the C code */ -- ldr r6, .Lcaml_young_ptr -- ldr r7, .Lcaml_exception_pointer -- str alloc_ptr, [r6, #0] -- str trap_ptr, [r7, #0] -+ /* Make the exception handler alloc ptr available to the C code */ -+ ldr r5, =caml_young_ptr -+ ldr r6, =caml_exception_pointer -+ str alloc_ptr, [r5] -+ str trap_ptr, [r6] - /* Call the function */ -- mov lr, pc -- bx r12 -+ blx r7 - /* Reload alloc ptr and alloc limit */ -- ldr r5, .Lcaml_young_limit -- ldr alloc_ptr, [r6, #0] /* r6 still points to caml_young_ptr */ -- ldr alloc_limit, [r5, #0] -+ ldr r6, =caml_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 - --/* Start the Caml program */ -+/* Start the OCaml program */ - -- .globl caml_start_program -+ .align 2 -+ .globl caml_start_program - .type caml_start_program, %function - caml_start_program: -- ldr r12, .Lcaml_program -+ PROFILE -+ ldr r12, =caml_program - - /* Code shared with caml_callback* */ --/* Address of Caml code to call is in r12 */ --/* Arguments to the Caml code are in r0...r3 */ -+/* Address of OCaml code to call is in r12 */ -+/* Arguments to the OCaml code are in r0...r3 */ - - .Ljump_to_caml: - /* Save return address and callee-save registers */ -- stmfd sp!, {r4,r5,r6,r7,r8,r10,r11,lr} /* 8-alignment */ -+ 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-alignment */ -- ldr r4, .Lcaml_bottom_of_stack -- ldr r4, [r4, #0] -- str r4, [sp, #0] -- ldr r4, .Lcaml_last_return_address -- ldr r4, [r4, #0] -- str r4, [sp, #4] -- ldr r4, .Lcaml_gc_regs -- ldr r4, [r4, #0] -- str r4, [sp, #8] -- /* Setup a trap frame to catch exceptions escaping the Caml code */ -- sub sp, sp, #4*2 -- ldr r4, .Lcaml_exception_pointer -- ldr r4, [r4, #0] -- str r4, [sp, #0] -- ldr r4, .LLtrap_handler -- str r4, [sp, #4] -+ 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, [r4] -+ ldr r5, [r5] -+ ldr r6, [r6] -+ str r4, [sp, 0] -+ str r5, [sp, 4] -+ 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 r4, [r6] -+ str r4, [sp, 0] -+ str r5, [sp, 4] - mov trap_ptr, sp - /* Reload allocation pointers */ -- ldr r4, .Lcaml_young_ptr -- ldr alloc_ptr, [r4, #0] -- ldr r4, .Lcaml_young_limit -- ldr alloc_limit, [r4, #0] -- /* Call the Caml code */ -- mov lr, pc -- bx r12 -+ ldr r4, =caml_young_ptr -+ ldr alloc_ptr, [r4] -+ ldr r4, =caml_young_limit -+ ldr alloc_limit, [r4] -+ /* Call the OCaml code */ -+ blx r12 - .Lcaml_retaddr: - /* Pop the trap frame, restoring caml_exception_pointer */ -- ldr r4, .Lcaml_exception_pointer -- ldr r5, [sp, #0] -- str r5, [r4, #0] -- add sp, sp, #2 * 4 -+ ldr r4, =caml_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, .Lcaml_bottom_of_stack -- ldr r5, [sp, #0] -- str r5, [r4, #0] -- ldr r4, .Lcaml_last_return_address -- ldr r5, [sp, #4] -- str r5, [r4, #0] -- ldr r4, .Lcaml_gc_regs -- ldr r5, [sp, #8] -- str r5, [r4, #0] -- add sp, sp, #4*4 -+ ldr r4, =caml_bottom_of_stack -+ ldr r5, [sp, 0] -+ str r5, [r4] -+ ldr r4, =caml_last_return_address -+ ldr r5, [sp, 4] -+ str r5, [r4] -+ ldr r4, =caml_gc_regs -+ ldr r5, [sp, 8] -+ str r5, [r4] -+ add sp, sp, 4*4 - /* Update allocation pointer */ -- ldr r4, .Lcaml_young_ptr -- str alloc_ptr, [r4, #0] -+ ldr r4, =caml_young_ptr -+ str alloc_ptr, [r4] - /* Reload callee-save registers and return */ -- ldmfd sp!, {r4,r5,r6,r7,r8,r10,r11,lr} -- bx lr -+ 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 - -- /* The trap handler */ -+/* The trap handler */ -+ -+ .align 2 - .Ltrap_handler: - /* Save exception pointer */ -- ldr r4, .Lcaml_exception_pointer -- str trap_ptr, [r4, #0] -+ ldr r12, =caml_exception_pointer -+ str trap_ptr, [r12] - /* Encode exception bucket as an exception result */ -- orr r0, r0, #2 -+ orr r0, r0, 2 - /* Return it */ - b .Lreturn_result -+ .type .Ltrap_handler, %function -+ .size .Ltrap_handler, .-.Ltrap_handler -+ -+/* Raise an exception from OCaml */ -+ -+ .align 2 -+ .globl caml_raise_exn -+caml_raise_exn: -+ PROFILE -+ /* Test if backtrace is active */ -+ ldr r1, =caml_backtrace_active -+ ldr r1, [r1] -+ cbz r1, 1f -+ /* Preserve exception bucket in callee-save register r4 */ -+ mov r4, r0 -+ /* Stash the backtrace */ -+ 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 -+ /* 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 - - /* Raise an exception from C */ - -- .globl caml_raise_exception -+ .align 2 -+ .globl caml_raise_exception - .type caml_raise_exception, %function - caml_raise_exception: -- /* Reload Caml allocation pointers */ -- ldr r12, .Lcaml_young_ptr -- ldr alloc_ptr, [r12, #0] -- ldr r12, .Lcaml_young_limit -- ldr alloc_limit, [r12, #0] -- /* Cut stack at current trap handler */ -- ldr r12, .Lcaml_exception_pointer -- ldr sp, [r12, #0] -+ 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, [trap_ptr] -+ ldr alloc_ptr, [alloc_ptr] -+ ldr alloc_limit, [alloc_limit] -+ /* Test if backtrace is active */ -+ ldr r1, =caml_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, [r1] -+ ldr r2, =caml_bottom_of_stack /* arg3: sp of raise */ -+ ldr r2, [r2] -+ mov r3, trap_ptr /* arg4: sp of handler */ -+ bl 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 */ -- ldmfd sp!, {trap_ptr, pc} -+ pop {trap_ptr, pc} -+ .type caml_raise_exception, %function -+ .size caml_raise_exception, .-caml_raise_exception - --/* Callback from C to Caml */ -+/* Callback from C to OCaml */ - -- .globl caml_callback_exn -+ .align 2 -+ .globl caml_callback_exn - .type caml_callback_exn, %function - 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, #0] /* code pointer */ -+ 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 - -- .globl caml_callback2_exn -+ .align 2 -+ .globl caml_callback2_exn - .type caml_callback2_exn, %function - 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, .Lcaml_apply2 -+ 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 - -- .globl caml_callback3_exn -+ .align 2 -+ .globl caml_callback3_exn - .type caml_callback3_exn, %function - caml_callback3_exn: -+ PROFILE - /* Initial shuffling of arguments */ - /* (r0 = closure, r1 = arg1, r2 = arg2, r3 = arg3) */ - mov r12, r0 -@@ -288,43 +413,36 @@ - mov r1, r2 /* r1 = second arg */ - mov r2, r3 /* r2 = third arg */ - mov r3, r12 /* r3 = closure environment */ -- ldr r12, .Lcaml_apply3 -+ ldr r12, =caml_apply3 - b .Ljump_to_caml -+ .type caml_callback3_exn, %function -+ .size caml_callback3_exn, .-caml_callback3_exn - -- .globl caml_ml_array_bound_error -+ .align 2 -+ .globl caml_ml_array_bound_error - .type caml_ml_array_bound_error, %function - caml_ml_array_bound_error: -- /* Load address of [caml_array_bound_error] in r12 */ -- ldr r12, .Lcaml_array_bound_error -+ PROFILE -+ /* Load address of [caml_array_bound_error] in r7 */ -+ ldr r7, =caml_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 - --/* Global references */ -- --.Lcaml_last_return_address: .word caml_last_return_address --.Lcaml_bottom_of_stack: .word caml_bottom_of_stack --.Lcaml_gc_regs: .word caml_gc_regs --.Lcaml_young_ptr: .word caml_young_ptr --.Lcaml_young_limit: .word caml_young_limit --.Lcaml_exception_pointer: .word caml_exception_pointer --.Lcaml_program: .word caml_program --.LLtrap_handler: .word .Ltrap_handler --.Lcaml_apply2: .word caml_apply2 --.Lcaml_apply3: .word caml_apply3 --.Lcaml_array_bound_error: .word caml_array_bound_error --.Lcaml_requested_size: .word caml_requested_size -- -- .data --caml_requested_size: -- .word 0 -+ .globl caml_system__code_end -+caml_system__code_end: - - /* GC roots for callback */ - - .data -- .globl caml_system__frametable -+ .align 2 -+ .globl caml_system__frametable - caml_system__frametable: - .word 1 /* one descriptor */ - .word .Lcaml_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 -diff -urN ocaml-3.12.1-noarm/asmrun/signals_osdep.h ocaml-3.12.1-arm/asmrun/signals_osdep.h ---- ocaml-3.12.1-noarm/asmrun/signals_osdep.h 2009-05-20 12:52:42.000000000 +0100 -+++ ocaml-3.12.1-arm/asmrun/signals_osdep.h 2012-04-28 09:23:12.209919224 +0100 -@@ -78,7 +78,7 @@ - - /****************** ARM, Linux */ - --#elif defined(TARGET_arm) && defined (SYS_linux) -+#elif defined(TARGET_arm) && (defined (SYS_linux_eabi) || defined(SYS_linux_eabihf)) - - #include - -diff -urN ocaml-3.12.1-noarm/configure ocaml-3.12.1-arm/configure ---- ocaml-3.12.1-noarm/configure 2012-04-27 20:51:07.193775283 +0100 -+++ ocaml-3.12.1-arm/configure 2012-04-28 09:23:59.270773673 +0100 -@@ -636,6 +636,7 @@ - i[345]86-*-netbsd*) natdynlink=true;; - x86_64-*-netbsd*) natdynlink=true;; - i386-*-gnu0.3) natdynlink=true;; -+ arm*-*-linux*) natdynlink=true;; - esac - fi - -@@ -690,8 +691,13 @@ - powerpc-*-rhapsody*) arch=power; model=ppc; system=rhapsody;; - powerpc-*-darwin*) arch=power; system=rhapsody - if $arch64; then model=ppc64; else model=ppc; fi;; -- arm*-*-linux*) arch=arm; system=linux;; -- arm*-*-gnu*) arch=arm; system=gnu;; -+ arm*-*-linux-gnueabihf) arch=arm; system=linux_eabihf;; -+ armv7*-*-linux-gnueabi) arch=arm; model=armv7; system=linux_eabi;; -+ armv6t2*-*-linux-gnueabi) arch=arm; model=armv6t2; system=linux_eabi;; -+ armv6*-*-linux-gnueabi) arch=arm; model=armv6; system=linux_eabi;; -+ armv5te*-*-linux-gnueabi) arch=arm; model=armv5te; system=linux_eabi;; -+ armv5*-*-linux-gnueabi) arch=arm; model=armv5; system=linux_eabi;; -+ arm*-*-linux-gnueabi) arch=arm; system=linux_eabi;; - ia64-*-linux*) arch=ia64; system=linux;; - ia64-*-gnu*) arch=ia64; system=gnu;; - ia64-*-freebsd*) arch=ia64; system=freebsd;; -@@ -801,6 +807,7 @@ - case "$nativecc" in gcc*) ;; *) cc_profile='-xpg';; esac;; - amd64,*,linux) profiling='prof';; - amd64,*,gnu) profiling='prof';; -+ arm,*,linux*) profiling='prof';; - *) profiling='noprof';; - esac - diff --git a/ocaml-ppc64.patch b/ocaml-ppc64.patch deleted file mode 100644 index 88eff4b..0000000 --- a/ocaml-ppc64.patch +++ /dev/null @@ -1,2083 +0,0 @@ -diff -uNr ocaml-3.10.1/asmcomp/power64/arch.ml ocaml-3.10.1.ppc64/asmcomp/power64/arch.ml ---- ocaml-3.10.1/asmcomp/power64/arch.ml 1969-12-31 19:00:00.000000000 -0500 -+++ ocaml-3.10.1.ppc64/asmcomp/power64/arch.ml 2008-02-29 08:37:45.000000000 -0500 -@@ -0,0 +1,84 @@ -+(***********************************************************************) -+(* *) -+(* Objective Caml *) -+(* *) -+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -+(* *) -+(* Copyright 1996 Institut National de Recherche en Informatique et *) -+(* en Automatique. All rights reserved. This file is distributed *) -+(* under the terms of the Q Public License version 1.0. *) -+(* *) -+(***********************************************************************) -+ -+(* $Id: ocaml-3.11.0-ppc64.patch,v 1.1 2008/11/20 15:30:55 rjones Exp $ *) -+ -+(* Specific operations for the PowerPC processor *) -+ -+open Misc -+open Format -+ -+(* Machine-specific command-line options *) -+ -+let command_line_options = [] -+ -+(* Specific operations *) -+ -+type specific_operation = -+ Imultaddf (* multiply and add *) -+ | Imultsubf (* multiply and subtract *) -+ | Ialloc_far of int (* allocation in large functions *) -+ -+(* Addressing modes *) -+ -+type addressing_mode = -+ Ibased of string * int (* symbol + displ *) -+ | Iindexed of int (* reg + displ *) -+ | Iindexed2 (* reg + reg *) -+ -+(* Sizes, endianness *) -+ -+let big_endian = true -+ -+let size_addr = 8 -+let size_int = 8 -+let size_float = 8 -+ -+(* Operations on addressing modes *) -+ -+let identity_addressing = Iindexed 0 -+ -+let offset_addressing addr delta = -+ match addr with -+ Ibased(s, n) -> Ibased(s, n + delta) -+ | Iindexed n -> Iindexed(n + delta) -+ | Iindexed2 -> assert false -+ -+let num_args_addressing = function -+ Ibased(s, n) -> 0 -+ | Iindexed n -> 1 -+ | Iindexed2 -> 2 -+ -+(* Printing operations and addressing modes *) -+ -+let print_addressing printreg addr ppf arg = -+ match addr with -+ | Ibased(s, n) -> -+ let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in -+ fprintf ppf "\"%s\"%s" s idx -+ | Iindexed n -> -+ let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in -+ fprintf ppf "%a%s" printreg arg.(0) idx -+ | Iindexed2 -> -+ fprintf ppf "%a + %a" printreg arg.(0) printreg arg.(1) -+ -+let print_specific_operation printreg op ppf arg = -+ match op with -+ | Imultaddf -> -+ fprintf ppf "%a *f %a +f %a" -+ printreg arg.(0) printreg arg.(1) printreg arg.(2) -+ | Imultsubf -> -+ fprintf ppf "%a *f %a -f %a" -+ printreg arg.(0) printreg arg.(1) printreg arg.(2) -+ | Ialloc_far n -> -+ fprintf ppf "alloc_far %d" n -+ -diff -uNr ocaml-3.10.1/asmcomp/power64/emit.mlp ocaml-3.10.1.ppc64/asmcomp/power64/emit.mlp ---- ocaml-3.10.1/asmcomp/power64/emit.mlp 1969-12-31 19:00:00.000000000 -0500 -+++ ocaml-3.10.1.ppc64/asmcomp/power64/emit.mlp 2008-02-29 08:37:45.000000000 -0500 -@@ -0,0 +1,989 @@ -+(***********************************************************************) -+(* *) -+(* Objective Caml *) -+(* *) -+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -+(* *) -+(* Copyright 1996 Institut National de Recherche en Informatique et *) -+(* en Automatique. All rights reserved. This file is distributed *) -+(* under the terms of the Q Public License version 1.0. *) -+(* *) -+(***********************************************************************) -+ -+(* $Id: ocaml-3.11.0-ppc64.patch,v 1.1 2008/11/20 15:30:55 rjones Exp $ *) -+ -+(* Emission of PowerPC assembly code *) -+ -+module StringSet = Set.Make(struct type t = string let compare = compare end) -+ -+open Location -+open Misc -+open Cmm -+open Arch -+open Proc -+open Reg -+open Mach -+open Linearize -+open Emitaux -+ -+(* Layout of the stack. The stack is kept 16-aligned. *) -+ -+let stack_size_lbl = ref 0 -+let stack_slot_lbl = ref 0 -+let stack_args_size = ref 0 -+let stack_traps_size = ref 0 -+ -+(* We have a stack frame of our own if we call other functions (including -+ use of exceptions, or if we need more than the red zone *) -+let has_stack_frame () = -+ if !contains_calls or (num_stack_slots.(0) + num_stack_slots.(1)) > (288-16)/8 then -+ true -+ else -+ false -+ -+let frame_size_sans_args () = -+ let size = 8 * num_stack_slots.(0) + 8 * num_stack_slots.(1) + 48 in -+ Misc.align size 16 -+ -+let slot_offset loc cls = -+ match loc with -+ Local n -> -+ if cls = 0 -+ then (!stack_slot_lbl, num_stack_slots.(1) * 8 + n * 8) -+ else (!stack_slot_lbl, n * 8) -+ | Incoming n -> ((if has_stack_frame() then !stack_size_lbl else 0), 48 + n) -+ | Outgoing n -> (0, n) -+ -+(* Output a symbol *) -+ -+let emit_symbol = -+ match Config.system with -+ | "elf" | "bsd" -> (fun s -> Emitaux.emit_symbol '.' s) -+ | "rhapsody" -> (fun s -> emit_char '_'; Emitaux.emit_symbol '$' s) -+ | _ -> assert false -+ -+(* Output a label *) -+ -+let label_prefix = -+ match Config.system with -+ | "elf" | "bsd" -> ".L" -+ | "rhapsody" -> "L" -+ | _ -> assert false -+ -+let emit_label lbl = -+ emit_string label_prefix; emit_int lbl -+ -+(* Section switching *) -+ -+let toc_space = -+ match Config.system with -+ | "elf" | "bsd" -> " .section \".toc\",\"aw\"\n" -+ | "rhapsody" -> " .toc\n" -+ | _ -> assert false -+ -+let data_space = -+ match Config.system with -+ | "elf" | "bsd" -> " .section \".data\"\n" -+ | "rhapsody" -> " .data\n" -+ | _ -> assert false -+ -+let code_space = -+ match Config.system with -+ | "elf" | "bsd" -> " .section \".text\"\n" -+ | "rhapsody" -> " .text\n" -+ | _ -> assert false -+ -+let rodata_space = -+ match Config.system with -+ | "elf" | "bsd" -> " .section \".rodata\"\n" -+ | "rhapsody" -> " .const\n" -+ | _ -> assert false -+ -+(* Output a pseudo-register *) -+ -+let emit_reg r = -+ match r.loc with -+ 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 lbl, ofs = slot_offset s (register_class r) in -+ if lbl > 0 then -+ `{emit_label lbl}+`; -+ `{emit_int ofs}({emit_gpr 1})` -+ | _ -> fatal_error "Emit.emit_stack" -+ -+(* Split a 32-bit integer constants in two 16-bit halves *) -+ -+let low n = n land 0xFFFF -+let high n = n asr 16 -+ -+let nativelow n = Nativeint.to_int n land 0xFFFF -+let nativehigh n = Nativeint.to_int (Nativeint.shift_right n 16) -+ -+let is_immediate n = -+ n <= 32767 && n >= -32768 -+ -+let is_native_immediate n = -+ n <= 32767n && n >= -32768n -+ -+ -+type tocentry = -+ TocSymOfs of (string * int) -+ | TocLabel of int -+ | TocInt of nativeint -+ | TocFloat of string -+ -+(* List of all labels in tocref (reverse order) *) -+let tocref_entries = ref [] -+ -+(* Output a TOC reference *) -+ -+let emit_symbol_offset (s, d) = -+ emit_symbol s; -+ if d > 0 then `+`; -+ if d <> 0 then emit_int d -+ -+let emit_tocentry entry = -+ match entry with -+ TocSymOfs(s,d) -> emit_symbol_offset(s,d) -+ | TocInt i -> emit_nativeint i -+ | TocFloat f -> emit_string f -+ | TocLabel lbl -> emit_label lbl -+ -+ let rec tocref_label = function -+ ( [] , content ) -> -+ let lbl = new_label() in -+ tocref_entries := (lbl, content) :: !tocref_entries; -+ lbl -+ | ( (lbl, o_content) :: lst, content) -> -+ if content = o_content then -+ lbl -+ else -+ tocref_label (lst, content) -+ -+let emit_tocref entry = -+ let lbl = tocref_label (!tocref_entries,entry) in -+ emit_label lbl; emit_string "@toc(2) #"; emit_tocentry entry -+ -+ -+(* Output a load or store operation *) -+ -+let valid_offset instr ofs = -+ ofs land 3 = 0 || (instr <> "ld" && instr <> "std") -+ -+let emit_load_store instr addressing_mode addr n arg = -+ match addressing_mode with -+ Ibased(s, d) -> -+ let dd = (d + 0x8000) in (* We can only offset by -0x8000 .. +0x7fff *) -+ let a = (dd land -0x10000) in -+ let b = (dd land 0xffff) - 0x8000 in -+ ` ld {emit_gpr 11}, {emit_tocref (TocSymOfs (s,a))}\n`; -+ ` {emit_string instr} {emit_reg arg}, {emit_int b}({emit_gpr 11})\n` -+ | Iindexed ofs -> -+ if is_immediate ofs && valid_offset instr 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` -+ -+(* 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` -+ | _ -> () -+ end -+ -+(* Record live pointers at call points *) -+ -+type frame_descr = -+ { fd_lbl: int; (* Return address *) -+ fd_frame_size_lbl: int; (* Size of stack frame *) -+ fd_live_offset: (int * int) list } (* Offsets/regs of live addresses *) -+ -+let frame_descriptors = ref([] : frame_descr list) -+ -+let record_frame live = -+ let lbl = new_label() in -+ let live_offset = ref [] in -+ Reg.Set.iter -+ (function -+ {typ = Addr; loc = Reg r} -> -+ live_offset := (0, (r lsl 1) + 1) :: !live_offset -+ | {typ = Addr; loc = Stack s} as reg -> -+ live_offset := slot_offset s (register_class reg) :: !live_offset -+ | _ -> ()) -+ live; -+ frame_descriptors := -+ { fd_lbl = lbl; -+ fd_frame_size_lbl = !stack_size_lbl; (* frame_size *) -+ fd_live_offset = !live_offset } :: !frame_descriptors; -+ `{emit_label lbl}:\n` -+ -+let emit_frame fd = -+ ` .quad {emit_label fd.fd_lbl} + 4\n`; -+ ` .short {emit_label fd.fd_frame_size_lbl}\n`; -+ ` .short {emit_int (List.length fd.fd_live_offset)}\n`; -+ List.iter -+ (fun (lbl,n) -> -+ ` .short `; -+ if lbl > 0 then `{emit_label lbl}+`; -+ `{emit_int n}\n`) -+ fd.fd_live_offset; -+ ` .align 3\n` -+ -+(* Record external C functions to be called in a position-independent way -+ (for MacOSX) *) -+ -+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`; -+ ` .quad 0\n` -+ -+(* Names for conditional branches after comparisons *) -+ -+let branch_for_comparison = function -+ Ceq -> "beq" | Cne -> "bne" -+ | Cle -> "ble" | Cgt -> "bgt" -+ | Cge -> "bge" | Clt -> "blt" -+ -+let name_for_int_comparison = function -+ Isigned cmp -> ("cmpd", branch_for_comparison cmp) -+ | Iunsigned cmp -> ("cmpld", branch_for_comparison cmp) -+ -+(* Names for various instructions *) -+ -+let name_for_intop = function -+ Iadd -> "add" -+ | Imul -> "mulld" -+ | Idiv -> "divd" -+ | Iand -> "and" -+ | Ior -> "or" -+ | Ixor -> "xor" -+ | Ilsl -> "sld" -+ | Ilsr -> "srd" -+ | Iasr -> "srad" -+ | _ -> Misc.fatal_error "Emit.Intop" -+ -+let name_for_intop_imm = function -+ Iadd -> "addi" -+ | Imul -> "mulli" -+ | Iand -> "andi." -+ | Ior -> "ori" -+ | Ixor -> "xori" -+ | Ilsl -> "sldi" -+ | Ilsr -> "srdi" -+ | Iasr -> "sradi" -+ | _ -> Misc.fatal_error "Emit.Intop_imm" -+ -+let name_for_floatop1 = function -+ Inegf -> "fneg" -+ | Iabsf -> "fabs" -+ | _ -> Misc.fatal_error "Emit.Iopf1" -+ -+let name_for_floatop2 = function -+ Iaddf -> "fadd" -+ | Isubf -> "fsub" -+ | Imulf -> "fmul" -+ | Idivf -> "fdiv" -+ | _ -> Misc.fatal_error "Emit.Iopf2" -+ -+let name_for_specific = function -+ Imultaddf -> "fmadd" -+ | Imultsubf -> "fmsub" -+ | _ -> Misc.fatal_error "Emit.Ispecific" -+ -+(* Name of current function *) -+let function_name = ref "" -+(* Entry point for tail recursive calls *) -+let tailrec_entry_point = ref 0 -+(* Names of functions defined in the current file *) -+let defined_functions = ref StringSet.empty -+(* Label of glue code for calling the GC *) -+let call_gc_label = ref 0 -+(* Label of jump table *) -+let lbl_jumptbl = ref 0 -+(* List of all labels in jumptable (reverse order) *) -+let jumptbl_entries = ref [] -+(* Number of jumptable entries *) -+let num_jumptbl_entries = ref 0 -+ -+(* Fixup conditional branches that exceed hardware allowed range *) -+ -+let load_store_size = function -+ Ibased(s, d) -> 2 -+ | Iindexed ofs -> if is_immediate ofs then 1 else 3 -+ | Iindexed2 -> 1 -+ -+let instr_size = function -+ Lend -> 0 -+ | Lop(Imove | Ispill | Ireload) -> 1 -+ | Lop(Iconst_int n) -> if is_native_immediate n then 1 else 2 -+ | Lop(Iconst_float s) -> 2 -+ | Lop(Iconst_symbol s) -> 2 -+ | Lop(Icall_ind) -> 6 -+ | Lop(Icall_imm s) -> 7 -+ | Lop(Itailcall_ind) -> if !contains_calls then 7 else if has_stack_frame() then 5 else 4 -+ | Lop(Itailcall_imm s) -> if s = !function_name then 1 else -+ if !contains_calls then 8 else -+ if has_stack_frame() then 6 else 5 -+ | Lop(Iextcall(s, true)) -> 8 -+ | Lop(Iextcall(s, false)) -> 7 -+ | Lop(Istackoffset n) -> 0 -+ | Lop(Iload(chunk, addr)) -> -+ if chunk = Byte_signed -+ then load_store_size addr + 1 -+ else load_store_size addr -+ | Lop(Istore(chunk, addr)) -> load_store_size addr -+ | Lop(Ialloc n) -> 4 -+ | Lop(Ispecific(Ialloc_far n)) -> 5 -+ | Lop(Iintop Imod) -> 3 -+ | Lop(Iintop(Icomp cmp)) -> 4 -+ | Lop(Iintop op) -> 1 -+ | Lop(Iintop_imm(Idiv, n)) -> 2 -+ | Lop(Iintop_imm(Imod, n)) -> 4 -+ | Lop(Iintop_imm(Icomp cmp, n)) -> 4 -+ | Lop(Iintop_imm(op, n)) -> 1 -+ | Lop(Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf) -> 1 -+ | Lop(Ifloatofint) -> 3 -+ | Lop(Iintoffloat) -> 3 -+ | Lop(Ispecific sop) -> 1 -+ | Lreloadretaddr -> 2 -+ | Lreturn -> if has_stack_frame() then 2 else 1 -+ | Llabel lbl -> 0 -+ | Lbranch lbl -> 1 -+ | Lcondbranch(tst, lbl) -> 2 -+ | Lcondbranch3(lbl0, lbl1, lbl2) -> -+ 1 + (if lbl0 = None then 0 else 1) -+ + (if lbl1 = None then 0 else 1) -+ + (if lbl2 = None then 0 else 1) -+ | Lswitch jumptbl -> 7 -+ | Lsetuptrap lbl -> 1 -+ | Lpushtrap -> 7 -+ | Lpoptrap -> 1 -+ | Lraise -> 6 -+ -+let label_map code = -+ let map = Hashtbl.create 37 in -+ let rec fill_map pc instr = -+ match instr.desc with -+ Lend -> (pc, map) -+ | Llabel lbl -> Hashtbl.add map lbl pc; fill_map pc instr.next -+ | op -> fill_map (pc + instr_size op) instr.next -+ in fill_map 0 code -+ -+let max_branch_offset = 8180 -+(* 14-bit signed offset in words. Remember to cut some slack -+ for multi-word instructions where the branch can be anywhere in -+ the middle. 12 words of slack is plenty. *) -+ -+let branch_overflows map pc_branch lbl_dest = -+ let pc_dest = Hashtbl.find map lbl_dest in -+ let delta = pc_dest - (pc_branch + 1) in -+ delta <= -max_branch_offset || delta >= max_branch_offset -+ -+let opt_branch_overflows map pc_branch opt_lbl_dest = -+ match opt_lbl_dest with -+ None -> false -+ | Some lbl_dest -> branch_overflows map pc_branch lbl_dest -+ -+let fixup_branches codesize map code = -+ let expand_optbranch lbl n arg next = -+ match lbl with -+ None -> next -+ | Some l -> -+ instr_cons (Lcondbranch(Iinttest_imm(Isigned Ceq, n), l)) -+ arg [||] next in -+ let rec fixup did_fix pc instr = -+ match instr.desc with -+ Lend -> did_fix -+ | Lcondbranch(test, lbl) when branch_overflows map pc lbl -> -+ let lbl2 = new_label() in -+ let cont = -+ instr_cons (Lbranch lbl) [||] [||] -+ (instr_cons (Llabel lbl2) [||] [||] instr.next) in -+ instr.desc <- Lcondbranch(invert_test test, lbl2); -+ instr.next <- cont; -+ fixup true (pc + 2) instr.next -+ | Lcondbranch3(lbl0, lbl1, lbl2) -+ when opt_branch_overflows map pc lbl0 -+ || opt_branch_overflows map pc lbl1 -+ || opt_branch_overflows map pc lbl2 -> -+ let cont = -+ expand_optbranch lbl0 0 instr.arg -+ (expand_optbranch lbl1 1 instr.arg -+ (expand_optbranch lbl2 2 instr.arg instr.next)) in -+ instr.desc <- cont.desc; -+ instr.next <- cont.next; -+ fixup true pc instr -+ | Lop(Ialloc n) when codesize - pc >= max_branch_offset -> -+ instr.desc <- Lop(Ispecific(Ialloc_far n)); -+ fixup true (pc + 4) instr.next -+ | op -> -+ fixup did_fix (pc + instr_size op) instr.next -+ in fixup false 0 code -+ -+(* Iterate branch expansion till all conditional branches are OK *) -+ -+let rec branch_normalization code = -+ let (codesize, map) = label_map code in -+ if codesize >= max_branch_offset && fixup_branches codesize map code -+ then branch_normalization code -+ else () -+ -+ -+(* Output the assembly code for an instruction *) -+ -+let rec emit_instr i dslot = -+ match i.desc with -+ Lend -> () -+ | Lop(Imove | Ispill | Ireload) -> -+ let src = i.arg.(0) and dst = i.res.(0) in -+ if src.loc <> dst.loc then begin -+ match (src, dst) with -+ {loc = Reg rs; typ = (Int | Addr)}, {loc = Reg rd} -> -+ ` mr {emit_reg dst}, {emit_reg src}\n` -+ | {loc = Reg rs; typ = Float}, {loc = Reg rd; typ = Float} -> -+ ` fmr {emit_reg dst}, {emit_reg src}\n` -+ | {loc = Reg rs; typ = (Int | Addr)}, {loc = Stack sd} -> -+ ` std {emit_reg src}, {emit_stack dst}\n` -+ | {loc = Reg rs; typ = Float}, {loc = Stack sd} -> -+ ` stfd {emit_reg src}, {emit_stack dst}\n` -+ | {loc = Stack ss; typ = (Int | Addr)}, {loc = Reg rd} -> -+ ` ld {emit_reg dst}, {emit_stack src}\n` -+ | {loc = Stack ss; typ = Float}, {loc = Reg rd} -> -+ ` lfd {emit_reg dst}, {emit_stack src}\n` -+ | (_, _) -> -+ fatal_error "Emit: Imove" -+ end -+ | Lop(Iconst_int n) -> -+ if is_native_immediate n then -+ ` li {emit_reg i.res.(0)}, {emit_nativeint n}\n` -+ else if n >= -0x8000_0000n && n <= 0x7FFF_FFFFn then begin -+ ` lis {emit_reg i.res.(0)}, {emit_int(nativehigh n)}\n`; -+ if nativelow n <> 0 then -+ ` ori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, {emit_int(nativelow n)}\n` -+ end else begin -+ ` ld {emit_reg i.res.(0)}, {emit_tocref (TocInt n)}\n` -+ end -+ | Lop(Iconst_float s) -> -+ ` lfd {emit_reg i.res.(0)}, {emit_tocref (TocFloat s)}\n` -+ | Lop(Iconst_symbol s) -> -+ ` ld {emit_reg i.res.(0)}, {emit_tocref (TocSymOfs (s,0))}\n` -+ | Lop(Icall_ind) -> -+ ` std {emit_gpr 2},40({emit_gpr 1})\n`; -+ ` ld {emit_gpr 2}, 8({emit_reg i.arg.(0)})\n`; -+ ` ld {emit_reg i.arg.(0)}, 0({emit_reg i.arg.(0)})\n`; -+ ` mtctr {emit_reg i.arg.(0)}\n`; -+ record_frame i.live; -+ ` bctrl\n`; -+ ` ld {emit_gpr 2},40({emit_gpr 1})\n` -+ | Lop(Icall_imm s) -> -+ ` ld {emit_gpr 11}, {emit_tocref (TocSymOfs (s,0))}\n`; -+ ` std {emit_gpr 2},40({emit_gpr 1})\n`; -+ ` ld {emit_gpr 2}, 8({emit_gpr 11})\n`; -+ ` ld {emit_gpr 11}, 0({emit_gpr 11})\n`; -+ ` mtctr {emit_gpr 11}\n`; -+ record_frame i.live; -+ ` bctrl\n`; -+ ` ld {emit_gpr 2},40({emit_gpr 1})\n` -+ | Lop(Itailcall_ind) -> -+ ` ld {emit_gpr 2}, 8({emit_reg i.arg.(0)})\n`; -+ ` ld {emit_reg i.arg.(0)}, 0({emit_reg i.arg.(0)})\n`; -+ ` mtctr {emit_reg i.arg.(0)}\n`; -+ if has_stack_frame() then -+ ` ld {emit_gpr 1}, 0({emit_gpr 1})\n`; -+ if !contains_calls then begin -+ ` ld {emit_gpr 11}, 16({emit_gpr 1})\n`; -+ ` mtlr {emit_gpr 11}\n` -+ end; -+ ` bctr\n` -+ | Lop(Itailcall_imm s) -> -+ if s = !function_name then -+ ` b {emit_label !tailrec_entry_point}\n` -+ else begin -+ if has_stack_frame() then -+ ` ld {emit_gpr 1}, 0({emit_gpr 1})\n`; -+ if !contains_calls then begin -+ ` ld {emit_gpr 11}, 16({emit_gpr 1})\n`; -+ ` mtlr {emit_gpr 11}\n` -+ end; -+ ` ld {emit_gpr 11}, {emit_tocref (TocSymOfs (s,0))}\n`; -+ ` ld {emit_gpr 2}, 8({emit_gpr 11})\n`; -+ ` ld {emit_gpr 11}, 0({emit_gpr 11})\n`; -+ ` mtctr {emit_gpr 11}\n`; -+ ` bctr\n` -+ end -+ | Lop(Iextcall(s, alloc)) -> -+ if alloc then begin -+ ` ld {emit_gpr 11}, {emit_tocref (TocSymOfs (s,0))}\n`; -+ ` ld {emit_gpr 12}, {emit_tocref (TocSymOfs ("caml_c_call",0))}\n`; -+ end else -+ ` ld {emit_gpr 12}, {emit_tocref (TocSymOfs (s,0))}\n`; -+ ` std {emit_gpr 2}, 40({emit_gpr 1})\n`; -+ ` ld {emit_gpr 2}, 8({emit_gpr 12})\n`; -+ ` ld {emit_gpr 12}, 0({emit_gpr 12})\n`; -+ ` mtctr {emit_gpr 12}\n`; -+ if alloc then record_frame i.live; -+ ` bctrl\n`; -+ ` ld {emit_gpr 2}, 40({emit_gpr 1})\n` -+ | Lop(Istackoffset n) -> -+ if n > !stack_args_size then -+ stack_args_size := n -+ | Lop(Iload(chunk, addr)) -> -+ let loadinstr = -+ match chunk with -+ Byte_unsigned -> "lbz" -+ | Byte_signed -> "lbz" -+ | Sixteen_unsigned -> "lhz" -+ | Sixteen_signed -> "lha" -+ | Thirtytwo_unsigned -> "lwz" -+ | Thirtytwo_signed -> "lwa" -+ | Word -> "ld" -+ | Single -> "lfs" -+ | Double | Double_u -> "lfd" in -+ emit_load_store loadinstr addr i.arg 0 i.res.(0); -+ if chunk = Byte_signed then -+ ` extsb {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` -+ | Lop(Istore(chunk, addr)) -> -+ let storeinstr = -+ match chunk with -+ Byte_unsigned | Byte_signed -> "stb" -+ | Sixteen_unsigned | Sixteen_signed -> "sth" -+ | Thirtytwo_unsigned | Thirtytwo_signed -> "stw" -+ | Word -> "std" -+ | Single -> "stfs" -+ | Double | Double_u -> "stfd" in -+ 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`; -+ ` cmpld {emit_gpr 31}, {emit_gpr 30}\n`; -+ ` addi {emit_reg i.res.(0)}, {emit_gpr 31}, 8\n`; -+ record_frame i.live; -+ ` bltl {emit_label !call_gc_label}\n` (* Must be 4 insns to restart *) -+ | Lop(Ispecific(Ialloc_far n)) -> -+ if !call_gc_label = 0 then call_gc_label := new_label(); -+ let lbl = new_label() in -+ ` addi {emit_gpr 31}, {emit_gpr 31}, {emit_int(-n)}\n`; -+ ` cmpld {emit_gpr 31}, {emit_gpr 30}\n`; -+ ` bge {emit_label lbl}\n`; -+ record_frame i.live; -+ ` bl {emit_label !call_gc_label}\n`; (* Must be 4 insns to restart *) -+ `{emit_label lbl}: addi {emit_reg i.res.(0)}, {emit_gpr 31}, 4\n` -+ | Lop(Iintop Isub) -> (* subfc has swapped arguments *) -+ ` subfc {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n` -+ | Lop(Iintop Imod) -> -+ ` divd {emit_gpr 0}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; -+ ` mulld {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` -+ | Lop(Iintop(Icomp cmp)) -> -+ begin match cmp with -+ Isigned c -> -+ ` cmpd {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; -+ emit_set_comp c i.res.(0) -+ | Iunsigned c -> -+ ` cmpld {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; -+ emit_set_comp c i.res.(0) -+ end -+ | Lop(Iintop Icheckbound) -> -+ ` tdlle {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` -+ | Lop(Iintop op) -> -+ let instr = name_for_intop op in -+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` -+ | Lop(Iintop_imm(Isub, n)) -> -+ ` addi {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int(-n)}\n` -+ | Lop(Iintop_imm(Idiv, n)) -> (* n is guaranteed to be a power of 2 *) -+ let l = Misc.log2 n in -+ ` sradi {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int l}\n`; -+ ` 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 -+ ` sradi {emit_gpr 0}, {emit_reg i.arg.(0)}, {emit_int l}\n`; -+ ` addze {emit_gpr 0}, {emit_gpr 0}\n`; -+ ` sldi {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 -> -+ ` cmpdi {emit_reg i.arg.(0)}, {emit_int n}\n`; -+ emit_set_comp c i.res.(0) -+ | Iunsigned c -> -+ ` cmpldi {emit_reg i.arg.(0)}, {emit_int n}\n`; -+ emit_set_comp c i.res.(0) -+ end -+ | Lop(Iintop_imm(Icheckbound, n)) -> -+ ` tdllei {emit_reg i.arg.(0)}, {emit_int n}\n` -+ | Lop(Iintop_imm(op, n)) -> -+ let instr = name_for_intop_imm op in -+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int n}\n` -+ | Lop(Inegf | Iabsf as op) -> -+ let instr = name_for_floatop1 op in -+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n` -+ | Lop(Iaddf | Isubf | Imulf | Idivf as op) -> -+ let instr = name_for_floatop2 op in -+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` -+ | Lop(Ifloatofint) -> -+ let ofs = if has_stack_frame() then 16 else 8 * (2 + num_stack_slots.(0) + num_stack_slots.(1)) in -+ ` std {emit_reg i.arg.(0)}, -{emit_int ofs}({emit_gpr 1})\n`; -+ ` lfd {emit_reg i.res.(0)}, -{emit_int ofs}({emit_gpr 1})\n`; -+ ` fcfid {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` -+ | Lop(Iintoffloat) -> -+ let ofs = if has_stack_frame() then 16 else 8 * (2 + num_stack_slots.(0) + num_stack_slots.(1)) in -+ ` fctidz {emit_fpr 0}, {emit_reg i.arg.(0)}\n`; -+ ` stfd {emit_fpr 0}, -{emit_int ofs}({emit_gpr 1})\n`; -+ ` ld {emit_reg i.res.(0)}, -{emit_int ofs}({emit_gpr 1})\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 -> -+ if has_stack_frame() then begin -+ ` ld {emit_gpr 11}, {emit_label !stack_size_lbl}+16({emit_gpr 1})\n`; -+ ` mtlr {emit_gpr 11}\n` -+ end -+ | Lreturn -> -+ if has_stack_frame() then -+ ` ld {emit_gpr 1}, 0({emit_gpr 1})\n`; -+ ` blr\n` -+ | Llabel lbl -> -+ `{emit_label lbl}:\n` -+ | Lbranch lbl -> -+ ` b {emit_label lbl}\n` -+ | Lcondbranch(tst, lbl) -> -+ begin match tst with -+ Itruetest -> -+ ` cmpdi {emit_reg i.arg.(0)}, 0\n`; -+ emit_delay dslot; -+ ` bne {emit_label lbl}\n` -+ | Ifalsetest -> -+ ` cmpdi {emit_reg i.arg.(0)}, 0\n`; -+ emit_delay dslot; -+ ` beq {emit_label lbl}\n` -+ | Iinttest cmp -> -+ let (comp, branch) = name_for_int_comparison cmp in -+ ` {emit_string comp} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; -+ emit_delay dslot; -+ ` {emit_string branch} {emit_label lbl}\n` -+ | Iinttest_imm(cmp, n) -> -+ let (comp, branch) = name_for_int_comparison cmp in -+ ` {emit_string comp}i {emit_reg i.arg.(0)}, {emit_int n}\n`; -+ 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 -+ Ceq -> (2, neg) -+ | Cne -> (2, not neg) -+ | Cle -> ` cror 3, 0, 2\n`; (* lt or eq *) -+ (3, neg) -+ | Cgt -> (1, neg) -+ | Cge -> ` cror 3, 1, 2\n`; (* gt or eq *) -+ (3, neg) -+ | Clt -> (0, neg) in -+ emit_delay dslot; -+ if negtst -+ 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 -+ | Lcondbranch3(lbl0, lbl1, lbl2) -> -+ ` cmpdi {emit_reg i.arg.(0)}, 1\n`; -+ emit_delay dslot; -+ begin match lbl0 with -+ None -> () -+ | Some lbl -> ` blt {emit_label lbl}\n` -+ end; -+ begin match lbl1 with -+ None -> () -+ | Some lbl -> ` beq {emit_label lbl}\n` -+ end; -+ begin match lbl2 with -+ None -> () -+ | Some lbl -> ` bgt {emit_label lbl}\n` -+ end -+ | Lswitch jumptbl -> -+ if !lbl_jumptbl = 0 then lbl_jumptbl := new_label(); -+ ` ld {emit_gpr 11}, {emit_tocref (TocLabel !lbl_jumptbl)}\n`; -+ ` addi {emit_gpr 0}, {emit_reg i.arg.(0)}, {emit_int !num_jumptbl_entries}\n`; -+ ` sldi {emit_gpr 0}, {emit_gpr 0}, 2\n`; -+ ` lwax {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; -+ incr num_jumptbl_entries -+ done -+ | Lsetuptrap lbl -> -+ ` bl {emit_label lbl}\n`; -+ | Lpushtrap -> -+ stack_traps_size := !stack_traps_size + 32; -+ ` addi {emit_gpr 11}, {emit_gpr 1}, {emit_label !stack_size_lbl}-{emit_int !stack_traps_size}\n`; -+ ` mflr {emit_gpr 0}\n`; -+ ` std {emit_gpr 29}, 0({emit_gpr 11})\n`; -+ ` std {emit_gpr 0}, 8({emit_gpr 11})\n`; -+ ` std {emit_gpr 1}, 16({emit_gpr 11})\n`; -+ ` std {emit_gpr 2}, 24({emit_gpr 11})\n`; -+ ` mr {emit_gpr 29}, {emit_gpr 11}\n` -+ | Lpoptrap -> -+ ` ld {emit_gpr 29}, 0({emit_gpr 29})\n` -+ | Lraise -> -+ ` ld {emit_gpr 0}, 8({emit_gpr 29})\n`; -+ ` ld {emit_gpr 1}, 16({emit_gpr 29})\n`; -+ ` ld {emit_gpr 2}, 24({emit_gpr 29})\n`; -+ ` mtlr {emit_gpr 0}\n`; -+ ` ld {emit_gpr 29}, 0({emit_gpr 29})\n`; -+ ` blr\n` -+ -+and emit_delay = function -+ None -> () -+ | Some i -> emit_instr i None -+ -+(* Checks if a pseudo-instruction expands to instructions -+ that do not branch and do not affect CR0 nor R12. *) -+ -+let is_simple_instr i = -+ match i.desc with -+ Lop op -> -+ begin match op with -+ Icall_imm _ | Icall_ind | Itailcall_imm _ | Itailcall_ind | -+ Iextcall(_, _) -> false -+ | Ialloc(_) -> false -+ | Iintop(Icomp _) -> false -+ | Iintop_imm(Iand, _) -> false -+ | Iintop_imm(Icomp _, _) -> false -+ | _ -> true -+ end -+ | Lreloadretaddr -> true -+ | _ -> false -+ -+let no_interference res arg = -+ try -+ for i = 0 to Array.length arg - 1 do -+ for j = 0 to Array.length res - 1 do -+ if arg.(i).loc = res.(j).loc then raise Exit -+ done -+ done; -+ true -+ with Exit -> -+ false -+ -+(* Emit a sequence of instructions, trying to fill delay slots for branches *) -+ -+let rec emit_all i = -+ match i with -+ {desc = Lend} -> () -+ | {next = {desc = (Lcondbranch(_, _) | Lcondbranch3(_, _, _))}} -+ when is_simple_instr i & no_interference i.res i.next.arg -> -+ emit_instr i.next (Some i); -+ emit_all i.next.next -+ | _ -> -+ emit_instr i None; -+ emit_all i.next -+ -+(* Emission of a function declaration *) -+ -+let fundecl fundecl = -+ function_name := fundecl.fun_name; -+ defined_functions := StringSet.add fundecl.fun_name !defined_functions; -+ tailrec_entry_point := new_label(); -+ if has_stack_frame() then -+ stack_size_lbl := new_label(); -+ stack_slot_lbl := new_label(); -+ stack_args_size := 0; -+ stack_traps_size := 0; -+ call_gc_label := 0; -+ ` .globl {emit_symbol fundecl.fun_name}\n`; -+ begin match Config.system with -+ | "elf" | "bsd" -> -+ ` .section \".opd\",\"aw\"\n`; -+ ` .align 3\n`; -+ ` .type {emit_symbol fundecl.fun_name}, @function\n`; -+ `{emit_symbol fundecl.fun_name}:\n`; -+ ` .quad .L.{emit_symbol fundecl.fun_name},.TOC.@tocbase\n`; -+ ` .previous\n`; -+ ` .align 2\n`; -+ emit_string code_space; -+ `.L.{emit_symbol fundecl.fun_name}:\n` -+ | _ -> -+ ` .align 2\n`; -+ emit_string code_space; -+ `{emit_symbol fundecl.fun_name}:\n` -+ end; -+ if !contains_calls then begin -+ ` mflr {emit_gpr 0}\n`; -+ ` std {emit_gpr 0}, 16({emit_gpr 1})\n` -+ end; -+ if has_stack_frame() then -+ ` stdu {emit_gpr 1}, -{emit_label !stack_size_lbl}({emit_gpr 1})\n`; -+ `{emit_label !tailrec_entry_point}:\n`; -+ branch_normalization fundecl.fun_body; -+ emit_all fundecl.fun_body; -+ ` .size .L.{emit_symbol fundecl.fun_name}, . - .L.{emit_symbol fundecl.fun_name}\n`; -+ if has_stack_frame() then begin -+ ` .set {emit_label !stack_size_lbl},{emit_int (frame_size_sans_args() + !stack_args_size + !stack_traps_size)} # stack size including traps\n`; -+ ` .set {emit_label !stack_slot_lbl},{emit_int (48 + !stack_args_size)} # stack slot offset\n` -+ end else (* leave 8 bytes for float <-> conversions *) -+ ` .set {emit_label !stack_slot_lbl},{emit_int (40-frame_size_sans_args())} # stack slot offset (negative)\n`; -+ -+ (* Emit the glue code to call the GC *) -+ if !call_gc_label > 0 then begin -+ `{emit_label !call_gc_label}:\n`; -+ ` ld {emit_gpr 12}, {emit_tocref (TocSymOfs ("caml_call_gc",0))}\n`; -+ ` ld {emit_gpr 12}, 0({emit_gpr 12})\n`; -+ ` mtctr {emit_gpr 12}\n`; -+ ` bctr\n`; -+ end -+ -+(* Emission of data *) -+ -+let declare_global_data s = -+ ` .globl {emit_symbol s}\n`; -+ if Config.system = "elf" || Config.system = "bsd" then -+ ` .type {emit_symbol s}, @object\n` -+ -+let emit_item = function -+ Cglobal_symbol s -> -+ declare_global_data s -+ | Cdefine_symbol s -> -+ `{emit_symbol s}:\n`; -+ | Cdefine_label lbl -> -+ `{emit_label (lbl + 100000)}:\n` -+ | Cint8 n -> -+ ` .byte {emit_int n}\n` -+ | Cint16 n -> -+ ` .short {emit_int n}\n` -+ | Cint32 n -> -+ ` .long {emit_nativeint n}\n` -+ | Cint n -> -+ ` .quad {emit_nativeint n}\n` -+ | Csingle f -> -+ ` .float 0d{emit_string f}\n` -+ | Cdouble f -> -+ ` .double 0d{emit_string f}\n` -+ | Csymbol_address s -> -+ ` .quad {emit_symbol s}\n` -+ | Clabel_address lbl -> -+ ` .quad {emit_label (lbl + 100000)}\n` -+ | Cstring s -> -+ emit_bytes_directive " .byte " s -+ | Cskip n -> -+ if n > 0 then ` .space {emit_int n}\n` -+ | Calign n -> -+ ` .align {emit_int (Misc.log2 n)}\n` -+ -+let data l = -+ emit_string data_space; -+ List.iter emit_item l -+ -+(* Beginning / end of an assembly file *) -+ -+let begin_assembly() = -+ defined_functions := StringSet.empty; -+ external_functions := StringSet.empty; -+ tocref_entries := []; -+ num_jumptbl_entries := 0; -+ jumptbl_entries := []; -+ lbl_jumptbl := 0; -+ (* Emit the beginning of the segments *) -+ let lbl_begin = Compilenv.make_symbol (Some "data_begin") in -+ emit_string data_space; -+ declare_global_data lbl_begin; -+ `{emit_symbol lbl_begin}:\n`; -+ let lbl_begin = Compilenv.make_symbol (Some "code_begin") in -+ emit_string code_space; -+ declare_global_data lbl_begin; -+ `{emit_symbol lbl_begin}:\n` -+ -+let end_assembly() = -+ (* Emit the jump table *) -+ if !num_jumptbl_entries > 0 then begin -+ emit_string code_space; -+ `{emit_label !lbl_jumptbl}:\n`; -+ List.iter -+ (fun lbl -> ` .long {emit_label lbl} - {emit_label !lbl_jumptbl}\n`) -+ (List.rev !jumptbl_entries); -+ jumptbl_entries := [] -+ end; -+ if !tocref_entries <> [] then begin -+ emit_string toc_space; -+ List.iter -+ (fun (lbl, entry) -> -+ `{emit_label lbl}:\n`; -+ match entry with -+ TocFloat f -> -+ ` .double {emit_tocentry entry}\n` -+ | _ -> -+ ` .tc {emit_label lbl}[TC],{emit_tocentry entry}\n` -+ ) -+ !tocref_entries; -+ tocref_entries := [] -+ 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.make_symbol (Some "code_end") in -+ declare_global_data lbl_end; -+ `{emit_symbol lbl_end}:\n`; -+ ` .long 0\n`; -+ emit_string data_space; -+ let lbl_end = Compilenv.make_symbol (Some "data_end") in -+ declare_global_data lbl_end; -+ `{emit_symbol lbl_end}:\n`; -+ ` .quad 0\n`; -+ (* Emit the frame descriptors *) -+ emit_string rodata_space; -+ let lbl = Compilenv.make_symbol (Some "frametable") in -+ declare_global_data lbl; -+ `{emit_symbol lbl}:\n`; -+ ` .quad {emit_int (List.length !frame_descriptors)}\n`; -+ List.iter emit_frame !frame_descriptors; -+ frame_descriptors := [] -diff -uNr ocaml-3.10.1/asmcomp/power64/proc.ml ocaml-3.10.1.ppc64/asmcomp/power64/proc.ml ---- ocaml-3.10.1/asmcomp/power64/proc.ml 1969-12-31 19:00:00.000000000 -0500 -+++ ocaml-3.10.1.ppc64/asmcomp/power64/proc.ml 2008-02-29 08:37:45.000000000 -0500 -@@ -0,0 +1,245 @@ -+(***********************************************************************) -+(* *) -+(* Objective Caml *) -+(* *) -+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -+(* *) -+(* Copyright 1996 Institut National de Recherche en Informatique et *) -+(* en Automatique. All rights reserved. This file is distributed *) -+(* under the terms of the Q Public License version 1.0. *) -+(* *) -+(***********************************************************************) -+ -+(* $Id: ocaml-3.11.0-ppc64.patch,v 1.1 2008/11/20 15:30:55 rjones Exp $ *) -+ -+(* Description of the Power PC *) -+ -+open Misc -+open Cmm -+open Reg -+open Arch -+open Mach -+ -+(* Instruction selection *) -+ -+let word_addressed = false -+ -+(* Registers available for register allocation *) -+ -+(* Integer register map: -+ 0 temporary, null register for some operations -+ 1 stack pointer -+ 2 pointer to table of contents -+ 3 - 10 function arguments and results -+ 11 - 12 temporaries -+ 13 pointer to small data area -+ 14 - 28 general purpose, preserved by C -+ 29 trap pointer -+ 30 allocation limit -+ 31 allocation pointer -+ Floating-point register map: -+ 0 temporary -+ 1 - 13 function arguments and results -+ 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 -+ -+let register_class r = -+ match r.typ with -+ Int -> 0 -+ | Addr -> 0 -+ | Float -> 1 -+ -+let num_available_registers = [| 23; 31 |] -+ -+let first_available_register = [| 0; 100 |] -+ -+let register_name r = -+ if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100) -+ -+let rotate_registers = true -+ -+(* Representation of hard registers by pseudo-registers *) -+ -+let hard_int_reg = -+ let v = Array.create 23 Reg.dummy in -+ for i = 0 to 22 do v.(i) <- Reg.at_location Int (Reg i) done; v -+ -+let hard_float_reg = -+ let v = Array.create 31 Reg.dummy in -+ for i = 0 to 30 do v.(i) <- Reg.at_location Float (Reg(100 + i)) done; v -+ -+let all_phys_regs = -+ Array.append hard_int_reg hard_float_reg -+ -+let phys_reg n = -+ if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100) -+ -+let stack_slot slot ty = -+ Reg.at_location ty (Stack slot) -+ -+(* Calling conventions *) -+ -+let calling_conventions -+ first_int last_int first_float last_float make_stack stack_ofs arg = -+ let loc = Array.create (Array.length arg) Reg.dummy in -+ let int = ref first_int in -+ let float = ref first_float in -+ let ofs = ref stack_ofs 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; -+ end; -+ ofs := !ofs + 8 -+ | Float -> -+ if !float <= last_float then begin -+ loc.(i) <- phys_reg !float; -+ incr float -+ end else begin -+ loc.(i) <- stack_slot (make_stack !ofs) Float; -+ end; -+ ofs := !ofs + 8 -+ done; -+ (loc, Misc.align !ofs 16) -+ (* Keep stack 16-aligned. *) -+ -+let incoming ofs = Incoming ofs -+let outgoing ofs = Outgoing ofs -+let not_supported ofs = fatal_error "Proc.loc_results: cannot call" -+ -+let loc_arguments arg = -+ calling_conventions 0 7 100 112 outgoing 48 arg -+let loc_parameters arg = -+ let (loc, ofs) = calling_conventions 0 7 100 112 incoming 0 arg in loc -+let loc_results res = -+ let (loc, ofs) = calling_conventions 0 7 100 112 not_supported 0 res in loc -+ -+(* C calling conventions under PowerOpen: -+ use GPR 3-10 and FPR 1-13 just like ML calling -+ conventions, but always reserve stack space for all arguments. -+ Also, using a float register automatically reserves two int registers -+ (in 32-bit mode) or one int register (in 64-bit mode). -+ (If we were to call a non-prototyped C function, each float argument -+ would have to go both in a float reg and in the matching pair -+ of integer regs.) -+ -+ C calling conventions under SVR4: -+ use GPR 3-10 and FPR 1-8 just like ML calling conventions. -+ Using a float register does not affect the int registers. -+ Always reserve 8 bytes at bottom of stack, plus whatever is needed -+ to hold the overflow arguments. *) -+ -+let poweropen_external_conventions first_int last_int -+ first_float last_float arg = -+ let loc = Array.create (Array.length arg) Reg.dummy in -+ let int = ref first_int in -+ let float = ref first_float in -+ let ofs = ref 112 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 (Outgoing !ofs) ty; -+ ofs := !ofs + size_int -+ end -+ | Float -> -+ if !float <= last_float then begin -+ loc.(i) <- phys_reg !float; -+ incr float -+ end else begin -+ loc.(i) <- stack_slot (Outgoing !ofs) Float; -+ ofs := !ofs + size_float -+ end; -+ int := !int + 1 -+ done; -+ (loc, Misc.align !ofs 16) (* Keep stack 16-aligned *) -+ -+let loc_external_arguments = -+ match Config.system with -+ | "rhapsody" -> poweropen_external_conventions 0 7 100 112 -+ | "elf" | "bsd" -> calling_conventions 0 7 100 107 outgoing 8 -+ | _ -> assert false -+ -+let extcall_use_push = false -+ -+(* Results are in GPR 3 and FPR 1 *) -+ -+let loc_external_results res = -+ let (loc, ofs) = calling_conventions 0 0 100 100 not_supported 0 res in loc -+ -+(* Exceptions are in GPR 3 *) -+ -+let loc_exn_bucket = phys_reg 0 -+ -+(* Registers destroyed by operations *) -+ -+let destroyed_at_c_call = -+ Array.of_list(List.map phys_reg -+ [0; 1; 2; 3; 4; 5; 6; 7; -+ 100; 101; 102; 103; 104; 105; 106; 107; 108; 109; 110; 111; 112]) -+ -+let destroyed_at_oper = function -+ Iop(Icall_ind | Icall_imm _ | Iextcall(_, true)) -> all_phys_regs -+ | Iop(Iextcall(_, false)) -> destroyed_at_c_call -+ | _ -> [||] -+ -+let destroyed_at_raise = all_phys_regs -+ -+(* Maximal register pressure *) -+ -+let safe_register_pressure = function -+ Iextcall(_, _) -> 15 -+ | _ -> 23 -+ -+let max_register_pressure = function -+ Iextcall(_, _) -> [| 15; 18 |] -+ | _ -> [| 23; 30 |] -+ -+(* Layout of the stack *) -+ -+let num_stack_slots = [| 0; 0 |] -+let contains_calls = ref false -+ -+(* Calling the assembler *) -+ -+let assemble_file infile outfile = -+ let infile = Filename.quote infile -+ and outfile = Filename.quote outfile in -+ match Config.system with -+ | "elf" -> -+ Ccomp.command ("as -u -m ppc64 -o " ^ outfile ^ " " ^ infile) -+ | _ -> assert false -+ -+open Clflags;; -+open Config;; -diff -uNr ocaml-3.10.1/asmcomp/power64/reload.ml ocaml-3.10.1.ppc64/asmcomp/power64/reload.ml ---- ocaml-3.10.1/asmcomp/power64/reload.ml 1969-12-31 19:00:00.000000000 -0500 -+++ ocaml-3.10.1.ppc64/asmcomp/power64/reload.ml 2008-02-29 08:37:45.000000000 -0500 -@@ -0,0 +1,18 @@ -+(***********************************************************************) -+(* *) -+(* Objective Caml *) -+(* *) -+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -+(* *) -+(* Copyright 1996 Institut National de Recherche en Informatique et *) -+(* en Automatique. All rights reserved. This file is distributed *) -+(* under the terms of the Q Public License version 1.0. *) -+(* *) -+(***********************************************************************) -+ -+(* $Id: ocaml-3.11.0-ppc64.patch,v 1.1 2008/11/20 15:30:55 rjones Exp $ *) -+ -+(* Reloading for the PowerPC *) -+ -+let fundecl f = -+ (new Reloadgen.reload_generic)#fundecl f -diff -uNr ocaml-3.10.1/asmcomp/power64/scheduling.ml ocaml-3.10.1.ppc64/asmcomp/power64/scheduling.ml ---- ocaml-3.10.1/asmcomp/power64/scheduling.ml 1969-12-31 19:00:00.000000000 -0500 -+++ ocaml-3.10.1.ppc64/asmcomp/power64/scheduling.ml 2008-02-29 08:37:45.000000000 -0500 -@@ -0,0 +1,66 @@ -+(***********************************************************************) -+(* *) -+(* Objective Caml *) -+(* *) -+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -+(* *) -+(* Copyright 1996 Institut National de Recherche en Informatique et *) -+(* en Automatique. All rights reserved. This file is distributed *) -+(* under the terms of the Q Public License version 1.0. *) -+(* *) -+(***********************************************************************) -+ -+(* $Id: ocaml-3.11.0-ppc64.patch,v 1.1 2008/11/20 15:30:55 rjones Exp $ *) -+ -+(* Instruction scheduling for the Power PC *) -+ -+open Arch -+open Mach -+ -+class scheduler = object -+ -+inherit Schedgen.scheduler_generic -+ -+(* Latencies (in cycles). Based roughly on the "common model". *) -+ -+method oper_latency = function -+ Ireload -> 2 -+ | Iload(_, _) -> 2 -+ | Iconst_float _ -> 2 (* turned into a load *) -+ | Iconst_symbol _ -> 1 -+ | Iintop Imul -> 9 -+ | Iintop_imm(Imul, _) -> 5 -+ | Iintop(Idiv | Imod) -> 36 -+ | Iaddf | Isubf -> 4 -+ | Imulf -> 5 -+ | Idivf -> 33 -+ | Ispecific(Imultaddf | Imultsubf) -> 5 -+ | _ -> 1 -+ -+method reload_retaddr_latency = 12 -+ (* If we can have that many cycles between the reloadretaddr and the -+ return, we can expect that the blr branch will be completely folded. *) -+ -+(* Issue cycles. Rough approximations. *) -+ -+method oper_issue_cycles = function -+ Iconst_float _ | Iconst_symbol _ -> 2 -+ | Iload(_, Ibased(_, _)) -> 2 -+ | Istore(_, Ibased(_, _)) -> 2 -+ | Ialloc _ -> 4 -+ | Iintop(Imod) -> 40 (* assuming full stall *) -+ | Iintop(Icomp _) -> 4 -+ | Iintop_imm(Idiv, _) -> 2 -+ | Iintop_imm(Imod, _) -> 4 -+ | Iintop_imm(Icomp _, _) -> 4 -+ | Ifloatofint -> 9 -+ | Iintoffloat -> 4 -+ | _ -> 1 -+ -+method reload_retaddr_issue_cycles = 3 -+ (* load then stalling mtlr *) -+ -+end -+ -+let fundecl f = (new scheduler)#schedule_fundecl f -+ -diff -uNr ocaml-3.10.1/asmcomp/power64/selection.ml ocaml-3.10.1.ppc64/asmcomp/power64/selection.ml ---- ocaml-3.10.1/asmcomp/power64/selection.ml 1969-12-31 19:00:00.000000000 -0500 -+++ ocaml-3.10.1.ppc64/asmcomp/power64/selection.ml 2008-02-29 08:37:45.000000000 -0500 -@@ -0,0 +1,103 @@ -+(***********************************************************************) -+(* *) -+(* Objective Caml *) -+(* *) -+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -+(* *) -+(* Copyright 1997 Institut National de Recherche en Informatique et *) -+(* en Automatique. All rights reserved. This file is distributed *) -+(* under the terms of the Q Public License version 1.0. *) -+(* *) -+(***********************************************************************) -+ -+(* $Id: ocaml-3.11.0-ppc64.patch,v 1.1 2008/11/20 15:30:55 rjones Exp $ *) -+ -+(* Instruction selection for the Power PC processor *) -+ -+open Misc -+open Cmm -+open Reg -+open Arch -+open Mach -+ -+(* Recognition of addressing modes *) -+ -+type addressing_expr = -+ Asymbol of string -+ | Alinear of expression -+ | Aadd of expression * expression -+ -+let rec select_addr = function -+ Cconst_symbol s -> -+ (Asymbol s, 0) -+ | Cop((Caddi | Cadda), [arg; Cconst_int m]) -> -+ let (a, n) = select_addr arg in (a, n + m) -+ | Cop((Caddi | Cadda), [Cconst_int m; arg]) -> -+ let (a, n) = select_addr arg in (a, n + m) -+ | Cop((Caddi | Cadda), [arg1; arg2]) -> -+ begin match (select_addr arg1, select_addr arg2) with -+ ((Alinear e1, n1), (Alinear e2, n2)) -> -+ (Aadd(e1, e2), n1 + n2) -+ | _ -> -+ (Aadd(arg1, arg2), 0) -+ end -+ | exp -> -+ (Alinear exp, 0) -+ -+(* Instruction selection *) -+ -+class selector = object (self) -+ -+inherit Selectgen.selector_generic as super -+ -+method is_immediate n = (n <= 32767) && (n >= -32768) -+ -+method select_addressing exp = -+ match select_addr exp with -+ (Asymbol s, d) -> -+ (Ibased(s, d), Ctuple []) -+ | (Alinear e, d) -> -+ (Iindexed d, e) -+ | (Aadd(e1, e2), d) -> -+ if d = 0 -+ then (Iindexed2, Ctuple[e1; e2]) -+ else (Iindexed d, Cop(Cadda, [e1; e2])) -+ -+method select_operation op args = -+ match (op, args) with -+ (* Prevent the recognition of (x / cst) and (x % cst) when cst is not -+ a power of 2, which do not correspond to an instruction. *) -+ (Cdivi, [arg; Cconst_int n]) when n = 1 lsl (Misc.log2 n) -> -+ (Iintop_imm(Idiv, n), [arg]) -+ | (Cdivi, _) -> -+ (Iintop Idiv, args) -+ | (Cmodi, [arg; Cconst_int n]) when n = 1 lsl (Misc.log2 n) -> -+ (Iintop_imm(Imod, n), [arg]) -+ | (Cmodi, _) -> -+ (Iintop Imod, args) -+ (* The and, or and xor instructions have a different range of immediate -+ operands than the other instructions *) -+ | (Cand, _) -> self#select_logical Iand args -+ | (Cor, _) -> self#select_logical Ior args -+ | (Cxor, _) -> self#select_logical Ixor args -+ (* Recognize mult-add and mult-sub instructions *) -+ | (Caddf, [Cop(Cmulf, [arg1; arg2]); arg3]) -> -+ (Ispecific Imultaddf, [arg1; arg2; arg3]) -+ | (Caddf, [arg3; Cop(Cmulf, [arg1; arg2])]) -> -+ (Ispecific Imultaddf, [arg1; arg2; arg3]) -+ | (Csubf, [Cop(Cmulf, [arg1; arg2]); arg3]) -> -+ (Ispecific Imultsubf, [arg1; arg2; arg3]) -+ | _ -> -+ super#select_operation op args -+ -+method select_logical op = function -+ [arg; Cconst_int n] when n >= 0 && n <= 0xFFFF -> -+ (Iintop_imm(op, n), [arg]) -+ | [Cconst_int n; arg] when n >= 0 && n <= 0xFFFF -> -+ (Iintop_imm(op, n), [arg]) -+ | args -> -+ (Iintop op, args) -+ -+end -+ -+let fundecl f = (new selector)#emit_fundecl f -diff -uNr ocaml-3.10.1/asmrun/Makefile ocaml-3.10.1.ppc64/asmrun/Makefile ---- ocaml-3.10.1/asmrun/Makefile 2007-02-23 04:29:45.000000000 -0500 -+++ ocaml-3.10.1.ppc64/asmrun/Makefile 2008-02-29 08:37:45.000000000 -0500 -@@ -74,6 +74,12 @@ - power.p.o: power-$(SYSTEM).o - cp power-$(SYSTEM).o power.p.o - -+power64.o: power64-$(SYSTEM).o -+ cp power64-$(SYSTEM).o power64.o -+ -+power64.p.o: power64-$(SYSTEM).o -+ cp power64-$(SYSTEM).o power64.p.o -+ - main.c: ../byterun/main.c - ln -s ../byterun/main.c main.c - misc.c: ../byterun/misc.c -diff -uNr ocaml-3.10.1/asmrun/power64-elf.S ocaml-3.10.1.ppc64/asmrun/power64-elf.S ---- ocaml-3.10.1/asmrun/power64-elf.S 1969-12-31 19:00:00.000000000 -0500 -+++ ocaml-3.10.1.ppc64/asmrun/power64-elf.S 2008-02-29 08:37:45.000000000 -0500 -@@ -0,0 +1,486 @@ -+/*********************************************************************/ -+/* */ -+/* Objective Caml */ -+/* */ -+/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -+/* */ -+/* Copyright 1996 Institut National de Recherche en Informatique et */ -+/* en Automatique. All rights reserved. This file is distributed */ -+/* under the terms of the GNU Library General Public License, with */ -+/* the special exception on linking described in file ../LICENSE. */ -+/* */ -+/*********************************************************************/ -+ -+/* $Id: ocaml-3.11.0-ppc64.patch,v 1.1 2008/11/20 15:30:55 rjones Exp $ */ -+ -+#define Addrglobal(reg,glob) \ -+ addis reg, 0, glob@ha; \ -+ addi reg, reg, glob@l -+#define Loadglobal(reg,glob,tmp) \ -+ addis tmp, 0, glob@ha; \ -+ ld reg, glob@l(tmp) -+#define Storeglobal(reg,glob,tmp) \ -+ addis tmp, 0, glob@ha; \ -+ std reg, glob@l(tmp) -+ -+ .section ".text" -+ -+/* Invoke the garbage collector. */ -+ -+ .globl caml_call_gc -+ .type caml_call_gc, @function -+ .section ".opd","aw" -+ .align 3 -+caml_call_gc: -+ .quad .L.caml_call_gc,.TOC.@tocbase -+ .previous -+ .align 2 -+.L.caml_call_gc: -+ /* Set up stack frame */ -+ mflr 0 -+ std 0, 16(1) -+ /* Record return address into Caml code */ -+ Storeglobal(0, caml_last_return_address, 11) -+ /* Record lowest stack address */ -+ Storeglobal(1, caml_bottom_of_stack, 11) -+ /* 0x220 = 8*32 (int regs) + 8*32 (float regs) + 48 (stack frame) */ -+ stdu 1, -0x230(1) -+ /* Record pointer to register array */ -+ addi 0, 1, 8*32 + 48 -+ Storeglobal(0, caml_gc_regs, 11) -+ /* Save current allocation pointer for debugging purposes */ -+ Storeglobal(31, caml_young_ptr, 11) -+ /* Save exception pointer (if e.g. a sighandler raises) */ -+ Storeglobal(29, caml_exception_pointer, 11) -+ /* Save all registers used by the code generator */ -+ addi 11, 1, 8*32 + 48 - 8 -+ stdu 3, 8(11) -+ stdu 4, 8(11) -+ stdu 5, 8(11) -+ stdu 6, 8(11) -+ stdu 7, 8(11) -+ stdu 8, 8(11) -+ stdu 9, 8(11) -+ stdu 10, 8(11) -+ stdu 14, 8(11) -+ stdu 15, 8(11) -+ stdu 16, 8(11) -+ stdu 17, 8(11) -+ stdu 18, 8(11) -+ stdu 19, 8(11) -+ stdu 20, 8(11) -+ stdu 21, 8(11) -+ stdu 22, 8(11) -+ stdu 23, 8(11) -+ stdu 24, 8(11) -+ stdu 25, 8(11) -+ stdu 26, 8(11) -+ stdu 27, 8(11) -+ stdu 28, 8(11) -+ addi 11, 1, 48 - 8 -+ stfdu 1, 8(11) -+ stfdu 2, 8(11) -+ stfdu 3, 8(11) -+ stfdu 4, 8(11) -+ stfdu 5, 8(11) -+ stfdu 6, 8(11) -+ stfdu 7, 8(11) -+ stfdu 8, 8(11) -+ stfdu 9, 8(11) -+ stfdu 10, 8(11) -+ stfdu 11, 8(11) -+ stfdu 12, 8(11) -+ stfdu 13, 8(11) -+ stfdu 14, 8(11) -+ stfdu 15, 8(11) -+ stfdu 16, 8(11) -+ stfdu 17, 8(11) -+ stfdu 18, 8(11) -+ stfdu 19, 8(11) -+ stfdu 20, 8(11) -+ stfdu 21, 8(11) -+ stfdu 22, 8(11) -+ stfdu 23, 8(11) -+ stfdu 24, 8(11) -+ stfdu 25, 8(11) -+ stfdu 26, 8(11) -+ stfdu 27, 8(11) -+ stfdu 28, 8(11) -+ stfdu 29, 8(11) -+ stfdu 30, 8(11) -+ stfdu 31, 8(11) -+ /* Call the GC */ -+ std 2,40(1) -+ Addrglobal(11, caml_garbage_collection) -+ ld 2,8(11) -+ ld 11,0(11) -+ mtlr 11 -+ blrl -+ ld 2,40(1) -+ /* Reload new allocation pointer and allocation limit */ -+ Loadglobal(31, caml_young_ptr, 11) -+ Loadglobal(30, caml_young_limit, 11) -+ /* Restore all regs used by the code generator */ -+ addi 11, 1, 8*32 + 48 - 8 -+ ldu 3, 8(11) -+ ldu 4, 8(11) -+ ldu 5, 8(11) -+ ldu 6, 8(11) -+ ldu 7, 8(11) -+ ldu 8, 8(11) -+ ldu 9, 8(11) -+ ldu 10, 8(11) -+ ldu 14, 8(11) -+ ldu 15, 8(11) -+ ldu 16, 8(11) -+ ldu 17, 8(11) -+ ldu 18, 8(11) -+ ldu 19, 8(11) -+ ldu 20, 8(11) -+ ldu 21, 8(11) -+ ldu 22, 8(11) -+ ldu 23, 8(11) -+ ldu 24, 8(11) -+ ldu 25, 8(11) -+ ldu 26, 8(11) -+ ldu 27, 8(11) -+ ldu 28, 8(11) -+ addi 11, 1, 48 - 8 -+ lfdu 1, 8(11) -+ lfdu 2, 8(11) -+ lfdu 3, 8(11) -+ lfdu 4, 8(11) -+ lfdu 5, 8(11) -+ lfdu 6, 8(11) -+ lfdu 7, 8(11) -+ lfdu 8, 8(11) -+ lfdu 9, 8(11) -+ lfdu 10, 8(11) -+ lfdu 11, 8(11) -+ lfdu 12, 8(11) -+ lfdu 13, 8(11) -+ lfdu 14, 8(11) -+ lfdu 15, 8(11) -+ lfdu 16, 8(11) -+ lfdu 17, 8(11) -+ lfdu 18, 8(11) -+ lfdu 19, 8(11) -+ lfdu 20, 8(11) -+ lfdu 21, 8(11) -+ lfdu 22, 8(11) -+ lfdu 23, 8(11) -+ lfdu 24, 8(11) -+ lfdu 25, 8(11) -+ lfdu 26, 8(11) -+ lfdu 27, 8(11) -+ lfdu 28, 8(11) -+ lfdu 29, 8(11) -+ lfdu 30, 8(11) -+ lfdu 31, 8(11) -+ /* Return to caller, restarting the allocation */ -+ Loadglobal(0, caml_last_return_address, 11) -+ addic 0, 0, -16 /* Restart the allocation (4 instructions) */ -+ mtlr 0 -+ /* Say we are back into Caml code */ -+ li 12, 0 -+ Storeglobal(12, caml_last_return_address, 11) -+ /* Deallocate stack frame */ -+ ld 1, 0(1) -+ /* Return */ -+ blr -+ .size .L.caml_call_gc,.-.L.caml_call_gc -+ -+/* Call a C function from Caml */ -+ -+ .globl caml_c_call -+ .type caml_c_call, @function -+ .section ".opd","aw" -+ .align 3 -+caml_c_call: -+ .quad .L.caml_c_call,.TOC.@tocbase -+ .previous -+ .align 2 -+.L.caml_c_call: -+ .cfi_startproc -+ /* Save return address */ -+ mflr 25 -+ .cfi_register lr,25 -+ /* Get ready to call C function (address in 11) */ -+ ld 2, 8(11) -+ ld 11,0(11) -+ mtlr 11 -+ /* Record lowest stack address and return address */ -+ Storeglobal(1, caml_bottom_of_stack, 12) -+ Storeglobal(25, caml_last_return_address, 12) -+ /* Make the exception handler and alloc ptr available to the C code */ -+ Storeglobal(31, caml_young_ptr, 11) -+ Storeglobal(29, caml_exception_pointer, 11) -+ /* Call the function (address in link register) */ -+ blrl -+ /* Restore return address (in 25, preserved by the C function) */ -+ mtlr 25 -+ /* Reload allocation pointer and allocation limit*/ -+ Loadglobal(31, caml_young_ptr, 11) -+ Loadglobal(30, caml_young_limit, 11) -+ /* Say we are back into Caml code */ -+ li 12, 0 -+ Storeglobal(12, caml_last_return_address, 11) -+ /* Return to caller */ -+ blr -+ .cfi_endproc -+ .size .L.caml_c_call,.-.L.caml_c_call -+ -+/* Raise an exception from C */ -+ -+ .globl caml_raise_exception -+ .type caml_raise_exception, @function -+ .section ".opd","aw" -+ .align 3 -+caml_raise_exception: -+ .quad .L.caml_raise_exception,.TOC.@tocbase -+ .previous -+ .align 2 -+.L.caml_raise_exception: -+ /* Reload Caml global registers */ -+ Loadglobal(29, caml_exception_pointer, 11) -+ Loadglobal(31, caml_young_ptr, 11) -+ Loadglobal(30, caml_young_limit, 11) -+ /* Say we are back into Caml code */ -+ li 0, 0 -+ Storeglobal(0, caml_last_return_address, 11) -+ /* Pop trap frame */ -+ ld 0, 8(29) -+ ld 1, 16(29) -+ mtlr 0 -+ ld 2, 24(29) -+ ld 29, 0(29) -+ /* Branch to handler */ -+ blr -+ .size .L.caml_raise_exception,.-.L.caml_raise_exception -+ -+/* Start the Caml program */ -+ -+ .globl caml_start_program -+ .type caml_start_program, @function -+ .section ".opd","aw" -+ .align 3 -+caml_start_program: -+ .quad .L.caml_start_program,.TOC.@tocbase -+ .previous -+ .align 2 -+.L.caml_start_program: -+ Addrglobal(12, caml_program) -+ -+/* Code shared between caml_start_program and caml_callback */ -+.L102: -+ /* Allocate and link stack frame */ -+ mflr 0 -+ std 0, 16(1) -+ stdu 1, -0x190(1) /* 48 + 8*36(regs) + 32(callback) + 32(exc) */ -+ /* Save return address */ -+ /* Save all callee-save registers */ -+ /* GPR 14 ... GPR 31 then FPR 14 ... FPR 31 starting at sp+16 */ -+ addi 11, 1, 48-8 -+ stdu 14, 8(11) -+ stdu 15, 8(11) -+ stdu 16, 8(11) -+ stdu 17, 8(11) -+ stdu 18, 8(11) -+ stdu 19, 8(11) -+ stdu 20, 8(11) -+ stdu 21, 8(11) -+ stdu 22, 8(11) -+ stdu 23, 8(11) -+ stdu 24, 8(11) -+ stdu 25, 8(11) -+ stdu 26, 8(11) -+ stdu 27, 8(11) -+ stdu 28, 8(11) -+ stdu 29, 8(11) -+ stdu 30, 8(11) -+ stdu 31, 8(11) -+ stfdu 14, 8(11) -+ stfdu 15, 8(11) -+ stfdu 16, 8(11) -+ stfdu 17, 8(11) -+ stfdu 18, 8(11) -+ stfdu 19, 8(11) -+ stfdu 20, 8(11) -+ stfdu 21, 8(11) -+ stfdu 22, 8(11) -+ stfdu 23, 8(11) -+ stfdu 24, 8(11) -+ stfdu 25, 8(11) -+ stfdu 26, 8(11) -+ stfdu 27, 8(11) -+ stfdu 28, 8(11) -+ stfdu 29, 8(11) -+ stfdu 30, 8(11) -+ stfdu 31, 8(11) -+ /* Set up a callback link */ -+ Loadglobal(9, caml_bottom_of_stack, 11) -+ Loadglobal(10, caml_last_return_address, 11) -+ Loadglobal(11, caml_gc_regs, 11) -+ std 9, 0x150(1) -+ std 10, 0x158(1) -+ std 11, 0x160(1) -+ /* Build an exception handler to catch exceptions escaping out of Caml */ -+ bl .L103 -+ b .L104 -+.L103: -+ mflr 0 -+ addi 29, 1, 0x170 /* Alignment */ -+ std 0, 8(29) -+ std 1, 16(29) -+ std 2, 24(29) -+ Loadglobal(11, caml_exception_pointer, 11) -+ std 11, 0(29) -+ /* Reload allocation pointers */ -+ Loadglobal(31, caml_young_ptr, 11) -+ Loadglobal(30, caml_young_limit, 11) -+ /* Say we are back into Caml code */ -+ li 0, 0 -+ Storeglobal(0, caml_last_return_address, 11) -+ /* Call the Caml code */ -+ std 2,40(1) -+ ld 2,8(12) -+ ld 12,0(12) -+ mtlr 12 -+.L105: -+ blrl -+ ld 2,40(1) -+ /* Pop the trap frame, restoring caml_exception_pointer */ -+ ld 9, 0x170(1) -+ Storeglobal(9, caml_exception_pointer, 11) -+ /* Pop the callback link, restoring the global variables */ -+.L106: -+ ld 9, 0x150(1) -+ ld 10, 0x158(1) -+ ld 11, 0x160(1) -+ Storeglobal(9, caml_bottom_of_stack, 12) -+ Storeglobal(10, caml_last_return_address, 12) -+ Storeglobal(11, caml_gc_regs, 12) -+ /* Update allocation pointer */ -+ Storeglobal(31, caml_young_ptr, 11) -+ /* Restore callee-save registers */ -+ addi 11, 1, 48-8 -+ ldu 14, 8(11) -+ ldu 15, 8(11) -+ ldu 16, 8(11) -+ ldu 17, 8(11) -+ ldu 18, 8(11) -+ ldu 19, 8(11) -+ ldu 20, 8(11) -+ ldu 21, 8(11) -+ ldu 22, 8(11) -+ ldu 23, 8(11) -+ ldu 24, 8(11) -+ ldu 25, 8(11) -+ ldu 26, 8(11) -+ ldu 27, 8(11) -+ ldu 28, 8(11) -+ ldu 29, 8(11) -+ ldu 30, 8(11) -+ ldu 31, 8(11) -+ lfdu 14, 8(11) -+ lfdu 15, 8(11) -+ lfdu 16, 8(11) -+ lfdu 17, 8(11) -+ lfdu 18, 8(11) -+ lfdu 19, 8(11) -+ lfdu 20, 8(11) -+ lfdu 21, 8(11) -+ lfdu 22, 8(11) -+ lfdu 23, 8(11) -+ lfdu 24, 8(11) -+ lfdu 25, 8(11) -+ lfdu 26, 8(11) -+ lfdu 27, 8(11) -+ lfdu 28, 8(11) -+ lfdu 29, 8(11) -+ lfdu 30, 8(11) -+ lfdu 31, 8(11) -+ /* Return */ -+ ld 1,0(1) -+ /* Reload return address */ -+ ld 0, 16(1) -+ mtlr 0 -+ blr -+ -+ /* The trap handler: */ -+.L104: -+ /* Update caml_exception_pointer */ -+ Storeglobal(29, caml_exception_pointer, 11) -+ /* Encode exception bucket as an exception result and return it */ -+ ori 3, 3, 2 -+ b .L106 -+ .size .L.caml_start_program,.-.L.caml_start_program -+ -+/* Callback from C to Caml */ -+ -+ .globl caml_callback_exn -+ .type caml_callback_exn, @function -+ .section ".opd","aw" -+ .align 3 -+caml_callback_exn: -+ .quad .L.caml_callback_exn,.TOC.@tocbase -+ .previous -+ .align 2 -+.L.caml_callback_exn: -+ /* Initial shuffling of arguments */ -+ mr 0, 3 /* Closure */ -+ mr 3, 4 /* Argument */ -+ mr 4, 0 -+ ld 12, 0(4) /* Code pointer */ -+ b .L102 -+ .size .L.caml_callback_exn,.-.L.caml_callback_exn -+ -+ -+ .globl caml_callback2_exn -+ .type caml_callback2_exn, @function -+ .section ".opd","aw" -+ .align 3 -+caml_callback2_exn: -+ .quad .L.caml_callback2_exn,.TOC.@tocbase -+ .previous -+ .align 2 -+.L.caml_callback2_exn: -+ mr 0, 3 /* Closure */ -+ mr 3, 4 /* First argument */ -+ mr 4, 5 /* Second argument */ -+ mr 5, 0 -+ Addrglobal(12, caml_apply2) -+ b .L102 -+ .size .L.caml_callback2_exn,.-.L.caml_callback2_exn -+ -+ -+ .globl caml_callback3_exn -+ .type caml_callback3_exn, @function -+ .section ".opd","aw" -+ .align 3 -+caml_callback3_exn: -+ .quad .L.caml_callback3_exn,.TOC.@tocbase -+ .previous -+ .align 2 -+.L.caml_callback3_exn: -+ mr 0, 3 /* Closure */ -+ mr 3, 4 /* First argument */ -+ mr 4, 5 /* Second argument */ -+ mr 5, 6 /* Third argument */ -+ mr 6, 0 -+ Addrglobal(12, caml_apply3) -+ b .L102 -+ .size .L.caml_callback3_exn,.-.L.caml_callback3_exn -+ -+/* Frame table */ -+ -+ .section ".data" -+ .globl caml_system__frametable -+ .type caml_system__frametable, @object -+caml_system__frametable: -+ .quad 1 /* one descriptor */ -+ .quad .L105 + 4 /* return address into callback */ -+ .short -1 /* negative size count => use callback link */ -+ .short 0 /* no roots here */ -+ .align 3 -+ -diff -uNr ocaml-3.10.1/asmrun/stack.h ocaml-3.10.1.ppc64/asmrun/stack.h ---- ocaml-3.10.1/asmrun/stack.h 2007-02-15 13:35:20.000000000 -0500 -+++ ocaml-3.10.1.ppc64/asmrun/stack.h 2008-02-29 08:37:45.000000000 -0500 -@@ -65,6 +65,15 @@ - #define Callback_link(sp) ((struct caml_context *)((sp) + Trap_frame_size)) - #endif - -+#ifdef TARGET_power64 -+#define Saved_return_address(sp) *((intnat *)((sp) +16)) -+#define Already_scanned(sp, retaddr) ((retaddr) & 1) -+#define Mark_scanned(sp, retaddr) (Saved_return_address(sp) = (retaddr) | 1) -+#define Mask_already_scanned(retaddr) ((retaddr) & ~1) -+#define Trap_frame_size 0x150 -+#define Callback_link(sp) ((struct caml_context *)((sp) + Trap_frame_size)) -+#endif -+ - #ifdef TARGET_m68k - #define Saved_return_address(sp) *((intnat *)((sp) - 4)) - #define Callback_link(sp) ((struct caml_context *)((sp) + 8)) -diff -uNr ocaml-3.11.0+beta1/configure ocaml-3.11.0+beta1.ppc64/configure ---- ocaml-3.11.0+beta1/configure.ppc64 2008-11-18 15:46:57.000000000 +0000 -+++ ocaml-3.11.0+beta1/configure 2008-11-18 15:49:19.000000000 +0000 -@@ -632,6 +632,7 @@ - hppa2.0*-*-hpux*) arch=hppa; system=hpux;; - hppa*-*-linux*) arch=hppa; system=linux;; - hppa*-*-gnu*) arch=hppa; system=gnu;; -+ powerpc64-*-linux*) arch=power64; model=ppc64; system=elf;; - powerpc*-*-linux*) arch=power; model=ppc; system=elf;; - powerpc-*-netbsd*) arch=power; model=ppc; system=elf;; - powerpc-*-rhapsody*) arch=power; model=ppc; system=rhapsody;; -@@ -655,7 +656,7 @@ - - if $arch64; then - case "$arch,$model" in -- sparc,default|mips,default|hppa,default|power,ppc) -+ sparc,default|mips,default|hppa,default) - arch=none; model=default; system=unknown;; - esac - fi -@@ -712,6 +713,8 @@ - aspp='as -n32 -O2';; - power,*,elf) as='as -u -m ppc' - aspp='gcc -c';; -+ power64,*,elf) as='as -u -m ppc64' -+ aspp='gcc -c';; - power,*,bsd) as='as' - aspp='gcc -c';; - power,*,rhapsody) as="as -arch $model" diff --git a/ocaml-rpath.patch b/ocaml-rpath.patch deleted file mode 100644 index 6bcb887..0000000 --- a/ocaml-rpath.patch +++ /dev/null @@ -1,12 +0,0 @@ ---- ocaml-3.10.0/tools/Makefile.rpath 2007-06-02 16:53:10.000000000 +0200 -+++ ocaml-3.10.0/tools/Makefile 2007-06-02 16:53:28.000000000 +0200 -@@ -107,9 +107,6 @@ - sed -e "s|%%BINDIR%%|$(BINDIR)|" \ - -e "s|%%SUPPORTS_SHARED_LIBRARIES%%|$(SUPPORTS_SHARED_LIBRARIES)|" \ - -e "s|%%MKSHAREDLIB%%|$(MKSHAREDLIB)|" \ -- -e "s|%%BYTECCRPATH%%|$(BYTECCRPATH)|" \ -- -e "s|%%NATIVECCRPATH%%|$(NATIVECCRPATH)|" \ -- -e "s|%%MKSHAREDLIBRPATH%%|$(MKSHAREDLIBRPATH)|" \ - -e "s|%%RANLIB%%|$(RANLIB)|" \ - ocamlmklib.mlp >> ocamlmklib.ml - diff --git a/ocaml-user-cflags.patch b/ocaml-user-cflags.patch deleted file mode 100644 index 8fd87c6..0000000 --- a/ocaml-user-cflags.patch +++ /dev/null @@ -1,13 +0,0 @@ ---- ocaml-3.10.0/configure.opt 2007-06-02 16:50:12.000000000 +0200 -+++ ocaml-3.10.0/configure 2007-06-02 16:50:34.000000000 +0200 -@@ -1425,6 +1425,10 @@ - nativecccompopts="$nativecccompopts -fomit-frame-pointer";; - esac - -+# Allow user defined C Compiler flags -+bytecccompopts="$bytecccompopts $CFLAGS" -+nativecccompopts="$nativecccompopts $CFLAGS" -+ - # Finish generated files - - cclibs="$cclibs $mathlib" diff --git a/ocaml.spec b/ocaml.spec index 2f89c21..ff53063 100644 --- a/ocaml.spec +++ b/ocaml.spec @@ -2,7 +2,7 @@ Name: ocaml Version: 3.12.1 -Release: 4%{?dist} +Release: 5%{?dist} Summary: Objective Caml compiler and programming environment @@ -16,32 +16,26 @@ Source1: http://caml.inria.fr/distrib/ocaml-3.12/ocaml-3.12-refman.html.t Source2: http://caml.inria.fr/distrib/ocaml-3.12/ocaml-3.12-refman.pdf Source3: http://caml.inria.fr/distrib/ocaml-3.12/ocaml-3.12-refman.info.tar.gz -# Useful utilities from Debian, and sent upstream. -# http://git.debian.org/?p=pkg-ocaml-maint/packages/ocaml.git;a=tree;f=debian/ocamlbyteinfo;hb=HEAD -Source6: ocamlbyteinfo.ml -#Source7: ocamlplugininfo.ml - -# GNU config.guess and config.sub supplied with OCaml are 8 years old. -# Use newer versions. -Source8: config.guess -Source9: config.sub - -Patch0: ocaml-3.12.0-rpath.patch -Patch1: ocaml-user-cflags.patch - -# Patch from Debian for ARM (sent upstream). -Patch3: debian_patches_0013-ocamlopt-arm-add-.type-directive-for-code-symbols.patch - -# Non-upstream patch to build on ppc64. -Patch4: ocaml-ppc64.patch - -# New ARM backend by Benedikt Meurer (PR#5433), backported to OCaml 3.12.1. -Patch5: ocaml-3.12.1-merge-the-new-ARM-backend-into-trunk-PR-5433.patch - -# the new arm backend missed one small patch for PPC: -Patch6: ocaml-3.12-ppc.patch - -BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n) +# IMPORTANT NOTE: +# +# These patches are generated from unpacked sources stored in a +# fedorahosted git repository. If you change the patches here, they +# will be OVERWRITTEN by the next update. Instead, request commit +# access to the fedorahosted project: +# +# http://git.fedorahosted.org/git/?p=fedora-ocaml.git +# +# ALTERNATIVELY add a patch to the end of the list (leaving the +# existing patches unchanged) adding a comment to note that it should +# be incorporated into the git repo at a later time. +# +Patch0001: 0001-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch +Patch0002: 0002-GNU-config.guess-and-config.sub-replacements.patch +Patch0003: 0003-Don-t-add-rpaths-to-libraries.patch +Patch0004: 0004-configure-Allow-user-defined-C-compiler-flags.patch +Patch0005: 0005-ocamlopt-arm-add-.type-directive-for-code-symbols.patch +Patch0006: 0006-Add-support-for-ppc64.patch +Patch0007: 0007-New-ARM-backend-written-by-Benedikt-Meurer-PR-5433.patch # Depend on previous version of OCaml so that ocamlobjinfo # can run. @@ -230,18 +224,16 @@ man pages and info files. %setup -q -T -b 0 -n %{name}-%{version} %setup -q -T -D -a 1 -n %{name}-%{version} %setup -q -T -D -a 3 -n %{name}-%{version} -%patch0 -p1 -b .rpath -%patch1 -p1 -b .cflags -%patch3 -p1 -b .arm-type-dir -%ifarch ppc ppc64 -%patch4 -p1 -b .ppc64 -%patch6 -p1 -b .ppc64_1 -%endif -%patch5 -p1 -b .new-arm + +git init +git config user.email "noone@example.com" +git config user.name "no one" +git add . +git commit -a -q -m "%{version} baseline" +git am %{patches} cp %{SOURCE2} refman.pdf -cp %{SOURCE8} %{SOURCE9} config/gnu/ chmod +x config/gnu/config.{guess,sub} @@ -261,7 +253,6 @@ make -C emacs ocamltags # Currently these tools are supplied by Debian, but are expected # to go upstream at some point. -cp %{SOURCE6} . includes="-nostdlib -I stdlib -I utils -I parsing -I typing -I bytecomp -I asmcomp -I driver -I otherlibs/unix -I otherlibs/str -I otherlibs/dynlink" boot/ocamlrun ./ocamlc $includes dynlinkaux.cmo ocamlbyteinfo.ml -o ocamlbyteinfo #cp otherlibs/dynlink/natdynlink.ml . @@ -508,7 +499,12 @@ fi %changelog -* Tue May 15 2012 Tue May 15 2012 Karsten Hopp 3.12.1-4 +* Tue May 29 2012 Richard W.M. Jones 3.12.1-5 +- Move patches to external git repo: + http://git.fedorahosted.org/git/?p=fedora-ocaml.git + There should be no change introduced here. + +* Tue May 15 2012 Karsten Hopp 3.12.1-4 - ppc64 got broken by the new ARM backend, add a minor patch * Sat Apr 28 2012 Richard W.M. Jones 3.12.1-3 diff --git a/ocamlbyteinfo.ml b/ocamlbyteinfo.ml deleted file mode 100644 index eb9a293..0000000 --- a/ocamlbyteinfo.ml +++ /dev/null @@ -1,101 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) -(* *) -(* Copyright 2009 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id$ *) - -(* Dumps a bytecode binary file *) - -open Sys -open Dynlinkaux - -let input_stringlist ic len = - let get_string_list sect len = - let rec fold s e acc = - if e != len then - if sect.[e] = '\000' then - fold (e+1) (e+1) (String.sub sect s (e-s) :: acc) - else fold s (e+1) acc - else acc - in fold 0 0 [] - in - let sect = String.create len in - let _ = really_input ic sect 0 len in - get_string_list sect len - -let print = Printf.printf -let perr s = - Printf.eprintf "%s\n" s; - exit(1) -let p_title title = print "%s:\n" title - -let p_section title format pdata = function - | [] -> () - | l -> - p_title title; - List.iter - (fun (name, data) -> print format (pdata data) name) - l - -let p_list title format = function - | [] -> () - | l -> - p_title title; - List.iter - (fun name -> print format name) - l - -let _ = - try - let input_name = Sys.argv.(1) in - let ic = open_in_bin input_name in - Bytesections.read_toc ic; - List.iter - (fun section -> - try - let len = Bytesections.seek_section ic section in - if len > 0 then match section with - | "CRCS" -> - p_section - "Imported Units" - "\t%s\t%s\n" - Digest.to_hex - (input_value ic : (string * Digest.t) list) - | "DLLS" -> - p_list - "Used Dlls" "\t%s\n" - (input_stringlist ic len) - | "DLPT" -> - p_list - "Additional Dll paths" - "\t%s\n" - (input_stringlist ic len) - | "PRIM" -> - let prims = (input_stringlist ic len) in - print "Uses unsafe features: "; - begin match prims with - [] -> print "no\n" - | l -> print "YES\n"; - p_list "Primitives declared in this module" - "\t%s\n" - l - end - | _ -> () - with Not_found | Failure _ | Invalid_argument _ -> () - ) - ["CRCS"; "DLLS"; "DLPT"; "PRIM"]; - close_in ic - with - | Sys_error msg -> - perr msg - | Invalid_argument("index out of bounds") -> - perr (Printf.sprintf "Usage: %s filename" Sys.argv.(0)) diff --git a/ocamlplugininfo.ml b/ocamlplugininfo.ml deleted file mode 100644 index e28800f..0000000 --- a/ocamlplugininfo.ml +++ /dev/null @@ -1,109 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) -(* *) -(* Copyright 2009 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id$ *) - -(* Dumps a .cmxs file *) - -open Natdynlink -open Format - -let file = - try - Sys.argv.(1) - with _ -> begin - Printf.eprintf "Usage: %s file.cmxs\n" Sys.argv.(0); - exit(1) - end - -exception Abnormal_exit - -let error s e = - let eprint = Printf.eprintf in - let print_exc s = function - | End_of_file -> - eprint "%s: %s\n" s file - | Abnormal_exit -> - eprint "%s\n" s - | e -> eprint "%s\n" (Printexc.to_string e) - in - print_exc s e; - exit(1) - -let read_in command = - let cmd = Printf.sprintf command file in - let ic = Unix.open_process_in cmd in - try - let line = input_line ic in - begin match (Unix.close_process_in ic) with - | Unix.WEXITED 0 -> Str.split (Str.regexp "[ ]+") line - | Unix.WEXITED _ | Unix.WSIGNALED _ | Unix.WSTOPPED _ -> - error - (Printf.sprintf - "Command \"%s\" exited abnormally" - cmd - ) - Abnormal_exit - end - with e -> error "File is empty" e - -let get_offset adr_off adr_sec = - try - let adr = List.nth adr_off 4 in - let off = List.nth adr_off 5 in - let sec = List.hd adr_sec in - - let (!) x = Int64.of_string ("0x" ^ x) in - let (+) = Int64.add in - let (-) = Int64.sub in - - Int64.to_int (!off + !sec - !adr) - - with Failure _ | Invalid_argument _ -> - error - "Command output doesn't have the expected format" - Abnormal_exit - -let print_infos name crc defines cmi cmx = - let print_name_crc (name, crc) = - printf "@ %s (%s)" name (Digest.to_hex crc) - in - let pr_imports ppf imps = List.iter print_name_crc imps in - printf "Name: %s@." name; - printf "CRC of implementation: %s@." (Digest.to_hex crc); - printf "@[Globals defined:"; - List.iter (fun s -> printf "@ %s" s) defines; - printf "@]@."; - printf "@[Interfaces imported:%a@]@." pr_imports cmi; - printf "@[Implementations imported:%a@]@." pr_imports cmx - -let _ = - let adr_off = read_in "objdump -h %s | grep ' .data '" in - let adr_sec = read_in "objdump -T %s | grep ' caml_plugin_header$'" in - - let ic = open_in file in - let _ = seek_in ic (get_offset adr_off adr_sec) in - let header = (input_value ic : Natdynlink.dynheader) in - if header.magic <> Natdynlink.dyn_magic_number then - raise(Error(Natdynlink.Not_a_bytecode_file file)) - else begin - List.iter - (fun ui -> - print_infos - ui.name - ui.crc - ui.defines - ui.imports_cmi - ui.imports_cmx) - header.units - end