6957 | | (cond ((consp form) |
6958 | | (let* ((op (%car form)) |
6959 | | (handler (and (symbolp op) (get op 'p2-handler)))) |
6960 | | (cond (handler |
6961 | | (funcall handler form target representation)) |
6962 | | ((symbolp op) |
6963 | | (cond ((macro-function op *compile-file-environment*) |
6964 | | (compile-form (macroexpand form *compile-file-environment*) |
6965 | | target representation)) |
6966 | | ((special-operator-p op) |
6967 | | (dformat t "form = ~S~%" form) |
6968 | | (compiler-unsupported |
6969 | | "COMPILE-FORM: unsupported special operator ~S" op)) |
6970 | | (t |
6971 | | (compile-function-call form target representation)))) |
6972 | | ((and (consp op) (eq (%car op) 'LAMBDA)) |
6973 | | (aver (progn 'unexpected-lambda nil)) |
6974 | | (let ((new-form (list* 'FUNCALL form))) |
6975 | | (compile-form new-form target representation))) |
| 6971 | (let ((outer-block-restores *outer-block-restores-environment*) |
| 6972 | (*outer-block-restores-environment* nil)) |
| 6973 | (cond ((consp form) |
| 6974 | (let* ((op (%car form)) |
| 6975 | (handler (and (symbolp op) (get op 'p2-handler)))) |
| 6976 | (cond (handler |
| 6977 | (funcall handler form target representation)) |
| 6978 | ((symbolp op) |
| 6979 | (cond ((macro-function op *compile-file-environment*) |
| 6980 | (compile-form (macroexpand form *compile-file-environment*) |
| 6981 | target representation)) |
| 6982 | ((special-operator-p op) |
| 6983 | (dformat t "form = ~S~%" form) |
| 6984 | (compiler-unsupported |
| 6985 | "COMPILE-FORM: unsupported special operator ~S" op)) |
| 6986 | (t |
| 6987 | (compile-function-call form target representation)))) |
| 6988 | ((and (consp op) (eq (%car op) 'LAMBDA)) |
| 6989 | (aver (progn 'unexpected-lambda nil)) |
| 6990 | (let ((new-form (list* 'FUNCALL form))) |
| 6991 | (compile-form new-form target representation))) |
| 6992 | (t |
| 6993 | (compiler-unsupported "COMPILE-FORM unhandled case ~S" form))))) |
| 6994 | ((symbolp form) |
| 6995 | (cond ((null form) |
| 6996 | (emit-push-false representation) |
| 6997 | (emit-move-from-stack target representation)) |
| 6998 | ((eq form t) |
| 6999 | (emit-push-true representation) |
| 7000 | (emit-move-from-stack target representation)) |
| 7001 | ((keywordp form) |
| 7002 | (ecase representation |
| 7003 | (:boolean |
| 7004 | (emit 'iconst_1)) |
| 7005 | ((nil) |
| 7006 | (emit-load-externalized-object form))) |
| 7007 | (emit-move-from-stack target representation)) |
6977 | | (compiler-unsupported "COMPILE-FORM unhandled case ~S" form))))) |
6978 | | ((symbolp form) |
6979 | | (cond ((null form) |
6980 | | (emit-push-false representation) |
6981 | | (emit-move-from-stack target representation)) |
6982 | | ((eq form t) |
6983 | | (emit-push-true representation) |
6984 | | (emit-move-from-stack target representation)) |
6985 | | ((keywordp form) |
6986 | | (ecase representation |
6987 | | (:boolean |
6988 | | (emit 'iconst_1)) |
6989 | | ((nil) |
6990 | | (emit-load-externalized-object form))) |
6991 | | (emit-move-from-stack target representation)) |
6992 | | (t |
6993 | | ;; Shouldn't happen. |
6994 | | (aver nil)))) |
6995 | | ((var-ref-p form) |
6996 | | (compile-var-ref form target representation)) |
6997 | | ((node-p form) |
6998 | | (cond |
6999 | | ((jump-node-p form) |
7000 | | (let ((op (car (node-form form)))) |
7001 | | (cond |
7002 | | ((eq op 'go) |
7003 | | (p2-go form target representation)) |
7004 | | ((eq op 'return-from) |
7005 | | (p2-return-from form target representation)) |
7006 | | (t |
7007 | | (assert (not "jump-node: can't happen")))))) |
7008 | | ((block-node-p form) |
7009 | | (p2-block-node form target representation)) |
7010 | | ((let/let*-node-p form) |
7011 | | (p2-let/let*-node form target representation)) |
7012 | | ((tagbody-node-p form) |
7013 | | (p2-tagbody-node form target) |
7014 | | (fix-boxing representation nil)) |
7015 | | ((unwind-protect-node-p form) |
7016 | | (p2-unwind-protect-node form target) |
7017 | | (fix-boxing representation nil)) |
7018 | | ((m-v-b-node-p form) |
7019 | | (p2-m-v-b-node form target) |
7020 | | (fix-boxing representation nil)) |
7021 | | ((flet-node-p form) |
7022 | | (p2-flet-node form target representation)) |
7023 | | ((labels-node-p form) |
7024 | | (p2-labels-node form target representation)) |
7025 | | ((locally-node-p form) |
7026 | | (p2-locally-node form target representation)) |
7027 | | ((catch-node-p form) |
7028 | | (p2-catch-node form target) |
7029 | | (fix-boxing representation nil)) |
7030 | | ((progv-node-p form) |
7031 | | (p2-progv-node form target representation)) |
7032 | | ((synchronized-node-p form) |
7033 | | (p2-threads-synchronized-on form target) |
7034 | | (fix-boxing representation nil)) |
7035 | | (t |
7036 | | (aver (not "Can't happen"))) |
7037 | | )) |
7038 | | ((constantp form) |
7039 | | (compile-constant form target representation)) |
7040 | | (t |
7041 | | (compiler-unsupported "COMPILE-FORM unhandled case ~S" form))) |
| 7009 | ;; Shouldn't happen. |
| 7010 | (aver nil)))) |
| 7011 | ((var-ref-p form) |
| 7012 | (compile-var-ref form target representation)) |
| 7013 | ((node-p form) |
| 7014 | (cond |
| 7015 | ((jump-node-p form) |
| 7016 | (let ((op (car (node-form form)))) |
| 7017 | (cond |
| 7018 | ((eq op 'go) |
| 7019 | (p2-go form target representation)) |
| 7020 | ((eq op 'return-from) |
| 7021 | (p2-return-from form target representation)) |
| 7022 | (t |
| 7023 | (assert (not "jump-node: can't happen")))))) |
| 7024 | ((block-node-p form) |
| 7025 | (p2-block-node form target representation)) |
| 7026 | ((let/let*-node-p form) |
| 7027 | (setq *outer-block-restores-environment* outer-block-restores) |
| 7028 | (p2-let/let*-node form target representation)) |
| 7029 | ((tagbody-node-p form) |
| 7030 | (p2-tagbody-node form target) |
| 7031 | (fix-boxing representation nil)) |
| 7032 | ((unwind-protect-node-p form) |
| 7033 | (p2-unwind-protect-node form target) |
| 7034 | (fix-boxing representation nil)) |
| 7035 | ((m-v-b-node-p form) |
| 7036 | (setq *outer-block-restores-environment* outer-block-restores) |
| 7037 | (p2-m-v-b-node form target) |
| 7038 | (fix-boxing representation nil)) |
| 7039 | ((flet-node-p form) |
| 7040 | (p2-flet-node form target representation)) |
| 7041 | ((labels-node-p form) |
| 7042 | (p2-labels-node form target representation)) |
| 7043 | ((locally-node-p form) |
| 7044 | (p2-locally-node form target representation)) |
| 7045 | ((catch-node-p form) |
| 7046 | (p2-catch-node form target) |
| 7047 | (fix-boxing representation nil)) |
| 7048 | ((progv-node-p form) |
| 7049 | (setq *outer-block-restores-environment* outer-block-restores) |
| 7050 | (p2-progv-node form target representation)) |
| 7051 | ((synchronized-node-p form) |
| 7052 | (p2-threads-synchronized-on form target) |
| 7053 | (fix-boxing representation nil)) |
| 7054 | (t |
| 7055 | (aver (not "Can't happen"))) |
| 7056 | )) |
| 7057 | ((constantp form) |
| 7058 | (compile-constant form target representation)) |
| 7059 | (t |
| 7060 | (compiler-unsupported "COMPILE-FORM unhandled case ~S" form)))) |