Commit ee93d264 authored by ehuelsmann@1c010e3e-69d0-11dd-93a8-456734b0d56f's avatar ehuelsmann@1c010e3e-69d0-11dd-93a8-456734b0d56f
Browse files

Re #163: Don't macroexpand anything in compiler pass 2; we're completely

macroexpanded by precompilation and pass 1.

Also: Reindenting to save left margin.
parent fa8295a4
......@@ -6881,91 +6881,91 @@ We need more thought here.
(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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment