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   ;; The native word size.  Note: don't use `word-size' from
  39   ;; (system vm objcode) to avoid a circular dependency.
  40   ((@ (system foreign) sizeof) '*))
  41
  42 (define %target-type (make-fluid %host-type))
  43 (define %target-endianness (make-fluid (native-endianness)))
  44 (define %target-word-size (make-fluid %native-word-size))
  45
  46 (define (validate-target target)
  47   (if (or (not (string? target))
  48           (let ((parts (string-split target #\-)))
  49             (or (< (length parts) 3)
  50                 (or-map string-null? parts))))
  51       (error "invalid target" target)))
  52
  53 (define (with-target target thunk)
  54   (validate-target target)
  55   (let ((cpu (triplet-cpu target)))
  56     (with-fluids ((%target-type target)
  57                   (%target-endianness (cpu-endianness cpu))
  58                   (%target-word-size (triplet-pointer-size target)))
  59       (thunk))))
  60
  61 (define (cpu-endianness cpu)
  62   "Return the endianness for CPU."
  63   (if (string=? cpu (triplet-cpu %host-type))
  64       (native-endianness)
  65       (cond ((string-match "^i[0-9]86$" cpu)
  66              (endianness little))
  67             ((member cpu '("x86_64" "ia64"
  68                            "powerpcle" "powerpc64le" "mipsel" "mips64el"))
  69              (endianness little))
  70             ((member cpu '("sparc" "sparc64" "powerpc" "powerpc64" "spu"
  71                            "mips" "mips64"))
  72              (endianness big))
  73             ((string-match "^arm.*el" cpu)
  74              (endianness little))
  75             (else
  76              (error "unknown CPU endianness" cpu)))))
  77
  78 (define (triplet-pointer-size triplet)
  79   "Return the size of pointers in bytes for TRIPLET."
  80   (let ((cpu (triplet-cpu triplet)))
  81     (cond ((and (string=? cpu (triplet-cpu %host-type))
  82                 (string=? (triplet-os triplet) (triplet-os %host-type)))
  83            %native-word-size)
  84
  85           ((string-match "^i[0-9]86$" cpu) 4)
  86
  87           ;; Although GNU config.guess doesn't yet recognize them,
  88           ;; Debian (ab)uses the OS part to denote the specific ABI
  89           ;; being used: <http://wiki.debian.org/Multiarch/Tuples>.
  90           ;; See <http://www.linux-mips.org/wiki/WhatsWrongWithO32N32N64>
  91           ;; for details on the MIPS ABIs.
  92           ((string-match "^mips64.*-gnuabi64" triplet) 8) ; n64 ABI
  93           ((string-match "^mips64" cpu) 4)                ; n32 or o32
  94
  95           ((string-match "^x86_64-.*-gnux32" triplet) 4)  ; x32
  96
  97           ((string-match "64$" cpu) 8)
  98           ((string-match "64[lbe][lbe]$" cpu) 8)
  99           ((member cpu '("sparc" "powerpc" "mips" "mipsel")) 4)
 100           ((string-match "^arm.*" cpu) 4)
 101           (else (error "unknown CPU word size" cpu)))))
 102
 103 (define (triplet-cpu t)
 104   (substring t 0 (string-index t #\-)))
 105
 106 (define (triplet-vendor t)
 107   (let ((start (1+ (string-index t #\-))))
 108     (substring t start (string-index t #\- start))))
 109
 110 (define (triplet-os t)
 111   (let ((start (1+ (string-index t #\- (1+ (string-index t #\-))))))
 112     (substring t start)))
 113
 114 \f
 115 (define (target-type)
 116   "Return the GNU configuration triplet of the target platform."
 117   (fluid-ref %target-type))
 118
 119 (define (target-cpu)
 120   "Return the CPU name of the target platform."
 121   (triplet-cpu (target-type)))
 122
 123 (define (target-vendor)
 124   "Return the vendor name of the target platform."
 125   (triplet-vendor (target-type)))
 126
 127 (define (target-os)
 128   "Return the operating system name of the target platform."
 129   (triplet-os (target-type)))
 130
 131 (define (target-endianness)
 132   "Return the endianness object of the target platform."
 133   (fluid-ref %target-endianness))
 134
 135 (define (target-word-size)
 136   "Return the word size, in bytes, of the target platform."
 137   (fluid-ref %target-word-size))