Changeset 6046


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

RLET, MAKE-RECORD assert pointer's type-ordinal.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/objc-gf/ccl/lib/macros.lisp

    r5974 r6046  
    27842784  (dolist (item inits result)
    27852785    (let* ((name (car item))
    2786            (record-name (cadr item))
    2787            (inits (cddr item))
    2788            (ftype (%foreign-type-or-record record-name)))
     2786           (record-name (cadr item))
     2787           (inits (cddr item))
     2788           (ftype (%foreign-type-or-record record-name))
     2789           (ordinal (foreign-type-ordinal ftype))
     2790           (ordinal-form (if (< ordinal max-canonical-foreign-type-ordinal)
     2791                           ordinal
     2792                           (progn
     2793                             (warn "Non canonical foreign-type-ordinal in ~s"
     2794                                   (unparse-foreign-type ftype))
     2795                             `(foreign-type-ordinal (load-time-value (%foreign-type-or-record ',record-name)))))))
     2796      (setq result (nconc result `((%set-macptr-type ,name ,ordinal-form))))
    27892797      (if (typep ftype 'foreign-record-type)
    2790         (setq result (nconc result (%foreign-record-field-forms name ftype record-name inits)))
    2791         (progn
    2792           ;(setq result (nconc result `((%assert-macptr-ftype ,name ,ftype))))
    2793           (when inits
    2794             (if (and ftype (null (cdr inits)))
     2798        (setq result
     2799              (nconc result (%foreign-record-field-forms name ftype record-name inits)))
     2800        (progn
     2801          (when inits
     2802            (if (and ftype (null (cdr inits)))
    27952803              (setq result
    27962804                    (nconc result
    27972805                           `((setf ,(%foreign-access-form name ftype 0 nil)
    2798                               ,(car inits)))))
     2806                              ,(car inits)))))
    27992807              (error "Unexpected or malformed initialization forms: ~s in field type: ~s"
    28002808                     inits record-name))))))))
     
    28252833  (%foreign-type-or-record-size recname :bytes))
    28262834
    2827 (defmacro make-record (record-name &rest initforms)
    2828   "Expand into code which allocates and initalizes an instance of the type
    2829 denoted by typespec, on the foreign heap. The record is allocated using the
    2830 C function malloc, and the user of make-record must explicitly call the C
    2831 function free to deallocate the record, when it is no longer needed."
     2835(defun make-record-form (record-name allocator &rest initforms)
    28322836  (let* ((ftype (%foreign-type-or-record record-name))
     2837         (ordinal (foreign-type-ordinal ftype))
     2838         (ordinal-form (if (< ordinal max-canonical-foreign-type-ordinal)
     2839                         ordinal
     2840                         `(foreign-type-ordinal (load-time-value (%foreign-type-or-record ',record-name)))))
    28332841         (bits (ensure-foreign-type-bits ftype))
    28342842         (bytes (if bits
     
    28382846         (p (gensym))
    28392847         (bzero (read-from-string "#_bzero")))   
    2840     `(let* ((,p (malloc ,bytes)))
     2848    `(let* ((,p (,allocator ,bytes)))
     2849      (%set-macptr-type ,p ,ordinal-form)
    28412850      (,bzero ,p ,bytes)
    28422851      ,@(%foreign-record-field-forms p ftype record-name initforms)
    28432852      ,p)))
     2853 
     2854(defmacro make-record (record-name &rest initforms)
     2855  "Expand into code which allocates and initalizes an instance of the type
     2856denoted by typespec, on the foreign heap. The record is allocated using the
     2857C function malloc, and the user of make-record must explicitly call the C
     2858function free to deallocate the record, when it is no longer needed."
     2859  (apply 'make-record-form record-name 'malloc initforms))
     2860
     2861(defmacro make-gcable-record (record-name &rest initforms)
     2862  "Like MAKE-RECORD, only advises the GC that the foreign memory can
     2863   be deallocated if the returned pointer becomes garbage."
     2864  (apply 'make-record-form record-name '%new-gcable-ptr initforms))
    28442865
    28452866(defmacro with-terminal-input (&body body)
Note: See TracChangeset for help on using the changeset viewer.