Changeset 6079


Ignore:
Timestamp:
Mar 21, 2007, 10:30:57 AM (13 years ago)
Author:
gb
Message:

Package defs moved elsewhere.

Lose the concept of foreign-struct encapsulations.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/objc-gf/ccl/examples/objc-runtime.lisp

    r6059 r6079  
    4949  (use-interface-dir :gnustep))
    5050
    51 (defpackage "OBJC"
    52   (:use)
    53   (:export "OBJC-OBJECT" "OBJC-CLASS-OBJECT" "OBJC-CLASS" "OBJC-METACLASS"))
     51
    5452
    5553(eval-when (:compile-toplevel :load-toplevel :execute)
     54  (require "OBJC-PACKAGE")
    5655  (require "SPLAY-TREE")
    5756  (require "NAME-TRANSLATION")
    58   ;(require "PROCESS-OBJC-MODULES")
    5957  (require "OBJC-CLOS"))
    6058
     
    12781276           (setf (paref stack-pointer (:* :address) nstackargs) arg-temp)
    12791277           (incf nstackargs))))
    1280       (foreign-struct-encapsulation
    1281        (if (< ngprs 6)
    1282          (progn
    1283            (setf (paref gpr-pointer (:* :address) ngprs)
    1284                  (foreign-struct-encapsulation-data arg-temp))
    1285            (incf ngprs))
    1286          (progn
    1287            (setf (paref stack-pointer (:* :address) nstackargs)
    1288                  (foreign-struct-encapsulation-data arg-temp))
    1289            (incf nstackargs))))
    12901278      (single-float
    12911279       (if (< nfprs 8)
     
    13781366               (incf n-static-stack-args)))
    13791367            (foreign-pointer-type
    1380              (let* ((to (foreign-pointer-type-to static-arg-type))
    1381                     (coerce (get-foreign-struct-association to)))
    1382                (if coerce
    1383                  (setq arg `(foreign-struct-encapsulation-data ,arg))))
    13841368             (static-arg-forms
    13851369              `(setf (paref ,gpr-base (:* address) ,gpr-offset) ,arg))
     
    14281412      (let* ((args (objc-gen-message-arglist (length arg-type-specs)))
    14291413             (struct-return-var nil)
    1430              (struct-return-coerce nil)
    14311414             (receiver (gensym))
    14321415             (selector (gensym)))
    14331416        (collect ((call)
    1434                   (stack-blocks)        ; for anonymous structures
    1435                   (imports)
    1436                   (exports))
     1417                  (lets))
    14371418          (let* ((result-type (parse-foreign-type return-type-spec)))
    1438             (if (typep result-type 'foreign-record-type)
    1439               (let* ((coerce-info (get-foreign-struct-association result-type)))
    1440                 (unless coerce-info
    1441                   (error "Can't return structure type ~s" return-type-spec))
    1442                 (setq struct-return-var (gensym))
    1443                 (stack-blocks `(,struct-return-var ,(ceiling (require-foreign-type-bits result-type) 8)))
    1444                 (call struct-return-var)
    1445                 (setq struct-return-coerce `(funcall ,(foreign-struct-association-return-function coerce-info) ,struct-return-var))))
     1419            (when (typep result-type 'foreign-record-type)
     1420              (setq struct-return-var (gensym))
     1421              (lets `(struct-return-var (make-gcable-record ,return-type-spec)))
     1422              (call struct-return-var))
    14461423            (call :id)
    14471424            (call receiver)
     
    14511428                 (spec (pop arg-type-specs) (pop arg-type-specs)))
    14521429                ((null args) (call return-type-spec))
    1453               (let* ((arg (car args))
    1454                      (ftype (unless (eq spec :id) (parse-foreign-type spec))))
    1455                 (cond ((typep ftype 'foreign-record-type)
    1456                        (let* ((coerce-info (get-foreign-struct-association ftype)))
    1457                          (unless coerce-info
    1458                            (error "Can't pass structure-type ~s by value." spec))
    1459                          (let* ((temp (gensym)))
    1460                            (stack-blocks `(,temp ,(ceiling (require-foreign-type-bits ftype) 8)))
    1461                            (exports `(,(foreign-struct-association-export-function coerce-info) ,arg ,temp))
    1462                            (call spec)
    1463                            (call temp))))
    1464                       ;; Pointer to structure type known to be passed by
    1465                       ;; value/returned ?
    1466                       ((typep ftype 'foreign-pointer-type)
    1467                        (let* ((to (foreign-pointer-type-to ftype))
    1468                               (coerce-info (if (typep to 'foreign-record-type)
    1469                                              (get-foreign-struct-association to))))
    1470                          (if (null coerce-info)
    1471                            (progn
    1472                              (call spec)
    1473                              (call arg))
    1474                            (let* ((temp (gensym)))
    1475                              (stack-blocks `(,temp ,(ceiling (require-foreign-type-bits to) 8)))
    1476                              (exports `(,(foreign-struct-association-export-function coerce-info) ,arg ,temp))
    1477                              (imports `(,(foreign-struct-association-import-function coerce-info) ,arg ,temp))
    1478                              (call spec)
    1479                              (call temp)))))
    1480                       (t
    1481                        (call spec)
    1482                        (case spec
    1483                          (:<BOOL> (call `(%coerce-to-bool ,arg)))
    1484                          (:id (call `(%coerce-to-address ,arg)))
    1485                          (t
    1486                           (call arg)))))))
     1430              (let* ((arg (car args)))
     1431                 (call spec)
     1432                 (case spec
     1433                   (:<BOOL> (call `(%coerce-to-bool ,arg)))
     1434                   (:id (call `(%coerce-to-address ,arg)))
     1435                   (t
     1436                    (call arg)))))
    14871437            (let* ((call (call))
    1488                    (stack-blocks (stack-blocks))
    1489                    (imports (imports))
    1490                    (exports (exports))
     1438                   (lets (lets))
    14911439                   (body (message-send-form-for-call call return-type-spec super-p)))
    1492               (if imports
    1493                 (setq body `(prog1 ,body ,@imports)))
    1494               (if struct-return-coerce
    1495                 (setq body `(progn ,body ,struct-return-coerce)))
    1496               (if stack-blocks
    1497                 (setq body `(%stack-block ,stack-blocks
    1498                              (progn ,@exports)
     1440              (if struct-return-var
     1441                (setq body `(progn ,body ,struct-return-var)))
     1442              (if lets
     1443                (setq body `(let* ,lets
    14991444                             ,body)))
    15001445              (compile nil
Note: See TracChangeset for help on using the changeset viewer.