[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