Changeset 8017


Ignore:
Timestamp:
Jan 8, 2008, 12:37:36 AM (17 years ago)
Author:
Gary Byers
Message:

Use multiple frag-lists ("sections"), so that we can move UUOs out of
line (like in compiled code), so that arg-check traps are always anchored
to the start of the function (if the lap function starts with check-nargs;
should ensure that all lap functions that check nargs do it as the first
explicit operation.)

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/working-0711/ccl/compiler/X86/x86-lap.lisp

    r7858 r8017  
    10151015        (finish-pending-talign-frag frag-list)))))
    10161016
    1017 (defun x86-lap-directive (frag-list directive arg)
    1018   (if (eq directive :tra)
    1019     (progn
    1020       (finish-frag-for-align frag-list 3)
    1021       (x86-lap-directive frag-list :long `(:^ ,arg))
    1022       (emit-x86-lap-label frag-list arg))
    1023     (if (eq directive :fixed-constants)
    1024       (dolist (constant arg)
    1025         (ensure-x86-lap-constant-label constant))
    1026       (if (eq directive :arglist)
    1027         (setq *x86-lap-lfun-bits* (encode-lambda-list arg))
    1028         (let* ((exp (parse-x86-lap-expression arg))
    1029                (constantp (or (constant-x86-lap-expression-p exp)
    1030                               (not (x86-lap-expression-p exp)))))
    1031                
    1032           (if constantp
    1033             (let* ((val (x86-lap-expression-value exp)))
    1034               (ecase directive
    1035                 (:code-size
    1036                  (if *x86-lap-fixed-code-words*
    1037                    (error "Duplicate :CODE-SIZE directive")
    1038                    (setq *x86-lap-fixed-code-words* val)))
    1039                 (:byte (frag-list-push-byte frag-list val))
    1040                 (:short (frag-list-push-16 frag-list val))
    1041                 (:long (frag-list-push-32 frag-list val))
    1042                 (:quad (frag-list-push-64 frag-list val))
    1043                 (:align (finish-frag-for-align frag-list val))
    1044                 (:talign (finish-frag-for-talign frag-list val))
    1045                 (:org (finish-frag-for-org frag-list val))))
    1046             (let* ((pos (frag-list-position frag-list))
    1047                    (frag (frag-list-current frag-list))
    1048                    (reloctype nil))
    1049               (ecase directive
    1050                 (:byte (frag-list-push-byte frag-list 0)
    1051                        (setq reloctype :expr8))
    1052                 (:short (frag-list-push-16 frag-list 0)
    1053                         (setq reloctype :expr16))
    1054                 (:long (frag-list-push-32 frag-list 0)
    1055                        (setq reloctype :expr32))
    1056                 (:quad (frag-list-push-64 frag-list 0)
    1057                        (setq reloctype :expr64))
    1058                 (:align (error ":align expression ~s not constant" arg))
    1059                 (:talign (error ":talign expression ~s not constant" arg)))
    1060               (when reloctype
    1061                 (push
    1062                  (make-reloc :type reloctype
    1063                              :arg exp
    1064                              :pos pos
    1065                              :frag frag)
    1066                  (frag-relocs frag)))))
    1067           nil)))))
     1017;;; Returns the active frag list after processing directive(s).
     1018(defun x86-lap-directive (frag-list directive arg &optional main-frag-list exception-frag-list)
     1019  (declare (ignorable main-frag-list exception-frag-list))
     1020  (case directive
     1021    (:tra
     1022     (finish-frag-for-align frag-list 3)
     1023     (x86-lap-directive frag-list :long `(:^ ,arg))
     1024     (emit-x86-lap-label frag-list arg))
     1025    (:fixed-constants
     1026     (dolist (constant arg)
     1027       (ensure-x86-lap-constant-label constant)))
     1028    (:arglist (setq *x86-lap-lfun-bits* (encode-lambda-list arg)))
     1029    ((:uuo :uuo-section)
     1030     (if exception-frag-list
     1031       (progn
     1032         (setq frag-list exception-frag-list)
     1033         (finish-frag-for-align frag-list 2))))
     1034    ((:main :main-section)
     1035     (when main-frag-list (setq frag-list main-frag-list)))
     1036    (:anchored-uuo-section
     1037     (setq frag-list (x86-lap-directive frag-list :uuo-section nil main-frag-list exception-frag-list))
     1038     (setq frag-list (x86-lap-directive frag-list :long `(:^ ,arg) main-frag-list exception-frag-list)))
     1039    (t (let* ((exp (parse-x86-lap-expression arg))
     1040              (constantp (or (constant-x86-lap-expression-p exp)
     1041                             (not (x86-lap-expression-p exp)))))
     1042         
     1043         (if constantp
     1044           (let* ((val (x86-lap-expression-value exp)))
     1045             (ecase directive
     1046               (:code-size
     1047                (if *x86-lap-fixed-code-words*
     1048                  (error "Duplicate :CODE-SIZE directive")
     1049                  (setq *x86-lap-fixed-code-words* val)))
     1050               (:byte (frag-list-push-byte frag-list val))
     1051               (:short (frag-list-push-16 frag-list val))
     1052               (:long (frag-list-push-32 frag-list val))
     1053               (:quad (frag-list-push-64 frag-list val))
     1054               (:align (finish-frag-for-align frag-list val))
     1055               (:talign (finish-frag-for-talign frag-list val))
     1056               (:org (finish-frag-for-org frag-list val))))
     1057           (let* ((pos (frag-list-position frag-list))
     1058                  (frag (frag-list-current frag-list))
     1059                  (reloctype nil))
     1060             (ecase directive
     1061               (:byte (frag-list-push-byte frag-list 0)
     1062                      (setq reloctype :expr8))
     1063               (:short (frag-list-push-16 frag-list 0)
     1064                       (setq reloctype :expr16))
     1065               (:long (frag-list-push-32 frag-list 0)
     1066                      (setq reloctype :expr32))
     1067               (:quad (frag-list-push-64 frag-list 0)
     1068                      (setq reloctype :expr64))
     1069               (:align (error ":align expression ~s not constant" arg))
     1070               (:talign (error ":talign expression ~s not constant" arg)))
     1071             (when reloctype
     1072               (push
     1073                (make-reloc :type reloctype
     1074                            :arg exp
     1075                            :pos pos
     1076                            :frag frag)
     1077                (frag-relocs frag))))))))
     1078  frag-list)
    10681079
    10691080
    … …  
    10811092         
    10821093
    1083 (defun x86-lap-form (form frag-list instruction)
     1094(defun x86-lap-form (form frag-list instruction  main-frag-list exception-frag-list)
    10841095  (if (and form (symbolp form))
    10851096    (emit-x86-lap-label frag-list form)
    … …  
    10891100          (x86-lap-macroexpand-1 form)
    10901101        (if expanded
    1091           (x86-lap-form expansion frag-list instruction)
     1102          (x86-lap-form expansion frag-list instruction main-frag-list exception-frag-list)
    10921103          (if (typep (car form) 'keyword)
    1093             (destructuring-bind (op arg) form
    1094               (x86-lap-directive frag-list op arg))
     1104            (destructuring-bind (op &optional arg) form
     1105              (setq frag-list (x86-lap-directive frag-list op arg main-frag-list exception-frag-list)))
    10951106            (case (car form)
    10961107              (progn
    10971108                (dolist (f (cdr form))
    1098                   (x86-lap-form f frag-list instruction)))
     1109                  (setq frag-list (x86-lap-form f frag-list instruction main-frag-list exception-frag-list))))
    10991110              (let
    11001111                  (destructuring-bind (equates &body body)
    11011112                      (cdr form)
    1102                     (x86-lap-equate-form equates frag-list instruction body)))
     1113                    (setq frag-list (x86-lap-equate-form equates frag-list instruction body main-frag-list exception-frag-list))))
    11031114              (t
    11041115               (parse-x86-instruction form instruction)
    1105                (x86-generate-instruction-code frag-list instruction)))))))))
     1116               (x86-generate-instruction-code frag-list instruction))))))))
     1117  frag-list)
    11061118
    11071119(defun relax-align (address bits)
    … …  
    13021314      (format t "~2,'0x " (frag-ref frag i)))))
    13031315
    1304 (defun x86-lap-equate-form (eqlist fraglist instruction  body)
     1316(defun x86-lap-equate-form (eqlist fraglist instruction  body main-frag exception-frag)
    13051317  (let* ((symbols (mapcar #'(lambda (x)
    13061318                              (let* ((name (car x)))
    … …  
    13201332                         eqlist)))
    13211333    (progv symbols values
    1322       (dolist (form body)
    1323         (x86-lap-form form fraglist instruction)))))         
     1334      (dolist (form body fraglist)
     1335        (setq fraglist (x86-lap-form form fraglist instruction main-frag exception-frag))))))
    13241336               
    13251337(defun cross-create-x86-function (name frag-list constants bits debug-info)
    … …  
    13851397         (entry-code-tag (gensym))
    13861398         (instruction (x86::make-x86-instruction))
    1387          (frag-list (make-frag-list)))
     1399         (main-frag-list (make-frag-list))
     1400         (exception-frag-list (make-frag-list))
     1401         (frag-list main-frag-list))
    13881402    (make-x86-lap-label end-code-tag)
    13891403    (make-x86-lap-label entry-code-tag)
    … …  
    13941408    (x86-lap-directive frag-list :byte 0) ;regsave mask
    13951409    (emit-x86-lap-label frag-list entry-code-tag)
    1396     (x86-lap-form `(lea (@ (:^ ,entry-code-tag) (% rip)) (% fn)) frag-list instruction)
     1410
     1411    (x86-lap-form `(lea (@ (:^ ,entry-code-tag) (% rip)) (% fn)) frag-list instruction main-frag-list exception-frag-list)
    13971412    (dolist (f forms)
    1398       (x86-lap-form f frag-list instruction))
     1413      (setq frag-list (x86-lap-form f frag-list instruction main-frag-list exception-frag-list)))
     1414    (setq frag-list main-frag-list)
     1415    (merge-dll-nodes frag-list exception-frag-list)
    13991416    (x86-lap-directive frag-list :align 3)
    14001417    (when *x86-lap-fixed-code-words*
Note: See TracChangeset for help on using the changeset viewer.