Changeset 14304


Ignore:
Timestamp:
Sep 28, 2010, 4:45:53 PM (9 years ago)
Author:
rme
Message:

New function acode-xxx-form-p. Use it in functions
acode-integer-form-p, acode-integer-constant-p, and
acode-real-constant-p.

File:
1 edited

Legend:

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

    r14297 r14304  
    571571      (cadr x))))
    572572
     573(defun acode-xxx-form-p (x fixnum-supertype)
     574  (or (acode-fixnum-form-p x)
     575      (progn
     576        (setq x (acode-unwrapped-form-value x))
     577        (if (acode-p x)
     578          (if (and (eq (acode-operator x) (%nx1-operator immediate))
     579                   (typep (cadr x) fixnum-supertype))
     580            (cadr x))))))
     581
     582(defun acode-integer-form-p (x)
     583  (acode-xxx-form-p x 'integer))
     584
    573585(defun acode-integer-constant-p (x bits)
    574   (let* ((int (or (acode-fixnum-form-p x)
    575                   (progn
    576                     (setq x (acode-unwrapped-form x))
    577                     (if (acode-p x)
    578                       (if (and (eq (acode-operator x) (%nx1-operator immediate))
    579                                (typep (cadr x) 'integer))
    580                         (cadr x)))))))
     586  (let ((int (acode-integer-form-p x)))
    581587    (and int
    582588         (or
     
    585591         int)))
    586592
    587 (defun acode-natural-constant-p (x)
    588   (let* ((int (or (acode-fixnum-form-p x)
    589                   (progn
    590                     (setq x (acode-unwrapped-form x))
    591                     (if (acode-p x)
    592                       (if (and (eq (acode-operator x) (%nx1-operator immediate))
    593                                (typep (cadr x) 'integer))
    594                         (cadr x)))))))
    595     (and int
    596          (target-word-size-case
    597           (32 (typep int '(unsigned-byte 32)))
    598           (64 (typep int '(unsigned-byte 64))))
    599          int)))
    600 
    601 
    602 
    603593(defun acode-real-constant-p (x)
    604   (or (acode-fixnum-form-p x)
    605       (progn
    606         (setq x (acode-unwrapped-form x))
    607         (if (acode-p x)
    608           (if (and (eq (acode-operator x) (%nx1-operator immediate))
    609                    (typep (cadr x) 'real))
    610             (cadr x))))))
    611 
    612 
     594  (acode-xxx-form-p x 'real))
    613595
    614596(defun nx-lookup-target-uvector-subtag (name)
Note: See TracChangeset for help on using the changeset viewer.