summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-05-30 21:28:30 +0200
committerAndy Wingo <wingo@pobox.com>2011-05-31 11:18:28 +0200
commit42090217cf2d7257a7efcf3902cfd447649242db (patch)
tree49f121754397efc7e6f19391dcadf8328557acb7
parent2187975e391efd3e4b8078f2ce477d62856edc20 (diff)
downloadguile-42090217cf2d7257a7efcf3902cfd447649242db.tar.gz
add (system base target)
* module/Makefile.am: * module/system/base/target.scm: Add a minimal module to parameterize the target system type and inspect properties on it like cpu, vendor, os, endianness, and word size.
-rw-r--r--module/Makefile.am3
-rw-r--r--module/system/base/target.scm76
2 files changed, 78 insertions, 1 deletions
diff --git a/module/Makefile.am b/module/Makefile.am
index ddd46749f..ecae83bbe 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -173,7 +173,8 @@ SYSTEM_BASE_SOURCES = \
system/base/compile.scm \
system/base/language.scm \
system/base/lalr.scm \
- system/base/message.scm
+ system/base/message.scm \
+ system/base/target.scm
ICE_9_SOURCES = \
ice-9/r4rs.scm \
diff --git a/module/system/base/target.scm b/module/system/base/target.scm
new file mode 100644
index 000000000..573ccca46
--- /dev/null
+++ b/module/system/base/target.scm
@@ -0,0 +1,76 @@
+;;; Compilation targets
+
+;; Copyright (C) 2011 Free Software Foundation, Inc.
+
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;;
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+;; 02110-1301 USA
+
+;;; Code:
+
+(define-module (system base target)
+ #:use-module (rnrs bytevectors)
+ #:export (target-type with-target
+
+ target-cpu target-vendor target-os
+
+ target-endianness target-word-size))
+
+
+
+;;;
+;;; Target types
+;;;
+
+(define %target-type (make-fluid))
+
+(define (target-type)
+ (or (fluid-ref %target-type)
+ %host-type))
+
+(define (validate-target target)
+ (if (or (not (string? target))
+ (let ((parts (string-split target #\-)))
+ (or (< 3 (length parts))
+ (or-map string-null? parts))))
+ (error "invalid target" target)))
+
+(define (with-target target thunk)
+ (validate-target target)
+ (with-fluids ((%target-type target))
+ (thunk)))
+
+(define (target-cpu)
+ (let ((t (target-type)))
+ (substring t 0 (string-index t #\-))))
+
+(define (target-vendor)
+ (let* ((t (target-type))
+ (start (1+ (string-index t #\-))))
+ (substring t start (string-index t #\- start))))
+
+(define (target-os)
+ (let* ((t (target-type))
+ (start (1+ (string-index t #\- (1+ (string-index t #\-))))))
+ (substring t start)))
+
+(define (target-endianness)
+ (if (equal? (target-type) %host-type)
+ (native-endianness)
+ (error "cross-compilation not yet handled" %host-type (target-type))))
+
+(define (target-word-size)
+ (if (equal? (target-type) %host-type)
+ ((@ (system foreign) sizeof) '*)
+ (error "cross-compilation not yet handled" %host-type (target-type))))