Home / Browse / Steel Bank Common Lisp / Mail / Archive
Steel Bank Common Lisp

Email Archive: sbcl-commits (read-only)

[Sbcl-commits] CVS: sbcl/src/compiler/x86-64 arith.lisp,1.12,1.13 call.lisp,1.2,1.3 cell.lisp,1.3,1.4 macros.lisp,1.4,1.5 move.lisp,1.2,1.3 nlx.lisp,1.2,1.3 subprim.lisp,1.1,1.2 system.lisp,1.2,1.3 type-vops.lisp,1.4,1.5 values.lisp,1.2,1.3
From: Christophe Rhodes <crhodes@us...> - 2005-04-29 14:37
Update of /cvsroot/sbcl/sbcl/src/compiler/x86-64
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10092/src/compiler/x86-64

Modified Files:
	arith.lisp call.lisp cell.lisp macros.lisp move.lisp nlx.lisp 
	subprim.lisp system.lisp type-vops.lisp values.lisp 
Log Message:
0.9.0.6:
	MORE CASE CONSISTENCY

	Make the system (with the x86-64 backend) buildable under
	(readtable-case *readtable*) => :invert.

	This may seem like a bit of an eccentric thing to do.  The plan,
	however, is to in future define this as the build mode for SBCL,
	enforcing it in the build scripts, so that userinits are 
	prevented from interfering in this respect, and also so that
	case-consistency throughout the system is enforced (to reduce
	potential reader confusion further down the line).  However,
	since there are 100000 MIPS-related patches waiting to be 
	merged, it would be a bad time to enforce this (and break
	all non-x86-64 backends).


Index: arith.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/arith.lisp,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- arith.lisp	17 Mar 2005 22:51:45 -0000	1.12
+++ arith.lisp	29 Apr 2005 14:37:40 -0000	1.13
@@ -753,14 +753,14 @@
     (move result number)
     (move ecx amount)
     (inst or ecx ecx)
-    (inst jmp :ns positive)
+    (inst jmp :ns POSITIVE)
     (inst neg ecx)
     (inst cmp ecx 63)
-    (inst jmp :be okay)
+    (inst jmp :be OKAY)
     (inst mov ecx 63)
     OKAY
     (inst sar result :cl)
-    (inst jmp done)
+    (inst jmp DONE)
 
     POSITIVE
     ;; The result-type ensures us that this shift will not overflow.
@@ -782,15 +782,15 @@
     (move result number)
     (move ecx amount)
     (inst or ecx ecx)
-    (inst jmp :ns positive)
+    (inst jmp :ns POSITIVE)
     (inst neg ecx)
     (inst cmp ecx 63)
-    (inst jmp :be okay)
+    (inst jmp :be OKAY)
     (inst xor result result)
-    (inst jmp done)
+    (inst jmp DONE)
     OKAY
     (inst shr result :cl)
-    (inst jmp done)
+    (inst jmp DONE)
 
     POSITIVE
     ;; The result-type ensures us that this shift will not overflow.
@@ -894,13 +894,13 @@
     (move result number)
     (move ecx amount)
     (inst or ecx ecx)
-    (inst jmp :ns positive)
+    (inst jmp :ns POSITIVE)
     (inst neg ecx)
     (inst xor zero zero)
     (inst shr result :cl)
     (inst cmp ecx 63)
     (inst cmov :nbe result zero)
-    (inst jmp done)
+    (inst jmp DONE)
     
     POSITIVE
     ;; The result-type ensures us that this shift will not overflow.
@@ -923,9 +923,9 @@
     (inst not res)
     POS
     (inst bsr res res)
-    (inst jmp :z zero)
+    (inst jmp :z ZERO)
     (inst inc res)
-    (inst jmp done)
+    (inst jmp DONE)
     ZERO
     (inst xor res res)
     DONE))
