GitLab

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.

  #!/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")

@@ -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)

@@ -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

@@ -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)))

@@ -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))

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

Commits:

7 changed files:

Changes:

@@ -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

  ;;; 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