[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