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 LC |
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) '*)) | |
42090217 | 41 | |
9447207f AW |
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 | ||
42090217 AW |
46 | (define (validate-target target) |
47 | (if (or (not (string? target)) | |
48 | (let ((parts (string-split target #\-))) | |
e0a9f022 | 49 | (or (< (length parts) 3) |
42090217 AW |
50 | (or-map string-null? parts)))) |
51 | (error "invalid target" target))) | |
52 | ||
53 | (define (with-target target thunk) | |
54 | (validate-target target) | |
de2c0a10 LC |
55 | (let ((cpu (triplet-cpu target))) |
56 | (with-fluids ((%target-type target) | |
57 | (%target-endianness (cpu-endianness cpu)) | |
9130ec74 | 58 | (%target-word-size (triplet-pointer-size target))) |
de2c0a10 LC |
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 | ||
9130ec74 LC |
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 | ||
aacc6896 | 95 | ((string-match "^x86_64-.*-gnux32" triplet) 4) ; x32 |
b946e08a | 96 | |
9130ec74 LC |
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))))) | |
de2c0a10 LC |
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." | |
9447207f | 117 | (fluid-ref %target-type)) |
42090217 AW |
118 | |
119 | (define (target-cpu) | |
de2c0a10 LC |
120 | "Return the CPU name of the target platform." |
121 | (triplet-cpu (target-type))) | |
42090217 AW |
122 | |
123 | (define (target-vendor) | |
de2c0a10 LC |
124 | "Return the vendor name of the target platform." |
125 | (triplet-vendor (target-type))) | |
42090217 AW |
126 | |
127 | (define (target-os) | |
de2c0a10 LC |
128 | "Return the operating system name of the target platform." |
129 | (triplet-os (target-type))) | |
42090217 AW |
130 | |
131 | (define (target-endianness) | |
de2c0a10 | 132 | "Return the endianness object of the target platform." |
9447207f | 133 | (fluid-ref %target-endianness)) |
42090217 AW |
134 | |
135 | (define (target-word-size) | |
de2c0a10 | 136 | "Return the word size, in bytes, of the target platform." |
9447207f | 137 | (fluid-ref %target-word-size)) |