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

@@ -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;
 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;
 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.