[Git][cmucl/cmucl][sparc64-dev] 7 commits: Add -i option to enable interactive builds

Raymond Toy rtoy at common-lisp.net
Wed Dec 28 06:23:58 UTC 2016


Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl


Commits:
fac1b87e by Raymond Toy at 2016-12-27T22:10:59-08:00
Add -i option to enable interactive builds

This enables interactive builds when compiling the
cross-compiler. This causes the build to be more verbose and to stop
if there is a fatal error when compiling the cross-copmiler.

- - - - -
a50a215c by Raymond Toy at 2016-12-27T22:13:24-08:00
Set word-bits to 64 for 64-bit sparc

Also hardwire the value of double-float-digits to 53 instead of trying
to compute it from word-bits.  This is actually independent of
word-bits.

- - - - -
8c57220e by Raymond Toy at 2016-12-27T22:14:44-08:00
Disable truncate-by-mult vops.

These cause errors and aren't needed; they're just speed optimizations
that aren't needed right now.

- - - - -
32b18ac1 by Raymond Toy at 2016-12-27T22:18:16-08:00
Update maybe-byte-swap for 32 and 64 bit architectures

maybe-byte-swap can handle either 32-bit or 64-bit architectures.
Added maybe-byte-swap-32 and maybe-byte-swap-64 to handle these
cases.  

For do-cold-fixup use maybe-byte-swap-32. (Might need further work? I
think the fixups are currently limited to 32-bit values at most.
Certainly sethi is.)

- - - - -
a43234fc by Raymond Toy at 2016-12-27T22:19:29-08:00
Leave map_failed as a 32-bit value for now for sparc64

The mmap stuff needs to be redone for 64-bit, but we don't need mmap
for cmucl core anyway.

- - - - -
244822ba by Raymond Toy at 2016-12-27T22:21:48-08:00
Don't flame out when changing constants

Stolen from cross-x86-amd64 so that defconstant doesn't flame out when
changing the value of a defconstant.

Also, don't frob old-vm:word-bits with a new value.  Not sure this is
needed, but it gets rid of a problem when compiling. (Why does the
old-vm stuff leak into the new vm anyway?)

- - - - -
6e22a43c by Raymond Toy at 2016-12-27T22:23:31-08:00
Compile 64-bit code.

Use -m64 to get 64-bit code.  I think this also implies abs44
addressing (code+data+bss size).

- - - - -


7 changed files:

- bin/cross-build-world.sh
- src/code/unix.lisp
- src/compiler/generic/new-genesis.lisp
- src/compiler/sparc64/arith.lisp
- src/compiler/sparc64/parms.lisp
- src/lisp/Config.sparc64_sunc
- src/tools/cross-scripts/cross-x86-sparc64.lisp


Changes:

=====================================
bin/cross-build-world.sh
=====================================
--- a/bin/cross-build-world.sh
+++ b/bin/cross-build-world.sh
@@ -1,19 +1,21 @@
 #!/bin/sh
 
 usage() {
-    echo "cross-build-world.sh [-crlX] [-B file] [-G Gnumake] target-dir cross-dir cross-compiler-script [build-binary [flags]]"
+    echo "cross-build-world.sh [-crlXi] [-B file] [-G Gnumake] target-dir cross-dir cross-compiler-script [build-binary [flags]]"
     echo "  -c      Clean target and cross directories before compiling"
     echo "  -r      Recompile lisp runtime"
     echo "  -l      Load cross-compiled kernel to make a new lisp kernel"
     echo "  -B file Use this as the cross bootstrap file." 
     echo "  -G make Specifies the name of GNU make"
     echo "  -X      (break) before quitting the cross compilation (for debugging)"
+    echo "  -i      Interactive compile when compiling cross-compiler"
 }
 
 MAKE=make
 BREAK=""
+INTERACTIVE=nil
 
-while getopts "crlXB:G:" arg
+while getopts "crlXiB:G:" arg
 do
     case $arg in
       c) CLEAN_DIR=yes ;;
@@ -22,6 +24,7 @@ do
       B) BOOTSTRAP=$OPTARG ;;
       G) MAKE=$OPTARG ;;
       X) BREAK="(break)" ;;
