[armedbear-cvs] r12399 - trunk/abcl/src/org/armedbear/lisp

Erik Huelsmann ehuelsmann at common-lisp.net
Sun Jan 24 22:26:31 UTC 2010


Author: ehuelsmann
Date: Sun Jan 24 17:26:29 2010
New Revision: 12399

Log:
Remove debugging cruft.

Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Sun Jan 24 17:26:29 2010
@@ -1844,82 +1844,81 @@
         (setf rest-p rest
               more-keys-p allow-other-keys-p
               keys-p key-p)
-        (when t
-          ;; process required args
-          (emit-push-constant-int (length req))
-          (emit 'anewarray +lisp-closure-parameter-class+)
-          (astore (setf req-params-register (method-max-locals constructor)))
-          (incf (method-max-locals constructor))
-          (do ((i 0 (1+ i))
-               (req req (cdr req)))
-              ((endp req))
-            (aload req-params-register)
-            (emit-push-constant-int i)
-            (emit 'new +lisp-closure-parameter-class+)
-            (emit 'dup)
-            (emit-push-t) ;; we don't need the actual symbol
-            (emit-invokespecial-init +lisp-closure-parameter-class+
-                                     (list +lisp-symbol+))
-            (emit 'aastore)))
-        (when t
-          ;; process optional args
-          (emit-push-constant-int (length opt))
-          (emit 'anewarray +lisp-closure-parameter-class+)
-          (astore (setf opt-params-register (method-max-locals constructor)))
-          (incf (method-max-locals constructor))
-          (do ((i 0 (1+ i))
-               (opt opt (cdr opt)))
-              ((endp opt))
-            (aload opt-params-register)
-            (emit-push-constant-int i)
-            (emit 'new +lisp-closure-parameter-class+)
-            (emit 'dup)
-            (emit-push-t) ;; we don't need the actual variable-symbol
-            (emit-read-from-string (second (car opt))) ;; initform
-            (if (null (third (car opt)))      ;; 
-                (emit-push-nil)
-                (emit-push-t)) ;; we don't need the actual supplied-p symbol
-            (emit 'getstatic +lisp-closure-class+ "OPTIONAL" "I")
-            (emit-invokespecial-init +lisp-closure-parameter-class+
-                                     (list +lisp-symbol+ +lisp-object+
-                                           +lisp-object+ "I"))
-            (emit 'aastore)))
-        (when t
-          ;; process key args
-          (emit-push-constant-int (length key))
-          (emit 'anewarray +lisp-closure-parameter-class+)
-          (astore (setf key-params-register (method-max-locals constructor)))
-          (incf (method-max-locals constructor))
-          (do ((i 0 (1+ i))
-               (key key (cdr key)))
-              ((endp key))
-            (aload key-params-register)
-            (emit-push-constant-int i)
-            (emit 'new +lisp-closure-parameter-class+)
-            (emit 'dup)
-            (let ((keyword (fourth (car key))))
-              (if (keywordp keyword)
-                  (progn
-                    (emit 'ldc (pool-string (symbol-name keyword)))
-                    (emit-invokestatic +lisp-class+ "internKeyword"
-                                       (list +java-string+) +lisp-symbol+))
-                  ;; symbol is not really a keyword; yes, that's allowed!
-                  (progn
-                    (emit 'ldc (pool-string (symbol-name keyword)))
-                    (emit 'ldc (pool-string
-                                (package-name (symbol-package keyword))))
-                    (emit-invokestatic +lisp-class+ "internInPackage"
-                                       (list +java-string+ +java-string+)
-                                       +lisp-symbol+))))
-            (emit-push-t) ;; we don't need the actual variable-symbol
-            (emit-read-from-string (second (car key)))
-            (if (null (third (car key)))
-                (emit-push-nil)
-                (emit-push-t)) ;; we don't need the actual supplied-p symbol
-            (emit-invokespecial-init +lisp-closure-parameter-class+
-                                     (list +lisp-symbol+ +lisp-symbol+
-                                           +lisp-object+ +lisp-object+))
-            (emit 'aastore)))
+        ;; process required args
+        (emit-push-constant-int (length req))
+        (emit 'anewarray +lisp-closure-parameter-class+)
+        (astore (setf req-params-register (method-max-locals constructor)))
+        (incf (method-max-locals constructor))
+        (do ((i 0 (1+ i))
+             (req req (cdr req)))
+            ((endp req))
+          (aload req-params-register)
+          (emit-push-constant-int i)
+          (emit 'new +lisp-closure-parameter-class+)
+          (emit 'dup)
+          (emit-push-t) ;; we don't need the actual symbol
+          (emit-invokespecial-init +lisp-closure-parameter-class+
+                                   (list +lisp-symbol+))
+          (emit 'aastore))
+
+        ;; process optional args
+        (emit-push-constant-int (length opt))
+        (emit 'anewarray +lisp-closure-parameter-class+)
+        (astore (setf opt-params-register (method-max-locals constructor)))
+        (incf (method-max-locals constructor))
+        (do ((i 0 (1+ i))
+             (opt opt (cdr opt)))
+            ((endp opt))
+          (aload opt-params-register)
+          (emit-push-constant-int i)
+          (emit 'new +lisp-closure-parameter-class+)
+          (emit 'dup)
+          (emit-push-t) ;; we don't need the actual variable-symbol
+          (emit-read-from-string (second (car opt))) ;; initform
+          (if (null (third (car opt)))               ;; 
+              (emit-push-nil)
+              (emit-push-t)) ;; we don't need the actual supplied-p symbol
+          (emit 'getstatic +lisp-closure-class+ "OPTIONAL" "I")
+          (emit-invokespecial-init +lisp-closure-parameter-class+
+                                   (list +lisp-symbol+ +lisp-object+
+                                         +lisp-object+ "I"))
+          (emit 'aastore))
+
+        ;; process key args
+        (emit-push-constant-int (length key))
+        (emit 'anewarray +lisp-closure-parameter-class+)
+        (astore (setf key-params-register (method-max-locals constructor)))
+        (incf (method-max-locals constructor))
+        (do ((i 0 (1+ i))
+             (key key (cdr key)))
+            ((endp key))
+          (aload key-params-register)
+          (emit-push-constant-int i)
+          (emit 'new +lisp-closure-parameter-class+)
+          (emit 'dup)
+          (let ((keyword (fourth (car key))))
+            (if (keywordp keyword)
+                (progn
+                  (emit 'ldc (pool-string (symbol-name keyword)))
+                  (emit-invokestatic +lisp-class+ "internKeyword"
+                                     (list +java-string+) +lisp-symbol+))
+                ;; symbol is not really a keyword; yes, that's allowed!
+                (progn
+                  (emit 'ldc (pool-string (symbol-name keyword)))
+                  (emit 'ldc (pool-string
+                              (package-name (symbol-package keyword))))
+                  (emit-invokestatic +lisp-class+ "internInPackage"
+                                     (list +java-string+ +java-string+)
+                                     +lisp-symbol+))))
+          (emit-push-t) ;; we don't need the actual variable-symbol
+          (emit-read-from-string (second (car key)))
+          (if (null (third (car key)))
+              (emit-push-nil)
+              (emit-push-t)) ;; we don't need the actual supplied-p symbol
+          (emit-invokespecial-init +lisp-closure-parameter-class+
+                                   (list +lisp-symbol+ +lisp-symbol+
+                                         +lisp-object+ +lisp-object+))
+          (emit 'aastore))
 
         ))
     (aload 0) ;; this




More information about the armedbear-cvs mailing list