Changeset 6045


Ignore:
Timestamp:
Mar 15, 2007, 11:28:58 AM (13 years ago)
Author:
gb
Message:

Macptr printing in the brave new world.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/objc-gf/ccl/level-1/l1-io.lisp

    r5206 r6045  
    15641564      (if null
    15651565        (progn
    1566           (%write-string "A Null Mac Pointer" stream))
     1566          (%write-string "A Null Foreign Pointer" stream))
    15671567        (progn
    1568           (pp-start-block stream "A Mac Pointer")
    1569           (%write-macptr-termination-info macptr stream)
     1568          (pp-start-block stream "A Foreign Pointer")
     1569          (%write-macptr-allocation-info macptr stream)
    15701570          (stream-write-char stream #\ )
     1571          (%write-macptr-type-info macptr stream)
    15711572          (write-an-integer (%ptr-to-int macptr) stream 16. t))))))
    15721573
    1573 ; redefined by macptr-termination.lisp
    1574 (defun %write-macptr-termination-info (macptr stream)
    1575   (declare (ignore macptr stream)))
    1576 
     1574(defun %write-macptr-allocation-info (macptr stream)
     1575  (if (or (on-any-csp-stack macptr)
     1576          (on-any-tsp-stack macptr))
     1577    (format stream " [stack-allocated]")
     1578    (if (eql (uvsize macptr) target::xmacptr.element-count)
     1579      (format stream " [gcable]"))))
     1580
     1581(defun %write-macptr-type-info (macptr stream)
     1582  (let* ((ordinal (%macptr-type macptr)))
     1583    (unless (eql 0 ordinal)
     1584      (let* ((type (gethash ordinal (ftd-ordinal-types *target-ftd*)))
     1585             (form
     1586              (if (typep type 'foreign-record-type)
     1587                `(:* (,(foreign-record-type-kind type)
     1588                        ,(foreign-record-type-name type)))
     1589                `(:* ,(unparse-foreign-type type)))))
     1590        (when form (format stream "~s " form))))))
     1591         
    15771592
    15781593
Note: See TracChangeset for help on using the changeset viewer.