From aeb7aaac646317083196fa197eea3df856d14e34 Mon Sep 17 00:00:00 2001 From: skalogryz Date: Fri, 13 Mar 2009 15:32:19 +0000 Subject: [PATCH] implemented some wrapper functions git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@739 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- bindings/objc/objcrtl10.pas | 255 ++++++++++++++++++++++++++++++++++-- 1 file changed, 241 insertions(+), 14 deletions(-) diff --git a/bindings/objc/objcrtl10.pas b/bindings/objc/objcrtl10.pas index 874dbe713..7be5ad4a2 100644 --- a/bindings/objc/objcrtl10.pas +++ b/bindings/objc/objcrtl10.pas @@ -14,6 +14,9 @@ unit objcrtl10; interface +uses + ctypes, objcrtl, dynlibs; + //todo: *10 WRAPPERS! { @@ -29,21 +32,185 @@ interface } -uses - objcrtl, dynlibs; - function InitializeObjCRtl10(const ObjCLibName: AnsiString): Boolean; implementation +const + CLS_CLASS = $1; + CLS_META = $2; + CLS_INITIALIZED = $4; + CLS_POSING = $8; + CLS_MAPPED = $10; + CLS_FLUSH_CACHE = $20; + CLS_GROW_CACHE = $40; + CLS_NEED_BIND = $80; + CLS_METHOD_ARRAY = $100; + // the JavaBridge constructs classes with these markers + CLS_JAVA_HYBRID = $200; + CLS_JAVA_CLASS = $400; + // thread-safe +initialize + CLS_INITIALIZING = $800; + // bundle unloading + CLS_FROM_BUNDLE = $1000; + // C++ ivar support + CLS_HAS_CXX_STRUCTORS = $2000; + // Lazy method list arrays + CLS_NO_METHOD_ARRAY = $4000;//L + // +load implementation + CLS_HAS_LOAD_METHOD = $8000; + + +// all obj-c types are postfixed with 1, to avoid type name confilcts + +type + P_Class = ^_Class; + + Pobjc_class1 = ^objc_class1; + + _Class1 = Pobjc_class1; // can be casted to _Class directly + + Pobjc_object1 = ^objc_object1; + + objc_object1 = record + isa: _Class1; + end; + + Pid1 = ^id1; + id1 = Pobjc_object1; + + Pobjc_selector1 = Pointer; + + PSEL1 = ^SEL1; + + SEL1 = Pobjc_selector1; + + {$WARNINGS OFF} + + IMP1 = function (param1: id; param2: SEL; param3: array of const): id; cdecl; + + Pobjc_ivar_list1 = ^objc_ivar_list1; + {$WARNINGS ON} + + Pobjc_method_list1 = ^objc_method_list1; + PPobjc_method_list1 = ^Pobjc_method_list1; + + Pobjc_cache1 = ^objc_cache1; + + Pobjc_protocol_list1 = ^objc_protocol_list1; + + objc_class1 = packed record + isa : Pobjc_class1; + super_class : Pobjc_class1; + name : PChar; + version : culong; + info : culong; + instance_size : culong; + ivars : Pobjc_ivar_list1; + methodLists : PPobjc_method_list1; + cache : Pobjc_cache1; + protocols : Pobjc_protocol_list1; + end; + + + {* Category Template} + Pobjc_category1 = ^objc_category1; + + Category1 = Pobjc_category1; + + objc_category1 = packed record + category_name : PChar; + class_name : PChar; + instance_methods : Pobjc_method_list1; + class_methods : Pobjc_method_list1; + protocols : Pobjc_protocol_list1; + end; + + {* Instance Variable Template} + Pobjc_ivar1 = ^objc_ivar1; + + Ivar1 = Pobjc_ivar1; + + objc_ivar1 = packed record + ivar_name : PChar; + ivar_type : PChar; + ivar_offset : cint; + {$ifdef __alpha__} + space: cint; + {$endif} + end; + + objc_ivar_list1 = packed record + ivar_count: cint; + {$ifdef __alpha__} + space: cint; + {$endif} + ivar_list: array[0..0] of objc_ivar1; { variable length structure } + end; + + {* Method Template } + Pobjc_method1 = ^objc_method1; + Method1 = Pobjc_method1; + + objc_method1 = packed record + method_name : SEL1; + method_types : PChar; + method_imp : IMP1; + end; + + objc_method_list1 = packed record + obsolete : Pobjc_method_list1; + method_count : cint; + {$ifdef __alpha__} + space: cint; + {$endif} + method_list1 : array[0..0] of objc_method1; { variable length structure } + end; + + { Protocol support } + + Protocol1 = objc_object1; + + objc_protocol_list1 = record + next : Pobjc_protocol_list1; + count : cint; + list : array[0..0] of Protocol1; + end; + + { Constants here moved down } + + { Structure for method cache - allocated/sized at runtime } + + Cache1 = Pobjc_cache1; + + objc_cache1 = record + mask : cuint; { total = mask + 1 } + occupied : cuint; + buckets : array[0..0] of Method1; + end; + +// objective-c 1.0 runtime functions. They are obsolete, for 2.0 +// and no longer available as interface functions +// these functions are used by wrapper-functions ! + +var + objc_addClass : procedure (myClass: _Class); cdecl = nil; + function object_getClass10(obj:id): _Class; cdecl; +var + name : PChar; begin - Result := nil; + if obj = 0 then Result := nil + else begin + Result := _Class(Pobjc_object1(obj)^.isa); + end; end; -function object_setClass10(obj:id; cls: _Class):_Class; cdecl; +function object_setClass10(obj:id; cls: _Class): _Class; cdecl; begin - Result := nil; + // can this be done in that way? + Result := _Class(Pobjc_object1(obj)^.isa); + Pobjc_object1(obj)^.isa := _Class1(cls); end; function object_getIvar10(obj:id; ivar:Ivar):id; cdecl; @@ -53,26 +220,27 @@ end; procedure object_setIvar10(obj:id; ivar:Ivar; value:id); cdecl; begin + //??? end; function class_getName10(cls:_Class):PChar; cdecl; begin - Result := nil; + Result := _Class1(cls)^.name; end; function class_getSuperclass10(cls:_Class):_Class; cdecl; begin - Result := nil; + Result := _Class1(cls)^.super_class; end; function class_isMetaClass10(cls:_Class):BOOL; cdecl; begin - Result := false; + Result := Assigned(cls) and (_Class1(cls)^.Info = CLS_META); end; -function class_copyMethodList10(cls:_Class; outCount:pdword):PMethod; cdecl; +function class_copyMethodList10(cls:_Class; outCount: pdword):PMethod; cdecl; begin - Result := nil; + Result := nil; //todo: ?? end; function class_getMethodImplementation10(cls:_Class; name:SEL):IMP; cdecl; @@ -105,15 +273,70 @@ begin Result := nil; end; - function objc_allocateClassPair10(superclass:_Class; name:pchar; extraBytes:size_t):_Class; cdecl; +var + cl : _Class1; + super : _Class1; + root_class : _Class1; + + new_class : _Class1; + meta_class : _Class1; + namelen : Integer; begin Result := nil; + if (superclass = nil) or (_Class1(objc_lookUpClass(name)) <> nil) then Exit; + super := _Class1(superclass); + + // Find the root class + root_class := super; + while root_class^.super_class <> nil do + root_class := root_class^.super_class; + + // Allocate space for the class and its metaclass + new_class := AllocMem(2 * SizeOf(objc_class1)); + meta_class := @new_class[1]; + + // setup class + new_class^.isa := meta_class; + new_class^.info := CLS_CLASS; + meta_class^.info := CLS_META; + + // Create a copy of the class name. + // For efficiency, we have the metaclass and the class itself + // to share this copy of the name, but this is not a requirement + // imposed by the runtime. + namelen := strlen(name); + new_class^.name := AllocMem(namelen + 1); + Move(name^, new_class^.name^, namelen); + meta_class^.name := new_class^.name; + + // Allocate empty method lists. + // We can add methods later. + new_class^.methodLists := AllocMem (SizeOf(Pobjc_method_list1)); + new_class^.methodLists^ := Pointer(-1); + meta_class^.methodLists := AllocMem (SizeOf(Pobjc_method_list1)); + meta_class^.methodLists^ := Pointer(-1); + + // Connect the class definition to the class hierarchy: + // Connect the class to the superclass. + // Connect the metaclass to the metaclass of the superclass. + // Connect the metaclass of the metaclass to the metaclass of the root class. + new_class^.super_class := super; + meta_class^.super_class := super^.isa; + meta_class^.isa := Pointer(root_class^.isa); + + // Set the sizes of the class and the metaclass. + new_class^.instance_size := super^.instance_size; + meta_class^.instance_size := meta_class^.super_class^.instance_size; + + Result := new_class; end; procedure objc_registerClassPair10(cls:_Class); cdecl; begin - + // Finally, register the class with the runtime. + if cls <> nil then + objc_addClass( _Class(cls)); end; function objc_duplicateClass10(original:_Class; name:pchar; extraBytes:size_t):_Class; cdecl; @@ -263,7 +486,6 @@ begin //_zoneCopy: no substitute //_error: no substitute - //Class Inspection //The following functions are unchanged: @@ -398,6 +620,11 @@ begin //The following functions are added: objc_getProtocol := @objc_getProtocol10; objc_copyProtocolList := @objc_copyProtocolList10; + + // Initializating additional objective-c runtime 1.0 functions + + Pointer(objc_addClass) := GetProcedureAddress(hnd, 'objc_addClass'); + end; end.