From af420c948585c742b94e5f8c50388540dbc06e18 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Thu, 12 Apr 2018 19:57:17 -0700
Subject: compile-file: need endian mark in .tlo files.

VM machine code is endian-specific: it consists of 32 bit
instruction words which are 32 bit in the local byte order.

Thus code assembled on a little-endian machine won't run
on a big endian-machine, or vice versa: unless we identify
the situation and byte-swap the code when we load it.

* buf.c (buf_swap32): New function.

* buf.h (buf_swap32): Declared.

* parser.c (read_file_common): Decode the third element from
the version: a Boolean indicating big endian, if true.
If the object file's endian is opposite from our endian, then
byte swap the code.

* itypes.c (itypes_init): Oops, calculation of
itypes_little_endian was broken due to classic C =/== typo.
Luckily, nothing has used this flag so far; it's been waiting
for this first use. I caught this due to testing on a PPC64
box.

* share/txr/stdlib/compiler.tl (%big-endian%, %tlo-ver%): New
variables.
(usr:compile-file): The file version comes from %tlo-ver% now,
which includes the big-endian flag.
---
 buf.c                        | 14 ++++++++++++++
 buf.h                        |  2 ++
 itypes.c                     |  2 +-
 parser.c                     |  9 ++++++++-
 share/txr/stdlib/compiler.tl |  6 +++++-
 5 files changed, 30 insertions(+), 3 deletions(-)

diff --git a/buf.c b/buf.c
index efd2e4a6..40e81607 100644
--- a/buf.c
+++ b/buf.c
@@ -914,6 +914,20 @@ val get_buf_from_stream(val stream)
   return s->buf;
 }
 
+void buf_swap32(val buf)
+{
+  val self = lit("buf-swap32");
+  struct buf *b = buf_handle(buf, self);
+  mem_t *data = b->data, *end = data + c_num(b->len);
+
+  for (; data + 3 < end; data += 4) {
+    u32_t sw32 = *coerce(u32_t *, data);
+    sw32 = ((sw32 & 0xFF00FF00U) >>  8) | ((sw32 & 0x00FF00FFU) <<  8);
+    sw32 = ((sw32 & 0xFFFF0000U) >> 16) | ((sw32 & 0x0000FFFFU) << 16);
+    *coerce(u32_t *, data) = sw32;
+  }
+}
+
 void buf_init(void)
 {
   reg_fun(intern(lit("make-buf"), user_package), func_n3o(make_buf, 1));
diff --git a/buf.h b/buf.h
index 107d7608..cf394ff0 100644
--- a/buf.h
+++ b/buf.h
@@ -106,4 +106,6 @@ val buf_pprint(val buf, val stream);
 val make_buf_stream(val buf_opt);
 val get_buf_from_stream(val stream);
 
+void buf_swap32(val buf);
+
 void buf_init(void);
diff --git a/itypes.c b/itypes.c
index a963e330..4e973d5f 100644
--- a/itypes.c
+++ b/itypes.c
@@ -228,5 +228,5 @@ void itypes_init()
     volatile unsigned char uc[sizeof (unsigned)];
   } u = { 0xff };
 
-  itypes_little_endian = (u.uc[0] = 0xff);
+  itypes_little_endian = (u.uc[0] == 0xff);
 }
diff --git a/parser.c b/parser.c
index 5d310b5b..93d9703c 100644
--- a/parser.c
+++ b/parser.c
@@ -55,6 +55,8 @@
 #include "cadr.h"
 #include "struct.h"
 #include "parser.h"
+#include "itypes.h"
+#include "buf.h"
 #include "vm.h"
 #include "txr.h"
 #if HAVE_TERMIOS
@@ -611,6 +613,7 @@ static val read_file_common(val stream, val error_stream, val compiled)
   val error_val = gensym(nil);
   val name = stream_get_prop(stream, name_k);
   val first = t;
+  val big_endian = nil;
 
   for (;;) {
     val form = lisp_parse(stream, error_stream, error_val, name, colon_k);
@@ -625,11 +628,12 @@ static val read_file_common(val stream, val error_stream, val compiled)
     }
 
     if (compiled && first) {
-      val major = pop(&form);
+      val major = car(form);
       if (gt(major, zero))
         uw_throwf(error_s,
                   lit("cannot load ~s; it was compiled by a newer implementation"),
                   stream, nao);
+      big_endian = caddr(form);
       first = nil;
     } else if (compiled) {
       for (; form; form = cdr(form)) {
@@ -640,6 +644,9 @@ static val read_file_common(val stream, val error_stream, val compiled)
         val datavec = pop(&item);
         val funvec = car(item);
         val desc = vm_make_desc(nlevels, nregs, bytecode, datavec, funvec);
+        if ((big_endian && itypes_little_endian) ||
+            (!big_endian && !itypes_little_endian))
+          buf_swap32(bytecode);
         (void) vm_execute_toplevel(desc);
         gc_hint(desc);
       }
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index 6a8bc59c..a10f4f14 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -1313,6 +1313,10 @@
 
 (defvar *eval*)
 
+(defvarl %big-endian% (equal (ffi-put 1 (ffi uint32)) #b'00000001'))
+
+(defvarl %tlo-ver% ^(0 0 ,%big-endian%))
+
 (defun open-compile-streams (in-path out-path)
   (let* ((rsuff (r$ %file-suff-rx% in-path))
          (suff (if rsuff [in-path rsuff]))
@@ -1386,7 +1390,7 @@
                                 (sys:vm-execute-toplevel vm-desc))
                               (when *emit*
                                 out.(add flat-vd)))))))))
-          (prinl '(0 0) out-stream)
+          (prinl %tlo-ver% out-stream)
           (unwind-protect
             (whilet ((obj (read in-stream *stderr* err-ret))
                      ((neq obj err-ret)))
-- 
cgit v1.2.3