@@ -940,9 +940,9 @@
   (:result-types unsigned-num)
   (:generator 26
     (inst bsr res arg)
-    (inst jmp :z zero)
+    (inst jmp :z ZERO)
     (inst inc res)
-    (inst jmp done)
+    (inst jmp DONE)
     ZERO
     (inst xor res res)
     DONE))

Index: call.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/call.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- call.lisp	6 Jan 2005 12:48:02 -0000	1.2
+++ call.lisp	29 Apr 2005 14:37:40 -0000	1.3
@@ -469,10 +469,10 @@
 	((sap-stack)
 	 #+nil (format t "*call-local: ret-tn on stack; offset=~S~%"
 		       (tn-offset ret-tn))
-	 (inst lea return-label (make-fixup nil :code-object return))
+	 (inst lea return-label (make-fixup nil :code-object RETURN))
 	 (storew return-label rbp-tn (- (1+ (tn-offset ret-tn)))))
 	((sap-reg)
-	 (inst lea ret-tn (make-fixup nil :code-object return)))))
+	 (inst lea ret-tn (make-fixup nil :code-object RETURN)))))
 
     (note-this-location vop :call-site)
     (inst jmp target)
@@ -509,11 +509,11 @@
 	 #+nil (format t "*multiple-call-local: ret-tn on stack; offset=~S~%"
 		       (tn-offset ret-tn))
 	 ;; Stack
-	 (inst lea return-label (make-fixup nil :code-object return))
+	 (inst lea return-label (make-fixup nil :code-object RETURN))
 	 (storew return-label rbp-tn (- (1+ (tn-offset ret-tn)))))
 	((sap-reg)
 	 ;; Register
-	 (inst lea ret-tn (make-fixup nil :code-object return)))))
+	 (inst lea ret-tn (make-fixup nil :code-object RETURN)))))
 
     (note-this-location vop :call-site)
     (inst jmp target)
@@ -558,11 +558,11 @@
 	 #+nil (format t "*known-call-local: ret-tn on stack; offset=~S~%"
 		       (tn-offset ret-tn))
 	 ;; Stack
-	 (inst lea return-label (make-fixup nil :code-object return))
+	 (inst lea return-label (make-fixup nil :code-object RETURN))
 	 (storew return-label rbp-tn (- (1+ (tn-offset ret-tn)))))
 	((sap-reg)
 	 ;; Register
-	 (inst lea ret-tn (make-fixup nil :code-object return)))))
+	 (inst lea ret-tn (make-fixup nil :code-object RETURN)))))
 
     (note-this-location vop :call-site)
     (inst jmp target)
@@ -1126,10 +1126,10 @@
   (:generator 20
     ;; Avoid the copy if there are no more args.
     (cond ((zerop fixed)
-	   (inst jecxz just-alloc-frame))
+	   (inst jecxz JUST-ALLOC-FRAME))
 	  (t
 	   (inst cmp rcx-tn (fixnumize fixed))
-	   (inst jmp :be just-alloc-frame)))
+	   (inst jmp :be JUST-ALLOC-FRAME)))
 
     ;; Allocate the space on the stack.
     ;; stack = rbp - (max 3 frame-size) - (nargs - fixed)
@@ -1152,7 +1152,7 @@
 	   ;; Number to copy = nargs-3
 	   (inst sub rcx-tn (fixnumize register-arg-count))
 	   ;; Everything of interest in registers.
-	   (inst jmp :be do-regs))
+	   (inst jmp :be DO-REGS))
 	  (t
 	   ;; Number to copy = nargs-fixed
 	   (inst sub rcx-tn (fixnumize fixed))))
@@ -1207,9 +1207,9 @@
 	      (if (zerop i)
 		  (inst test rcx-tn rcx-tn)
 		(inst cmp rcx-tn (fixnumize i)))
-	      (inst jmp :eq done)))
+	      (inst jmp :eq DONE)))
 
