Changeset 7218


Ignore:
Timestamp:
Sep 14, 2007, 9:46:01 PM (12 years ago)
Author:
rme
Message:

Clean up %define-x8632-lap-function a bit.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/ia32/compiler/X86/x86-lap.lisp

    r7102 r7218  
    114114(defun (setf frag-ref) (new frag index)
    115115  (setf (%vector-list-ref (frag-code-buffer frag) index) new))
     116
     117;;; get/set little-endian 32 bit word in frag at index
     118(defun frag-ref-32 (frag index)
     119  (let ((result 0))
     120    (setf (ldb (byte 8 0) result) (frag-ref frag index)
     121          (ldb (byte 8 8) result) (frag-ref frag (+ index 1))
     122          (ldb (byte 8 16) result) (frag-ref frag (+ index 2))
     123          (ldb (byte 8 24) result) (frag-ref frag (+ index 3)))
     124    result))
     125
     126(defun (setf frag-ref-32) (new frag index)
     127  (setf (frag-ref frag index) (ldb (byte 8 0) new)
     128        (frag-ref frag (+ index 1)) (ldb (byte 8 8) new)
     129        (frag-ref frag (+ index 2)) (ldb (byte 8 16) new)
     130        (frag-ref frag (+ index 3)) (ldb (byte 8 24) new)))
    116131
    117132(defun frag-length (frag)
     
    198213(defparameter *x86-lap-fixed-code-words* nil)
    199214(defvar *x86-lap-lfun-bits* 0)
    200 
    201 (defvar *x86-lap-self-reference-offsets* ())
    202 
    203215
    204216(defun x86-lap-macro-function (name)
     
    428440                 condition form)
    429441          val)))))
     442
     443(defun x86-acc-reg-p (regname)
     444  (let ((r (lookup-x86-register regname :%)))
     445    (if r
     446      (logtest (x86::encode-operand-type :acc) (x86::reg-entry-reg-type r)))))
    430447
    431448(defun x86-byte-reg-p (regname)
     
    11561173  ;; make it all the way through the frag-list.
    11571174  (loop
    1158     (let* ((address 8))
     1175    (let* ((address (target-arch-case (:x8632 4) (:x8664 8)))) ;after header
    11591176      (declare (fixnum address))
    11601177      (when (do-dll-nodes (frag frag-list t)
     
    13021319                    (:expr32 (emit-long frag pos (x86-lap-expression-value arg)))
    13031320                    (:expr64 (emit-quad frag pos (x86-lap-expression-value arg)))
    1304                     (:self (push pos *x86-lap-self-reference-offsets*))))))))))))
    1305 
    1306 ;;; maintain count in a special variable instead?
    1307 (defun count-self-relocs (frag-list)
    1308   (let ((n 0))
    1309     (ccl::do-dll-nodes (frag frag-list n)
    1310       (dolist (reloc (frag-relocs frag))
    1311         (when (eq (reloc-type reloc) :self)
    1312           (incf n))))))
    1313 
    1314 (defun insert-self-reference-offsets (frag offset)
    1315   (dolist (w *x86-lap-self-reference-offsets*)
    1316     (format t "~&self-reference-offset at ~a" w)
    1317     (setf (frag-ref frag offset) (ldb (byte 8 0) w))
    1318     (setf (frag-ref frag (+ offset 1)) (ldb (byte 8 8) w))
    1319     (setf (frag-ref frag (+ offset 2)) (ldb (byte 8 16) w))
    1320     (setf (frag-ref frag (+ offset 3)) (ldb (byte 8 24) w))
    1321     (incf offset 4)))
     1321                    (:self (emit-long frag pos (x86-lap-expression-value arg)))))))))))))
    13221322
    13231323(defun frag-emit-nops (frag count)
     
    13801380      (dolist (form body)
    13811381        (x86-lap-form form fraglist instruction)))))         
    1382                
     1382
     1383;;; xxx --- need to call COMPILER-FUNCTION-OVERFLOW somewhere if the code
     1384;;; size exceeds 65535 words on IA-32.
     1385
    13831386(defun cross-create-x86-function (name frag-list constants bits debug-info)
    13841387  (let* ((constants-vector (%alloc-misc (+ (length constants)
     
    14781481(defun %define-x8632-lap-function (name forms &optional (bits 0))
    14791482  (let* ((*x86-lap-labels* ())
    1480          (*x86-lap-self-reference-offsets* ())
    14811483         (*x86-lap-constants* ())
    1482          (*x86-lap-entry-offset* 6)
     1484         (*x86-lap-entry-offset* x8632::fulltag-misc)
    14831485         (*x86-lap-fixed-code-words* nil)
    14841486         (*x86-lap-lfun-bits* bits)
     1487         (srt-tag (gensym))
    14851488         (end-code-tag (gensym))
    14861489         (entry-code-tag (gensym))
     
    14891492    (make-x86-lap-label end-code-tag)
    14901493    (make-x86-lap-label entry-code-tag)
    1491     (x86-lap-directive frag-list :short 0) ;count of 32-bit imm. elements
     1494    ;; count of 32-bit words between header and function boundary
     1495    ;; marker, inclusive.
     1496    (x86-lap-directive frag-list :short `(ash (+ (:^ ,end-code-tag)
     1497                                                 *x86-lap-entry-offset*) -2))
    14921498    (emit-x86-lap-label frag-list entry-code-tag)
    1493     (x86-lap-form `(movl ($ :self) (% fn)) frag-list instruction)
     1499    (x86-lap-form '(movl ($ :self) (% fn)) frag-list instruction)
    14941500    (dolist (f forms)
    14951501      (x86-lap-form f frag-list instruction))
     
    14971503    ;; self reference table
    14981504    (x86-lap-directive frag-list :long 0)
    1499     (when *x86-lap-self-reference-offsets*
    1500       (dotimes (i (count-self-relocs frag-list))
    1501         (x86-lap-directive frag-list :long 0)))
     1505    (emit-x86-lap-label frag-list srt-tag)
     1506    ;; reserve space for self-reference offsets
     1507    (do-dll-nodes (frag frag-list)
     1508      (dolist (reloc (frag-relocs frag))
     1509        (when (eq (reloc-type reloc) :self)
     1510          (x86-lap-directive frag-list :long 0))))
    15021511    (x86-lap-directive frag-list :long x8632::function-boundary-marker)
    15031512    (emit-x86-lap-label frag-list end-code-tag)
     
    15131522    (fill-for-alignment frag-list)
    15141523    ;; determine start of self-reference-table
    1515     (let* ((end-code-label
    1516             (find end-code-tag *x86-lap-labels* :test #'eq
    1517                                                 :key #'x86-lap-label-name))
    1518            (start-frag (dll-header-first frag-list))
    1519            (nbytes (frag-list-length frag-list))
    1520            (nwords (ash nbytes (- x8632::word-shift)))
    1521            (frag (x86-lap-label-frag end-code-label))
    1522            (offset (x86-lap-label-offset end-code-label)))
    1523       (insert-self-reference-offsets frag offset)
    1524       ;; count of 32-bit elements
    1525       (setf (frag-ref start-frag 0) (logand #xff nwords)
    1526             (frag-ref start-frag 1) (logand #xff00 nwords)))
     1524    (let* ((label (find srt-tag *x86-lap-labels* :test #'eq
     1525                                                 :key #'x86-lap-label-name))
     1526           (srt-frag (x86-lap-label-frag label))
     1527           (srt-index (x86-lap-label-offset label)))
     1528      ;; fill in self-reference offsets
     1529      (do-dll-nodes (frag frag-list)
     1530        (dolist (reloc (frag-relocs frag))
     1531          (when (eq (reloc-type reloc) :self)
     1532            (setf (frag-ref-32 srt-frag srt-index)
     1533                  (+ (frag-address frag) (reloc-pos reloc)))
     1534            (incf srt-index 4)))))
    15271535    (show-frag-bytes frag-list)
    15281536    (cross-create-x86-function name frag-list *x86-lap-constants* *x86-lap-lfun-bits* nil)))
Note: See TracChangeset for help on using the changeset viewer.