+      i) INTERACTIVE=t ;;
       h | \?) usage; exit 1 ;;
     esac
 done
@@ -98,7 +101,7 @@ $LISP "$@" -noinit -nositeinit <<EOF
 (load "target:tools/setup" :if-source-newer :load-source)
 (comf "target:tools/setup" :load t)
 
-(setq *gc-verbose* nil *interactive* nil)
+(setq *gc-verbose* nil *interactive* ${INTERACTIVE})
 
 (load "$SCRIPT")
 


=====================================
src/code/unix.lisp
=====================================
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -2501,7 +2501,10 @@
 (defconstant ms_invalidate 2)
 
 ;; The return value from mmap that means mmap failed.
-(defconstant map_failed (int-sap (1- (ash 1 vm:word-bits))))
+(defconstant map_failed
+  #-sparc64 (int-sap (1- (ash 1 vm:word-bits)))
+  #+sparc64 (ldb (byte 32 0) -1)
+  )
 
 (defun unix-mmap (addr length prot flags fd offset)
   (declare (type (or null system-area-pointer) addr)
@@ -2522,11 +2525,13 @@
 	(values nil (unix-errno))
 	(values result 0))))
 
+#-sparc64
 (defun unix-munmap (addr length)
   (declare (type system-area-pointer addr)
 	   (type (unsigned-byte 32) length))
   (syscall ("munmap" system-area-pointer size-t) t addr length))
 
