You've already forked lazarus-ccr
implemented some wrapper functions
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@739 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
@ -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.
|
||||
|
||||
Reference in New Issue
Block a user