[armedbear-cvs] r12882 - branches/generic-class-file/abcl/src/org/armedbear/lisp
Erik Huelsmann
ehuelsmann at common-lisp.net
Mon Aug 9 12:23:21 UTC 2010
Author: ehuelsmann
Date: Mon Aug 9 08:23:20 2010
New Revision: 12882
Log:
Move the u2, s1 and s2 helper functions to jvm.lisp.
Modified:
branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm.lisp
Modified: branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (original)
+++ branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp Mon Aug 9 08:23:20 2010
@@ -79,36 +79,6 @@
(defun pool-double (double)
(pool-add-double *pool* double))
-(defknown u2 (fixnum) cons)
-(defun u2 (n)
- (declare (optimize speed))
- (declare (type (unsigned-byte 16) n))
- (when (not (<= 0 n 65535))
- (error "u2 argument ~A out of 65k range." n))
- (list (logand (ash n -8) #xff)
- (logand n #xff)))
-
-(defknown s1 (fixnum) fixnum)
-(defun s1 (n)
- (declare (optimize speed))
- (declare (type (signed-byte 8) n))
- (when (not (<= -128 n 127))
- (error "s2 argument ~A out of 16-bit signed range." n))
- (if (< n 0)
- (1+ (logxor (- n) #xFF))
- n))
-
-
-(defknown s2 (fixnum) cons)
-(defun s2 (n)
- (declare (optimize speed))
- (declare (type (signed-byte 16) n))
- (when (not (<= -32768 n 32767))
- (error "s2 argument ~A out of 16-bit signed range." n))
- (u2 (if (< n 0) (1+ (logxor (- n) #xFFFF))
- n)))
-
-
(defun add-exception-handler (start end handler type)
(if (null *current-code-attribute*)
(push (make-handler :from start
Modified: branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm.lisp
==============================================================================
--- branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm.lisp (original)
+++ branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm.lisp Mon Aug 9 08:23:20 2010
@@ -62,6 +62,40 @@
(defmacro dformat (&rest ignored)
(declare (ignore ignored)))
+(declaim (inline u2 s1 s2))
+
+(defknown u2 (fixnum) cons)
+(defun u2 (n)
+ (declare (optimize speed))
+ (declare (type (unsigned-byte 16) n))
+ (when (not (<= 0 n 65535))
+ (error "u2 argument ~A out of 65k range." n))
+ (list (logand (ash n -8) #xff)
+ (logand n #xff)))
+
+(defknown s1 (fixnum) fixnum)
+(defun s1 (n)
+ (declare (optimize speed))
+ (declare (type (signed-byte 8) n))
+ (when (not (<= -128 n 127))
+ (error "s2 argument ~A out of 16-bit signed range." n))
+ (if (< n 0)
+ (1+ (logxor (- n) #xFF))
+ n))
+
+
+(defknown s2 (fixnum) cons)
+(defun s2 (n)
+ (declare (optimize speed))
+ (declare (type (signed-byte 16) n))
+ (when (not (<= -32768 n 32767))
+ (error "s2 argument ~A out of 16-bit signed range." n))
+ (u2 (if (< n 0) (1+ (logxor (- n) #xFFFF))
+ n)))
+
+
+
+
(defmacro with-saved-compiler-policy (&body body)
"Saves compiler policy variables, restoring them after evaluating `body'."
More information about the armedbear-cvs
mailing list