[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.1-108-gf0b7c3c

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=f0b7c3c6b9d5ed8b95ed501c24037880815c8325

The branch, stable-2.0 has been updated
       via  f0b7c3c6b9d5ed8b95ed501c24037880815c8325 (commit)
       via  34ed9dfd1f728cc5d509665d4c6f4b66c4dda02c (commit)
       via  42090217cf2d7257a7efcf3902cfd447649242db (commit)
      from  2187975e391efd3e4b8078f2ce477d62856edc20 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit f0b7c3c6b9d5ed8b95ed501c24037880815c8325
Author: Andy Wingo <address@hidden>
Date:   Mon May 30 22:18:48 2011 +0200

    write-objcode uses target-endianness, target-word-size
    
    * libguile/_scm.h (SCM_OBJCODE_ENDIANNESS_OFFSET):
      (SCM_OBJCODE_WORD_SIZE_OFFSET): New defines.
    * libguile/objcodes.c (scm_write_objcode): Use target-endianness and
      target-word-size when writing the objcode cookie.

commit 34ed9dfd1f728cc5d509665d4c6f4b66c4dda02c
Author: Andy Wingo <address@hidden>
Date:   Fri May 27 13:29:45 2011 +0200

    compile-bytecode uses target-endianness
    
    * module/language/assembly/compile-bytecode.scm (compile-bytecode):
      Use target-endianness, from (system base target).

commit 42090217cf2d7257a7efcf3902cfd447649242db
Author: Andy Wingo <address@hidden>
Date:   Mon May 30 21:28:30 2011 +0200

    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.

-----------------------------------------------------------------------

Summary of changes:
 libguile/_scm.h                               |    3 +
 libguile/objcodes.c                           |   30 +++++++++-
 module/Makefile.am                            |    3 +-
 module/language/assembly/compile-bytecode.scm |   12 ++--
 module/system/base/target.scm                 |   76 +++++++++++++++++++++++++
 5 files changed, 117 insertions(+), 7 deletions(-)
 create mode 100644 module/system/base/target.scm

diff --git a/libguile/_scm.h b/libguile/_scm.h
index 2842130..48fb2cc 100644
--- a/libguile/_scm.h
+++ b/libguile/_scm.h
@@ -219,6 +219,9 @@
 /* The objcode magic header.  */
 #define SCM_OBJCODE_COOKIE                              \
   "GOOF----" SCM_OBJCODE_MACHINE_VERSION_STRING
+#define SCM_OBJCODE_ENDIANNESS_OFFSET 8
+#define SCM_OBJCODE_WORD_SIZE_OFFSET 11
+
 
 #endif  /* SCM__SCM_H */
 
diff --git a/libguile/objcodes.c b/libguile/objcodes.c
index 448bada..c45ca85 100644
--- a/libguile/objcodes.c
+++ b/libguile/objcodes.c
@@ -327,10 +327,38 @@ SCM_DEFINE (scm_write_objcode, "write-objcode", 2, 0, 0,
            "")
 #define FUNC_NAME s_scm_write_objcode
 {
+  static SCM target_endianness_var = SCM_BOOL_F;
+  static SCM target_word_size_var = SCM_BOOL_F;
+
+  char cookie[sizeof (SCM_OBJCODE_COOKIE) - 1];
+  char endianness;
+  char word_size;
+
   SCM_VALIDATE_OBJCODE (1, objcode);
   SCM_VALIDATE_OUTPUT_PORT (2, port);
   
-  scm_c_write (port, SCM_OBJCODE_COOKIE, strlen (SCM_OBJCODE_COOKIE));
+  if (scm_is_false (target_endianness_var))
+    target_endianness_var =
+      scm_c_public_variable ("system base target", "target-endianness");
+  if (scm_is_false (target_word_size_var))
+    target_word_size_var =
+      scm_c_public_variable ("system base target", "target-word-size");
+
+  endianness = 
+    scm_is_eq (scm_call_0 (scm_variable_ref (target_endianness_var)),
+               scm_endianness_big) ? 'B' : 'L';
+  switch (scm_to_int (scm_call_0 (scm_variable_ref (target_word_size_var))))
+    {
+    case 4: word_size = '4'; break;
+    case 8: word_size = '8'; break;
+    default: abort ();
+    }
+
+  memcpy (cookie, SCM_OBJCODE_COOKIE, strlen (SCM_OBJCODE_COOKIE));
+  cookie[SCM_OBJCODE_ENDIANNESS_OFFSET] = endianness;
+  cookie[SCM_OBJCODE_WORD_SIZE_OFFSET] = word_size;
+
+  scm_c_write (port, cookie, strlen (SCM_OBJCODE_COOKIE));
   scm_c_write (port, SCM_OBJCODE_DATA (objcode),
                sizeof (struct scm_objcode) + SCM_OBJCODE_TOTAL_LEN (objcode));
 
diff --git a/module/Makefile.am b/module/Makefile.am
index ddd4674..ecae83b 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/language/assembly/compile-bytecode.scm 
b/module/language/assembly/compile-bytecode.scm
index c315829..163ffcc 100644
--- a/module/language/assembly/compile-bytecode.scm
+++ b/module/language/assembly/compile-bytecode.scm
@@ -20,6 +20,7 @@
 
 (define-module (language assembly compile-bytecode)
   #:use-module (system base pmatch)
+  #:use-module (system base target)
   #:use-module (language assembly)
   #:use-module (system vm instruction)
   #:use-module (rnrs bytevectors)
@@ -38,7 +39,7 @@
            ((_ arg)
             (begin body body* ...)))))))
        
-  (define (fill-bytecode bv)
+  (define (fill-bytecode bv target-endianness)
     (let ((pos 0))
       (define-inline1 (write-byte b)
         (bytevector-u8-set! bv pos b)
@@ -54,7 +55,7 @@
         (bytevector-u32-set! bv pos x (endianness big))
         (set! pos (+ pos 4)))
       (define-inline1 (write-uint32 x)
-        (bytevector-u32-native-set! bv pos x)
+        (bytevector-u32-set! bv pos x target-endianness)
         (set! pos (+ pos 4)))
       (define-inline1 (write-loader-len len)
         (bytevector-u8-set! bv pos (ash len -16))
@@ -77,7 +78,7 @@
           (bytevector-copy! bv* 0 bv pos len)
           (set! pos (+ pos len))))
       (define-inline1 (write-wide-string s)
-        (write-bytevector (string->utf32 s (native-endianness))))
+        (write-bytevector (string->utf32 s target-endianness)))
       (define-inline1 (write-break label)
         (let ((offset (- (assq-ref labels label) (+ (get-addr) 3))))
           (cond ((>= offset (ash 1 23)) (error "jump too far forward" offset))
@@ -160,6 +161,7 @@
      (fill-bytecode (make-bytevector (+ 4 4 length
                                         (if meta
                                             (1- (byte-length meta))
-                                            0)))))
-
+                                            0)))
+                    (target-endianness)))
+    
     (else (error "bad assembly" assembly))))
diff --git a/module/system/base/target.scm b/module/system/base/target.scm
new file mode 100644
index 0000000..573ccca
--- /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))))


hooks/post-receive
-- 
GNU Guile