Changeset 14335


Ignore:
Timestamp:
Oct 7, 2010, 5:46:30 PM (9 years ago)
Author:
gb
Message:

Optionally (mostly optional for bootstrapping reasons) expect the
backend to handle %ILOGNOT, ASH (in the latter case, by trying to
do something other than a subprim call, if possible.)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/nx1.lisp

    r14309 r14335  
    22302230  (make-acode (%nx1-default-operator) (nx1-form arg)))
    22312231
    2232 
     2232(defnx1 nx1-%ilognot (%ilognot) (n)
     2233  ;; Bootstrapping nonsense.
     2234  (if (aref (backend-p2-dispatch *target-backend*)
     2235            (logand operator-id-mask (%nx1-operator %ilognot)))
     2236    (make-acode (%nx1-operator typed-form)
     2237                'fixnum
     2238                (make-acode (%nx1-operator %ilognot)
     2239                            (nx1-form n)))
     2240    (nx1-form (macroexpand `(%ilognot ,n)))))
     2241
     2242   
    22332243(defnx1 nx1-ash (ash) (&whole call &environment env num amt)
    2234   (let* ((unsigned-natural-type (target-word-size-case
    2235                                  (32 '(unsigned-byte 32))
    2236                                  (64 '(unsigned-byte 64))))
    2237          (max (target-word-size-case (32 32) (64 64)))
    2238          (maxbits (target-word-size-case
    2239                    (32 29)
    2240                    (64 60))))
    2241     (cond ((eq amt 0) (nx1-form `(require-type ,num 'integer) env))
    2242           ((and (fixnump amt)
    2243                 (< amt 0))
    2244            (if (nx-form-typep num 'fixnum env)
    2245              (make-acode (%nx1-operator %iasr)
    2246                          (make-acode (%nx1-operator fixnum)
    2247                                      (- amt))
    2248                          (nx1-form num))
    2249              (if (nx-form-typep num unsigned-natural-type env)
    2250                (if (< (- amt) max)
    2251                  (make-acode (%nx1-operator natural-shift-right)
    2252                              (nx1-form num)
    2253                              (make-acode (%nx1-operator fixnum)
    2254                                          (- amt)))
    2255                  (nx1-form `(progn (require-type ,num 'integer) 0) env))
     2244  (flet ((defer-to-backend ()
     2245             ;; Bootstrapping nonsense
     2246             (if (svref (backend-p2-dispatch *target-backend*)
     2247                        (logand operator-id-mask (%nx1-operator ash)))
     2248               (make-acode (%nx1-operator typed-form)
     2249                           'integer
     2250                           (make-acode
     2251                            (%nx1-operator ash)
     2252                            (nx1-form num)
     2253                            (nx1-form amt)))
    22562254               (nx1-treat-as-call call))))
    2257           ((and (fixnump amt)
    2258                 (<= 0 amt maxbits)
    2259                 (or (nx-form-typep num `(signed-byte ,(- (1+ maxbits) amt)) env)
    2260                     (and (nx-form-typep num 'fixnum env)
    2261                          (nx-trust-declarations env)
    2262                          (subtypep *nx-form-type* 'fixnum))))
    2263            (nx1-form `(%ilsl ,amt ,num)))
    2264           ((and (fixnump amt)
    2265                 (< amt max)
    2266                 (nx-form-typep num unsigned-natural-type env)
    2267                 (nx-trust-declarations env)
    2268                 (subtypep *nx-form-type* unsigned-natural-type))
    2269            (make-acode (%nx1-operator natural-shift-left)
    2270                        (nx1-form num)
    2271                        (nx1-form amt)))
    2272           ((fixnump num)
    2273            (let* ((field-width (1+ (integer-length num)))
    2274                   ;; num fits in a `(signed-byte ,field-width)
    2275                   (max-shift (- (1+ maxbits) field-width)))
    2276              (if (nx-form-typep amt `(mod ,(1+ max-shift)) env)
    2277                (nx1-form `(%ilsl ,amt ,num))
    2278                (nx1-treat-as-call call))))
    2279           (t (nx1-treat-as-call call)))))
     2255    (let* ((unsigned-natural-type (target-word-size-case
     2256                                   (32 '(unsigned-byte 32))
     2257                                   (64 '(unsigned-byte 64))))
     2258           (max (target-word-size-case (32 32) (64 64)))
     2259           (maxbits (target-word-size-case
     2260                     (32 29)
     2261                     (64 60))))
     2262      (cond ((eq amt 0) (nx1-form `(require-type ,num 'integer) env))
     2263            ((and (fixnump amt)
     2264                  (< amt 0))
     2265             (if (nx-form-typep num 'fixnum env)
     2266               (make-acode (%nx1-operator %iasr)
     2267                           (make-acode (%nx1-operator fixnum)
     2268                                       (- amt))
     2269                           (nx1-form num))
     2270               (if (nx-form-typep num unsigned-natural-type env)
     2271                 (if (< (- amt) max)
     2272                   (make-acode (%nx1-operator natural-shift-right)
     2273                               (nx1-form num)
     2274                               (make-acode (%nx1-operator fixnum)
     2275                                           (- amt)))
     2276                   (nx1-form `(progn (require-type ,num 'integer) 0) env))
     2277                 (defer-to-backend))))
     2278            ((and (fixnump amt)
     2279                  (<= 0 amt maxbits)
     2280                  (or (nx-form-typep num `(signed-byte ,(- (1+ maxbits) amt)) env)
     2281                      (and (nx-form-typep num 'fixnum env)
     2282                           (nx-trust-declarations env)
     2283                           (subtypep *nx-form-type* 'fixnum))))
     2284             (nx1-form `(%ilsl ,amt ,num)))
     2285            ((and (fixnump amt)
     2286                  (< 0 amt max)
     2287                  (nx-form-typep num unsigned-natural-type env)
     2288                  (nx-trust-declarations env)
     2289                  (subtypep *nx-form-type* unsigned-natural-type))
     2290             (make-acode (%nx1-operator natural-shift-left)
     2291                         (nx1-form num)
     2292                         (nx1-form amt)))
     2293            ((fixnump num)
     2294             (let* ((field-width (1+ (integer-length num)))
     2295                    ;; num fits in a `(signed-byte ,field-width)
     2296                    (max-shift (- (1+ maxbits) field-width)))
     2297               (if (nx-form-typep amt `(mod ,(1+ max-shift)) env)
     2298                 (nx1-form `(%ilsl ,amt ,num))
     2299                 (defer-to-backend))))
     2300            (t (defer-to-backend))))))
    22802301
    22812302   
Note: See TracChangeset for help on using the changeset viewer.