diff --git a/compiler/hppa/macros.lisp b/compiler/hppa/macros.lisp
index 3d41dabf3b62856018179075c3b40113c157534f..ad0a2dfbb6e05cdcfa6582ac85467b38c0d9bdb7 100644
--- a/compiler/hppa/macros.lisp
+++ b/compiler/hppa/macros.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/hppa/macros.lisp,v 1.1 1992/07/13 03:48:24 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/hppa/macros.lisp,v 1.2 1992/10/13 13:18:20 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -319,84 +319,83 @@
 
 (defmacro define-partial-reffer (name type size signed offset lowtag scs
 				      el-type &optional translate)
-  `(progn
-     (define-vop (,name)
-		 ,@(when translate
-		     `((:translate ,translate)))
-       (:policy :fast-safe)
-       (:args (object :scs (descriptor-reg) :to (:eval 0))
-	      (index :scs (unsigned-reg)))
-       (:arg-types ,type positive-fixnum)
-       (:results (value :scs ,scs))
-       (:result-types ,el-type)
-       (:temporary (:scs (interior-reg)) lip)
-       (:generator 5
-	 (inst ,(ecase size (:byte 'add) (:short 'sh1add))
-	       index object lip)
-	 (inst ,(ecase size (:byte 'ldb) (:short 'ldh))
-	       (- (* ,offset word-bytes) ,lowtag) lip value)
-	 ,@(when signed
-	     `((inst extrs value 31 ,(ecase size (:byte 8) (:short 16))
-		     value)))))
-     (define-vop (,(symbolicate name "-C"))
-		 ,@(when translate
-		     `((:translate ,translate)))
-       (:policy :fast-safe)
-       (:args (object :scs (descriptor-reg)))
-       (:info index)
-       (:arg-types ,type
-		   (:constant (load/store-index ,(ecase size
-						   (:byte 1)
-						   (:short 2))
-						,(eval lowtag)
-						,(eval offset))))
-       (:results (value :scs ,scs))
-       (:result-types ,el-type)
-       (:generator 5
-	 (inst ,(ecase size (:byte 'ldb) (:short 'ldh))
-	       (- (* (+ ,offset index) word-bytes) ,lowtag) object value)
-	 ,@(when signed
-	     `((inst extrs value 31 ,(ecase size (:byte 8) (:short 16))
-		     value)))))))
+  (let ((scale (ecase size (:byte 1) (:short 2))))
+    `(progn
+       (define-vop (,name)
+	 ,@(when translate
+	     `((:translate ,translate)))
+	 (:policy :fast-safe)
+	 (:args (object :scs (descriptor-reg) :to (:eval 0))
+		(index :scs (unsigned-reg)))
+	 (:arg-types ,type positive-fixnum)
+	 (:results (value :scs ,scs))
+	 (:result-types ,el-type)
+	 (:temporary (:scs (interior-reg)) lip)
+	 (:generator 5
+	   (inst ,(ecase size (:byte 'add) (:short 'sh1add))
+		 index object lip)
+	   (inst ,(ecase size (:byte 'ldb) (:short 'ldh))
+		 (- (* ,offset word-bytes) ,lowtag) lip value)
+	   ,@(when signed
+	       `((inst extrs value 31 ,(* scale byte-bits) value)))))
+       (define-vop (,(symbolicate name "-C"))
+	 ,@(when translate
+	     `((:translate ,translate)))
+	 (:policy :fast-safe)
+	 (:args (object :scs (descriptor-reg)))
+	 (:info index)
+	 (:arg-types ,type
+		     (:constant (load/store-index ,scale
+						  ,(eval lowtag)
+						  ,(eval offset))))
+	 (:results (value :scs ,scs))
+	 (:result-types ,el-type)
+	 (:generator 5
+	   (inst ,(ecase size (:byte 'ldb) (:short 'ldh))
+		 (- (+ (* ,offset word-bytes) (* index ,scale)) ,lowtag)
+		 object value)
+	   ,@(when signed
+	       `((inst extrs value 31 ,(* scale byte-bits) value))))))))
 
 (defmacro define-partial-setter (name type size offset lowtag scs el-type
 				      &optional translate)
-  `(progn
-     (define-vop (,name)
-		 ,@(when translate
-		     `((:translate ,translate)))
-       (:policy :fast-safe)
-       (:args (object :scs (descriptor-reg))
-	      (index :scs (unsigned-reg))
-	      (value :scs ,scs :target result))
-       (:arg-types ,type positive-fixnum ,el-type)
-       (:temporary (:scs (interior-reg)) lip)
-       (:results (result :scs ,scs))
-       (:result-types ,el-type)
-       (:generator 5
-	 (inst ,(ecase size (:byte 'add) (:short 'sh1add))
-	       index object lip)
-	 (inst ,(ecase size (:byte 'stb) (:short 'sth))
-	       value (- (* ,offset word-bytes) ,lowtag) lip)
-	 (move value result)))
-     (define-vop (,(symbolicate name "-C"))
-		 ,@(when translate
-		     `((:translate ,translate)))
-       (:policy :fast-safe)
-       (:args (object :scs (descriptor-reg))
-	      (value :scs ,scs :target result))
-       (:info index)
-       (:arg-types ,type
-		   (:constant (load/store-index ,(ecase size
-						   (:byte 1)
-						   (:short 2))
-						,(eval lowtag)
-						,(eval offset)))
-		   ,el-type)
-       (:results (result :scs ,scs))
-       (:result-types ,el-type)
-       (:generator 5
-	 (inst ,(ecase size (:byte 'stb) (:short 'sth))
-	       value (- (* (+ ,offset index) word-bytes) ,lowtag) object)
-	 (move value result)))))
+  (let ((scale (ecase size (:byte 1) (:short 2))))
+    `(progn
+       (define-vop (,name)
+	 ,@(when translate
+	     `((:translate ,translate)))
+	 (:policy :fast-safe)
+	 (:args (object :scs (descriptor-reg))
+		(index :scs (unsigned-reg))
+		(value :scs ,scs :target result))
+	 (:arg-types ,type positive-fixnum ,el-type)
+	 (:temporary (:scs (interior-reg)) lip)
+	 (:results (result :scs ,scs))
+	 (:result-types ,el-type)
+	 (:generator 5
+	   (inst ,(ecase size (:byte 'add) (:short 'sh1add))
+		 index object lip)
+	   (inst ,(ecase size (:byte 'stb) (:short 'sth))
+		 value (- (* ,offset word-bytes) ,lowtag) lip)
+	   (move value result)))
+       (define-vop (,(symbolicate name "-C"))
+	 ,@(when translate
+	     `((:translate ,translate)))
+	 (:policy :fast-safe)
+	 (:args (object :scs (descriptor-reg))
+		(value :scs ,scs :target result))
+	 (:info index)
+	 (:arg-types ,type
+		     (:constant (load/store-index ,scale
+						  ,(eval lowtag)
+						  ,(eval offset)))
+		     ,el-type)
+	 (:results (result :scs ,scs))
+	 (:result-types ,el-type)
+	 (:generator 5
+	   (inst ,(ecase size (:byte 'stb) (:short 'sth))
+		 value
+		 (- (+ (* ,offset word-bytes) (* index ,scale)) ,lowtag)
+		 object)
+	   (move value result))))))