Changeset 8392
- Timestamp:
- Feb 1, 2008, 8:46:51 PM (17 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/source-tracking-0801/ccl/compiler/X86/x862.lisp
r8390 r8392 432 432 0 433 433 (min (- (ash ea (- x8664::word-shift)) count) #xff))) 434 435 434 (defun x862-compile (afunc &optional lambda-form *x862-record-symbols*) 436 435 (progn … … 534 533 (with-dll-node-freelist ((frag-list make-frag-list) *frag-freelist*) 535 534 (with-dll-node-freelist ((uuo-frag-list make-frag-list) *frag-freelist*) 536 (let* ((*x86-lap-labels* nil) 537 (instruction (x86::make-x86-instruction)) 538 (end-code-tag (gensym)) 539 debug-info) 540 (make-x86-lap-label end-code-tag) 541 (x86-lap-directive frag-list :long `(ash (+ (- (:^ ,end-code-tag ) 8) 542 *x86-lap-entry-offset*) -3)) 543 (x86-lap-directive frag-list :byte 0) ;regsave PC 544 (x86-lap-directive frag-list :byte 0) ;regsave ea 545 (x86-lap-directive frag-list :byte 0) ;regsave mask 546 547 (x862-expand-vinsns vinsns frag-list instruction uuo-frag-list) 548 (when (or *x862-double-float-constant-alist* 549 *x862-single-float-constant-alist*) 535 (let* ((*x86-lap-labels* nil) 536 (instruction (x86::make-x86-instruction)) 537 (end-code-tag (gensym)) 538 debug-info) 539 (make-x86-lap-label end-code-tag) 540 (x86-lap-directive frag-list :long `(ash (+ (- (:^ ,end-code-tag ) 8) 541 *x86-lap-entry-offset*) 542 -3)) 543 (x86-lap-directive frag-list :byte 0) ;regsave PC 544 (x86-lap-directive frag-list :byte 0) ;regsave ea 545 (x86-lap-directive frag-list :byte 0) ;regsave mask 546 547 (x862-expand-vinsns vinsns frag-list instruction uuo-frag-list) 548 (when (or *x862-double-float-constant-alist* 549 *x862-single-float-constant-alist*) 550 (x86-lap-directive frag-list :align 3) 551 (dolist (double-pair *x862-double-float-constant-alist*) 552 (destructuring-bind (dfloat . lab) double-pair 553 (setf (vinsn-label-info lab) (emit-x86-lap-label frag-list lab)) 554 (multiple-value-bind (high low) 555 (x862-double-float-bits dfloat) 556 (x86-lap-directive frag-list :long low) 557 (x86-lap-directive frag-list :long high)))) 558 (dolist (single-pair *x862-single-float-constant-alist*) 559 (destructuring-bind (sfloat . lab) single-pair 560 (setf (vinsn-label-info lab) (emit-x86-lap-label frag-list lab)) 561 (let* ((val (single-float-bits sfloat))) 562 (x86-lap-directive frag-list :long val))))) 550 563 (x86-lap-directive frag-list :align 3) 551 (dolist (double-pair *x862-double-float-constant-alist*) 552 (destructuring-bind (dfloat . lab) double-pair 553 (setf (vinsn-label-info lab) (emit-x86-lap-label frag-list lab)) 554 (multiple-value-bind (high low) 555 (x862-double-float-bits dfloat) 556 (x86-lap-directive frag-list :long low) 557 (x86-lap-directive frag-list :long high)))) 558 (dolist (single-pair *x862-single-float-constant-alist*) 559 (destructuring-bind (sfloat . lab) single-pair 560 (setf (vinsn-label-info lab) (emit-x86-lap-label frag-list lab)) 561 (let* ((val (single-float-bits sfloat))) 562 (x86-lap-directive frag-list :long val))))) 563 (x86-lap-directive frag-list :align 3) 564 (x86-lap-directive frag-list :quad x8664::function-boundary-marker) 565 (emit-x86-lap-label frag-list end-code-tag) 566 (dolist (c (reverse *x862-constant-alist*)) 567 (let* ((vinsn-label (cdr c))) 568 (or (vinsn-label-info vinsn-label) 569 (setf (vinsn-label-info vinsn-label) 570 (find-or-create-x86-lap-label 571 vinsn-label))) 572 (emit-x86-lap-label frag-list vinsn-label) 573 (x86-lap-directive frag-list :quad 0))) 564 (x86-lap-directive frag-list :quad x8664::function-boundary-marker) 565 (emit-x86-lap-label frag-list end-code-tag) 566 (dolist (c (reverse *x862-constant-alist*)) 567 (let* ((vinsn-label (cdr c))) 568 (or (vinsn-label-info vinsn-label) 569 (setf (vinsn-label-info vinsn-label) 570 (find-or-create-x86-lap-label 571 vinsn-label))) 572 (emit-x86-lap-label frag-list vinsn-label) 573 (x86-lap-directive frag-list :quad 1))) 574 574 575 (if (logbitp $fbitnonnullenv (the fixnum (afunc-bits afunc)))575 (if (logbitp $fbitnonnullenv (the fixnum (afunc-bits afunc))) 576 576 (setq bits (+ bits (ash 1 $lfbits-nonnullenv-bit)))) 577 578 579 580 (unless (afunc-parent afunc) 581 (x862-fixup-fwd-refs afunc)) 582 (setf (afunc-all-vars afunc) nil) 583 584 (let* ((regsave-label (if (typep *x862-compiler-register-save-label* 'vinsn-note) 577 (unless (afunc-parent afunc) 578 (x862-fixup-fwd-refs afunc)) 579 (setf (afunc-all-vars afunc) nil) 580 (let* ((regsave-label (if (typep *x862-compiler-register-save-label* 'vinsn-note) 585 581 (vinsn-label-info (vinsn-note-label *x862-compiler-register-save-label*)))) 586 (regsave-mask (if regsave-label (x862-register-mask-byte 587 *x862-register-restore-count*))) 588 (regsave-addr (if regsave-label (x862-encode-register-save-ea 589 *x862-register-restore-ea* 590 *x862-register-restore-count*)))) 591 592 (when (or lambda-form 593 (and *compiler-record-source* *definition-source-note*) 594 *x862-recorded-symbols* 595 (and *compiler-record-source* *x862-emitted-source-notes*)) 596 (x86-lap-directive frag-list :quad 0)) 597 (when fname 598 (x86-lap-directive frag-list :quad 0)) 599 (x86-lap-directive frag-list :quad 0) 600 (relax-frag-list frag-list) 601 (apply-relocs frag-list) 602 (fill-for-alignment frag-list) 603 (x862-lap-process-regsave-info frag-list regsave-label regsave-mask regsave-addr) 604 (setf debug-info 605 (nconc (when lambda-form 606 (list 'function-debugging-info lambda-form)) 607 (when (and *compiler-record-source* *definition-source-note*) 608 (list 'function-source-note 609 (source-note-to-list *definition-source-note* :form nil :children nil))) 610 (when *x862-recorded-symbols* 611 (list 'function-symbol-map (x862-digest-symbols))) 612 (when (and *compiler-record-source* 613 *x862-emitted-source-notes* 614 *definition-source-note*) 615 (list 'pc-source-map 616 (x862-generate-pc-source-map *definition-source-note* 617 *x862-emitted-source-notes*))))) 618 (when debug-info 619 (setq bits (logior (ash 1 $lfbits-info-bit) bits))) 620 (unless fname 621 (setq bits (logior (ash 1 $lfbits-noname-bit) bits))) 622 (setf (afunc-argsword afunc) bits) 623 (setf (afunc-lfun afunc) 624 #+x86-target 625 (if (eq *host-backend* *target-backend*) 626 (create-x86-function fname frag-list *x862-constant-alist* bits debug-info) 582 (regsave-mask (if regsave-label (x862-register-mask-byte 583 *x862-register-restore-count*))) 584 (regsave-addr (if regsave-label (x862-encode-register-save-ea 585 *x862-register-restore-ea* 586 *x862-register-restore-count*)))) 587 588 589 (when (or (afunc-lfun-info afunc) 590 lambda-form 591 (and *compiler-record-source* *definition-source-note*) 592 *x862-recorded-symbols* 593 (and *compiler-record-source* *x862-emitted-source-notes* *definition-source-note*)) 594 (x86-lap-directive frag-list :quad 0)) 595 (when fname 596 (x86-lap-directive frag-list :quad 0)) 597 (x86-lap-directive frag-list :quad 0) 598 (relax-frag-list frag-list) 599 (apply-relocs frag-list) 600 (fill-for-alignment frag-list) 601 (x862-lap-process-regsave-info frag-list regsave-label regsave-mask regsave-addr) 602 (setf debug-info 603 (nconc (copy-list (afunc-lfun-info afunc)) 604 (when lambda-form 605 (list 'function-debugging-info lambda-form)) 606 (when (and *compiler-record-source* *definition-source-note*) 607 (list 'function-source-note 608 (source-note-to-list *definition-source-note* :form nil :children nil))) 609 (when *x862-recorded-symbols* 610 (list 'function-symbol-map *x862-recorded-symbols*)) 611 (when (and *compiler-record-source* 612 *x862-emitted-source-notes* 613 *definition-source-note*) 614 (list 'pc-source-map 615 (x862-generate-pc-source-map *definition-source-note* 616 *x862-emitted-source-notes*))))) 617 (when debug-info 618 (setq bits (logior (ash 1 $lfbits-info-bit) bits))) 619 (unless (or fname lambda-form *x862-recorded-symbols*) 620 (setq bits (logior (ash 1 $lfbits-noname-bit) bits))) 621 (setf (afunc-argsword afunc) bits) 622 (setf (afunc-lfun afunc) 623 #+x86-target 624 (if (eq *host-backend* *target-backend*) 625 (create-x86-function fname frag-list *x862-constant-alist* bits debug-info) 627 626 (cross-create-x86-function fname frag-list *x862-constant-alist* bits debug-info)) 628 #-x86-target629 (cross-create-x86-function fname frag-list *x862-constant-alist* bits ())))630 ))))627 #-x86-target 628 (cross-create-x86-function fname frag-list *x862-constant-alist* bits debug-info)) 629 (x862-digest-symbols)))))) 631 630 (backend-remove-labels)))) 632 631 afunc))
Note:
See TracChangeset
for help on using the changeset viewer.
