Ignore:
Timestamp:
May 27, 2010, 11:50:14 PM (9 years ago)
Author:
gb
Message:

Keep moving forward. Can -almost- compile simple functions.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/arm/compiler/ARM/arm2.lisp

    r13714 r13741  
    503503      (setf (uvref function (1+ 2)) (aref imms i)))
    504504    (setf (uvref function (+ numimms 1)) bits)
    505     (let* ((maxpc (arm-lap-encode-regsave-info (arm-lap-do-labels)))
    506            (code-vector-size (+ traceback-size (ash maxpc -2) prefix-size)))
    507       (let* ((code-vector (%alloc-misc code-vector-size
     505    (let* ((code-vector-size (arm::arm-finalize code data))
     506           (code-vector (%alloc-misc code-vector-size
    508507                                     (if cross-compiling
    509508                                       target::subtag-xcode-vector
    510509                                       target::subtag-code-vector)))
    511              (j 0))
    512         (dotimes (i prefix-size)
    513           (setf (uvref code-vector i) (pop prefix)))
    514         (arm-lap-resolve-labels)
    515         (do-dll-nodes (insn *lap-instructions*)
    516           (arm-lap-generate-instruction code-vector i insn)
    517           (incf i))
    518         (unless (eql 0 traceback-size)
    519           (add-traceback-table code-vector i traceback-string))
    520         (setf (uvref function 0) code-vector)
    521         (%make-code-executable code-vector)
    522         function))))
     510           (j 0))
     511      (dotimes (i prefix-size)
     512        (setf (uvref code-vector i) (pop prefix)))
     513      (arm-lap-resolve-labels)
     514      (do-dll-nodes (insn *lap-instructions*)
     515        (arm-lap-generate-instruction code-vector i insn)
     516        (incf i))
     517      (setf (uvref function 1) code-vector)
     518      (%make-code-executable code-vector)
     519      function)))
    523520     
    524521   
     
    816813           (reg-vars ()))
    817814      (declare (type (unsigned-byte 16) nargs))
    818       (! save-lr)
    819815      (if (<= nargs $numarmargregs)       ; caller didn't vpush anything
    820         (if *arm2-open-code-inline*
    821           (! save-lisp-context-vsp)
    822           (! save-lisp-context-vsp-ool))
     816        (! save-lisp-context-vsp)
    823817        (let* ((offset (* (the fixnum (- nargs $numarmargregs)) *arm2-target-node-size*)))
    824818          (declare (fixnum offset))
    825           (if *arm2-open-code-inline*
    826             (! save-lisp-context-offset offset)
    827             (! save-lisp-context-offset-ool offset))))
     819          (! save-lisp-context-offset offset)))
    828820      (destructuring-bind (&optional zvar yvar xvar &rest stack-args) revargs
    829821        (let* ((nstackargs (length stack-args)))
     
    47774769  (or (eq cd $backend-return) (arm2-mvpass-p cd)))
    47784770
    4779 (defun arm2-expand-note (note)
     4771(defun arm2-expand-note (note header)
    47804772  (let* ((lab (vinsn-note-label note)))
    47814773    (case (vinsn-note-class note)
    47824774      ((:begin-variable-scope :end-variable-scope
    47834775        :source-location-begin :source-location-end)
    4784        (setf (vinsn-label-info lab) (emit-lap-label lab))))))
     4776       (setf (vinsn-label-info lab) (arm::emit-lap-label header lab))))))
    47854777
    47864778(defun arm2-expand-vinsns (header current sections)
     
    47914783          (when (or t (vinsn-label-refs v) (null id))
    47924784            (setf (vinsn-label-info v) (arm::emit-lap-label current v)))
    4793           (arm2-expand-note id)))
     4785          (arm2-expand-note current id)))
    47944786      (setq current (arm2-expand-vinsn v current sections))))
    47954787  ;;; This doesn't have too much to do with anything else that's
     
    53375329    (let* ((fixval (or fix1 fix2))
    53385330           (unboxed-fixval (if fixval (ash fixval *arm2-target-fixnum-shift*)))
    5339            (high (if fixval (if (= unboxed-fixval (logand #xffff0000 unboxed-fixval)) (ash unboxed-fixval -16))))
    5340            (low (if fixval (unless high (if (= unboxed-fixval (logand #x0000ffff unboxed-fixval)) unboxed-fixval))))
    5341            (otherform (if (or high low) (if fix1 form2 form1))))
     5331           (ok-imm (and unboxed-fixval
     5332                        (arm::encode-arm-immediate unboxed-fixval)))
     5333           (otherform (if ok-imm (if fix1 form2 form1))))
    53425334      (if otherform
    53435335        (let* ((other-reg (arm2-one-untargeted-reg-form seg otherform arm::arg_z)))
    53445336          (when vreg
    5345             (ensuring-node-target (target vreg)
    5346               (if high
    5347                 (! logior-high target other-reg high)
    5348                 (! logior-low target other-reg low)))))
     5337            (ensuring-node-target (target vreg)
     5338              (! logior-immediate target other-reg unboxed-fixval))))
    53495339        (multiple-value-bind (r1 r2) (arm2-two-untargeted-reg-forms seg form1 arm::arg_y form2 arm::arg_z)
    53505340          (if vreg (ensuring-node-target (target vreg) (! %logior2 target r1 r2)))))   
    53515341      (^))))
    53525342
    5353 ;;; in a lot of (typical ?) cases, it might be possible to use a
    5354 ;;; rotate-and-mask instead of andi./andis.
    53555343
    53565344(defarm2 arm2-%ilogand2 %ilogand2 (seg vreg xfer form1 form2)
     
    53605348      (arm2-use-operator (%nx1-operator fixnum) seg vreg xfer (logand fix1 fix2))
    53615349      (let* ((fixval (or fix1 fix2))
    5362              (fixlen (if fixval (integer-length fixval)))
    5363              (unboxed-fixval (if fixval (ash fixval *arm2-target-fixnum-shift*)))
    5364              (high (if fixval (if (= unboxed-fixval (logand #xffff0000 unboxed-fixval)) (ash unboxed-fixval -16))))
    5365              (low (if fixval (unless high (if (= unboxed-fixval (logand #x0000ffff unboxed-fixval)) unboxed-fixval))))
    5366              (otherform (if (or high low) (if fix1 form2 form1))))
     5350             (unboxed-fixval (if fixval (ash fixval arm::fixnum-shift)))
     5351             (ok-imm (and unboxed-fixval
     5352                          (or (arm::encode-arm-immediate unboxed-fixval)
     5353                              (arm::encode-arm-immediate
     5354                               (logand #xffffffff (lognot unboxed-fixval))))))
     5355                                                                 
     5356             (otherform (if ok-imm (if fix1 form2 form1))))
    53675357        (if otherform
    53685358          (let* ((other-reg (arm2-one-untargeted-reg-form seg otherform arm::arg_z)))
    53695359            (when vreg
    5370               (ensuring-node-target (target vreg)
    5371                 (if high
    5372                   (! logand-high target other-reg high)
    5373                   (! logand-low target other-reg low)))))
    5374           (if (and fixval (= fixlen (logcount fixval)))
    5375             (let* ((nbits (- *arm2-target-bits-in-word*
    5376                              (1+ (+ *arm2-target-fixnum-shift* fixlen))))
    5377                    (otherreg (arm2-one-untargeted-reg-form seg (if fix1 form2 form1) arm::arg_z)))
    5378            
    5379               (if vreg (ensuring-node-target (target vreg)
    5380                          (if (> fixval 0)
    5381                            (! clear-left target otherreg nbits)
    5382                            (! clear-right target otherreg (+ fixlen
    5383                                                              *arm2-target-fixnum-shift*))))))
    5384          
     5360              (ensuring-node-target (target vreg)
     5361                (! logand-immediate target other-reg unboxed-fixval))))
    53855362            (multiple-value-bind (r1 r2) (arm2-two-untargeted-reg-forms seg form1 arm::arg_y form2 arm::arg_z)
    5386               (if vreg (ensuring-node-target (target vreg) (! %logand2 target r1 r2))))))
     5363              (if vreg (ensuring-node-target (target vreg) (! %logand2 target r1 r2)))))
    53875364        (^)))))
    53885365
     
    77787755(defarm2 arm2-%setf-double-float %setf-double-float (seg vref xfer fnode fval)
    77797756  (arm2-vpush-register seg (arm2-one-untargeted-reg-form seg fnode arm::arg_z))
    7780   (let* ((target ($ arm::fp1 :class :fpr :mode :double-float))
     7757  (let* ((target ($ arm::d0 :class :fpr :mode :double-float))
    77817758         (node ($ arm::arg_z)))
    77827759    (arm2-one-targeted-reg-form seg fval target)
     
    77907767(defarm2 arm2-%setf-short-float %setf-short-float (seg vreg xfer fnode fval)
    77917768  (arm2-vpush-register seg (arm2-one-untargeted-reg-form seg fnode arm::arg_z))
    7792   (let* ((target ($ arm::fp1 :class :fpr :mode :single-float))
     7769  (let* ((target ($ arm::s0 :class :fpr :mode :single-float))
    77937770         (freg ($ arm::arg_z)))
    77947771    (arm2-one-targeted-reg-form seg fval target)
Note: See TracChangeset for help on using the changeset viewer.