module/system/base/target.scm

   1 ;;; Compilation targets
   2
   3 ;; Copyright (C) 2011, 2012, 2013 Free Software Foundation, Inc.
   4
   5 ;; This library is free software; you can redistribute it and/or
   6 ;; modify it under the terms of the GNU Lesser General Public
   7 ;; License as published by the Free Software Foundation; either
   8 ;; version 3 of the License, or (at your option) any later version.
   9 ;;
  10 ;; This library is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;; Lesser General Public License for more details.
  14 ;;
  15 ;; You should have received a copy of the GNU Lesser General Public
  16 ;; License along with this library; if not, write to the Free Software
  17 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  18 ;; 02110-1301 USA
  19
  20 ;;; Code:
  21
  22 (define-module (system base target)
  23   #:use-module (rnrs bytevectors)
  24   #:use-module (ice-9 regex)
  25   #:export (target-type with-target
  26
  27             target-cpu target-vendor target-os
  28
  29             target-endianness target-word-size))
  30
  31
  32 \f
  33 ;;;
  34 ;;; Target types
  35 ;;;
  36
  37 (define %native-word-size
  38   ((@ (system foreign) sizeof) '*))
  39
  40 (define %target-type (make-fluid %host-type))
  41 (define %target-endianness (make-fluid (native-endianness)))
  42 (define %target-word-size (make-fluid %native-word-size))
  43
  44 (define (validate-target target)
  45   (if (or (not (string? target))
  46           (let ((parts (string-split target #\-)))
  47             (or (< (length parts) 3)
  48                 (or-map string-null? parts))))
  49       (error "invalid target" target)))
  50
  51 (define (with-target target thunk)
  52   (validate-target target)
  53   (let ((cpu (triplet-cpu target)))
  54     (with-fluids ((%target-type target)
  55                   (%target-endianness (cpu-endianness cpu))
  56                   (%target-word-size (triplet-pointer-size target)))
  57       (thunk))))
  58
  59 (define (cpu-endianness cpu)
  60   "Return the endianness for CPU."
  61   (if (string=? cpu (triplet-cpu %host-type))
  62       (native-endianness)
  63       (cond ((string-match "^i[0-9]86$" cpu)
  64              (endianness little))
  65             ((member cpu '("x86_64" "ia64"
  66                            "powerpcle" "powerpc64le" "mipsel" "mips64el"))
  67              (endianness little))
  68             ((member cpu '("sparc" "sparc64" "powerpc" "powerpc64" "spu"
  69                            "mips" "mips64"))
  70              (endianness big))
  71             ((string-match "^arm.*el" cpu)
  72              (endianness little))
  73             (else
  74              (error "unknown CPU endianness" cpu)))))
  75
  76 (define (triplet-pointer-size triplet)
  77   "Return the size of pointers in bytes for TRIPLET."
  78   (let ((cpu (triplet-cpu triplet)))
  79     (cond ((and (string=? cpu (triplet-cpu %host-type))
  80                 (string=? (triplet-os triplet) (triplet-os %host-type)))
  81            %native-word-size)
  82
  83           ((string-match "^i[0-9]86$" cpu) 4)
  84
  85           ;; Although GNU config.guess doesn't yet recognize them,
  86           ;; Debian (ab)uses the OS part to denote the specific ABI
  87           ;; being used: <http://wiki.debian.org/Multiarch/Tuples>.
  88           ;; See <http://www.linux-mips.org/wiki/WhatsWrongWithO32N32N64>
  89           ;; for details on the MIPS ABIs.
  90           ((string-match "^mips64.*-gnuabi64" triplet) 8) ; n64 ABI
  91           ((string-match "^mips64" cpu) 4)                ; n32 or o32
  92
  93           ((string-match "^x86_64-.*-gnux32" triplet) 4)  ; x32
  94
  95           ((string-match "64$" cpu) 8)
  96           ((string-match "64[lbe][lbe]$" cpu) 8)
  97           ((member cpu '("sparc" "powerpc" "mips" "mipsel")) 4)
  98           ((string-match "^arm.*" cpu) 4)
  99           (else (error "unknown CPU word size" cpu)))))
 100
 101 (define (triplet-cpu t)
 102   (substring t 0 (string-index t #\-)))
 103
 104 (define (triplet-vendor t)
 105   (let ((start (1+ (string-index t #\-))))
 106     (substring t start (string-index t #\- start))))
 107
 108 (define (triplet-os t)
 109   (let ((start (1+ (string-index t #\- (1+ (string-index t #\-))))))
 110     (substring t start)))
 111
 112 \f
 113 (define (target-type)
 114   "Return the GNU configuration triplet of the target platform."
 115   (fluid-ref %target-type))
 116
 117 (define (target-cpu)
 118   "Return the CPU name of the target platform."
 119   (triplet-cpu (target-type)))
 120
 121 (define (target-vendor)
 122   "Return the vendor name of the target platform."
 123   (triplet-vendor (target-type)))
 124
 125 (define (target-os)
 126   "Return the operating system name of the target platform."
 127   (triplet-os (target-type)))
 128
 129 (define (target-endianness)
 130   "Return the endianness object of the target platform."
 131   (fluid-ref %target-endianness))
 132
 133 (define (target-word-size)
 134   "Return the word size, in bytes, of the target platform."
 135   (fluid-ref %target-word-size))