Changeset 15876


Ignore:
Timestamp:
Aug 7, 2013, 11:52:10 AM (6 years ago)
Author:
gb
Message:

Work in progress.

Location:
branches/acode-rewrite/source/compiler
Files:
8 edited

Legend:

Unmodified
Added
Removed
  • branches/acode-rewrite/source/compiler

    • Property svn:mergeinfo changed (with no actual effect on merging)
  • branches/acode-rewrite/source/compiler/ARM/arm2.lisp

    r15868 r15876  
    67706770
    67716771(defarm2 arm2-add2 add2 (seg vreg xfer form1 form2)
    6772   (or (acode-optimize-add2 seg vreg xfer form1 form2 *arm2-trust-declarations*)
    6773       (if (or (arm2-explicit-non-fixnum-type-p form1)
    6774               (arm2-explicit-non-fixnum-type-p form2))
    6775         (arm2-binary-builtin seg vreg xfer '+-2 form1 form2)
    6776         (arm2-inline-add2 seg vreg xfer form1 form2))))
     6772  (if (or (arm2-explicit-non-fixnum-type-p form1)
     6773          (arm2-explicit-non-fixnum-type-p form2))
     6774    (arm2-binary-builtin seg vreg xfer '+-2 form1 form2)
     6775    (arm2-inline-add2 seg vreg xfer form1 form2)))
    67776776
    67786777(defarm2 arm2-sub2 sub2 (seg vreg xfer form1 form2)
    6779   (or (acode-optimize-sub2 seg vreg xfer form1 form2 *arm2-trust-declarations*)
    6780       (if (or (arm2-explicit-non-fixnum-type-p form1)
    6781               (arm2-explicit-non-fixnum-type-p form2))
    6782         (arm2-binary-builtin seg vreg xfer '--2 form1 form2)
    6783         (arm2-inline-sub2 seg vreg xfer form1 form2))))
     6778  (if (or (arm2-explicit-non-fixnum-type-p form1)
     6779          (arm2-explicit-non-fixnum-type-p form2))
     6780    (arm2-binary-builtin seg vreg xfer '--2 form1 form2)
     6781    (arm2-inline-sub2 seg vreg xfer form1 form2)))
    67846782
    67856783(defarm2 arm2-mul2 mul2 (seg vreg xfer form1 form2)
  • branches/acode-rewrite/source/compiler/X86/x862.lisp

    r15868 r15876  
    41834183          (x862-stack-to-register seg ea temp)
    41844184          (! compare-value-cell-to-nil temp))
    4185         (! compare-vframe-offset-to-nil (memspec-frame-address-offset ea) *x862-vstack*))
     4185        (let* ((offset (memspec-frame-address-offset ea))
     4186               (reg (x862-register-for-frame-offset offset)))
     4187          (if reg
     4188            (! compare-to-nil reg)
     4189            (! compare-vframe-offset-to-nil offset  *x862-vstack*))))
    41864190      (regspec-crf-gpr-case
    41874191       (vreg dest)
    41884192       (^ cr-bit true-p)
    41894193       (progn
    4190        (ensuring-node-target (target dest)
    4191          (if (not true-p)
    4192            (setq cr-bit (logxor 1 cr-bit)))
    4193          (! cr-bit->boolean target cr-bit))
    4194        (^))))))
     4194         (ensuring-node-target (target dest)
     4195           (if (not true-p)
     4196             (setq cr-bit (logxor 1 cr-bit)))
     4197           (! cr-bit->boolean target cr-bit))
     4198         (^))))))
    41954199
    41964200(defun x862-cr-bit-for-unsigned-comparison (cr-bit)
     
    56425646    (declare (fixnum numundo))
    56435647    (with-x86-local-vinsn-macros (seg vreg xfer)
    5644       (if (eq current-stack old-stack)
     5648      (if (x862-equal-encodings-p current-stack old-stack)
    56455649        (x862-form seg vreg xfer body)
    56465650        (if (eq xfer $backend-return)
     
    79347938           
    79357939(defx862 x862-add2 add2 (seg vreg xfer form1 form2)
    7936   (or (acode-optimize-add2 seg vreg xfer form1 form2 *x862-trust-declarations*)
    7937       (if (or (x862-explicit-non-fixnum-type-p form1)
    7938               (x862-explicit-non-fixnum-type-p form2))
    7939         (x862-binary-builtin seg vreg xfer '+-2 form1 form2)
    7940         (x862-inline-add2 seg vreg xfer form1 form2))))
     7940  (if (or (x862-explicit-non-fixnum-type-p form1)
     7941          (x862-explicit-non-fixnum-type-p form2))
     7942    (x862-binary-builtin seg vreg xfer '+-2 form1 form2)
     7943    (x862-inline-add2 seg vreg xfer form1 form2)))
    79417944
    79427945(defx862 x862-sub2 sub2 (seg vreg xfer form1 form2)
    7943   (or (acode-optimize-sub2 seg vreg xfer form1 form2 *x862-trust-declarations*)
    7944       (if (or (x862-explicit-non-fixnum-type-p form1)
    7945               (x862-explicit-non-fixnum-type-p form2))
    7946         (x862-binary-builtin seg vreg xfer '--2 form1 form2)
    7947         (x862-inline-sub2 seg vreg xfer form1 form2))))
     7946  (if (or (x862-explicit-non-fixnum-type-p form1)
     7947          (x862-explicit-non-fixnum-type-p form2))
     7948    (x862-binary-builtin seg vreg xfer '--2 form1 form2)
     7949    (x862-inline-sub2 seg vreg xfer form1 form2)))
    79487950
    79497951(defx862 x862-mul2 mul2 (seg vreg xfer form1 form2)
  • branches/acode-rewrite/source/compiler/acode-rewrite.lisp

    r15863 r15876  
    157157
    158158(defun acode-rewrite-binop-for-numeric-contagion (form1 form2 trust-decls)
     159  (rewrite-acode-form form1)
     160  (rewrite-acode-form form2)
    159161  (cond ((acode-form-typep form1 'double-float trust-decls)
    160162         (unless (acode-form-typep form2 'double-float trust-decls)
     
    518520;;; happen here.
    519521(def-acode-rewrite acode-rewrite-setq-lexical setq-lexical asserted-type (var value)
    520   (declare (ignore var))
    521   (rewrite-acode-form value))
     522  (rewrite-acode-form value (or (and *acode-rewrite-trust-declarations*
     523                                     (var-declared-type var))
     524                                t)))
    522525
    523526(def-acode-rewrite acode-rewrite-unwind-protect unwind-protect asserted-type (protected-form cleanup-form)
     
    681684               (:ge '>=)
    682685               (:gt '>))))
    683     (rewrite-acode-form num1)
    684     (rewrite-acode-form num2)
     686    (acode-rewrite-binop-for-numeric-contagion num1 num2 *acode-rewrite-trust-declarations*)
    685687    (multiple-value-bind (v1 c1) (acode-constant-p num1)
    686688      (multiple-value-bind (v2 c2) (acode-constant-p num2)
  • branches/acode-rewrite/source/compiler/nx0.lisp

    r15864 r15876  
    112112
    113113
    114 (defparameter *nx-operator-result-types*
    115   '((#.(%nx1-operator list) . list)
    116     (#.(%nx1-operator memq) . list)
    117     (#.(%nx1-operator %temp-list) . list)
    118     (#.(%nx1-operator assq) . list)
    119     (#.(%nx1-operator cons) . cons)
    120     (#.(%nx1-operator rplaca) . cons)
    121     (#.(%nx1-operator %rplaca) . cons)
    122     (#.(%nx1-operator rplacd) . cons)
    123     (#.(%nx1-operator %rplacd) . cons)
    124     (#.(%nx1-operator %temp-cons) . cons)
    125     (#.(%nx1-operator %i+) . fixnum)
    126     (#.(%nx1-operator %i-) . fixnum)
    127     (#.(%nx1-operator %i*) . fixnum)
    128     (#.(%nx1-operator %ilsl) . fixnum)
    129     (#.(%nx1-operator %ilsr) . fixnum)
    130     (#.(%nx1-operator %iasr) . fixnum)
    131     (#.(%nx1-operator %ilogior2) . fixnum)
    132     (#.(%nx1-operator %ilogand2) . fixnum)
    133     (#.(%nx1-operator %ilogxor2) . fixnum)
    134     (#.(%nx1-operator %code-char) . character)
    135     (#.(%nx1-operator schar) . character)
    136     (#.(%nx1-operator length) . fixnum)
    137     (#.(%nx1-operator uvsize) . fixnum)
    138     (#.(%nx1-operator %double-float/-2) . double-float)
    139     (#.(%nx1-operator %double-float+-2) . double-float)
    140     (#.(%nx1-operator %double-float--2) . double-float)
    141     (#.(%nx1-operator %double-float*-2) . double-float)
    142     (#.(%nx1-operator %short-float/-2) . single-float)
    143     (#.(%nx1-operator %short-float+-2) . single-float)
    144     (#.(%nx1-operator %short-float--2) . single-float)
    145     (#.(%nx1-operator %short-float*-2) . single-float)
    146     (#.(%nx1-operator %double-to-single) . single-float)
    147     (#.(%nx1-operator %single-to-double) . double-float)
    148     (#.(%nx1-operator %fixnum-to-single) . single-float)
    149     (#.(%nx1-operator %fixnum-to-double) . double-float)
    150     (#.(%nx1-operator char-code) . #.`(integer 0 (,char-code-limit)))
    151    ))
     114
    152115
    153116(defparameter *nx-operator-result-types-by-name*
     
    456419        (%nx1-operator div2)))
    457420
    458 
     421(defparameter *acode-operator-types* (make-array (1+ operator-id-mask) :initial-element t)) ; initialized by next-nx-defops
     422
     423
     424(defparameter *acode-simple-type-inferrers* (make-array (1+ operator-id-mask) :initial-element nil))
     425
     426(defmacro def-simple-type-infer (name operator-list trust-decls arglist &body body)
     427  (when (atom operator-list)
     428    (setq operator-list (list operator-list)))
     429  (multiple-value-bind (lambda-list whole-var) (normalize-lambda-list arglist t)
     430    (unless whole-var (setq whole-var (gensym)))
     431    (multiple-value-bind (body decls)
     432        (parse-body body nil t)
     433      (collect ((let-body))
     434        (dolist (operator operator-list)
     435          (let-body `(setf (svref *acode-simple-type-inferrers*  (logand operator-id-mask (%nx1-operator ,operator))) fun)))
     436        (multiple-value-bind (bindings binding-decls)
     437            (%destructure-lambda-list lambda-list whole-var nil nil
     438                                      :cdr-p t
     439                                      :whole-p nil
     440                                      :use-whole-var t
     441                                      :default-initial-value nil)
     442             
     443          `(let* ((fun (nfunction ,name
     444                                  (lambda (,whole-var &optional (,trust-decls t))
     445                                    (declare (ignorable ,trust-decls))
     446                                    (block ,name
     447                                      (let* ,(nreverse bindings)
     448                                        ,@(when binding-decls `((declare ,@binding-decls)))
     449                                        ,@decls
     450                                        ,@body))))))
     451            ,@(let-body)))))))
     452
     453(defun acode-assert-type (form typespec)
     454  (let* ((new (cons typespec (cons (cons (%car form) (%cdr form)) nil))))
     455    (setf (%car form) (%nx1-operator type-asserted-form)
     456          (%cdr form) new)
     457    typespec))
     458
     459(def-simple-type-infer infer-fixnum fixnum trust-decls (val)
     460  `(integer ,val ,val))
     461
     462(def-simple-type-infer infer-immediate immediate trust-decls (val)
     463  (type-of val))
     464
     465(def-simple-type-infer infer-progn progn trust-decls (forms)
     466  (acode-form-type (car (last forms)) trust-decls))
     467
     468(def-simple-type-infer infer-typed-form typed-form trust-decls (&whole w type form &optional check)
     469  (declare (ignorable w form))
     470  (if (or trust-decls check)
     471    type
     472    '*))
     473
     474(def-simple-type-infer infer-let (let let) trust-decls (vars vals body p2decls)
     475  (declare (ignore vars vals))
     476  (acode-form-type body (logtest $decl_trustdecls p2decls)))
     477
     478(def-simple-type-infer infer-ff-call (ff-call eabi-ff-call poweropen-ff-call i386-ff-call) trust-decls (address argspecs argvals resultspec &optional monitor)
     479  (declare (ignore address argspecs argvals monitor))
     480  (case resultspec
     481    (:unsigned-byte '(unsigned-byte 8))
     482    (:signed-byte '(signed-byte 8))
     483    (:unsigned-halfword '(unsigned-byte 16))
     484    (:signed-halfword '(signed-byte 16))
     485    (:unsigned-fullword '(unsigned-byte 32))
     486    (:signed-fullword '(signed-byte 32))
     487    (:unsigned-doubleword '(unsigned-byte 64))
     488    (:signed-doubleword '(signed-byte 64))
     489    (:single-float 'single-float)
     490    (:double-float 'double-float)
     491    (:address 'macptr)
     492    (otherwise '*)))
     493
     494
     495(def-simple-type-infer infer-lambda-bind lambda-bind trust-decls
     496    (vals req rest keys-p auxen body p2decls)
     497  (declare (ignore vals req rest keys-p auxen))
     498  (acode-form-type body (logtest $decl_trustdecls p2decls)))
     499
     500(def-simple-type-infer infer-if if trust-decls (test true false)
     501  (declare (ignore test))
     502  (type-specifier (specifier-type `(or ,(acode-form-type true trust-decls) ,(acode-form-type false trust-decls)))))
     503
     504
     505(def-simple-type-infer infer-lexical-reference lexical-reference trust-decls (var)
     506  (var-declared-type  var))
     507
     508(def-simple-type-infer infer-aref (%aref1 simple-typed-aref2 general-aref2 simple-typed-aref3 general-aref3) trust-decls (array &rest args)
     509  (declare (ignore args))
     510  (let* ((atype (acode-form-type array trust-decls))
     511         (actype (if atype (specifier-type atype))))
     512    (if (typep actype 'array-ctype)
     513      (type-specifier (array-ctype-specialized-element-type actype))
     514      '*)))
     515
     516(def-simple-type-infer infer-typed-form typed-form trust-decls (type form &optional check)
     517  (declare (ignore form))
     518  (if (or trust-decls check)
     519    type
     520    '*))
    459521
    460522(defun acode-form-type (form trust-decls &optional (assert t))
    461   (let* ((typespec
    462           (if (nx-null form)
    463             'null
    464             (if (nx-t form)
    465               'boolean
    466               (nx-target-type
    467                (if (acode-p form)
    468                  (let* ((op (acode-operator form)))
    469                    (if (eq op (%nx1-operator fixnum))
    470                      (let* ((val (cadr form)))
    471                        `(integer ,val ,val))
    472                      (if (eq op (%nx1-operator immediate))
    473                        (type-of (%cadr form))
    474                        (and trust-decls
    475                             (if (eq op (%nx1-operator type-asserted-form))
    476                               (progn
    477                                 (setq assert nil)
     523  (declare (ignorable assert)) 
     524  (if (not (acode-p form))
     525    t
     526    (let* ((op (acode-operator form))
     527           (op-id (logand  op operator-id-mask))
     528           (type (svref *acode-operator-types* op-id)))
     529      (declare (fixnum op op-id))
     530      (if (not (eq type :infer))
     531        (nx-target-type type)
     532        (if (eql op (%nx1-operator type-asserted-form))
     533          (nx-target-type (%cadr form))
     534          (let* ((fn (svref *acode-simple-type-inferrers* op-id)))
     535            (if fn
     536              (let* ((inferred (nx-target-type (funcall fn form trust-decls))))
     537                (when (eql (acode-operator form) op-id)
     538                  (acode-assert-type form inferred))
     539                inferred)
     540              t)))))))
     541
     542#||
     543(let* ((typespec
     544        (if (nx-null form)
     545          'null
     546          (if (nx-t form)
     547            'boolean
     548            (nx-target-type
     549             (if (acode-p form)
     550               (let* ((op (acode-operator form)))
     551                 (if (eq op (%nx1-operator fixnum))
     552                   (let* ((val (cadr form)))
     553                     `(integer ,val ,val))
     554                   (if (eq op (%nx1-operator immediate))
     555                     (type-of (%cadr form))
     556                     (and trust-decls
     557                          (if (eq op (%nx1-operator type-asserted-form))
     558                            (progn
     559                              (setq assert nil)
     560                              (%cadr form))
     561                            (if (eq op (%nx1-operator typed-form))
     562                              (destructuring-bind (type subform &optional check) (%cdr form)                                 
     563                                (when (and assert (null check))
     564                                  (setf (%car form) (%nx1-operator type-asserted-form)
     565                                        (%cadr form)
     566                                        (type-specifier
     567                                         (specifier-type `(and ,type ,(acode-form-type subform trust-decls assert))))
     568                                        assert nil))
    478569                                (%cadr form))
    479                               (if (eq op (%nx1-operator typed-form))
    480                                 (destructuring-bind (type subform &optional check) (%cdr form)                                 
    481                                   (when (and assert (null check))
    482                                     (setf (%car form) (%nx1-operator type-asserted-form)
    483                                           (%cadr form)
    484                                           (type-specifier
    485                                            (specifier-type `(and ,type ,(acode-form-type subform trust-decls assert))))
    486                                           assert nil))
    487                                   (%cadr form))
    488                                 (if (eq op (%nx1-operator lexical-reference))
    489                                   (locally (declare (special *nx-in-frontend*))
    490                                     (if *nx-in-frontend*
    491                                       (setq assert nil)
    492                                       (let* ((var (cadr form))
    493                                              (bits (nx-var-bits var))
    494                                              (punted (logbitp $vbitpunted bits)))
    495                                         (if (or punted
    496                                                 (eql 0 (nx-var-root-nsetqs var)))
    497                                           (var-inittype var)))))
    498                                   (if (or (eq op (%nx1-operator %aref1))
    499                                           (eq op (%nx1-operator simple-typed-aref2))
    500                                           (eq op (%nx1-operator general-aref2))
    501                                           (eq op (%nx1-operator simple-typed-aref3))
    502                                           (eq op (%nx1-operator general-aref3)))
    503                                     (let* ((atype (acode-form-type (cadr form) t))
    504                                            (actype (if atype (specifier-type atype))))
    505                                       (if (typep actype 'array-ctype)
    506                                         (type-specifier (array-ctype-specialized-element-type
    507                                                          actype))))
    508                                     (if (member op *numeric-acode-ops*)
    509                                       (multiple-value-bind (f1 f2)
    510                                           (nx-binop-numeric-contagion (cadr form)
    511                                                                       (caddr form)
    512                                                                       trust-decls)
    513                                         (if (and (acode-form-typep f1 'real trust-decls)
    514                                                  (acode-form-typep f2 'real trust-decls))
    515 
    516                                           (if (or (acode-form-typep f1 'double-float trust-decls)
    517                                                   (acode-form-typep f2 'double-float trust-decls))
    518                                             'double-float
    519                                             (if (or (acode-form-typep f1 'single-float trust-decls)
    520                                                     (acode-form-typep f2 'single-float trust-decls))
    521                                               'single-float
    522                                               'float))))
    523                                       (cdr (assq op *nx-operator-result-types*)))))))))))))))))
    524     (if (or (null typespec) (eq typespec '*)) (setq typespec t))
    525     (when (and (acode-p form) (typep (acode-operator form) 'fixnum) assert)
    526       (let* ((new (cons typespec (cons (cons (%car form) (%cdr form)) nil))))
    527         (setf (%car form) (%nx1-operator type-asserted-form)
    528               (%cdr form) new)))
    529     typespec))
     570                              (if (eq op (%nx1-operator lexical-reference))
     571                                (locally (declare (special *nx-in-frontend*))
     572                                  (if *nx-in-frontend*
     573                                    (setq assert nil)
     574                                    (let* ((var (cadr form))
     575                                           (bits (nx-var-bits var))
     576                                           (punted (logbitp $vbitpunted bits)))
     577                                      (if (or punted
     578                                              (eql 0 (nx-var-root-nsetqs var)))
     579                                        (var-inittype var)))))
     580                                (if (or (eq op (%nx1-operator %aref1))
     581                                        (eq op (%nx1-operator simple-typed-aref2))
     582                                        (eq op (%nx1-operator general-aref2))
     583                                        (eq op (%nx1-operator simple-typed-aref3))
     584                                        (eq op (%nx1-operator general-aref3)))
     585                                  (let* ((atype (acode-form-type (cadr form) t))
     586                                         (actype (if atype (specifier-type atype))))
     587                                    (if (typep actype 'array-ctype)
     588                                      (type-specifier (array-ctype-specialized-element-type
     589                                                       actype))))
     590                                  (if (member op *numeric-acode-ops*)
     591                                    (multiple-value-bind (f1 f2)
     592                                        (nx-binop-numeric-contagion (cadr form)
     593                                                                    (caddr form)
     594                                                                    trust-decls)
     595                                      (if (and (acode-form-typep f1 'real trust-decls)
     596                                               (acode-form-typep f2 'real trust-decls))
     597
     598                                        (if (or (acode-form-typep f1 'double-float trust-decls)
     599                                                (acode-form-typep f2 'double-float trust-decls))
     600                                          'double-float
     601                                          (if (or (acode-form-typep f1 'single-float trust-decls)
     602                                                  (acode-form-typep f2 'single-float trust-decls))
     603                                            'single-float
     604                                            'float))))
     605                                    (cdr (assq op *nx-operator-result-types*)))))))))))))))))
     606  (if (or (null typespec) (eq typespec '*)) (setq typespec t))
     607  (when (and (acode-p form) (typep (acode-operator form) 'fixnum) assert)
     608    (let* ((new (cons typespec (cons (cons (%car form) (%cdr form)) nil))))
     609      (setf (%car form) (%nx1-operator type-asserted-form)
     610            (%cdr form) new)))
     611  typespec)
     612||#
    530613
    531614(defun nx-binop-numeric-contagion (form1 form2 trust-decls)
  • branches/acode-rewrite/source/compiler/nx1.lisp

    r15868 r15876  
    753753              (nx1-form :value vector env) (nx1-form :value index) (nx1-form :value value)))
    754754
    755 (defnx1 nx1-+ ((+-2)) context (&environment env num1 num2)
    756   (let* ((f1 (nx1-form :value num1))
    757          (f2 (nx1-form :value num2)))
    758     (if (nx-binary-fixnum-op-p num1 num2 env t)
    759       (let* ((fixadd (make-acode (%nx1-operator %i+) f1 f2))
    760              (small-enough (target-word-size-case
    761                             (32 '(signed-byte 28))
    762                             (64 '(signed-byte 59)))))
    763         (if (or (and (nx-acode-form-typep f1 small-enough env)
    764                      (nx-acode-form-typep f2 small-enough env))
    765                 (nx-binary-fixnum-op-p num1 num2 env nil))
    766           fixadd
    767           (make-acode (%nx1-operator typed-form) 'integer (make-acode (%nx1-operator fixnum-overflow) fixadd))))
    768       (if (and (nx-form-typep num1 'double-float env)
    769                (nx-form-typep num2 'double-float env))
    770         (make-acode (%nx1-operator %double-float+-2) (nx1-form :value num1) (nx1-form :value num2))
    771         (if (and (nx-form-typep num1 'short-float env)
    772                  (nx-form-typep num2 'short-float env))
    773           (make-acode (%nx1-operator %short-float+-2) (nx1-form :value num1) (nx1-form :value num2))
    774           (if (nx-binary-natural-op-p num1 num2 env nil)
    775             (make-acode (%nx1-operator typed-form)
    776                         *nx-target-natural-type*
    777                         (make-acode (%nx1-operator %natural+) f1 f2))
    778             (make-acode (%nx1-operator typed-form) 'number
    779                         (make-acode (%nx1-operator add2) f1 f2))))))))
     755(defnx1 nx1-+ ((+-2)) context (num1 num2)
     756  (make-acode (%nx1-operator add2)
     757              (nx1-form :value num1)
     758              (nx1-form :value num2)))
     759
    780760 
    781761
     
    812792
    813793       
    814 (defnx1 nx1--2 ((--2)) context (&environment env num0 num1)       
    815   (if (nx-binary-fixnum-op-p num0 num1 env t)
    816     (let* ((f0 (nx1-form :value num0))
    817            (f1 (nx1-form :value num1))
    818            (fixsub (make-acode (%nx1-operator %i-) f0 f1))
    819            (small-enough (target-word-size-case
    820                           (32 '(signed-byte 28))
    821                           (64 '(signed-byte 59)))))
    822       (if (or (and (nx-acode-form-typep f0 small-enough env)
    823                    (nx-acode-form-typep f1 small-enough env))
    824               (nx-binary-fixnum-op-p num0 num1 env nil))
    825         fixsub
    826         (make-acode (%nx1-operator fixnum-overflow) fixsub)))
    827     (if (and (nx-form-typep num0 'double-float env)
    828              (nx-form-typep num1 'double-float env))
    829       (make-acode (%nx1-operator %double-float--2) (nx1-form :value num0 env) (nx1-form :value num1 env))
    830       (if (and (nx-form-typep num0 'short-float env)
    831                (nx-form-typep num1 'short-float env))
    832       (make-acode (%nx1-operator %short-float--2) (nx1-form :value num0 env) (nx1-form :value num1 env))
    833         (if (nx-binary-natural-op-p num0 num1 env nil)
    834           (make-acode (%nx1-operator %natural-)
    835                       (nx1-form :value num0)
    836                       (nx1-form :value num1))
    837           (make-acode (%nx1-operator sub2)
     794(defnx1 nx1--2 ((--2)) context (num0 num1)
     795  (make-acode (%nx1-operator sub2)
    838796                      (nx1-form :value num0)
    839                       (nx1-form :value num1)))))))
     797                      (nx1-form :value num1)))
    840798     
    841799(defnx1 nx1-/-2 ((/-2)) context (num0 num1 &environment env)
     
    12051163                               (nx-set-var-bits info (%ilogior2 (%ilsl $vbitsetq 1) (nx-var-bits info))))
    12061164                           (nx-adjust-setq-count info 1 catchp) ; In the hope that that day will come ...
     1165                           (let* ((type (var-declared-type info)))
     1166                             (when type
     1167                               (setq val (make-acode (%nx1-operator typed-form)
     1168                                                     type val))))
    12071169                           (make-acode (%nx1-operator setq-lexical) info val))
    12081170                         (make-acode
  • branches/acode-rewrite/source/compiler/nx2.lisp

    r15868 r15876  
    151151            (if (logbitp $vbitsetq bits)
    152152              (setf (var-refs v) (ash (var-refs v) 2))
    153               (unless (var-declared-unboxed-type v)
     153              (unless (var-declared-type v)
    154154                (let* ((inittype (var-inittype v)))
    155155                  (when inittype
    156156                    (if (subtypep inittype 'double-float)
    157                       (setf (var-declared-unboxed-type v) 'double-float)
     157                      (setf (var-declared-type v) 'double-float)
    158158                      (if (subtypep inittype 'single-float)
    159                         (setf (var-declared-unboxed-type v) 'single-float)))))))
    160             (let* ((type (var-declared-unboxed-type v)))
     159                        (setf (var-declared-type v) 'single-float)))))))
     160            (let* ((type (var-declared-type v)))
    161161              (when (and (or (eq type 'single-float)
    162162                             (eq type 'double-float))
     
    645645              (t nil)))))
    646646
    647 
    648 
    649 (defun acode-optimize-add2 (seg vreg xfer num1 num2 trust-decls &optional (result-type 'number))
    650   (declare (ignorable result-type))
    651   (or (acode-constant-fold-binop seg vreg xfer num1 num2 '+)
    652       (multiple-value-bind (num1 num2)
    653           (nx-binop-numeric-contagion num1 num2 trust-decls)
    654         (if (and (acode-form-typep num1 'double-float trust-decls)
    655                  (acode-form-typep num2 'double-float trust-decls))
    656           (progn
    657             (backend-use-operator (%nx1-operator %double-float+-2)
    658                                   seg
    659                                   vreg
    660                                   xfer
    661                                   num1
    662                                   num2)
    663             t)
    664           (if (and (acode-form-typep num1 'single-float trust-decls)
    665                    (acode-form-typep num2 'single-float trust-decls))
    666             (progn
    667               (backend-use-operator (%nx1-operator %short-float+-2)
    668                                     seg
    669                                     vreg
    670                                     xfer
    671                                     num1
    672                                     num2)
    673               t)
    674             (if (and (acode-form-typep num1 *nx-target-fixnum-type* trust-decls)
    675                      (acode-form-typep num2 *nx-target-fixnum-type* trust-decls))
    676               (progn
    677                 (backend-use-operator (%nx1-operator %i+)
    678                                       seg
    679                                       vreg
    680                                       xfer
    681                                       num1
    682                                       num2
    683                                       t)
    684                 t)))))))
    685 
    686 (defun acode-optimize-sub2 (seg vreg xfer num1 num2 trust-decls &optional (result-type 'number))
    687   (declare (ignorable result-type))
    688   (or (acode-constant-fold-binop seg vreg xfer num1 num2 '-)
    689       (multiple-value-bind (num1 num2)
    690           (nx-binop-numeric-contagion num1 num2 trust-decls)
    691         (if (and (acode-form-typep num1 'double-float trust-decls)
    692                  (acode-form-typep num2 'double-float trust-decls))
    693           (progn
    694             (backend-use-operator (%nx1-operator %double-float--2)
    695                                   seg
    696                                   vreg
    697                                   xfer
    698                                   num1
    699                                   num2)
    700             t)
    701           (if (and (acode-form-typep num1 'single-float trust-decls)
    702                    (acode-form-typep num2 'single-float trust-decls))
    703             (progn
    704               (backend-use-operator (%nx1-operator %short-float--2)
    705                                     seg
    706                                     vreg
    707                                     xfer
    708                                     num1
    709                                     num2)
    710               t)
    711             (if (and (acode-form-typep num1 *nx-target-fixnum-type* trust-decls)
    712                      (acode-form-typep num2 *nx-target-fixnum-type* trust-decls))
    713               (progn
    714                 (if (eql (acode-constant-p num1) 0)
    715                   (backend-use-operator (%nx1-operator %ineg) seg vreg xfer num2)
    716                   (backend-use-operator (%nx1-operator %i-)
    717                                         seg
    718                                         vreg
    719                                         xfer
    720                                         num1
    721                                         num2
    722                                         t))
    723                 t)))))))
    724        
    725 
    726647       
    727648(defun acode-optimize-mul2 (seg vreg xfer num1 num2 trust-decls &optional (result-type 'number))
  • branches/acode-rewrite/source/compiler/nxenv.lisp

    r15801 r15876  
    4141  var-refs
    4242  var-nvr
    43   var-declared-unboxed-type             ; NIL or float or natural-integer type
     43  var-declared-type                     ;
    4444  var-root-nrefs                        ; reference count of "root" var
    4545  var-root-nsetqs                       ; setq count of root var
     
    111111  (reverse
    112112   '(()
    113      (progn . #.(logior operator-acode-list-mask operator-assignment-free-mask operator-side-effect-free-mask))
    114      (not . #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask))
    115      (%i+ . #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    116      (%i- . #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    117      (fixnum-add-no-overflow . #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    118      (ash . #.(logior operator-single-valued-mask operator-assignment-free-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    119      (%ilsl . #.(logior operator-single-valued-mask operator-assignment-free-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    120      (%ilogand2 . #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    121      (%ilogior2 . #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    122      (%ilogbitp . #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask))
    123      (eq . #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask))
    124      (neq . #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask))
    125      (list . #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-list-mask operator-side-effect-free-mask))
    126      (values . #.(logior operator-acode-list-mask operator-assignment-free-mask operator-side-effect-free-mask))
    127      (if . #.(logior operator-acode-subforms-mask operator-side-effect-free-mask))
    128      (or . 0)
    129      (fixnum-add-overflow . #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    130      (%fixnum-ref . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    131      (%fixnum-ref-natural . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    132      (%current-tcr . #.operator-single-valued-mask)
    133      (%ilognot . #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask ))
    134      (multiple-value-prog1 . 0)
    135      (multiple-value-bind . 0)
    136      (multiple-value-call . 0)
    137      ()
    138      ()
    139      (typed-form . 0)
    140      (let . 0)
    141      (let* . 0)
    142      (tag-label . 0)
    143      (local-tagbody . #.operator-single-valued-mask)
    144      ()
    145      (type-asserted-form . 0)
    146      (fixnum-ash .  #.(logior operator-single-valued-mask operator-assignment-free-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    147      (simple-function . #.operator-single-valued-mask)
    148      (closed-function . #.operator-single-valued-mask)
    149      (setq-lexical . #.operator-single-valued-mask)
    150      (lexical-reference . #.(logior operator-assignment-free-mask operator-single-valued-mask))
    151      (free-reference . #.(logior operator-assignment-free-mask operator-single-valued-mask))
    152      (immediate . #.(logior operator-assignment-free-mask operator-single-valued-mask))
    153      (fixnum . #.(logior operator-assignment-free-mask operator-single-valued-mask ))
    154      (call . 0)
    155      (local-go . 0)
    156      (local-block . 0)
    157      (local-return-from . 0)
    158      (%car . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    159      (%cdr . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    160      (%rplaca . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    161      (%rplacd . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    162      (cons . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask))
    163      (simple-typed-aref2 . #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask))
    164      (setq-free . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    165      (prog1 . 0)
    166      (catch . #.operator-acode-subforms-mask)
    167      (throw . #.operator-acode-subforms-mask)
    168      (unwind-protect . 0)
    169      (characterp . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask))
    170      (multiple-value-list . #.operator-acode-subforms-mask)
    171      (%izerop . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask))
    172      (%immediate-ptr-to-int . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    173      (%immediate-int-to-ptr . #.(logior operator-returns-address-mask operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    174      (immediate-get-xxx . 0)
    175      ()
    176      (setq-special . 0)
    177      (special-ref . #.operator-single-valued-mask)
    178      ()
    179      ()
    180      (add2 . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    181      (sub2 . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    182      ()
    183      (numcmp . #.(logior operator-assignment-free-mask operator-acode-subforms-mask operator-single-valued-mask operator-cc-invertable-mask))
    184      (struct-ref . #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask operator-side-effect-free-mask))
    185      (struct-set . #.(logior operator-acode-subforms-mask operator-single-valued-mask))
    186      (%aref1 . #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask operator-side-effect-free-mask))
    187      (nil . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-side-effect-free-mask))
    188      (t . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-side-effect-free-mask))
    189      (%word-to-int . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask))
    190      (%svref . #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask))
    191      (%svset . #.(logior operator-acode-subforms-mask operator-single-valued-mask))
    192      (%consmacptr% . #.operator-acode-subforms-mask)
    193      (%macptrptr% . #.operator-acode-subforms-mask)
    194      (%ptr-eql . #.(logior operator-cc-invertable-mask operator-acode-subforms-mask))
    195      (%setf-macptr . #.operator-acode-subforms-mask)
    196      (bound-special-ref . #.operator-single-valued-mask)
    197      (%char-code . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    198      (%code-char . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    199      ()
    200      ()
    201      (%function . #.operator-single-valued-mask)
    202      (%valid-code-char . #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    203      ()
    204      (uvsize . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    205      (endp . #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask))
    206      (sequence-type . #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask))
    207      (fixnum-overflow . #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    208      (vector . #.(logior operator-assignment-free-mask operator-single-valued-mask))
    209      (%immediate-inc-ptr . #.(logior operator-returns-address-mask operator-single-valued-mask operator-acode-subforms-mask))
    210      (general-aref3 . #.(logior operator-acode-subforms-mask operator-single-valued-mask))
    211      (general-aset2 . #.(logior operator-acode-subforms-mask operator-single-valued-mask))
    212      (%new-ptr . #.operator-acode-subforms-mask)
    213      (%schar . #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    214      (%set-schar . #.(logior operator-single-valued-mask operator-acode-subforms-mask)) ;??
    215      ()
    216      (lambda-bind . 0)
    217      (general-aset3 . #.(logior operator-acode-subforms-mask operator-single-valued-mask))
    218      (simple-typed-aref3 . #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask))
    219      (simple-typed-aset3 . #.(logior operator-acode-subforms-mask  operator-single-valued-mask))
    220      (nth-value . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask))
    221      (progv . #.operator-acode-subforms-mask)
    222      (svref . #.(logior operator-assignment-free-mask operator-single-valued-mask))
    223      (svset . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    224      (make-list . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask))    ; exists only so we can stack-cons
    225      (%badarg1 . #.operator-acode-subforms-mask)
    226      (%badarg2 . #.operator-acode-subforms-mask)
    227      (%fixnum-ref-double-float . #.(logior operator-acode-subforms-mask  operator-single-valued-mask))
    228      (%fixnum-set-double-float . #.(logior operator-acode-subforms-mask  operator-single-valued-mask))
    229      (flet . 0)                         ; may not be necessary - for dynamic-extent, mostly
     113     (progn  #.(logior operator-acode-list-mask operator-assignment-free-mask operator-side-effect-free-mask) :infer)
     114     (not  #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask) boolean)
     115     (%i+  #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask) integer)
     116     (%i-  #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask) integer)
     117     (fixnum-add-no-overflow  #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask)fixnum)
     118     (ash  #.(logior operator-single-valued-mask operator-assignment-free-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask) integer)
     119     (%ilsl  #.(logior operator-single-valued-mask operator-assignment-free-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask) fixnum)
     120     (%ilogand2  #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask) fixnum)
     121     (%ilogior2  #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask) fixnum)
     122     (%ilogbitp  #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask) boolean)
     123     (eq  #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask) boolean)
     124     (neq  #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask) boolean)
     125     (list  #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-list-mask operator-side-effect-free-mask) list)
     126     (values  #.(logior operator-acode-list-mask operator-assignment-free-mask operator-side-effect-free-mask) t)
     127     (if  #.(logior operator-acode-subforms-mask operator-side-effect-free-mask) :infer)
     128     (or  0 :infer)
     129     (fixnum-add-overflow  #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask) integer)
     130     (%fixnum-ref  #.(logior operator-single-valued-mask operator-acode-subforms-mask) t)
     131     (%fixnum-ref-natural  #.(logior operator-single-valued-mask operator-acode-subforms-mask) natural)
     132     (%current-tcr  #.operator-single-valued-mask fixnum)
     133     (%ilognot  #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask ) fixnum)
     134     (multiple-value-prog1  0 :infer)
     135     (multiple-value-bind  0 :infer)
     136     (multiple-value-call  0 :infer)
     137     ()
     138     ()
     139     (typed-form  0 :infer)
     140     (let  0 :infer)
     141     (let*  0 :infer)
     142     (tag-label  0 nil)
     143     (local-tagbody  #.operator-single-valued-mask null)
     144     ()
     145     (type-asserted-form  0 :infer)
     146     (fixnum-ash   #.(logior operator-single-valued-mask operator-assignment-free-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask) fixnum)
     147     (simple-function  #.operator-single-valued-mask function)
     148     (closed-function  #.operator-single-valued-mask function)
     149     (setq-lexical  #.operator-single-valued-mask :infer)
     150     (lexical-reference  #.(logior operator-assignment-free-mask operator-single-valued-mask) :infer)
     151     (free-reference  #.(logior operator-assignment-free-mask operator-single-valued-mask) :infer)
     152     (immediate  #.(logior operator-assignment-free-mask operator-single-valued-mask) :infer)
     153     (fixnum  #.(logior operator-assignment-free-mask operator-single-valued-mask ) :infer)
     154     (call  0 :infer)
     155     (local-go  0 nil)
     156     (local-block  0 :infer)
     157     (local-return-from  0 :infer)
     158     (%car  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) :infer)
     159     (%cdr  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) :infer)
     160     (%rplaca  #.(logior operator-single-valued-mask operator-acode-subforms-mask) :infer)
     161     (%rplacd  #.(logior operator-single-valued-mask operator-acode-subforms-mask) :infer)
     162     (cons  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask) cons)
     163     (simple-typed-aref2  #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask) :infer)
     164     (setq-free  #.(logior operator-single-valued-mask operator-acode-subforms-mask) :infer)
     165     (prog1  0 :infer)
     166     (catch  #.operator-acode-subforms-mask :infer)
     167     (throw  #.operator-acode-subforms-mask nil)
     168     (unwind-protect  0 t)
     169     (characterp  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask) boolean)
     170     (multiple-value-list  #.operator-acode-subforms-mask list)
     171     (%izerop  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask) boolean)
     172     (%immediate-ptr-to-int  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) natural)
     173     (%immediate-int-to-ptr  #.(logior operator-returns-address-mask operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) macptr)
     174     (immediate-get-xxx  0 :infer)
     175     ()
     176     (setq-special  0 :infer)
     177     (special-ref  #.operator-single-valued-mask :infer)
     178     ()
     179     ()
     180     (add2  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) number)
     181     (sub2  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) number)
     182     ()
     183     (numcmp  #.(logior operator-assignment-free-mask operator-acode-subforms-mask operator-single-valued-mask operator-cc-invertable-mask) boolean)
     184     (struct-ref  #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask operator-side-effect-free-mask) :infer)
     185     (struct-set  #.(logior operator-acode-subforms-mask operator-single-valued-mask) :infer)
     186     (%aref1  #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask operator-side-effect-free-mask) :infer)
     187     (nil  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-side-effect-free-mask) null)
     188     (t  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-side-effect-free-mask) boolean)
     189     (%word-to-int  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask) fixnum)
     190     (%svref  #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask) :infer)
     191     (%svset  #.(logior operator-acode-subforms-mask operator-single-valued-mask) :infer)
     192     (%consmacptr%  #.operator-acode-subforms-mask macptr)
     193     (%macptrptr%  #.operator-acode-subforms-mask macptr)
     194     (%ptr-eql  #.(logior operator-cc-invertable-mask operator-acode-subforms-mask) boolean)
     195     (%setf-macptr  #.operator-acode-subforms-mask macptr)
     196     (bound-special-ref  #.operator-single-valued-mask :infer)
     197     (%char-code  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) (unsigned-byte 8))
     198     (%code-char  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) character)
     199     ()
     200     ()
     201     (%function  #.operator-single-valued-mask function)
     202     (%valid-code-char  #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) character)
     203     ()
     204     (uvsize  #.(logior operator-single-valued-mask operator-acode-subforms-mask) index)
     205     (endp  #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask) boolean)
     206     (sequence-type  #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask) boolean)
     207     (fixnum-overflow  #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) integer)
     208     (vector  #.(logior operator-assignment-free-mask operator-single-valued-mask) simple-vector)
     209     (%immediate-inc-ptr  #.(logior operator-returns-address-mask operator-single-valued-mask operator-acode-subforms-mask) macptr)
     210     (general-aref3  #.(logior operator-acode-subforms-mask operator-single-valued-mask) :infer)
     211     (general-aset2  #.(logior operator-acode-subforms-mask operator-single-valued-mask) :infer)
     212     (%new-ptr  #.operator-acode-subforms-mask macptr)
     213     (%schar  #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) character)
     214     (%set-schar  #.(logior operator-single-valued-mask operator-acode-subforms-mask) character)        ;??
     215     ()
     216     (lambda-bind  0 :infer)
     217     (general-aset3  #.(logior operator-acode-subforms-mask operator-single-valued-mask) :infer)
     218     (simple-typed-aref3  #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask) :infer)
     219     (simple-typed-aset3  #.(logior operator-acode-subforms-mask  operator-single-valued-mask) :infer)
     220     (nth-value  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask) :infer)
     221     (progv  #.operator-acode-subforms-mask :infer)
     222     (svref  #.(logior operator-assignment-free-mask operator-single-valued-mask) :infer)
     223     (svset  #.(logior operator-single-valued-mask operator-acode-subforms-mask) :infer)
     224     (make-list  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask) list)        ; exists only so we can stack-cons
     225     (%badarg1  #.operator-acode-subforms-mask nil)
     226     (%badarg2  #.operator-acode-subforms-mask nil)
     227     (%fixnum-ref-double-float  #.(logior operator-acode-subforms-mask  operator-single-valued-mask) double-float)
     228     (%fixnum-set-double-float  #.(logior operator-acode-subforms-mask  operator-single-valued-mask) double-float)
     229     (flet  0 :infer)                           ; may not be necessary - for dynamic-extent, mostly
    230230                                        ; for dynamic-extent, forward refs, etc.
    231      (labels . 0)                       ; removes 75% of LABELS bogosity
    232      (lexical-function-call . 0)        ; most of other 25%
    233      ()
    234      (self-call . 0)
    235      (inherited-arg . #.operator-single-valued-mask)     
    236      (ff-call . 0)
    237      ()
    238      (%immediate-set-xxx . #.(logior operator-acode-subforms-mask))
    239      (symbol-name . #.(logior operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    240      (memq . #.(logior operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    241      (assq . #.(logior operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    242      (simple-typed-aset2 . #.(logior operator-acode-subforms-mask operator-single-valued-mask))
    243      (consp . #.(logior operator-cc-invertable-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-boolean-mask))
    244      (aset1 . #.(logior operator-acode-subforms-mask))
    245      ()
    246      (car . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    247      (cdr . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    248      (length . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    249      (list-length . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    250      (ensure-simple-string . #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    251      (%ilsr . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    252      (set . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    253      (eql . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-boolean-mask))
    254      (%iasr . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    255      (logand2 . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    256      (logior2 . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    257      (logxor2 . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    258      (%i<> . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask))
    259      (set-car . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    260      (set-cdr . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    261      (rplaca . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    262      (rplacd . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    263      (with-variable-c-frame . #.(logior operator-acode-list-mask operator-assignment-free-mask))
    264      (uvref . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    265      (uvset . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    266      (%temp-cons . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    267      (%temp-List . #.(logior operator-single-valued-mask operator-side-effect-free-mask))
    268      (%make-uvector . #.(logior operator-assignment-free-mask operator-single-valued-mask  operator-side-effect-free-mask operator-acode-subforms-mask))
    269      (%decls-body . 0)
    270      (%old-gvector . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    271      (%typed-uvref . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    272      (%typed-uvset . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    273      (schar . #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    274      (set-schar . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    275      (code-char . #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    276      (char-code . #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    277      (list* . #.(logior operator-assignment-free-mask operator-single-valued-mask  operator-side-effect-free-mask))
    278      ()
    279      (symbolp . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-boolean-mask))
    280      (fixnum-sub-no-overflow . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    281      (fixnum-sub-overflow . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    282      (int>0-p . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask))
    283      ()
    284      ()
    285      ()
    286      (istruct-typep . #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask))
    287      (%ilogxor2 . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    288      (%err-disp . 0)
    289      (%quo2 . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    290      (minus1 . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    291      (%ineg . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    292      (%i* . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    293      (logbitp . #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-boolean-mask))
    294      (%sbchar . 0)
    295      ()
    296      (%set-sbchar . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    297      (%scharcode . #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    298      (%set-scharcode . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    299      (lambda-list . 0)
    300      ()
    301      (lisptag . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    302      (fulltag . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    303      (typecode . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    304      (require-simple-vector . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    305      (require-simple-string . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    306      (require-integer . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    307      (require-fixnum . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    308      (require-real . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    309      (require-list . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    310      (require-character . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    311      (require-number . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    312      (require-symbol . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    313      (base-char-p . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask))
    314      ()
    315      (%unbound-marker . #.operator-single-valued-mask)
    316      (%slot-unbound-marker . #.operator-single-valued-mask)
    317      (%gvector . #.(logior operator-assignment-free-mask operator-single-valued-mask))
    318      (immediate-get-ptr . #.(logior operator-returns-address-mask operator-acode-subforms-mask))
    319      (%lisp-word-ref . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    320      (%lisp-lowbyte-ref . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    321      (poweropen-ff-call . 0)
    322      (double-float-compare . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask))
    323      (builtin-call . 0)
    324      (%setf-double-float . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    325      (%double-float+-2 . #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask))
    326      (%double-float--2 .  #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask))
    327      (%double-float*-2 .  #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask))
    328      (%double-float/-2 .  #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask))
    329      ()
    330      ()
    331      ()
    332      ()
    333      ()
    334      (%debug-trap . #.operator-acode-subforms-mask)
    335      (%%ineg . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    336      (%setf-short-float . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    337      (%short-float+-2 .  #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask))
    338      (%short-float--2 .  #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask))
    339      (%short-float*-2 .  #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask))
    340      (%short-float/-2 .  #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask))
    341      (short-float-compare . #.operator-acode-subforms-mask)
    342      (eabi-ff-call . 0)
    343      (%reference-external-entry-point . #.operator-acode-subforms-mask)
    344      ()
    345      (%get-bit . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    346      (%set-bit   . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    347      (%natural+ .  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    348      (%natural- .  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    349      (%natural-logand .  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    350      (%natural-logior . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    351      (%natural-logxor .  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    352      (%natural<> . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask))
    353      (%get-double-float . #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    354      (%get-single-float . #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    355      (%set-double-float . #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    356       (%set-single-float . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    357      (natural-shift-right  . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    358      (natural-shift-left  . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    359      (global-ref . 0)
    360      (global-setq . 0)
    361      ()
    362      (%interrupt-poll  . #.(logior operator-assignment-free-mask operator-single-valued-mask))
    363      (with-c-frame . #.(logior operator-acode-list-mask operator-assignment-free-mask operator-side-effect-free-mask))   
    364      (%current-frame-ptr . 0)
    365      (%slot-ref . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask))
    366      (%illegal-marker . #.operator-single-valued-mask)
    367      (%symbol->symptr . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    368      (%single-to-double  . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    369      (%double-to-single . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    370      (%symptr->symvector  . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    371      (%symvector->symptr  . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    372      (%foreign-stack-pointer . 0)
    373      (mul2 . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    374      (div2 . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    375      (%fixnum-to-single  . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    376      (%fixnum-to-double .  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    377      (require-s8 . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    378      (require-u8 . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    379      (require-s16 . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    380      (require-u16 . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    381      (require-s32 . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    382      (require-u32 . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    383      (require-s64 . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    384      (require-u64 . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    385      (general-aref2 .  #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask))
    386      (%single-float .  #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask))
    387      (%double-float . #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask))
    388      (i386-ff-call . 0)
    389      ()
    390      (%double-float-negate . #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask))
    391      (%single-float-negate . #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask)) )))
     231     (labels  0 :infer)                 ; removes 75% of LABELS bogosity
     232     (lexical-function-call  0 :infer)  ; most of other 25%
     233     ()
     234     (self-call  0 :infer)
     235     (inherited-arg  #.operator-single-valued-mask :infer)     
     236     (ff-call  0 :infer)
     237     ()
     238     (%immediate-set-xxx  #.(logior operator-acode-subforms-mask) :infer)
     239     (symbol-name  #.(logior operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask) simple-base-string)
     240     (memq  #.(logior operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask) list)
     241     (assq  #.(logior operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask) list)
     242     (simple-typed-aset2  #.(logior operator-acode-subforms-mask operator-single-valued-mask) :infer)
     243     (consp  #.(logior operator-cc-invertable-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-boolean-mask) boolean)
     244     (aset1  #.(logior operator-acode-subforms-mask) :infer)
     245     ()
     246     (car  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) :infer)
     247     (cdr  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) :infer)
     248     (length  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) fixnum)
     249     (list-length  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) t)
     250     (ensure-simple-string  #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) simple-base-string)
     251     (%ilsr  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) fixnum)
     252     (set  #.(logior operator-single-valued-mask operator-acode-subforms-mask) :infer)
     253     (eql  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-boolean-mask) boolean)
     254     (%iasr  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) fixnum)
     255     (logand2  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) integer)
     256     (logior2  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) integer)
     257     (logxor2  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) integer)
     258     (%i<>  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask) boolean)
     259     (set-car  #.(logior operator-single-valued-mask operator-acode-subforms-mask) :infer)
     260     (set-cdr  #.(logior operator-single-valued-mask operator-acode-subforms-mask) :infer)
     261     (rplaca  #.(logior operator-single-valued-mask operator-acode-subforms-mask) cons)
     262     (rplacd  #.(logior operator-single-valued-mask operator-acode-subforms-mask) cons)
     263     (with-variable-c-frame  #.(logior operator-acode-list-mask operator-assignment-free-mask) :infer)
     264     (uvref  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) :infer)
     265     (uvset  #.(logior operator-single-valued-mask operator-acode-subforms-mask) :infer)
     266     (%temp-cons  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) cons)
     267     (%temp-List  #.(logior operator-single-valued-mask operator-side-effect-free-mask) list)
     268     (%make-uvector  #.(logior operator-assignment-free-mask operator-single-valued-mask  operator-side-effect-free-mask operator-acode-subforms-mask) :infer)
     269     (%decls-body  0 :infer)
     270     (%old-gvector  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) :infer)
     271     (%typed-uvref  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) :infer)
     272     (%typed-uvset  #.(logior operator-single-valued-mask operator-acode-subforms-mask) :infer)
     273     (schar  #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) character)
     274     (set-schar  #.(logior operator-single-valued-mask operator-acode-subforms-mask) character)
     275     (code-char  #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) character)
     276     (char-code  #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) (mod #.char-code-limit))
     277     (list*  #.(logior operator-assignment-free-mask operator-single-valued-mask  operator-side-effect-free-mask) :infer)
     278     ()
     279     (symbolp  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-boolean-mask) boolean)
     280     (fixnum-sub-no-overflow  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) fixnum)
     281     (fixnum-sub-overflow  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) integer)
     282     (int>0-p  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask) boolean)
     283     ()
     284     ()
     285     ()
     286     (istruct-typep  #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask) boolean)
     287     (%ilogxor2  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) fixnum)
     288     (%err-disp  0 nil)
     289     (%quo2  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) number)
     290     (minus1  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) number)
     291     (%ineg  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) integer)
     292     (%i*  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) fixnum)
     293     (logbitp  #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-boolean-mask) boolean)
     294     (%sbchar  0 character)
     295     ()
     296     (%set-sbchar  #.(logior operator-single-valued-mask operator-acode-subforms-mask) character)
     297     (%scharcode  #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) (mod #.char-code-limit))
     298     (%set-scharcode  #.(logior operator-single-valued-mask operator-acode-subforms-mask) (mod #.char-code-limit))
     299     (lambda-list  0 :infer)
     300     ()
     301     (lisptag  #.(logior operator-single-valued-mask operator-acode-subforms-mask) (unsigned-byte 8))
     302     (fulltag  #.(logior operator-single-valued-mask operator-acode-subforms-mask) (unsigned-byte 8))
     303     (typecode  #.(logior operator-single-valued-mask operator-acode-subforms-mask) (unsigned-byte 8))
     304     (require-simple-vector  #.(logior operator-single-valued-mask operator-acode-subforms-mask) simple-vector)
     305     (require-simple-string  #.(logior operator-single-valued-mask operator-acode-subforms-mask) simple-base-string)
     306     (require-integer  #.(logior operator-single-valued-mask operator-acode-subforms-mask) integer)
     307     (require-fixnum  #.(logior operator-single-valued-mask operator-acode-subforms-mask) fixnum)
     308     (require-real  #.(logior operator-single-valued-mask operator-acode-subforms-mask) real)
     309     (require-list  #.(logior operator-single-valued-mask operator-acode-subforms-mask) list)
     310     (require-character  #.(logior operator-single-valued-mask operator-acode-subforms-mask) character)
     311     (require-number  #.(logior operator-single-valued-mask operator-acode-subforms-mask) number)
     312     (require-symbol  #.(logior operator-single-valued-mask operator-acode-subforms-mask) symbol)
     313     (base-char-p  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask) boolean)
     314     ()
     315     (%unbound-marker  #.operator-single-valued-mask t)
     316     (%slot-unbound-marker  #.operator-single-valued-mask t)
     317     (%gvector  #.(logior operator-assignment-free-mask operator-single-valued-mask) :infer)
     318     (immediate-get-ptr  #.(logior operator-returns-address-mask operator-acode-subforms-mask) macptr)
     319     (%lisp-word-ref  #.(logior operator-single-valued-mask operator-acode-subforms-mask) t)
     320     (%lisp-lowbyte-ref  #.(logior operator-single-valued-mask operator-acode-subforms-mask) (unsigned-byte 8))
     321     (poweropen-ff-call  0 :infer)
     322     (double-float-compare  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask) boolean)
     323     (builtin-call  0 :infer)
     324     (%setf-double-float  #.(logior operator-single-valued-mask operator-acode-subforms-mask) double-float)
     325     (%double-float+-2  #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask) double-float)
     326     (%double-float--2   #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask) double-float)
     327     (%double-float*-2   #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask) double-float)
     328     (%double-float/-2   #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask) double-float)
     329     ()
     330     ()
     331     ()
     332     ()
     333     ()
     334     (%debug-trap  #.operator-acode-subforms-mask t)
     335     (%%ineg  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) fixnum)
     336     (%setf-short-float  #.(logior operator-single-valued-mask operator-acode-subforms-mask) single-float)
     337     (%short-float+-2   #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask) single-float)
     338     (%short-float--2   #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask) single-float)
     339     (%short-float*-2   #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask) single-float)
     340     (%short-float/-2   #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask) single-float)
     341     (short-float-compare  #.operator-acode-subforms-mask boolean)
     342     (eabi-ff-call  0 :infer)
     343     (%reference-external-entry-point  #.operator-acode-subforms-mask t)
     344     ()
     345     (%get-bit  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) bit)
     346     (%set-bit    #.(logior operator-single-valued-mask operator-acode-subforms-mask) bit)
     347     (%natural+   #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) natural)
     348     (%natural-   #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) natural)
     349     (%natural-logand   #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) natural)
     350     (%natural-logior  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) natural)
     351     (%natural-logxor   #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) natural)
     352     (%natural<>  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask) boolean)
     353     (%get-double-float  #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) double-float)
     354     (%get-single-float  #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) single-float)
     355     (%set-double-float  #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) double-float)
     356      (%set-single-float  #.(logior operator-single-valued-mask operator-acode-subforms-mask) single-float)
     357     (natural-shift-right   #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) natural)
     358     (natural-shift-left   #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) natural)
     359     (global-ref  0 :infer)
     360     (global-setq  0 :infer)
     361     ()
     362     (%interrupt-poll   #.(logior operator-assignment-free-mask operator-single-valued-mask) nil)
     363     (with-c-frame  #.(logior operator-acode-list-mask operator-assignment-free-mask operator-side-effect-free-mask):infer)   
     364     (%current-frame-ptr  0 fixnum)
     365     (%slot-ref  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask) :infer)
     366     (%illegal-marker  #.operator-single-valued-mask t)
     367     (%symbol->symptr  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) t)
     368     (%single-to-double   #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) double-float)
     369     (%double-to-single  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) single-float)
     370     (%symptr->symvector   #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) t)
     371     (%symvector->symptr   #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) t)
     372     (%foreign-stack-pointer  0 fixnum)
     373     (mul2  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) number)
     374     (div2  #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) number)
     375     (%fixnum-to-single   #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) single-float)
     376     (%fixnum-to-double   #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask) double-float)
     377     (require-s8  #.(logior operator-single-valued-mask operator-acode-subforms-mask) (signed-byte 8))
     378     (require-u8  #.(logior operator-single-valued-mask operator-acode-subforms-mask) (unsigned-byte 8))
     379     (require-s16  #.(logior operator-single-valued-mask operator-acode-subforms-mask) (signed-byte 16))
     380     (require-u16  #.(logior operator-single-valued-mask operator-acode-subforms-mask) (unsigned-byte 16))
     381     (require-s32  #.(logior operator-single-valued-mask operator-acode-subforms-mask) (signed-byte 32))
     382     (require-u32  #.(logior operator-single-valued-mask operator-acode-subforms-mask) (unsigned-byte 32))
     383     (require-s64  #.(logior operator-single-valued-mask operator-acode-subforms-mask) (signed-byte 64))
     384     (require-u64  #.(logior operator-single-valued-mask operator-acode-subforms-mask) (unsigned-byte 64))
     385     (general-aref2   #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask) :infer)
     386     (%single-float   #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask) single-float)
     387     (%double-float  #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask) double-float)
     388     (i386-ff-call  0 :infer)
     389     ()
     390     (%double-float-negate  #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask) double-float)
     391     (%single-float-negate  #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask) single-float) )))
    392392
    393393(defmacro %nx1-operator (sym)
    394394  (let ((op (assq sym *next-nx-operators*)))
    395     (if op (logior (%cdr op) (length (%cdr (memq op *next-nx-operators*))))
     395    (if op (logior (cadr op) (length (%cdr (memq op *next-nx-operators*))))
    396396        (error "Bug - operator not found for ~S" sym))))
    397397
     
    402402            *next-nx-operators*)))
    403403
    404 (declaim (special *nx1-alphatizers* *nx1-operators*))
     404(declaim (special *nx1-alphatizers* *nx1-operators* *acode-operator-types*))
    405405
    406406(defmacro %nx1-default-operator ()
     
    413413
    414414(defmacro next-nx-defops (&aux (ops (gensym))
    415                                 (num (gensym))
    416                                 (flags (gensym))
     415                                (num (gensym))
     416                                (name (gensym))
     417                                (flags (gensym))
     418                                (type (gensym))
    417419                                (op (gensym)))
     420  (dolist (def *next-nx-operators*)
     421    (when def
     422      (destructuring-bind (name flags &optional (type t type-p)) def
     423        (declare (ignore name flags))
     424        (unless (and type-p
     425                     (or (eq type :infer)
     426                         (specifier-type-if-known type)))
     427          (warn "Suspect operator type definition in ~s" def)))))
    418428  `(let ((,num ,(length *next-nx-operators*))
    419429         (,ops ',*next-nx-operators*)
    420          (,flags nil)
    421430         (,op nil))
    422431     (while ,ops
    423        (setq ,op (%car ,ops)  ,flags (cdr ,op)
    424              ,num (%i- ,num 1))
     432       (setq ,op (%car ,ops) ,num (%i- ,num 1))
    425433       (when ,op
    426          (setf (gethash (car ,op) *nx1-operators*)
    427                (logior ,flags ,num)))
     434         (destructuring-bind (,name ,flags ,type) ,op
     435         (setf (gethash ,name *nx1-operators*)
     436               (logior ,flags ,num)
     437               (svref *acode-operator-types* ,num)
     438               ,type)))
    428439       (setq ,ops (cdr ,ops)))))
    429440
     
    533544        ((ignorable ignore-if-unused) (setq bits (%ilogior bits (%ilsl $vbitignoreunused 1))))
    534545        (dynamic-extent (setq bits (%ilogior bits (%ilsl $vbitdynamicextent 1))))
    535         (type (let* ((type (cdr decl)))
    536                 (cond ((or (eq type 'double-float)
    537                            (subtypep type 'double-float))
    538                        (setf (var-declared-unboxed-type node) 'double-float))
    539                       ((or (eq type 'single-float)
    540                            (subtypep type 'single-float))
    541                        (setf (var-declared-unboxed-type node) 'single-float)))))))
     546        (type (let* ((type (cdr decl))
     547                     (ctype (specifier-type-if-known type env)))
     548                (when ctype (setf (var-declared-type node)
     549                                  (type-specifier ctype)))))))
    542550    node))
    543551
Note: See TracChangeset for help on using the changeset viewer.