Changeset 13523 for trunk/abcl/src/org
 Timestamp:
 08/21/11 12:54:20 (10 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/abcl/src/org/armedbear/lisp/compilerpass2.lisp
r13520 r13523 6882 6882 (defknown compileform (t t t) t) 6883 6883 (defun compileform (form target representation) 6884 (cond ((consp form)6885 (let* ((op (%car form))6886 (handler (and (symbolp op) (get op 'p2handler))))6887 (cond (handler6888 (funcall handler form target representation))6889 ((symbolp op)6890 (cond ((macrofunction op *compilefileenvironment*)6891 (compileform (macroexpand form *compilefileenvironment*)6892 target representation))6893 6894 6895 6896 6897 6898 6899 6900 6901 6902 6903 6904 6905 6906 (cond ((null form)6907 (emitpushfalse representation)6908 (emitmovefromstack target representation))6909 ((eq form t)6910 (emitpushtrue representation)6911 (emitmovefromstack target representation))6912 ((keywordp form)6913 (ecase representation6914 (:boolean6915 (emit 'iconst_1))6916 ((nil)6917 (emitloadexternalizedobject form)))6918 (emitmovefromstack target representation))6919 (t6920 ;; Shouldn't happen.6921 (aver nil))))6922 ( (varrefp form)6923 (compilevarref form target representation))6924 ((nodep form)6925 (cond6926 ((jumpnodep form)6927 (let ((op (car (nodeform form))))6928 (cond6929 ((eq op 'go)6930 (p2go form target representation))6931 ((eq op 'returnfrom)6932 (p2returnfrom form target representation))6933 (t6934 (assert (not "jumpnode: can't happen"))))))6935 ((blocknodep form)6936 (p2blocknode form target representation))6937 ((let/let*nodep form)6938 (p2let/let*node form target representation))6939 ((tagbodynodep form)6940 (p2tagbodynode form target)6941 (fixboxing representation nil))6942 ((unwindprotectnodep form)6943 (p2unwindprotectnode form target)6944 (fixboxing representation nil))6945 ((mvbnodep form)6946 (p2mvbnode form target)6947 (fixboxing representation nil))6948 ((fletnodep form)6949 (p2fletnode form target representation))6950 ((labelsnodep form)6951 (p2labelsnode form target representation))6952 ((locallynodep form)6953 (p2locallynode form target representation))6954 ((catchnodep form)6955 (p2catchnode form target)6956 (fixboxing representation nil))6957 ((progvnodep form)6958 (p2progvnode form target representation))6959 ((synchronizednodep form)6960 (p2threadssynchronizedon form target)6961 (fixboxing representation nil))6962 (t6963 (aver (not "Can't happen")))6964 ))6965 6966 6967 6968 6884 (cond 6885 ((consp form) 6886 (let* ((op (%car form)) 6887 (handler (and (symbolp op) (get op 'p2handler)))) 6888 (cond 6889 (handler 6890 (funcall handler form target representation)) 6891 ((symbolp op) 6892 (cond 6893 ((specialoperatorp op) 6894 (dformat t "form = ~S~%" form) 6895 (compilerunsupported 6896 "COMPILEFORM: unsupported special operator ~S" op)) 6897 (t 6898 (compilefunctioncall form target representation)))) 6899 ((and (consp op) (eq (%car op) 'LAMBDA)) 6900 (aver (progn 'unexpectedlambda nil)) 6901 (let ((newform (list* 'FUNCALL form))) 6902 (compileform newform target representation))) 6903 (t 6904 (compilerunsupported "COMPILEFORM unhandled case ~S" form))))) 6905 ((symbolp form) 6906 (cond 6907 ((null form) 6908 (emitpushfalse representation) 6909 (emitmovefromstack target representation)) 6910 ((eq form t) 6911 (emitpushtrue representation) 6912 (emitmovefromstack target representation)) 6913 ((keywordp form) 6914 (ecase representation 6915 (:boolean 6916 (emit 'iconst_1)) 6917 ((nil) 6918 (emitloadexternalizedobject form))) 6919 (emitmovefromstack target representation)) 6920 (t 6921 ;; Shouldn't happen. 6922 (aver nil)))) 6923 ((varrefp form) 6924 (compilevarref form target representation)) 6925 ((nodep form) 6926 (cond 6927 ((jumpnodep form) 6928 (let ((op (car (nodeform form)))) 6929 (cond 6930 ((eq op 'go) 6931 (p2go form target representation)) 6932 ((eq op 'returnfrom) 6933 (p2returnfrom form target representation)) 6934 (t 6935 (assert (not "jumpnode: can't happen")))))) 6936 ((blocknodep form) 6937 (p2blocknode form target representation)) 6938 ((let/let*nodep form) 6939 (p2let/let*node form target representation)) 6940 ((tagbodynodep form) 6941 (p2tagbodynode form target) 6942 (fixboxing representation nil)) 6943 ((unwindprotectnodep form) 6944 (p2unwindprotectnode form target) 6945 (fixboxing representation nil)) 6946 ((mvbnodep form) 6947 (p2mvbnode form target) 6948 (fixboxing representation nil)) 6949 ((fletnodep form) 6950 (p2fletnode form target representation)) 6951 ((labelsnodep form) 6952 (p2labelsnode form target representation)) 6953 ((locallynodep form) 6954 (p2locallynode form target representation)) 6955 ((catchnodep form) 6956 (p2catchnode form target) 6957 (fixboxing representation nil)) 6958 ((progvnodep form) 6959 (p2progvnode form target representation)) 6960 ((synchronizednodep form) 6961 (p2threadssynchronizedon form target) 6962 (fixboxing representation nil)) 6963 (t 6964 (aver (not "Can't happen"))))) 6965 ((constantp form) 6966 (compileconstant form target representation)) 6967 (t 6968 (compilerunsupported "COMPILEFORM unhandled case ~S" form))) 6969 6969 t) 6970 6970
Note: See TracChangeset
for help on using the changeset viewer.