Changeset 7859


Ignore:
Timestamp:
Dec 9, 2007, 1:54:02 PM (13 years ago)
Author:
gb
Message:

Support the use of 2 (x86-asm) frag-lists for vinsn expansion (one for
code expected to be executed, one for UUOs.)

Location:
branches/working-0711/ccl/compiler/X86
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/compiler/X86/x86-backend.lisp

    r6466 r7859  
    316316                                 (progn
    317317                                   (list opname
    318                                          (simplify-operand (car opvals)))
    319                                    )
     318                                         (if (eq opname :anchored-uuo)
     319                                           (simplify-form (car opvals))
     320                                           (simplify-operand (car opvals)))))
    320321                                 (let* ((name (string opname)))
    321322                                   (multiple-value-bind (opnum types)
  • branches/working-0711/ccl/compiler/X86/x862.lisp

    r7790 r7859  
    526526           
    527527               (with-dll-node-freelist ((frag-list make-frag-list) *frag-freelist*)
     528                 (with-dll-node-freelist ((uuo-frag-list make-frag-list) *frag-freelist*)
    528529                 (let* ((*x86-lap-labels* nil)
    529530                        (instruction (x86::make-x86-instruction))
     
    537538                   (x86-lap-directive frag-list :byte 0) ;regsave mask
    538539
    539                    (x862-expand-vinsns vinsns frag-list instruction)
     540                   (x862-expand-vinsns vinsns frag-list instruction uuo-frag-list)
    540541                   (when (or *x862-double-float-constant-alist*
    541542                             *x862-single-float-constant-alist*)
     
    605606                           #-x86-target
    606607                           (cross-create-x86-function fname frag-list *x862-constant-alist* bits debug-info)))
    607                    (x862-digest-symbols))))
     608                   (x862-digest-symbols)))))
    608609          (backend-remove-labels))))
    609610    afunc))
     
    52185219         
    52195220   
    5220 (defun x862-expand-vinsns (header frag-list instruction)
     5221(defun x862-expand-vinsns (header frag-list instruction &optional uuo-frag-list)
    52215222  (let* ((immediate-operand (x86::make-x86-immediate-operand)))
    52225223    (do-dll-nodes (v header)
     
    52275228              (setf (vinsn-label-info v) (emit-x86-lap-label frag-list v)))
    52285229            (x862-expand-note frag-list id)))
    5229         (x862-expand-vinsn v frag-list instruction immediate-operand))))
     5230        (x862-expand-vinsn v frag-list instruction immediate-operand uuo-frag-list)))
     5231    (when uuo-frag-list
     5232      (merge-dll-nodes frag-list uuo-frag-list)))
    52305233  ;;; This doesn't have too much to do with anything else that's
    52315234  ;;; going on here, but it needs to happen before the lregs
     
    52485251;;; on entry, but it might be reasonable to make PARSE-OPERAND-FORM
    52495252;;; deal with lregs ...
    5250 (defun x862-expand-vinsn (vinsn frag-list instruction immediate-operand)
     5253(defun x862-expand-vinsn (vinsn frag-list instruction immediate-operand &optional uuo-frag-list)
    52515254  (let* ((template (vinsn-template vinsn))
     5255         (main-frag-list frag-list)
    52525256         (vp (vinsn-variable-parts vinsn))
    52535257         (nvp (vinsn-template-nvp template))
     
    53195323                 (t (compiler-bug "Unknown predicate: ~s" f))))
    53205324             (expand-pseudo-op (f)
    5321                (destructuring-bind (directive arg) f
    5322                  (setq arg (parse-operand-form arg))
    5323                  (let* ((exp (parse-x86-lap-expression arg))
    5324                         (constantp (or (not (x86-lap-expression-p exp))
    5325                                        (constant-x86-lap-expression-p exp))))
    5326                    (if constantp
    5327                      (let* ((val (x86-lap-expression-value exp)))
    5328                        (ecase directive
    5329                          (:byte (frag-list-push-byte frag-list val))
    5330                          (:short (frag-list-push-16 frag-list val))
    5331                          (:long (frag-list-push-32 frag-list val))
    5332                          (:quad (frag-list-push-64 frag-list val))
    5333                          (:align (finish-frag-for-align frag-list val))
    5334                          (:talign (finish-frag-for-talign frag-list val))))
    5335                      (let* ((pos (frag-list-position frag-list))
    5336                             (frag (frag-list-current frag-list))
    5337                             (reloctype nil))
    5338                        (ecase directive
    5339                          (:byte (frag-list-push-byte frag-list 0)
    5340                                 (setq reloctype :expr8))
    5341                          (:short (frag-list-push-16 frag-list 0)
    5342                                  (setq reloctype :expr16))
    5343                          (:long (frag-list-push-32 frag-list 0)
    5344                                 (setq reloctype :expr32))
    5345                          (:quad (frag-list-push-64 frag-list 0)
    5346                                 (setq reloctype :expr64))
    5347                          ((:align :talign) (compiler-bug "~s expression ~s not constant" directive arg)))
    5348                        (when reloctype
    5349                          (push
    5350                           (make-reloc :type reloctype
    5351                                       :arg exp
    5352                                       :pos pos
    5353                                       :frag frag)
    5354                           (frag-relocs frag))))))))
     5325               (case (car f)
     5326                 (:anchored-uuo-section
     5327                  (expand-form '(:uuo-section))
     5328                  (expand-form `(:long (:^ ,(cadr f)))))
     5329                 (:anchored-uuo
     5330                  (expand-form (cadr f))
     5331                  ;; add a trailing 0 byte after the uu0
     5332                  (frag-list-push-byte frag-list 0))
     5333                 ((:uuo :uuo-section)
     5334                      (if uuo-frag-list
     5335                        (progn
     5336                          (setq frag-list uuo-frag-list)
     5337                          (finish-frag-for-align frag-list 2))
     5338                        (compiler-bug "No frag-list for :uuo")))
     5339                 ((:main :main-section)
     5340                  (setq frag-list main-frag-list))
     5341                 (t
     5342                  (destructuring-bind (directive arg) f
     5343                     (setq arg (parse-operand-form arg))
     5344                     (let* ((exp (parse-x86-lap-expression arg))
     5345                            (constantp (or (not (x86-lap-expression-p exp))
     5346                                           (constant-x86-lap-expression-p exp))))
     5347                       (if constantp
     5348                         (let* ((val (x86-lap-expression-value exp)))
     5349                           (ecase directive
     5350                             (:byte (frag-list-push-byte frag-list val))
     5351                             (:short (frag-list-push-16 frag-list val))
     5352                             (:long (frag-list-push-32 frag-list val))
     5353                             (:quad (frag-list-push-64 frag-list val))
     5354                             (:align (finish-frag-for-align frag-list val))
     5355                             (:talign (finish-frag-for-talign frag-list val))))
     5356                         (let* ((pos (frag-list-position frag-list))
     5357                                (frag (frag-list-current frag-list))
     5358                                (reloctype nil))
     5359                           (ecase directive
     5360                             (:byte (frag-list-push-byte frag-list 0)
     5361                                    (setq reloctype :expr8))
     5362                             (:short (frag-list-push-16 frag-list 0)
     5363                                     (setq reloctype :expr16))
     5364                             (:long (frag-list-push-32 frag-list 0)
     5365                                    (setq reloctype :expr32))
     5366                             (:quad (frag-list-push-64 frag-list 0)
     5367                                    (setq reloctype :expr64))
     5368                             ((:align :talign) (compiler-bug "~s expression ~s not constant" directive arg)))
     5369                           (when reloctype
     5370                             (push
     5371                              (make-reloc :type reloctype
     5372                                          :arg exp
     5373                                          :pos pos
     5374                                          :frag frag)
     5375                              (frag-relocs frag))))))))))
    53555376                   
    53565377             (expand-form (f)
     
    63336354      (if (eq (acode-operator form) tagop)
    63346355        (let ((tag (cddr form)))
     6356          (when (cddr tag) (! align-loop-head))
    63356357          (@ (car tag)))
    63366358        (x862-form seg nil nil form)))
Note: See TracChangeset for help on using the changeset viewer.