+#-sparc64
 (defun unix-mprotect (addr length prot)
   (declare (type system-area-pointer addr)
 	   (type (unsigned-byte 32) length)
@@ -2534,6 +2539,7 @@
   (syscall ("mprotect" system-area-pointer size-t int)
 	   t addr length prot))
   
+#-sparc64
 (defun unix-msync (addr length flags)
   (declare (type system-area-pointer addr)
 	   (type (unsigned-byte 32) length)


=====================================
src/compiler/generic/new-genesis.lisp
=====================================
--- a/src/compiler/generic/new-genesis.lisp
+++ b/src/compiler/generic/new-genesis.lisp
@@ -290,17 +290,36 @@
 
 ;; TODO: make this work for 64-bit
 (defun maybe-byte-swap (word)
+  (ecase vm:word-bits
+    (32 (maybe-byte-swap-32 word))
+    (64 (maybe-byte-swap-64 word))))
+
+(defun maybe-byte-swap-32 (word)
   (if (eq (c:backend-byte-order c:*native-backend*)
 	  (c:backend-byte-order c:*backend*))
       word
       (locally (declare (type (unsigned-byte 32) word))
-	(assert (= vm:word-bits 32))
 	(assert (= vm:byte-bits 8))
 	(logior (ash (ldb (byte 8 0) word) 24)
 		(ash (ldb (byte 8 8) word) 16)
 		(ash (ldb (byte 8 16) word) 8)
 		(ldb (byte 8 24) word)))))
 
+(defun maybe-byte-swap-64 (word)
+  (if (eq (c:backend-byte-order c:*native-backend*)
+	  (c:backend-byte-order c:*backend*))
+      word
+      (locally (declare (type (unsigned-byte 64) word))
+	(assert (= vm:byte-bits 8))
+	(logior (ash (ldb (byte 8 0) word) 56)
+		(ash (ldb (byte 8 8) word) 48)
+		(ash (ldb (byte 8 16) word) 40)
+		(ash (ldb (byte 8 24) word) 32)
+		(ash (ldb (byte 8 32) word) 24)
+		(ash (ldb (byte 8 40) word) 16)
+		(ash (ldb (byte 8 48) word) 8)
+		(ldb (byte 8 56) word)))))
+  
 (defun maybe-byte-swap-short (short)
   (if (eq (c:backend-byte-order c:*native-backend*)
 	  (c:backend-byte-order c:*backend*))
@@ -2275,7 +2294,7 @@
 		 (ldb (byte 16 0) value))))))
       ((#.c:sparc-fasl-file-implementation
 	#.c:sparc64-fasl-file-implementation)
-       (let ((inst (maybe-byte-swap (sap-ref-32 sap 0))))
+       (let ((inst (maybe-byte-swap-32 (sap-ref-32 sap 0))))
 	 (ecase kind
 	   (:call
 	    (error "Can't deal with call fixups yet."))
@@ -2290,7 +2309,7 @@
 		       (byte 10 0)
 		       inst))))
 	 (setf (sap-ref-32 sap 0)
-	       (maybe-byte-swap inst))))
+	       (maybe-byte-swap-32 inst))))
       ((#.c:rt-fasl-file-implementation 
 	#.c:rt-afpa-fasl-file-implementation)
        (ecase kind


=====================================
src/compiler/sparc64/arith.lisp
=====================================
--- a/src/compiler/sparc64/arith.lisp
+++ b/src/compiler/sparc64/arith.lisp
@@ -1567,6 +1567,7 @@
 ;;
 ;; See generic/vm-tran.lisp for the algorithm.
 
+#+nil
 (define-vop (signed-truncate-by-mult fast-signed-binop)
   (:translate truncate)
   (:args (x :scs (signed-reg)))
@@ -1612,6 +1613,7 @@
       (unless (location= quo q)
         (move quo q)))))
 
+#+nil
 (define-vop (unsigned-truncate-by-mult fast-signed-binop)
   (:translate truncate)
   (:args (x :scs (unsigned-reg)))


=====================================
src/compiler/sparc64/parms.lisp
=====================================
--- a/src/compiler/sparc64/parms.lisp
+++ b/src/compiler/sparc64/parms.lisp
@@ -92,7 +92,7 @@
 
 (eval-when (compile load eval)
 
-(defconstant word-bits 32
+(defconstant word-bits 64
   "Number of bits per word where a word holds one lisp descriptor.")
 
 (defconstant byte-bits 8
@@ -163,7 +163,7 @@
   (+ (byte-size single-float-significand-byte) 1))
 
 (defconstant double-float-digits
-  (+ (byte-size double-float-significand-byte) word-bits 1))
+  53)
 
 (defconstant long-float-digits
   (+ (byte-size long-float-significand-byte) word-bits 1))


=====================================
src/lisp/Config.sparc64_sunc
=====================================
--- a/src/lisp/Config.sparc64_sunc
+++ b/src/lisp/Config.sparc64_sunc
@@ -20,8 +20,8 @@ include Config.sparc_common
 ifdef FEATURE_SPARC_V9
 # For SunStudio 11, use -xarch=v8plus.  For SunStudio 12, that is
 # deprecated; use -m32 -xarch=sparc.
-CC_V8PLUS = -xarch=sparc
-AS_V8PLUS = -xarch=sparc
+CC_V8PLUS = -m64
+AS_V8PLUS = -m64
 endif
 
 ASSEM_SRC = sparc64-assem.S


=====================================
src/tools/cross-scripts/cross-x86-sparc64.lisp
=====================================
--- a/src/tools/cross-scripts/cross-x86-sparc64.lisp
+++ b/src/tools/cross-scripts/cross-x86-sparc64.lisp
@@ -1,6 +1,19 @@
 ;;; Cross-compile script to build a sparc core using x86 as the
 ;;; compiling system.  This needs work!
 
+(in-package "LISP")
+(defun c::%%defconstant (name value doc source-location)
+  (when doc
+    (setf (documentation name 'variable) doc))
+  (when (boundp name)
+    (unless (equalp (symbol-value name) value)
+      (warn "Constant ~S being redefined." name)))
+  (setf (symbol-value name) value)
+  (setf (info variable kind name) :constant)
+  (clear-info variable constant-value name)
+  (set-defvar-source-location name source-location)
+  name)
+
 (in-package :cl-user)
 
 ;;; Rename the X86 package and backend so that new-backend does the
@@ -191,7 +204,7 @@
 						    :vm))))
 			       syms))))
   (frob OLD-VM:BYTE-BITS
-	OLD-VM:WORD-BITS
+	;;OLD-VM:WORD-BITS
 	OLD-VM:CHAR-BITS
 	OLD-VM:CHAR-BYTES
 	OLD-VM:LOWTAG-BITS



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/1b987a649d4cbeae93a764a99815c5ccebe5b84d...6e22a43c01b267c010cfb20563ffacb95916a52a
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20161228/a12b05b8/attachment-0001.html>


More information about the cmucl-cvs mailing list