Changeset 15798


Ignore:
Timestamp:
Apr 25, 2013, 7:49:49 PM (7 years ago)
Author:
gb
Message:

Even less braindamage!

Location:
branches/acode-rewrite/source
Files:
3 edited

Legend:

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

    r15795 r15798  
    293293   
    294294     
    295 (def-acode-rewrite acode-rewrite-progn progn asserted-type (&whole w &rest forms)
    296   (do* ((form (pop forms) (pop forms)))
     295(def-acode-rewrite acode-rewrite-progn progn asserted-type (forms)
     296  (do* ()
    297297       ((null forms))
    298     (if forms
    299       (rewrite-acode-form form)
    300       (rewrite-acode-form form asserted-type))))
    301 
    302 (def-acode-rewrite acode-rewrite-prog1 prog1 asserted-type  (&whole w (first &rest others))
     298    (let* ((form (pop forms)))
     299      (if forms
     300        (rewrite-acode-form form)
     301        (rewrite-acode-form form asserted-type)))))
     302
     303(def-acode-rewrite acode-rewrite-prog1 (prog1 multiple-value-prog1) asserted-type  (&whole w (first &rest others))
    303304  (rewrite-acode-form first asserted-type)
    304305  (dolist (other others) (rewrite-acode-form other)))
     
    422423  (rewrite-acode-form form (if (or check *acode-rewrite-trust-declarations*) type t)))
    423424
    424 (def-acode-rewrite rewrite-trivial-unary (fixnum immediate simple-function closed-function lexical-reference bound-special-ref special-ref local-go %function) asserted-type (&whole w val)
     425(def-acode-rewrite rewrite-trivial-unary (fixnum immediate simple-function closed-function lexical-reference bound-special-ref special-ref local-go %function global-ref) asserted-type (&whole w val)
    425426  (declare (ignore val)))
    426427
    427428
    428 (def-acode-rewrite rewrite-nullary (t nil %unbound-marker %slot-unbound-marker) asserted-type (&whole w))
     429(def-acode-rewrite rewrite-nullary (t nil %unbound-marker %slot-unbound-marker %illegal-marker %current-tcr %foreign-stack-pointer) asserted-type (&whole w))
    429430
    430431(def-acode-rewrite rewrite-call (call lexical-function-call builtin-call) asserted-type (&whole w callable arglist &optional spread-p)
     
    493494  (with-acode-declarations p2decls (rewrite-acode-form form asserted-type)))
    494495
    495 #||
    496 
    497 
    498 (def-acode-rewrite acode-rewrite-lambda-bind lambda-bind asserted-type (vals req rest keys-p body p2decls)
    499 
     496
     497;;; The backends may try to eliminate the &rest arg if the body is
     498;;; obviously an APPLY that uses it.  We could do that here.
     499(def-acode-rewrite acode-rewrite-lambda-bind lambda-bind asserted-type (vals req rest keys-p auxen body p2decls)
     500  (declare (ignore keys-p rest))
     501  (dolist (var req)
     502    (acode-maybe-punt-var var (pop vals)))
     503  (dolist (val vals)
     504    (rewrite-acode-form val))
     505  (do* ((auxvars (car auxen) (cdr auxvars))
     506        (auxvals (cadr auxen) (cdr auxvals)))
     507       ((null auxvars))
     508    (acode-maybe-punt-var (car auxvars) (car auxvals)))
     509  (with-acode-declarations p2decls (rewrite-acode-form body asserted-type))
    500510)
    501 ||#
     511
     512;;; The frontend may have type-constrained the value.  That should probably
     513;;; happen here.
     514(def-acode-rewrite acode-rewrite-setq-lexical setq-lexical asserted-type (var value)
     515  (declare (ignore var))
     516  (rewrite-acode-form value))
     517
     518(def-acode-rewrite acode-rewrite-unwind-protect unwind-protect asserted-type (protected-form cleanup-form)
     519  (rewrite-acode-form protected-form asserted-type)
     520  (rewrite-acode-form cleanup-form))
     521
     522(def-acode-rewrite acode-rewrite-setq-special setq-special asserted-type (sym val)
     523  (declare (ignore sym))
     524  (rewrite-acode-form val))
     525
     526(def-acode-rewrite acode-rewrite-immediate-get-xxx immediate-get-xxx asserted-type (bits ptr offset)
     527  (declare (ignore bits))
     528  (rewrite-acode-form ptr)
     529  (rewrite-acode-form offset))
     530
     531(def-acode-rewrite with-variable-c-frame with-variable-c-frame asserted-type (size body)
     532  (rewrite-acode-form size)
     533  (rewrite-acode-form body asserted-type))
     534
     535(def-acode-rewrite acode-rewrite-ff-call ff-call asserted-type (address argspecs argvals resultspec &optional monitor)
     536  (declare (ignore argspecs resultspec monitor))
     537  (rewrite-acode-form address)
     538  (dolist (val argvals) (rewrite-acode-form val)))
  • branches/acode-rewrite/source/compiler/nxenv.lisp

    r15795 r15798  
    128128     (or . 0)
    129129     (fixnum-add-overflow . #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    130      (%fixnum-ref . #.operator-single-valued-mask)
    131      (%fixnum-ref-natural . #.operator-single-valued-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))
    132132     (%current-tcr . #.operator-single-valued-mask)
    133133     (%ilognot . #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask ))
     
    168168     (unwind-protect . 0)
    169169     (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 . 0)
     170     (multiple-value-list . #.operator-acode-subforms-mask)
    171171     (%izerop . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-cc-invertable-mask))
    172172     (%immediate-ptr-to-int . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
     
    187187     (nil . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-side-effect-free-mask))
    188188     (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))
     189     (%word-to-int . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask))
    190190     (%svref . #.(logior operator-acode-subforms-mask operator-assignment-free-mask operator-single-valued-mask))
    191191     (%svset . #.(logior operator-acode-subforms-mask operator-single-valued-mask))
    192      (%consmacptr% . 0)
    193      (%macptrptr% . 0)
    194      (%ptr-eql . #.operator-cc-invertable-mask)
    195      (%setf-macptr . 0)
     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)
    196196     (bound-special-ref . #.operator-single-valued-mask)
    197197     (%char-code . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
     
    207207     (fixnum-overflow . #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    208208     (vector . #.(logior operator-assignment-free-mask operator-single-valued-mask))
    209      (%immediate-inc-ptr . #.(logior operator-returns-address-mask operator-single-valued-mask))
     209     (%immediate-inc-ptr . #.(logior operator-returns-address-mask operator-single-valued-mask operator-acode-subforms-mask))
    210210     (general-aref3 . #.(logior operator-acode-subforms-mask operator-single-valued-mask))
    211211     (general-aset2 . #.(logior operator-acode-subforms-mask operator-single-valued-mask))
    212      (%new-ptr . 0)
     212     (%new-ptr . #.operator-acode-subforms-mask)
    213213     (%schar . #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    214214     (%set-schar . #.(logior operator-single-valued-mask operator-acode-subforms-mask)) ;??
     
    223223     (svset . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    224224     (make-list . #.(logior operator-assignment-free-mask operator-single-valued-mask)) ; exists only so we can stack-cons
    225      (%badarg1 . 0)
    226      (%badarg2 . 0)
     225     (%badarg1 . #.operator-acode-subforms-mask)
     226     (%badarg2 . #.operator-acode-subforms-mask)
    227227     (%fixnum-ref-double-float . #.(logior operator-acode-subforms-mask  operator-single-valued-mask))
    228228     (%fixnum-set-double-float . #.(logior operator-acode-subforms-mask  operator-single-valued-mask))
     
    266266     (%temp-cons . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    267267     (%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))
     268     (%make-uvector . #.(logior operator-assignment-free-mask operator-single-valued-mask  operator-side-effect-free-mask operator-acode-subforms-mask))
    269269     (%decls-body . 0)
    270270     (%old-gvector . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
     
    293293     (logbitp . #.(logior operator-single-valued-mask operator-assignment-free-mask operator-acode-subforms-mask operator-side-effect-free-mask operator-boolean-mask))
    294294     (%sbchar . 0)
    295      (%sechar . 0)
    296      (%set-sbchar . 0)
     295     (obsolete-%sechar . 0)
     296     (%set-sbchar . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    297297     (%scharcode . #.(logior operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    298298     (%set-scharcode . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
     
    316316     (%slot-unbound-marker . #.operator-single-valued-mask)
    317317     (%gvector . #.(logior operator-assignment-free-mask operator-single-valued-mask))
    318      (immediate-get-ptr . #.operator-returns-address-mask)
     318     (immediate-get-ptr . #.(logior operator-returns-address-mask operator-acode-subforms-mask))
    319319     (%lisp-word-ref . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    320320     (%lisp-lowbyte-ref . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
     
    322322     (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))
    323323     (builtin-call . 0)
    324      (%setf-double-float . 0)
     324     (%setf-double-float . #.(logior operator-single-valued-mask operator-acode-subforms-mask))
    325325     (%double-float+-2 . #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask))
    326326     (%double-float--2 .  #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask))
     
    332332     (%double-float/-2! . 0)
    333333     (poweropen-syscall . 0)
    334      (%debug-trap . 0)
     334     (%debug-trap . #.operator-acode-subforms-mask)
    335335     (%%ineg . #.(logior operator-assignment-free-mask operator-single-valued-mask operator-acode-subforms-mask operator-side-effect-free-mask))
    336336     (%setf-short-float . 0)
     
    339339     (%short-float*-2 .  #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask))
    340340     (%short-float/-2 .  #.(logior operator-single-valued-mask operator-side-effect-free-mask operator-acode-subforms-mask))
    341      (short-float-compare . 0)
     341     (short-float-compare . #.operator-acode-subforms-mask)
    342342     (eabi-ff-call . 0)
    343343     (%reference-external-entry-point . 0)
  • branches/acode-rewrite/source/level-0/l0-numbers.lisp

    r15797 r15798  
    11541154           (let ((res (%unary-truncate (%double-float/-2! fnum ,divisor f2))))
    11551155             (values res
    1156                      (%double-float--2 fnum (%double-float*-2! (%double-float res f2) ,divisor f2))))))
     1156                     (- (the double-float fnum) (the double-float  (%double-float*-2! (%double-float res f2) ,divisor f2)))))))
    11571157       (truncate-rat-sfloat (number divisor)
    11581158         #+32-bit-target
     
    12421242                          (let* ((res (%unary-truncate (%double-float/-2! fnum divisor f2))))
    12431243                            (values res
    1244                                     (%double-float--2
    1245                                      fnum
    1246                                      (%double-float*-2! (%double-float res f2) divisor f2)))))))))
     1244                                    (-
     1245                                     (the double-float fnum)
     1246                                     (the double-float (%double-float*-2! (%double-float res f2) divisor f2))))))))))
    12471247      (double-float (if (eql divisor 1)
    12481248                      (let ((res (%unary-truncate number)))
     
    12541254                           (let ((res (%unary-truncate (%double-float/-2! number fdiv f2))))
    12551255                             (values res
    1256                                      (%double-float--2
    1257                                       number
    1258                                       (%double-float*-2! (%double-float res f2) fdiv f2))))))                       
     1256                                     (-
     1257                                      (the double-float number)
     1258                                      (the double-float (%double-float*-2! (%double-float res f2) fdiv f2)))))))                       
    12591259                        (double-float
    12601260                         (with-stack-double-floats ((f2))
    12611261                           (let ((res (%unary-truncate (%double-float/-2! number divisor f2))))
    12621262                             (values res
    1263                                      (%double-float--2
    1264                                       number
    1265                                       (%double-float*-2! (%double-float res f2) divisor f2)))))))))
     1263                                     (-
     1264                                      (the double-float number)
     1265                                      (the double-float  (%double-float*-2! (%double-float res f2) divisor f2))))))))))
    12661266      (ratio (number-case divisor
    12671267               (double-float (truncate-rat-dfloat number divisor))
Note: See TracChangeset for help on using the changeset viewer.