target.scm 6.7 KB

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