[armedbear-cvs] r13523 - trunk/abcl/src/org/armedbear/lisp
ehuelsmann at common-lisp.net
ehuelsmann at common-lisp.net
Sun Aug 21 12:54:21 UTC 2011
Author: ehuelsmann
Date: Sun Aug 21 05:54:20 2011
New Revision: 13523
Log:
Reindenting to save left margin.
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 Sun Aug 21 02:10:43 2011 (r13522)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp Sun Aug 21 05:54:20 2011 (r13523)
@@ -6881,91 +6881,91 @@
(defknown compile-form (t t t) t)
(defun compile-form (form target representation)
- (cond ((consp form)
- (let* ((op (%car form))
- (handler (and (symbolp op) (get op 'p2-handler))))
- (cond (handler
- (funcall handler form target representation))
- ((symbolp op)
- (cond ((macro-function op *compile-file-environment*)
- (compile-form (macroexpand form *compile-file-environment*)
- target representation))
- ((special-operator-p op)
- (dformat t "form = ~S~%" form)
- (compiler-unsupported
- "COMPILE-FORM: unsupported special operator ~S" op))
- (t
- (compile-function-call form target representation))))
- ((and (consp op) (eq (%car op) 'LAMBDA))
- (aver (progn 'unexpected-lambda nil))
- (let ((new-form (list* 'FUNCALL form)))
- (compile-form new-form target representation)))
- (t
- (compiler-unsupported "COMPILE-FORM unhandled case ~S" form)))))
- ((symbolp form)
- (cond ((null form)
- (emit-push-false representation)
- (emit-move-from-stack target representation))
- ((eq form t)
- (emit-push-true representation)
- (emit-move-from-stack target representation))
- ((keywordp form)
- (ecase representation
- (:boolean
- (emit 'iconst_1))
- ((nil)
- (emit-load-externalized-object form)))
- (emit-move-from-stack target representation))
- (t
- ;; Shouldn't happen.
- (aver nil))))
- ((var-ref-p form)
- (compile-var-ref form target representation))
- ((node-p form)
- (cond
- ((jump-node-p form)
- (let ((op (car (node-form form))))
- (cond
- ((eq op 'go)
- (p2-go form target representation))
- ((eq op 'return-from)
- (p2-return-from form target representation))
- (t
- (assert (not "jump-node: can't happen"))))))
- ((block-node-p form)
- (p2-block-node form target representation))
- ((let/let*-node-p form)
- (p2-let/let*-node form target representation))
- ((tagbody-node-p form)
- (p2-tagbody-node form target)
- (fix-boxing representation nil))
- ((unwind-protect-node-p form)
- (p2-unwind-protect-node form target)
- (fix-boxing representation nil))
- ((m-v-b-node-p form)
- (p2-m-v-b-node form target)
- (fix-boxing representation nil))
- ((flet-node-p form)
- (p2-flet-node form target representation))
- ((labels-node-p form)
- (p2-labels-node form target representation))
- ((locally-node-p form)
- (p2-locally-node form target representation))
- ((catch-node-p form)
- (p2-catch-node form target)
- (fix-boxing representation nil))
- ((progv-node-p form)
- (p2-progv-node form target representation))
- ((synchronized-node-p form)
- (p2-threads-synchronized-on form target)
- (fix-boxing representation nil))
- (t
- (aver (not "Can't happen")))
-))
- ((constantp form)
- (compile-constant form target representation))
- (t
- (compiler-unsupported "COMPILE-FORM unhandled case ~S" form)))
+ (cond
+ ((consp form)
+ (let* ((op (%car form))
+ (handler (and (symbolp op) (get op 'p2-handler))))
+ (cond
+ (handler
+ (funcall handler form target representation))
+ ((symbolp op)
+ (cond
+ ((special-operator-p op)
+ (dformat t "form = ~S~%" form)
+ (compiler-unsupported
+ "COMPILE-FORM: unsupported special operator ~S" op))
+ (t
+ (compile-function-call form target representation))))
+ ((and (consp op) (eq (%car op) 'LAMBDA))
+ (aver (progn 'unexpected-lambda nil))
+ (let ((new-form (list* 'FUNCALL form)))
+ (compile-form new-form target representation)))
+ (t
+ (compiler-unsupported "COMPILE-FORM unhandled case ~S" form)))))
+ ((symbolp form)
+ (cond
+ ((null form)
+ (emit-push-false representation)
+ (emit-move-from-stack target representation))
+ ((eq form t)
+ (emit-push-true representation)
+ (emit-move-from-stack target representation))
+ ((keywordp form)
+ (ecase representation
+ (:boolean
+ (emit 'iconst_1))
+ ((nil)
+ (emit-load-externalized-object form)))
+ (emit-move-from-stack target representation))
+ (t
+ ;; Shouldn't happen.
+ (aver nil))))
+ ((var-ref-p form)
+ (compile-var-ref form target representation))
+ ((node-p form)
+ (cond
+ ((jump-node-p form)
+ (let ((op (car (node-form form))))
+ (cond
+ ((eq op 'go)
+ (p2-go form target representation))
+ ((eq op 'return-from)
+ (p2-return-from form target representation))
+ (t
+ (assert (not "jump-node: can't happen"))))))
+ ((block-node-p form)
+ (p2-block-node form target representation))
+ ((let/let*-node-p form)
+ (p2-let/let*-node form target representation))
+ ((tagbody-node-p form)
+ (p2-tagbody-node form target)
+ (fix-boxing representation nil))
+ ((unwind-protect-node-p form)
+ (p2-unwind-protect-node form target)
+ (fix-boxing representation nil))
+ ((m-v-b-node-p form)
+ (p2-m-v-b-node form target)
+ (fix-boxing representation nil))
+ ((flet-node-p form)
+ (p2-flet-node form target representation))
+ ((labels-node-p form)
+ (p2-labels-node form target representation))
+ ((locally-node-p form)
+ (p2-locally-node form target representation))
+ ((catch-node-p form)
+ (p2-catch-node form target)
+ (fix-boxing representation nil))
+ ((progv-node-p form)
+ (p2-progv-node form target representation))
+ ((synchronized-node-p form)
+ (p2-threads-synchronized-on form target)
+ (fix-boxing representation nil))
+ (t
+ (aver (not "Can't happen")))))
+ ((constantp form)
+ (compile-constant form target representation))
+ (t
+ (compiler-unsupported "COMPILE-FORM unhandled case ~S" form)))
t)
More information about the armedbear-cvs
mailing list