source: project/release/4/objc/trunk/objc-class-proxies-bin.scm @ 14899

Last change on this file since 14899 was 14899, checked in by Alex Shinn, 12 years ago

initial conversion, not yet working

File size: 3.8 KB
Line 
1;;; Foreign helpers
2
3;; compile: csc -X objc -objc -framework Foundation -s objc-tinyclos-bin.scm scheme-object.m
4;;(declare (emit-external-prototypes-first))
5
6#>
7#import "objc-runtime.h"
8#import <objc/objc-class.h>
9#import <objc/objc-runtime.h>
10#import "scheme-object.h"
11<#
12
13;;; GC root operations
14;; These operate on a pointer which contains the root pointer, such as an instance variable.
15
16(define gc-root-ref
17  (foreign-lambda* scheme-object ((c-pointer ptr))
18                   "return(CHICKEN_gc_root_ref(*(void **)ptr));"))
19
20(define gc-root-set!
21  (foreign-lambda* void ((c-pointer ptr) (scheme-object obj)) #<<EOF
22     void *root = *(void **)ptr;
23     if (root == NULL)
24       root = CHICKEN_new_gc_root();
25       
26     CHICKEN_gc_root_set(root, obj);
27     *(void **)ptr = root;
28EOF
29))
30
31(define gc-root-delete!
32  (foreign-lambda* void (((pointer "void *") ptr))
33                   "if (*ptr) CHICKEN_delete_gc_root(*ptr);"))
34
35;;; Scheme object wrapper
36
37;;;; For instance variables:
38(define scheme-object-wrapper-ref
39  (foreign-lambda* scheme-object (((pointer "Scheme_Object_Wrapper *") ivar_ptr))
40                   "return( [(*ivar_ptr) __scheme_object__] );"))
41
42(define scheme-object-wrapper-set!
43  (foreign-lambda* void (((pointer "Scheme_Object_Wrapper *") ivar_ptr) (scheme-object obj)) #<<EOF
44    if (*ivar_ptr == NULL) {
45      *ivar_ptr = [Scheme_Object_Wrapper alloc];
46    }
47    [(*ivar_ptr) initWithObject: obj];
48EOF
49))
50
51(define scheme-object-wrapper-delete!
52  (foreign-lambda* void (((pointer "Scheme_Object_Wrapper *") ivar_ptr))
53                         "if (*ivar_ptr) [*ivar_ptr release];"))
54
55;;;; For argument conversion:
56
57;; Wrap a scheme object in a Scheme_Object_Wrapper instance so it may be passed
58;; as an ID.  This is not an NSProxy -- messages are not forwarded to the payload.
59;; It's mainly useful for scheme->scheme communication when return or arg type is ID.
60(define (objc:wrap obj)
61  (define obj->id (foreign-lambda* c-pointer ((scheme-object o))
62                                   "return([[Scheme_Object_Wrapper alloc] initWithObject: o]);"))
63  (let* ((id      (obj->id obj))
64         (wrapper (objc:pointer->instance id)))
65      (objc-release id)  ;; remove extra reference count, allowing finalizer to dealloc it
66      wrapper))
67
68(define (objc:unwrap instance)
69  (define wrapper->obj (foreign-lambda* scheme-object (((pointer "Scheme_Object_Wrapper") wrapper))
70                                        "return([wrapper __scheme_object__]);"))
71  (define wrapper? (foreign-lambda* bool (((pointer "NSObject") o))
72                                    "return([o isKindOfClass: [Scheme_Object_Wrapper class]]);"))
73  (let ((ptr (objc:instance->pointer instance)))
74    (if (wrapper? ptr)
75        (wrapper->obj ptr)
76        (error 'objc:unwrap "expected Scheme_Object_Wrapper, got" instance))))
77 
78
79;;; Deallocation
80
81;; Unfortunately, dealloc has to be an FFI closure, not a simple function.  We need
82;; to pass the superclass in, as it depends on the method definition point, not self.
83#>
84#include <ffi.h>
85
86static void objc_method_dealloc(ffi_cif* cif __attribute__((__unused__)), void* resp,
87                                 void** args, void *userdata) {
88  struct objc_super super;
89  id self = *(id *)args[0];
90  SEL _cmd = *(SEL *)args[1];
91  dealloc_scheme(self, userdata);
92
93  super.class = ((Class)userdata)->super_class;
94  RECEIVER(super) = self;
95  objc_msgSendSuper(&super, (SEL)_cmd);
96}
97
98<#
99
100(define objc_method_dealloc (foreign-value "objc_method_dealloc" c-pointer))
101
102;; Temporarily using make-objc:instance so we do not retain this instance, as it
103;; must be released (finalized) before calling the superclass impl, and we don't want
104;; to force a garbage collection. make-objc:instance may be illegal in the future.
105(define-external (dealloc_scheme (c-pointer self) (c-pointer klass-ptr)) void
106  (dealloc-scheme self (objc:pointer->class klass-ptr)))
107
108
109
Note: See TracBrowser for help on using the repository browser.