Changeset 15903
 Timestamp:
 Sep 19, 2013, 3:04:49 PM (8 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

branches/acoderewrite/source/compiler/ARM/arm2.lisp
r15898 r15903 328 328 329 329 (defun acodeconditiontoarmcrbit (cond) 330 (conditiontoarmcrbit (ca dr cond)))330 (conditiontoarmcrbit (car (acodeoperands cond)))) 331 331 332 332 (defun conditiontoarmcrbit (cond) … … 1074 1074 (defun arm2toplevelform (seg vreg xfer form) 1075 1075 (let* ((codenote (acodenote form)) 1076 (args (if codenote `(,@( %cdr form) ,codenote) (%cdrform))))1076 (args (if codenote `(,@(acodeoperands form) ,codenote) (acodeoperands form)))) 1077 1077 (apply (arm2acodeoperatorfunction form) seg vreg xfer args))) 1078 1078 … … 1088 1088 (%ilogbitp operatoracodesubformsbit op) 1089 1089 (%ilogbitp operatorassignmentfreebit op)) 1090 (dolist (f ( %cdrform) (arm2branch seg xfer nil))1090 (dolist (f (acodeoperands form) (arm2branch seg xfer nil)) 1091 1091 (arm2form seg nil nil f )) 1092 (apply fn seg vreg xfer ( %cdrform))))))))1092 (apply fn seg vreg xfer (acodeoperands form)))))))) 1093 1093 1094 1094 ;;; dest is a float reg  form is acode … … 1102 1102 (setnoderegspectypemodes freg hardregclassfprtypedouble)) 1103 1103 (let* ((fn (arm2acodeoperatorfunction form))) 1104 (apply fn seg freg nil ( %cdrform)))))1104 (apply fn seg freg nil (acodeoperands form))))) 1105 1105 1106 1106 … … 1392 1392 (while (and (acodep form) (or (eq (acodeoperator form) (%nx1operator progn)) 1393 1393 (eq (acodeoperator form) (%nx1operator localtagbody)))) 1394 (setq form (caa dr form)))1394 (setq form (caar (acodeoperands form)))) 1395 1395 (when (acodep form) 1396 1396 (let ((op (acodeoperator form))) 1397 1397 (if (and (eq op (%nx1operator localgo)) 1398 (arm2equalencodingsp (%caddr ( %cadr form)) currentstack))1399 (%cadr ( %cadr form))1398 (arm2equalencodingsp (%caddr (car (acodeoperands form))) currentstack)) 1399 (%cadr (car (acodeoperands form))) 1400 1400 (if (and (eq op (%nx1operator localreturnfrom)) 1401 (nxnull (cad dr form)))1402 (let ((tagdata (car (ca dr form))))1401 (nxnull (cadr (acodeoperands form)))) 1402 (let ((tagdata (car (car (acodeoperands form))))) 1403 1403 (and (arm2equalencodingsp (cdr tagdata) currentstack) 1404 1404 (null (caar tagdata)) … … 1414 1414 (or (%ilogbitp operatorsinglevaluedbit op) 1415 1415 (and (eql op (%nx1operator values)) 1416 (let ((values (ca dr form)))1416 (let ((values (car (acodeoperands form)))) 1417 1417 (and values (null (cdr values))))) 1418 1418 nil ; Learn about functions someday … … 1985 1985 (or (eq (acodeoperator form) (%nx1operator immediate)) 1986 1986 (eq (acodeoperator form) (%nx1operator fixnum)))) 1987 (let* ((val ( %cadr form))1987 (let* ((val (car (acodeoperands form))) 1988 1988 (typep (cond ((eq typekeyword :signed32bitvector) 1989 1989 (typep val '(signedbyte 32))) … … 2460 2460 (acodep fn) 2461 2461 (eq (acodeoperator fn) (%nx1operator immediate)) 2462 (symbolp (ca dr fn)))2463 (setq fn (arm2tailcallalias fn ( %cadr fn) arglist)))2462 (symbolp (car (acodeoperands fn)))) 2463 (setq fn (arm2tailcallalias fn (car (acodeoperands fn)) arglist))) 2464 2464 2465 2465 (if (and (eq xfer $backendreturn) (not (arm2tailcallok xfer))) … … 2518 2518 (witharmlocalvinsnmacros (seg) 2519 2519 (let* ((fop (acodeunwrappedformvalue fn)) 2520 (immp (and ( consp fop)2521 (eq ( %car fop) (%nx1operator immediate))))2522 (symp (and immp (symbolp ( %cadr fop))))2520 (immp (and (acodep fop) 2521 (eq (acodeoperator fop) (%nx1operator immediate)))) 2522 (symp (and immp (symbolp (car (acodeoperands fop))))) 2523 2523 (labelp (and (fixnump fn) 2524 2524 (locally (declare (fixnum fn)) 2525 2525 (and (= fn 1) ( fn))))) 2526 2526 (tailp (eq xfer $backendreturn)) 2527 (func (if ( consp fop) (%cadr fop)))2527 (func (if (acodep fop) (car (acodeoperands fop)))) 2528 2528 (areg nil) 2529 2529 (lfunp (and (acodep fop) … … 2768 2768 (setq f (acodeunwrappedformvalue f)) 2769 2769 (and (acodep f) 2770 (or (eq ( %car f) (%nx1operator immediate))2771 (eq ( %car f) (%nx1operator simplefunction)))))2770 (or (eq (acodeoperator f) (%nx1operator immediate)) 2771 (eq (acodeoperator f) (%nx1operator simplefunction))))) 2772 2772 2773 2773 (defun armconstantformp (form) … … 2776 2776 (or (nxnull form) 2777 2777 (nxt form) 2778 (and ( consp form)2778 (and (acodep form) 2779 2779 (or (eq (acodeoperator form) (%nx1operator immediate)) 2780 2780 (eq (acodeoperator form) (%nx1operator fixnum)) … … 2788 2788 (and (acodep form) 2789 2789 (eq (acodeoperator form) (%nx1operator immediate)) 2790 (setq form ( %cadr form))2790 (setq form (car (acodeoperands form))) 2791 2791 (if (typep form 'integer) 2792 2792 form))))) … … 2799 2799 ;(eq (acodeoperator form) (%nx1operator boundspecialref)) 2800 2800 (if (eq (acodeoperator form) (%nx1operator lexicalreference)) 2801 (not (%ilogbitp $vbitsetq (nxvarbits ( %cadr form))))))))2801 (not (%ilogbitp $vbitsetq (nxvarbits (car (acodeoperands form))))))))) 2802 2802 2803 2803 (defun arm2formlist (seg stkargs &optional revregargs) … … 3736 3736 (when (acodep (setq form (acodeunwrappedformvalue form))) 3737 3737 (if (eq (acodeoperator form) (%nx1operator lexicalreference)) 3738 (let* ((addr (varea ( %cadr form))))3738 (let* ((addr (varea (car (acodeoperands form))))) 3739 3739 (if (typep addr 'lreg) 3740 3740 addr … … 3956 3956 (withnote (form seg curstack) ; note this rebinds form/seg/curstack so can't setq 3957 3957 (witharmlocalvinsnmacros (seg) 3958 (let* ((op (acodeoperator form))) 3958 (let* ((op (acodeoperator form)) 3959 (operands (acodeoperands form))) 3959 3960 (cond ((eq op (%nx1operator list)) 3960 3961 (let* ((*arm2vstack* *arm2vstack*) 3961 3962 (*arm2topvstacklcell* *arm2topvstacklcell*)) 3962 (arm2setnargs seg (arm2formlist seg ( %cadr form) nil))3963 (arm2setnargs seg (arm2formlist seg (car operands) nil)) 3963 3964 (arm2openundo $undostkblk curstack) 3964 3965 (! stackconslist)) 3965 3966 (setq val arm::arg_z)) 3966 3967 ((eq op (%nx1operator list*)) 3967 (let* ((arglist ( %cadr form)))3968 (let* ((arglist (car operands))) 3968 3969 (let* ((*arm2vstack* *arm2vstack*) 3969 3970 (*arm2topvstacklcell* *arm2topvstacklcell*)) … … 3975 3976 (setq val arm::arg_z))) 3976 3977 ((eq op (%nx1operator multiplevaluelist)) 3977 (arm2multiplevaluebody seg ( %cadr form))3978 (arm2multiplevaluebody seg (car operands)) 3978 3979 (arm2openundo $undostkblk curstack) 3979 3980 (! stackconslist) … … 3983 3984 (z ($ arm::arg_z)) 3984 3985 (result ($ arm::arg_z))) 3985 (arm2twotargetedregforms seg ( %cadr form) y (%caddr form) z)3986 (arm2twotargetedregforms seg (car operands) y (cadr operands) z) 3986 3987 (arm2openundo $undostkblk ) 3987 3988 (! makestackcons result y z) … … 3995 3996 (setq val node)))) 3996 3997 ((eq op (%nx1operator %newptr)) 3997 (let* ((clearform (cad dr form))3998 (let* ((clearform (cadr operands)) 3998 3999 (cval (nx2constantformvalue clearform))) 3999 4000 (if cval 4000 4001 (progn 4001 (arm2onetargetedregform seg ( %cadr form) ($ arm::arg_z))4002 (arm2onetargetedregform seg (car operands) ($ arm::arg_z)) 4002 4003 (if (nxnull cval) 4003 4004 (! makestackblock) … … 4008 4009 (rval ($ arm::arg_z)) 4009 4010 (rclear ($ arm::arg_y))) 4010 (arm2twotargetedregforms seg ( %cadr form) rval clearform rclear)4011 (arm2twotargetedregforms seg (car operands) rval clearform rclear) 4011 4012 (! comparetonil crf rclear) 4012 4013 (! cbranchfalse (aref *backendlabels* stackblock0label) crf arm::armcondeq) … … 4026 4027 (let* ((*arm2vstack* *arm2vstack*) 4027 4028 (*arm2topvstacklcell* *arm2topvstacklcell*)) 4028 (arm2setnargs seg (arm2formlist seg ( %cadr form) nil))4029 (arm2setnargs seg (arm2formlist seg (car operands) nil)) 4029 4030 (! makestackvector)) 4030 4031 (arm2openundo $undostkblk) … … 4039 4040 (setq val arm::arg_z)) 4040 4041 ((eq op (%nx1operator closedfunction)) 4041 (setq val (arm2makeclosure seg (ca dr form) t))) ; can't error4042 (setq val (arm2makeclosure seg (car operands) t))) ; can't error 4042 4043 ((eq op (%nx1operator %makeuvector)) 4043 (destructuringbind (elementcount subtag &optional (init 0 initp)) (%cdr form)4044 (destructuringbind (elementcount subtag &optional (init 0 initp)) operands 4044 4045 (if initp 4045 4046 (progn … … 4052 4053 (setq val ($ arm::arg_z))))))))) 4053 4054 val) 4054 4055 ;;; this far 4055 4056 (defun arm2addrspectoreg (seg addrspec reg) 4056 4057 (if (memoryspecp addrspec)
Note: See TracChangeset
for help on using the changeset viewer.