-    (inst jmp done)
+    (inst jmp DONE)
 
     JUST-ALLOC-FRAME
     (inst lea rsp-tn

Index: cell.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/cell.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- cell.lisp	7 Apr 2005 08:00:45 -0000	1.3
+++ cell.lisp	29 Apr 2005 14:37:40 -0000	1.4
@@ -261,9 +261,9 @@
 		   :disp (- (* simple-fun-code-offset n-word-bytes)
 			    fun-pointer-lowtag)))
     (inst cmp type simple-fun-header-widetag)
-    (inst jmp :e normal-fn)
+    (inst jmp :e NORMAL-FUN)
     (inst lea raw (make-fixup "closure_tramp" :foreign))
-    NORMAL-FN
+    NORMAL-FUN
     (storew function fdefn fdefn-fun-slot other-pointer-lowtag)
     (storew raw fdefn fdefn-raw-addr-slot other-pointer-lowtag)
     (move result function)))
@@ -365,12 +365,12 @@
   (:generator 0
     (load-tl-symbol-value bsp *binding-stack-pointer*)
     (inst cmp where bsp)
-    (inst jmp :e done)
+    (inst jmp :e DONE)
 
     LOOP
     (loadw symbol bsp (- binding-symbol-slot binding-size))
     (inst or symbol symbol)
-    (inst jmp :z skip)
+    (inst jmp :z SKIP)
     (loadw value bsp (- binding-value-slot binding-size))
     #!-sb-thread (storew value symbol symbol-value-slot other-pointer-lowtag)
 
@@ -383,7 +383,7 @@
     SKIP
     (inst sub bsp (* binding-size n-word-bytes))
     (inst cmp where bsp)
-    (inst jmp :ne loop)
+    (inst jmp :ne LOOP)
     ;; we're done with value, so can use it as a temporary
     (store-tl-symbol-value bsp *binding-stack-pointer* value)
 

Index: macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/macros.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- macros.lisp	7 Apr 2005 08:00:45 -0000	1.4
+++ macros.lisp	29 Apr 2005 14:37:40 -0000	1.5
@@ -163,8 +163,8 @@
 
 (defun allocation (alloc-tn size &optional ignored)
   (declare (ignore ignored))
-  (let ((not-inline (gen-label))
-	(done (gen-label))
+  (let ((NOT-INLINE (gen-label))
+	(DONE (gen-label))
 	;; Yuck.
 	(in-elsewhere (eq *elsewhere* sb!assem::**current-segment**))
 	(free-pointer

Index: move.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/move.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- move.lisp	6 Jan 2005 12:48:02 -0000	1.2
+++ move.lisp	29 Apr 2005 14:37:40 -0000	1.3
@@ -236,9 +236,9 @@
   (:generator 4
     (move eax x)
     (inst test al-tn 7)			; a symbolic constant for this 
-    (inst jmp :z fixnum)		; would be nice
+    (inst jmp :z FIXNUM)		; would be nice
     (loadw y eax bignum-digits-offset other-pointer-lowtag)
-    (inst jmp done)
+    (inst jmp DONE)
     FIXNUM
     (inst sar eax (1- n-lowtag-bits))
     (move y eax)

Index: nlx.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/nlx.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- nlx.lisp	6 Jan 2005 12:48:03 -0000	1.2
+++ nlx.lisp	29 Apr 2005 14:37:40 -0000	1.3
@@ -207,7 +207,7 @@
     (move num rcx)
     (inst shr rcx word-shift)		; word count for <rep movs>
     ;; If we got zero, we be done.
-    (inst jecxz done)
+    (inst jecxz DONE)
     ;; Copy them down.
     (inst std)
     (inst rep)

Index: subprim.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/subprim.lisp,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- subprim.lisp	26 Jun 2004 17:48:22 -0000	1.1
+++ subprim.lisp	29 Apr 2005 14:37:40 -0000	1.2
@@ -31,7 +31,7 @@
     (inst xor count count)
     ;; If we are starting with NIL, then it's really easy.
     (inst cmp ptr nil-value)
-    (inst jmp :e done)
+    (inst jmp :e DONE)
     ;; Note: we don't have to test to see whether the original argument is a
     ;; list, because this is a :fast-safe vop.
     LOOP
@@ -40,13 +40,13 @@
     (inst add count (fixnumize 1))
     ;; If we hit NIL, then we are done.
     (inst cmp ptr nil-value)
-    (inst jmp :e done)
+    (inst jmp :e DONE)
     ;; Otherwise, check to see whether we hit the end of a dotted list. If
     ;; not, loop back for more.
     (move eax ptr)
     (inst and al-tn lowtag-mask)
     (inst cmp al-tn list-pointer-lowtag)
-    (inst jmp :e loop)
+    (inst jmp :e LOOP)
     ;; It's dotted all right. Flame out.
     (error-call vop object-not-list-error ptr)
     ;; We be done.
@@ -69,14 +69,14 @@
     (inst xor count count)
     ;; If we are starting with NIL, we be done.
     (inst cmp ptr nil-value)
-    (inst jmp :e done)
+    (inst jmp :e DONE)
     ;; Indirect the next cons cell, and boost the count.
     LOOP
     (loadw ptr ptr cons-cdr-slot list-pointer-lowtag)
     (inst add count (fixnumize 1))
     ;; If we aren't done, go back for more.
     (inst cmp ptr nil-value)
-    (inst jmp :ne loop)
+    (inst jmp :ne LOOP)
     DONE))
 
 (define-static-fun length (object) :translate length)

Index: system.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/system.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- system.lisp	6 Jan 2005 12:48:03 -0000	1.2
+++ system.lisp	29 Apr 2005 14:37:40 -0000	1.3
@@ -35,25 +35,25 @@
     (inst mov rax object)
     (inst and al-tn lowtag-mask)
     (inst cmp al-tn other-pointer-lowtag)
-    (inst jmp :e other-ptr)
+    (inst jmp :e OTHER-PTR)
     (inst cmp al-tn fun-pointer-lowtag)
-    (inst jmp :e function-ptr)
+    (inst jmp :e FUNCTION-PTR)
 
     ;; Pick off structures and list pointers.
     (inst test al-tn 1)
-    (inst jmp :ne done)
+    (inst jmp :ne DONE)
 
     ;; Pick off fixnums.
     (inst and al-tn 7)
-    (inst jmp :e done)
+    (inst jmp :e DONE)
 
     ;; must be an other immediate
     (inst mov rax object)
-    (inst jmp done)
+    (inst jmp DONE)
 
     FUNCTION-PTR
     (load-type al-tn object (- fun-pointer-lowtag))
-    (inst jmp done)
+    (inst jmp DONE)
 
     OTHER-PTR
     (load-type al-tn object (- other-pointer-lowtag))

Index: type-vops.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/type-vops.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- type-vops.lisp	14 Mar 2005 17:39:39 -0000	1.4
+++ type-vops.lisp	29 Apr 2005 14:37:40 -0000	1.5
@@ -199,12 +199,12 @@
     ;; (and (fixnum) (or (no bits set >31) (all bits set >31))
     (move rax-tn value)
     (inst test rax-tn 7)
-    (inst jmp :ne (if not-p target not-target))
+    (inst jmp :ne (if not-p target NOT-TARGET))
     (inst sar rax-tn (+ 32 3 -1))
     (if not-p
 	(progn
-	  (inst jmp :nz maybe)
-	  (inst jmp not-target))
+	  (inst jmp :nz MAYBE)
+	  (inst jmp NOT-TARGET))
 	(inst jmp :z target))
     MAYBE
     (inst cmp rax-tn -1)
@@ -224,7 +224,7 @@
       (inst jmp :z ok)
       (inst cmp rax-tn -1)
       (inst jmp :ne nope)
-      (emit-label OK)
+      (emit-label ok)
       (move result value))))
 
 
@@ -234,7 +234,7 @@
     ;; (and (fixnum) (no bits set >31))
     (move rax-tn value)
     (inst test rax-tn 7)
-    (inst jmp :ne (if not-p target not-target))
+    (inst jmp :ne (if not-p target NOT-TARGET))
     (inst shr rax-tn (+ 32 sb!vm::n-fixnum-tag-bits))
     (inst jmp (if not-p :nz :z) target)
     NOT-TARGET))
@@ -350,7 +350,7 @@
 (define-vop (symbolp type-predicate)
   (:translate symbolp)
   (:generator 12
-    (let ((is-symbol-label (if not-p drop-thru target)))
+    (let ((is-symbol-label (if not-p DROP-THRU target)))
       (inst cmp value nil-value)
       (inst jmp :e is-symbol-label)
       (test-type value target not-p (symbol-header-widetag)))
@@ -360,7 +360,7 @@
   (:generator 12
     (let ((error (generate-error-code vop object-not-symbol-error value)))
       (inst cmp value nil-value)
-      (inst jmp :e drop-thru)
+      (inst jmp :e DROP-THRU)
       (test-type value error t (symbol-header-widetag)))
     DROP-THRU
     (move result value)))
@@ -368,7 +368,7 @@
 (define-vop (consp type-predicate)
   (:translate consp)
   (:generator 8
-    (let ((is-not-cons-label (if not-p target drop-thru)))
+    (let ((is-not-cons-label (if not-p target DROP-THRU)))
       (inst cmp value nil-value)
       (inst jmp :e is-not-cons-label)
       (test-type value target not-p (list-pointer-lowtag)))

Index: values.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/values.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- values.lisp	6 Jan 2005 12:48:03 -0000	1.2
+++ values.lisp	29 Apr 2005 14:37:40 -0000	1.3
@@ -32,12 +32,12 @@
     (inst sub rsi n-word-bytes)
     (inst sub rdi n-word-bytes)
     (inst cmp rsp-tn rsi)
-    (inst jmp :a done)
+    (inst jmp :a DONE)
     (inst std)
     LOOP
     (inst movs :qword)
     (inst cmp rsp-tn rsi)
-    (inst jmp :be loop)
+    (inst jmp :be LOOP)
     DONE
     (inst lea rsp-tn (make-ea :qword :base rdi :disp n-word-bytes))
     (inst sub rdi rsi)
@@ -85,13 +85,13 @@
 
     LOOP
     (inst cmp list nil-temp)
-    (inst jmp :e done)
+    (inst jmp :e DONE)
     (pushw list cons-car-slot list-pointer-lowtag)
     (loadw list list cons-cdr-slot list-pointer-lowtag)
     (inst mov rax list)
     (inst and al-tn lowtag-mask)
     (inst cmp al-tn list-pointer-lowtag)
-    (inst jmp :e loop)
+    (inst jmp :e LOOP)
     (error-call vop bogus-arg-to-values-list-error list)
 
     DONE
@@ -137,7 +137,7 @@
 
     (move temp1 count)
     (inst mov start rsp-tn)
-    (inst jecxz done)  ; check for 0 count?
+    (inst jecxz DONE)  ; check for 0 count?
 
     (inst shr temp1 word-shift) ; convert the fixnum to a count.
 
@@ -145,7 +145,7 @@
     LOOP
     (inst lods temp)
     (inst push temp)
-    (inst loop loop)
+    (inst loop LOOP)
 
     DONE))
Thread View

Thread	Author	Date
[Sbcl-commits] CVS: sbcl/src/compiler/x86-64 arith.lisp,1.12,1.13 call.lisp,1.2,1.3 cell.lisp,1.3,1.4 macros.lisp,1.4,1.5 move.lisp,1.2,1.3 nlx.lisp,1.2,1.3 subprim.lisp,1.1,1.2 system.lisp,1.2,1.3 type-vops.lisp,1.4,1.5 values.lisp,1.2,1.3	Christophe Rhodes <crhodes@us...>