Commit | Line | Data |
---|---|---|
42090217 AW |
1 | ;;; Compilation targets |
2 | ||
cc2948aa | 3 | ;; Copyright (C) 2011, 2012, 2013 Free Software Foundation, Inc. |
42090217 AW |
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) | |
de2c0a10 | 24 | #:use-module (ice-9 regex) |
42090217 AW |
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 | ||
de2c0a10 | 37 | (define %native-word-size |
de2c0a10 | 38 | ((@ (system foreign) sizeof) '*)) |
42090217 | 39 | |
9447207f AW |
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 | ||
42090217 AW |
44 | (define (validate-target target) |
45 | (if (or (not (string? target)) | |
46 | (let ((parts (string-split target #\-))) | |
e0a9f022 | 47 | (or (< (length parts) 3) |
42090217 AW |
48 | (or-map string-null? parts)))) |
49 | (error "invalid target" target))) | |
50 | ||
51 | (define (with-target target thunk) | |
52 | (validate-target target) | |
de2c0a10 LC |
53 | (let ((cpu (triplet-cpu target))) |
54 | (with-fluids ((%target-type target) | |
55 | (%target-endianness (cpu-endianness cpu)) | |
9130ec74 | 56 | (%target-word-size (triplet-pointer-size target))) |
de2c0a10 LC |
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 | ||
9130ec74 LC |
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 | ||
aacc6896 | 93 | ((string-match "^x86_64-.*-gnux32" triplet) 4) ; x32 |
b946e08a | 94 | |
9130ec74 LC |
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))))) | |
de2c0a10 LC |
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." | |
9447207f | 115 | (fluid-ref %target-type)) |
42090217 AW |
116 | |
117 | (define (target-cpu) | |
de2c0a10 LC |
118 | "Return the CPU name of the target platform." |
119 | (triplet-cpu (target-type))) | |
42090217 AW |
120 | |
121 | (define (target-vendor) | |
de2c0a10 LC |
122 | "Return the vendor name of the target platform." |
123 | (triplet-vendor (target-type))) | |
42090217 AW |
124 | |
125 | (define (target-os) | |
de2c0a10 LC |
126 | "Return the operating system name of the target platform." |
127 | (triplet-os (target-type))) | |
42090217 AW |
128 | |
129 | (define (target-endianness) | |
de2c0a10 | 130 | "Return the endianness object of the target platform." |
9447207f | 131 | (fluid-ref %target-endianness)) |
42090217 AW |
132 | |
133 | (define (target-word-size) | |
de2c0a10 | 134 | "Return the word size, in bytes, of the target platform." |
9447207f | 135 | (fluid-ref %target-word-size)) |