diff options
author | Andy Wingo <wingo@pobox.com> | 2011-05-30 21:28:30 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-05-31 11:18:28 +0200 |
commit | 42090217cf2d7257a7efcf3902cfd447649242db (patch) | |
tree | 49f121754397efc7e6f19391dcadf8328557acb7 | |
parent | 2187975e391efd3e4b8078f2ce477d62856edc20 (diff) | |
download | guile-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.am | 3 | ||||
-rw-r--r-- | module/system/base/target.scm | 76 |
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)))) |