mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-29 12:30:36 +02:00
objc: removed objcrtl functions, because they're part of fcl
git-svn-id: trunk@21536 -
This commit is contained in:
dmitry
parent
c490900d86
commit
e9eb6109a6
7
.gitattributes
vendored
7
.gitattributes
vendored
@ -4075,7 +4075,6 @@ lcl/interfaces/carbon/interfaces.pas svneol=native#text/pascal
|
||||
lcl/interfaces/carbon/issues.xml svneol=native#text/xml
|
||||
lcl/interfaces/carbon/mackeycodes.inc svneol=native#text/pascal
|
||||
lcl/interfaces/carbon/objc/List.inc svneol=native#text/plain
|
||||
lcl/interfaces/carbon/objc/MacOSobjcrtl.pas svneol=native#text/plain
|
||||
lcl/interfaces/carbon/objc/Object.inc svneol=native#text/plain
|
||||
lcl/interfaces/carbon/objc/Protocol.inc svneol=native#text/plain
|
||||
lcl/interfaces/carbon/objc/clean.sh svneol=native#text/plain
|
||||
@ -4092,12 +4091,6 @@ lcl/interfaces/carbon/objc/objc-runtime.inc svneol=native#text/plain
|
||||
lcl/interfaces/carbon/objc/objc-sync.inc svneol=native#text/plain
|
||||
lcl/interfaces/carbon/objc/objc.inc svneol=native#text/plain
|
||||
lcl/interfaces/carbon/objc/objc.pas svneol=native#text/plain
|
||||
lcl/interfaces/carbon/objc/objcrtl.pas svneol=native#text/plain
|
||||
lcl/interfaces/carbon/objc/objcrtl10.pas svneol=native#text/plain
|
||||
lcl/interfaces/carbon/objc/objcrtl20.pas svneol=native#text/plain
|
||||
lcl/interfaces/carbon/objc/objcrtliPhoneOS.pas svneol=native#text/plain
|
||||
lcl/interfaces/carbon/objc/objcrtltest.pas svneol=native#text/plain
|
||||
lcl/interfaces/carbon/objc/objcrtlutils.pas svneol=native#text/plain
|
||||
lcl/interfaces/carbon/objc/zone.inc svneol=native#text/plain
|
||||
lcl/interfaces/carbon/opengl.pas svneol=native#text/plain
|
||||
lcl/interfaces/carbon/pascocoa/appkit/AppKit.inc svneol=native#text/plain
|
||||
|
||||
@ -1,29 +0,0 @@
|
||||
unit MacOSobjcrtl;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
MacOSAll, objcrtl, objcrtl10, objcrtl20;
|
||||
|
||||
implementation
|
||||
|
||||
procedure InitObjCRunTime;
|
||||
var
|
||||
MacVersion : SInt32;
|
||||
begin
|
||||
if (Gestalt(gestaltSystemVersionMinor, MacVersion) = noErr) then begin
|
||||
if MacVersion >= 5
|
||||
then InitializeObjcRtl20(DefaultObjCLibName)
|
||||
else InitializeObjcRtl10(DefaultObjCLibName);
|
||||
end else
|
||||
InitializeObjcRtl20(DefaultObjCLibName);
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
InitObjCRuntime;
|
||||
|
||||
end.
|
||||
|
||||
@ -1,407 +0,0 @@
|
||||
{
|
||||
objcrtl.pas
|
||||
|
||||
Copyright (C) 2009 Dmitry Boyarintsev
|
||||
|
||||
This unit is a pascal binding for dynamic Objective-C Run-time Library
|
||||
headers included with XCode 3.1.2
|
||||
The original copyright note of is kept on each include file
|
||||
}
|
||||
unit objcrtl;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
dynlibs;
|
||||
|
||||
const
|
||||
DefaultObjCLibName : AnsiString = 'libobjc.A.dylib';
|
||||
|
||||
|
||||
{ Overview
|
||||
--------
|
||||
|
||||
This document describes the Mac OS X Objective-C 2.0 runtime library support
|
||||
functions and data structures. The functions are implemented in the shared
|
||||
library found at /usr/lib/libobjc.A.dylib. This shared library provides support
|
||||
for the dynamic properties of the Objective-C language, and as such is linked
|
||||
to by all Objective-C applications.
|
||||
|
||||
This reference is useful primarily for developing bridge layers between
|
||||
Objective-C and other languages, or for low-level debugging. You typically do
|
||||
not need to use the Objective-C runtime library directly when programming
|
||||
in Objective-C.
|
||||
|
||||
The Mac OS X implementation of the Objective-C runtime library is unique
|
||||
to the Mac OS X platform. For other platforms, the GNU Compiler Collection
|
||||
provides a different implementation with a similar API. This document covers
|
||||
only the Mac OS X implementation.
|
||||
|
||||
The low-level Objective-C runtime API is significantly updated in Mac OS X
|
||||
version 10.5. Many functions and all existing data structures are replaced
|
||||
with new functions. The old functions and structures are deprecated in 32-bit
|
||||
and absent in 64-bit mode. The API constrains several values to 32-bit ints
|
||||
even in 64-bit mode—class count, protocol count, methods per class, ivars
|
||||
per class, arguments per method, sizeof(all arguments) per method, and
|
||||
class version number. In addition, the new Objective-C ABI (not described here)
|
||||
further constrains sizeof(anInstance) to 32 bits, and three other values
|
||||
to 24 bits—methods per class, ivars per class, and sizeof(a single ivar).
|
||||
Finally, the obsolete NXHashTable and NXMapTable are limited to 4 billion items.
|
||||
|
||||
“Deprecated” below means “deprecated in Mac OS X version 10.5 for 32-bit code,
|
||||
and disallowed for 64-bit code.
|
||||
|
||||
Legacy and Modern Versions
|
||||
--------------------------
|
||||
|
||||
There are two versions of the Objective-C runtime—“modern” and “legacy”.
|
||||
The modern version was introduced with Objective-C 2.0 and includes a number
|
||||
of new features. The programming interface for the legacy version of the runtime
|
||||
is described in Objective-C 1 Runtime Reference; the programming interface
|
||||
for the modern version of the runtime is described in Objective-C 2.0 Runtime
|
||||
Reference.
|
||||
|
||||
The most notable new feature is that instance variables in the modern runtime are “non-fragile”:
|
||||
* In the legacy runtime, if you change the layout of instance variables in a class,
|
||||
you must recompile classes that inherit from it.
|
||||
* In the modern runtime, if you change the layout of instance variables in a class,
|
||||
you do not have to recompile classes that inherit from it.
|
||||
|
||||
In addition, the modern runtime supports instance variable synthesis
|
||||
for declared properties (see Declared Properties in The Objective-C 2.0 Programming Language).
|
||||
|
||||
Platforms
|
||||
---------
|
||||
|
||||
iPhone applications and 64-bit programs on Mac OS X v10.5 and later use
|
||||
the modern version of the runtime.
|
||||
|
||||
Other programs (32-bit programs on Mac OS X desktop) use the legacy version
|
||||
of the runtime.
|
||||
}
|
||||
|
||||
type
|
||||
//todo: types MUST BE declared properly as 2.0 opaques
|
||||
SEL = Pointer;
|
||||
IMP = Pointer;
|
||||
id = Pointer; //??
|
||||
size_t = LongWord;
|
||||
_Class = Pointer;
|
||||
Ivar = Pointer;
|
||||
PProtocol = Pointer;
|
||||
PArrayPProtocol = Pointer;
|
||||
BOOL = Boolean;
|
||||
PIvar = Pointer;
|
||||
Method = Pointer;
|
||||
PMethod = Pointer;
|
||||
Protocol = Pointer;
|
||||
objc_property_t = Pointer;
|
||||
Pobjc_property_t = Pointer;
|
||||
uint8_t = byte;
|
||||
Pobjc_method_description = Pointer;
|
||||
ptrdiff_t = Pointer;
|
||||
objc_method_description = Pointer;
|
||||
TMutationHandlerProc = Pointer;
|
||||
|
||||
pobjc_super = ^objc_super;
|
||||
objc_super = packed record
|
||||
reciever : id;
|
||||
class_ : _class;
|
||||
end;
|
||||
|
||||
var
|
||||
sel_getName : function (sel: SEL): PChar; cdecl = nil;
|
||||
sel_registerName : function (str: PChar): SEL; cdecl = nil;
|
||||
object_getClassName : function (obj: id): PChar; cdecl = nil;
|
||||
object_getIndexedIvars : function (obj: id ): Pointer; cdecl = nil;
|
||||
|
||||
sel_isMapped: function (sel: SEL): Boolean; cdecl = nil;
|
||||
sel_getUid: function (const str: PChar): SEL; cdecl = nil;
|
||||
|
||||
object_copy : function (obj:id; size:size_t):id; cdecl = nil;
|
||||
object_dispose : function (obj:id):id; cdecl = nil;
|
||||
|
||||
object_getClass : function (obj:id): _Class; cdecl = nil;
|
||||
object_setClass : function (obj:id; cls: _Class):_Class; cdecl = nil;
|
||||
|
||||
object_getIvar : function (obj:id; ivar:Ivar):id; cdecl = nil;
|
||||
object_setIvar : procedure (obj:id; ivar:Ivar; value:id); cdecl = nil;
|
||||
|
||||
object_setInstanceVariable : function (obj:id; name:pchar; value:pointer):Ivar; cdecl = nil;
|
||||
object_getInstanceVariable : function (obj:id; name:pchar; var outValue: Pointer):Ivar; cdecl = nil;
|
||||
|
||||
objc_getClass : function (name:pchar):id; cdecl = nil;
|
||||
objc_getMetaClass : function (name:pchar):id; cdecl = nil;
|
||||
objc_lookUpClass : function (name:pchar):id; cdecl = nil;
|
||||
objc_getRequiredClass : function (name:pchar):id; cdecl = nil;
|
||||
objc_getFutureClass : function (name:pchar):_Class; cdecl = nil;
|
||||
objc_setFutureClass : procedure (cls:_Class; name:pchar); cdecl = nil;
|
||||
objc_getClassList : function (buffer:pClass; bufferCount:longint):longint; cdecl = nil;
|
||||
|
||||
objc_getProtocol : function (name:pchar): PProtocol; cdecl = nil;
|
||||
objc_copyProtocolList : function (outCount:pdword):PArrayPProtocol; cdecl = nil;
|
||||
|
||||
class_getName : function (cls:_Class):PChar; cdecl = nil;
|
||||
class_isMetaClass : function (cls:_Class):BOOL; cdecl = nil;
|
||||
class_getSuperclass : function (cls:_Class):_Class; cdecl = nil;
|
||||
class_setSuperclass : function (cls: _Class; newSuper: _Class): _Class; cdecl = nil;
|
||||
|
||||
|
||||
class_getVersion : function (cls:_Class):longint; cdecl = nil;
|
||||
class_setVersion : procedure (cls:_Class; version:longint); cdecl = nil;
|
||||
|
||||
class_getInstanceSize : function (cls:_Class):size_t; cdecl = nil;
|
||||
|
||||
class_getInstanceVariable : function (cls:_Class; name:pchar):Ivar; cdecl = nil;
|
||||
class_getClassVariable : function (cls:_Class; name:pchar):Ivar; cdecl = nil;
|
||||
class_copyIvarList : function (cls:_Class; outCount:pdword):PIvar; cdecl = nil;
|
||||
|
||||
class_getInstanceMethod : function (cls:_Class; name:SEL):Method; cdecl = nil;
|
||||
class_getClassMethod : function (cls:_Class; name:SEL):Method; cdecl = nil;
|
||||
class_getMethodImplementation : function (cls:_Class; name:SEL):IMP; cdecl = nil;
|
||||
class_getMethodImplementation_stret : function (cls:_Class; name:SEL):IMP; cdecl = nil;
|
||||
class_respondsToSelector : function (cls:_Class; sel:SEL):BOOL; cdecl = nil;
|
||||
class_copyMethodList : function (cls:_Class; outCount:pdword):PMethod; cdecl = nil;
|
||||
|
||||
class_conformsToProtocol : function (cls:_Class; var protocol: Protocol):BOOL; cdecl = nil;
|
||||
class_copyProtocolList : function (cls:_Class; var outCount: dword):PArrayPProtocol; cdecl = nil;
|
||||
|
||||
class_getProperty : function (cls:_Class; name: pchar): objc_property_t; cdecl = nil;
|
||||
class_copyPropertyList : function (cls:_Class; var Count:dword):Pobjc_property_t; cdecl = nil;
|
||||
|
||||
class_getIvarLayout : function (cls:_Class):Pchar; cdecl = nil;
|
||||
class_getWeakIvarLayout : function (cls:_Class):Pchar; cdecl = nil;
|
||||
|
||||
class_createInstance : function (cls:_Class; extraBytes:size_t):id; cdecl = nil;
|
||||
|
||||
objc_allocateClassPair : function (superclass:_Class; name:pchar; extraBytes:size_t):_Class; cdecl = nil;
|
||||
objc_registerClassPair : procedure (cls:_Class); cdecl = nil;
|
||||
objc_duplicateClass : function (original:_Class; name:pchar; extraBytes:size_t):_Class; cdecl = nil;
|
||||
objc_disposeClassPair : procedure (cls:_Class); cdecl = nil;
|
||||
|
||||
class_addMethod : function (cls:_Class; name:SEL; imp:IMP; types:pchar):BOOL; cdecl = nil;
|
||||
class_replaceMethod : function (cls:_Class; name:SEL; imp:IMP; types:pchar):IMP; cdecl = nil;
|
||||
class_addIvar: function (cls:_Class; name:pchar; size:size_t; alignment:uint8_t; types:pchar):BOOL; cdecl = nil;
|
||||
class_addProtocol : function (cls:_Class; protocol:pProtocol):BOOL; cdecl = nil;
|
||||
class_setIvarLayout : procedure (cls:_Class; layout:pchar); cdecl = nil;
|
||||
class_setWeakIvarLayout : procedure (cls:_Class; layout:pchar); cdecl = nil;
|
||||
|
||||
method_getName : function (m:Method):SEL; cdecl = nil;
|
||||
method_getImplementation : function (m:Method):IMP; cdecl = nil;
|
||||
method_getTypeEncoding : function (m:Method):Pchar; cdecl = nil;
|
||||
|
||||
method_getNumberOfArguments : function (m:Method):dword; cdecl = nil;
|
||||
method_copyReturnType : function (m:Method):Pchar; cdecl = nil;
|
||||
method_copyArgumentType : function (m:Method; index:dword):Pchar; cdecl = nil;
|
||||
method_getReturnType : procedure (m:Method; dst:pchar; dst_len:size_t); cdecl = nil;
|
||||
method_getArgumentType : procedure (m:Method; index:dword; dst:pchar; dst_len:size_t); cdecl = nil;
|
||||
method_getDescription : function (m: Method) : Pobjc_method_description; cdecl = nil;
|
||||
|
||||
method_setImplementation: function (m:Method; imp:IMP):IMP; cdecl = nil;
|
||||
method_exchangeImplementations : procedure (m1:Method; m2:Method); cdecl = nil;
|
||||
|
||||
ivar_getName : function (v:Ivar):Pchar; cdecl = nil;
|
||||
ivar_getTypeEncoding : function (v:Ivar):Pchar; cdecl = nil;
|
||||
ivar_getOffset : function (v:Ivar):ptrdiff_t; cdecl = nil;
|
||||
|
||||
property_getName :function (_property:objc_property_t):Pchar; cdecl = nil;
|
||||
property_getAttributes : function (_property:objc_property_t):Pchar; cdecl = nil;
|
||||
|
||||
|
||||
protocol_conformsToProtocol : function (proto:pProtocol; other:pProtocol):BOOL; cdecl = nil;
|
||||
protocol_isEqual : function (proto:pProtocol; other:pProtocol):BOOL; cdecl = nil;
|
||||
protocol_getMethodDescription : function (p: PProtocol; aSel: SEL; isRequiredMethod, isInstanceMethod: BOOL): objc_method_description; cdecl = nil;
|
||||
protocol_copyMethodDescriptionList : function (p: PProtocol; isRequiredMethod, isInstanceMethod: BOOL ; var outCount: LongWord): Pobjc_method_description; cdecl = nil;
|
||||
protocol_getProperty : function (proto:PProtocol; name:pchar; isRequiredProperty:BOOL; isInstanceProperty:BOOL):objc_property_t; cdecl = nil;
|
||||
protocol_copyPropertyList : function (proto:PProtocol; outCount:pdword):Pobjc_property_t; cdecl = nil;
|
||||
protocol_copyProtocolList : function (proto:PProtocol; outCount:pdword):PArrayPProtocol; cdecl = nil;
|
||||
|
||||
objc_copyImageNames : function (var outCount:dword): PPchar; cdecl = nil;
|
||||
class_getImageName : function (cls:_Class):Pchar; cdecl = nil;
|
||||
objc_copyClassNamesForImage : function (image:pchar; var outCount: Dword):PPchar; cdecl = nil;
|
||||
|
||||
sel_isEqual : function (lhs:SEL; rhs:SEL):BOOL; cdecl = nil;
|
||||
objc_enumerationMutation : procedure (_para1:id); cdecl = nil;
|
||||
objc_setEnumerationMutationHandler : procedure (handler:TMutationHandlerProc); cdecl = nil;
|
||||
objc_setForwardHandler: procedure (fwd:pointer; fwd_stret:pointer); cdecl = nil;
|
||||
|
||||
{$WARNINGS OFF} // warning: cdecl'ared funtions have no high parameter
|
||||
objc_msgSend : function (self: id; op: SEL; param3: array of const): id; cdecl = nil;
|
||||
objc_msgSendSuper : function (super: pobjc_super; op: SEL; param3: array of const): id; cdecl = nil;
|
||||
objc_msgSend_stret : procedure (stret: Pointer; self: id; op: SEL; param3: array of const); cdecl= nil;
|
||||
objc_msgSend_stretreg : function (self: id; op: SEL; param3: array of const): id; cdecl= nil;
|
||||
objc_msgSendSuper_stret : procedure (stret: Pointer; super: pobjc_super; op: SEL; param3: array of const); cdecl = nil;
|
||||
objc_msgSend_fpret : function (self: id; op: SEL; param3: array of const): double; cdecl = nil;
|
||||
{$WARNINGS ON}
|
||||
|
||||
method_invoke : function (receiver: id; m: Method {, ...}): id= nil;
|
||||
method_invoke_stret : procedure (receiver: id; m: Method{ , ...})= nil;
|
||||
objc_collect : procedure (options: LongWord); cdecl= nil;
|
||||
objc_collectingEnabled : function : BOOL; cdecl= nil;
|
||||
|
||||
const
|
||||
_C_ID = '@';
|
||||
_C_CLASS = '#';
|
||||
_C_SEL = ':';
|
||||
_C_CHR = 'c';
|
||||
_C_UCHR = 'C';
|
||||
_C_SHT = 's';
|
||||
_C_USHT = 'S';
|
||||
_C_INT = 'i';
|
||||
_C_UINT = 'I';
|
||||
_C_LNG = 'l';
|
||||
_C_ULNG = 'L';
|
||||
_C_FLT = 'f';
|
||||
_C_DBL = 'd';
|
||||
_C_BFLD = 'b';
|
||||
_C_VOID = 'v';
|
||||
_C_UNDEF = '?';
|
||||
_C_PTR = '^';
|
||||
_C_CHARPTR = '*';
|
||||
_C_ARY_B = '[';
|
||||
_C_ARY_E = ']';
|
||||
_C_UNION_B = '(';
|
||||
_C_UNION_E = ')';
|
||||
_C_STRUCT_B = '{';
|
||||
_C_STRUCT_E = '}';
|
||||
_C_PASOBJ = _C_PTR + _C_VOID;
|
||||
_C_SELF_AND_SEL = '@:';
|
||||
|
||||
// objc-exception.h
|
||||
|
||||
// compiler reserves a setjmp buffer + 4 words as localExceptionData
|
||||
|
||||
type
|
||||
Tobjc_exception_throw = procedure (exception: id); cdecl;
|
||||
Tobjc_exception_try_enter = procedure (localExceptionData: Pointer); cdecl;
|
||||
Tobjc_exception_try_exit = procedure (localExceptionData: Pointer); cdecl;
|
||||
Tobjc_exception_extract = function (localExceptionData: Pointer): id; cdecl;
|
||||
Tobjc_exception_match = function (exceptionClass:_Class; exception:id ): Integer; cdecl;
|
||||
|
||||
var
|
||||
objc_exception_throw : Tobjc_exception_throw = nil;
|
||||
objc_exception_try_enter : Tobjc_exception_try_enter = nil;
|
||||
objc_exception_try_exit : Tobjc_exception_try_exit = nil;
|
||||
objc_exception_extract : Tobjc_exception_extract = nil;
|
||||
objc_exception_match : Tobjc_exception_match = nil;
|
||||
|
||||
type
|
||||
pobjc_exception_functions_t = ^objc_exception_functions_t;
|
||||
objc_exception_functions_t = packed record
|
||||
version : Integer;
|
||||
throw_exc : Tobjc_exception_throw; // version 0
|
||||
try_enter : Tobjc_exception_try_enter; // version 0
|
||||
try_exit : Tobjc_exception_try_exit; // version 0
|
||||
extract : Tobjc_exception_extract; // version 0
|
||||
match : Tobjc_exception_match; // version 0
|
||||
end;
|
||||
|
||||
// get table; version tells how many
|
||||
var
|
||||
objc_exception_get_functions : procedure (var table: objc_exception_functions_t); cdecl = nil;
|
||||
objc_exception_set_functions : procedure (table: pobjc_exception_functions_t); cdecl = nil;
|
||||
|
||||
|
||||
// __LP64__ // 64-bit only functions
|
||||
{
|
||||
typedef id (*objc_exception_preprocessor)(id exception);
|
||||
typedef int (*objc_exception_matcher)(Class catch_type, id exception);
|
||||
typedef void (*objc_uncaught_exception_handler)(id exception);
|
||||
typedef void (*objc_exception_handler)(id unused, void *context);
|
||||
|
||||
OBJC_EXPORT void objc_exception_throw(id exception);
|
||||
OBJC_EXPORT void objc_exception_rethrow(void);
|
||||
OBJC_EXPORT id objc_begin_catch(void *exc_buf);
|
||||
OBJC_EXPORT void objc_end_catch(void);
|
||||
|
||||
OBJC_EXPORT uintptr_t objc_addExceptionHandler(objc_exception_handler fn, void *context);
|
||||
OBJC_EXPORT void objc_removeExceptionHandler(uintptr_t token);
|
||||
|
||||
OBJC_EXPORT objc_exception_preprocessor objc_setExceptionPreprocessor(objc_exception_preprocessor fn);
|
||||
OBJC_EXPORT objc_exception_matcher objc_setExceptionMatcher(objc_exception_matcher fn);
|
||||
OBJC_EXPORT objc_uncaught_exception_handler objc_setUncaughtExceptionHandler(objc_uncaught_exception_handler fn);
|
||||
}
|
||||
|
||||
|
||||
|
||||
// objc-sync.h
|
||||
|
||||
var
|
||||
// Begin synchronizing on 'obj'.
|
||||
// Allocates recursive pthread_mutex associated with 'obj' if needed.
|
||||
// Returns OBJC_SYNC_SUCCESS once lock is acquired.
|
||||
objc_sync_enter: function (obj: id): Integer; cdecl = nil;
|
||||
// End synchronizing on 'obj'.
|
||||
// Returns OBJC_SYNC_SUCCESS or OBJC_SYNC_NOT_OWNING_THREAD_ERROR
|
||||
objc_sync_exit : function (obj: id) : Integer; cdecl = nil;
|
||||
// Temporarily release lock on 'obj' and wait for another thread to notify on 'obj'
|
||||
// Return OBJC_SYNC_SUCCESS, OBJC_SYNC_NOT_OWNING_THREAD_ERROR, OBJC_SYNC_TIMED_OUT
|
||||
objc_sync_wait : function (obj: id; milliSecondsMaxWait: Int64): Integer; cdecl = nil;
|
||||
// Wake up another thread waiting on 'obj'
|
||||
// Return OBJC_SYNC_SUCCESS, OBJC_SYNC_NOT_OWNING_THREAD_ERROR
|
||||
objc_sync_notify : function (obj: id): Integer; cdecl = nil;
|
||||
// Wake up all threads waiting on 'obj'
|
||||
// Return OBJC_SYNC_SUCCESS, OBJC_SYNC_NOT_OWNING_THREAD_ERROR
|
||||
objc_sync_notifyAll : function (obj: id): Integer; cdecl = nil;
|
||||
|
||||
const
|
||||
OBJC_SYNC_SUCCESS = 0;
|
||||
OBJC_SYNC_NOT_OWNING_THREAD_ERROR = -1;
|
||||
OBJC_SYNC_TIMED_OUT = -2;
|
||||
OBJC_SYNC_NOT_INITIALIZED = -3;
|
||||
|
||||
// since exception handling does not change from version to version
|
||||
// it's nice to make a common RTL loading function for exception functions.
|
||||
// this proc, MUST BE called by run-time initialization proc!
|
||||
function LoadDefaultObjCExepction(hnd: TLibHandle): Boolean;
|
||||
function LoadDefaultObjCSync(hnd: TLibHandle): Boolean;
|
||||
function LoadDefaultObjCMessaging(hnd: TLibHandle): Boolean;
|
||||
|
||||
implementation
|
||||
|
||||
function LoadDefaultObjCExepction(hnd: TLibHandle): Boolean;
|
||||
begin
|
||||
Result := hnd <> 0;
|
||||
if not Result then Exit;
|
||||
|
||||
objc_exception_throw := Tobjc_exception_throw(GetProcedureAddress(hnd, 'objc_exception_throw'));
|
||||
objc_exception_try_enter := Tobjc_exception_try_enter(GetProcedureAddress(hnd, 'objc_exception_try_enter'));
|
||||
objc_exception_try_exit := Tobjc_exception_try_exit(GetProcedureAddress(hnd, 'objc_exception_try_exit'));
|
||||
objc_exception_extract := Tobjc_exception_extract(GetProcedureAddress(hnd, 'objc_exception_extract'));
|
||||
objc_exception_match := Tobjc_exception_match(GetProcedureAddress(hnd, 'objc_exception_match'));
|
||||
end;
|
||||
|
||||
function LoadDefaultObjCSync(hnd: TLibHandle): Boolean;
|
||||
begin
|
||||
Result := hnd <> 0;
|
||||
if not Result then Exit;
|
||||
Pointer(objc_sync_enter) := GetProcedureAddress(hnd, 'objc_sync_enter');
|
||||
Pointer(objc_sync_exit) := GetProcedureAddress(hnd, 'objc_sync_exit');
|
||||
Pointer(objc_sync_wait) := GetProcedureAddress(hnd, 'objc_sync_wait');
|
||||
Pointer(objc_sync_notify) := GetProcedureAddress(hnd, 'objc_sync_notify');
|
||||
Pointer(objc_sync_notifyAll) := GetProcedureAddress(hnd, 'objc_sync_notifyAll');
|
||||
end;
|
||||
|
||||
function LoadDefaultObjCMessaging(hnd: TLibHandle): Boolean;
|
||||
begin
|
||||
Pointer(objc_msgSend) := GetProcedureAddress(hnd, 'objc_msgSend');
|
||||
Pointer(objc_msgSendSuper) := GetProcedureAddress(hnd, 'objc_msgSendSuper');
|
||||
Pointer(objc_msgSend_stret) := GetProcedureAddress(hnd, 'objc_msgSend_stret');
|
||||
Pointer(objc_msgSendSuper_stret) := GetProcedureAddress(hnd, 'objc_msgSendSuper_stret');
|
||||
|
||||
{$ifndef CPUPOWERPC} // arm also uses objc_msgSend_fpret?
|
||||
Pointer(objc_msgSend_fpret) := GetProcedureAddress(hnd, 'objc_msgSend_fpret');
|
||||
Pointer(objc_msgSend_stretreg) := GetProcedureAddress(hnd, 'objc_msgSend');
|
||||
{$else}
|
||||
Pointer(objc_msgSend_fpret) := GetProcedureAddress(hnd, 'objc_msgSend');
|
||||
Pointer(objc_msgSend_stretreg) := GetProcedureAddress(hnd, 'objc_msgSend_stret');
|
||||
{$endif}
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
end.
|
||||
|
||||
@ -1,832 +0,0 @@
|
||||
{
|
||||
objcrtl10.pas
|
||||
|
||||
Copyright (C) 2009 Dmitry Boyarintsev
|
||||
|
||||
This unit is implementation for dynamic Objective-C Run-time Library based on run-time version 1.0
|
||||
headers included with XCode 3.1.2
|
||||
The original copyright note of is kept on each include file
|
||||
}
|
||||
{.$DEFINE DEBUG}
|
||||
|
||||
unit objcrtl10;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
ctypes, objcrtl, dynlibs;
|
||||
|
||||
{
|
||||
Mac OS X Version 10.5 Delta
|
||||
---------------------------
|
||||
|
||||
The low-level Objective-C runtime API is significantly updated
|
||||
in Mac OS X version 10.5. Many functions and all existing data structures
|
||||
are replaced with new functions. This document describes the differences
|
||||
between the 10.5 version and previous versions.
|
||||
|
||||
http://developer.apple.com/documentation/Cocoa/Reference/ObjCRuntimeRef/Articles/ocr10_5delta.html#//apple_ref/doc/uid/TP40002981-TPXREF101
|
||||
}
|
||||
|
||||
function InitializeObjCRtl10(const ObjCLibName: AnsiString): Boolean;
|
||||
|
||||
implementation
|
||||
|
||||
{$HINTS OFF} {.Parameter not used.}
|
||||
|
||||
function ObjCAllocMem(size: Integer): Pointer;
|
||||
begin
|
||||
//todo: store the mem pointers
|
||||
// and release them at finalization section
|
||||
// this must be thread safe, so allocating additional NsObject
|
||||
// that can be used with objc_sync is recommended
|
||||
Result := AllocMem(size);
|
||||
end;
|
||||
|
||||
procedure ObjCFreeMem(p: Pointer);
|
||||
begin
|
||||
//todo:
|
||||
Freemem(p);
|
||||
end;
|
||||
|
||||
|
||||
function allocstr(const src: String): Pchar;
|
||||
begin
|
||||
Result := ObjCAllocMem(length(src)+1);
|
||||
if src <> '' then System.Move(src[1], Result^, length(src));
|
||||
end;
|
||||
|
||||
|
||||
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 = ^id;
|
||||
// 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;
|
||||
//class_addMethods : procedure (myClass: _Class1; methodList : Pobjc_method_list1); cdecl;
|
||||
|
||||
type
|
||||
|
||||
{ TClassMethod1Reg }
|
||||
|
||||
TClassMethod1Reg = class(TObject)
|
||||
private
|
||||
methods : array of objc_method1;
|
||||
count : Integer;
|
||||
public
|
||||
procedure AddMethod(name:SEL; imp:IMP; types:pchar);
|
||||
function AllocMethodList: Pobjc_method_list1;
|
||||
end;
|
||||
//PClassMethod1Reg = ^TClassMethod1Reg;
|
||||
|
||||
TIVar1Reg = record
|
||||
size : Integer;
|
||||
types : String;
|
||||
name : String;
|
||||
alignment : Uint8_t;
|
||||
end;
|
||||
|
||||
{ TClassIVar1Reg }
|
||||
|
||||
TClassIVar1Reg = class(TObject)
|
||||
private
|
||||
ivarscount : Integer;
|
||||
ivars : array of TIVar1Reg;
|
||||
public
|
||||
procedure AddIVar(name:pchar; size:size_t; alignment:uint8_t; types:pchar);
|
||||
function AllocIVarsList(ivarOffset: Integer; out ivarssize: Integer): Pobjc_ivar_list1;
|
||||
end;
|
||||
|
||||
{ TClassMethod1Reg }
|
||||
|
||||
procedure TClassMethod1Reg.AddMethod(name: SEL; imp: IMP; types: pchar);
|
||||
begin
|
||||
if length(methods) = count then begin
|
||||
if count = 0 then SetLength(methods, 4)
|
||||
else begin
|
||||
SetLength(methods, count * 2);
|
||||
end;
|
||||
end;
|
||||
methods[count].method_imp := IMP1(imp);
|
||||
methods[count].method_types := allocstr(types);
|
||||
methods[count].method_name := name;
|
||||
inc(count);
|
||||
end;
|
||||
|
||||
function TClassMethod1Reg.AllocMethodList: Pobjc_method_list1;
|
||||
var
|
||||
i : Integer;
|
||||
begin
|
||||
if count = 0 then Result := nil
|
||||
else begin
|
||||
Result := ObjCAllocMem( sizeof(objc_method_list1) + (count-1)*sizeof(objc_method1) );
|
||||
Pobjc_method_list1(Result)^.method_count := count;
|
||||
for i := 0 to count - 1 do begin
|
||||
Pobjc_method_list1(Result)^.method_list1[i].method_name := methods[i].method_name;
|
||||
Pobjc_method_list1(Result)^.method_list1[i].method_types := methods[i].method_types;
|
||||
Pobjc_method_list1(Result)^.method_list1[i].method_imp := methods[i].method_imp;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TClassIVar1Reg.AddIVar(name: pchar; size: size_t; alignment: uint8_t;
|
||||
types: pchar);
|
||||
begin
|
||||
if ivarscount = length(ivars) then begin
|
||||
if ivarscount = 0 then SetLength(ivars, 4)
|
||||
else setLength(ivars, ivarscount * 2);
|
||||
end;
|
||||
ivars[ivarscount].name := name;
|
||||
ivars[ivarscount].size := size;
|
||||
ivars[ivarscount].types := types;
|
||||
ivars[ivarscount].alignment := alignment;
|
||||
inc(ivarscount);
|
||||
end;
|
||||
|
||||
function TClassIVar1Reg.AllocIVarsList(ivarOffset: Integer; out ivarssize: Integer): Pobjc_ivar_list1;
|
||||
var
|
||||
i : Integer;
|
||||
begin
|
||||
if ivarscount = 0 then begin
|
||||
Result := nil;
|
||||
ivarssize := 0;
|
||||
end else begin
|
||||
ivarssize := 0;
|
||||
Result := ObjCAllocMem( sizeof(objc_ivar_list1) + (ivarscount-1)*sizeof(objc_ivar1) );
|
||||
Result^.ivar_count := ivarscount;
|
||||
for i := 0 to ivarscount - 1 do begin
|
||||
Result^.ivar_list[i].ivar_name := allocstr(ivars[i].name);
|
||||
Result^.ivar_list[i].ivar_offset := ivarOffset + ivarssize;
|
||||
Result^.ivar_list[i].ivar_type := allocstr(ivars[i].types);
|
||||
inc(ivarssize, ivars[i].size);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function object_getClass10(obj:id): _Class; cdecl;
|
||||
begin
|
||||
if obj = nil then Result := nil
|
||||
else begin
|
||||
Result := _Class(Pobjc_object1(obj)^.isa);
|
||||
end;
|
||||
end;
|
||||
|
||||
function object_setClass10(obj:id; cls: _Class): _Class; cdecl;
|
||||
begin
|
||||
// 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;
|
||||
begin
|
||||
Result := nil;
|
||||
if not Assigned(obj) or not Assigned(_ivar) then Exit;
|
||||
Result := Pid1(PtrUInt(obj) + ivar_getOffset(_ivar))^;
|
||||
end;
|
||||
|
||||
procedure object_setIvar10(obj:id; _ivar:Ivar; value:id); cdecl;
|
||||
begin
|
||||
if not Assigned(obj) or not Assigned(_ivar) then Exit;
|
||||
Pid1(PtrUInt(obj) + ivar_getOffset(_ivar))^ := value;
|
||||
end;
|
||||
|
||||
function class_getName10(cls:_Class):PChar; cdecl;
|
||||
begin
|
||||
Result := _Class1(cls)^.name;
|
||||
end;
|
||||
|
||||
function class_getSuperclass10(cls:_Class):_Class; cdecl;
|
||||
begin
|
||||
Result := _Class1(cls)^.super_class;
|
||||
end;
|
||||
|
||||
function class_isMetaClass10(cls:_Class):BOOL; cdecl;
|
||||
begin
|
||||
Result := Assigned(cls) and (_Class1(cls)^.Info = CLS_META);
|
||||
end;
|
||||
|
||||
function class_copyMethodList10(cls:_Class; outCount: pdword):PMethod; cdecl;
|
||||
begin
|
||||
//todo:
|
||||
Result := nil; //todo: ??
|
||||
end;
|
||||
|
||||
function class_getMethodImplementation10(cls:_Class; name:SEL):IMP; cdecl;
|
||||
begin
|
||||
//todo:
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function class_respondsToSelector10(cls:_Class; sel:SEL):BOOL; cdecl;
|
||||
begin
|
||||
//todo:
|
||||
Result := false;
|
||||
end;
|
||||
|
||||
function class_conformsToProtocol10(cls:_Class; var protocol: Protocol):BOOL; cdecl;
|
||||
begin
|
||||
//todo:
|
||||
Result := false;
|
||||
end;
|
||||
|
||||
function class_copyProtocolList10(cls:_Class; var outCount: dword):PArrayPProtocol; cdecl;
|
||||
begin
|
||||
//todo:
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function class_copyIvarList10(cls:_Class; outCount:pdword):PIvar; cdecl;
|
||||
begin
|
||||
//todo:
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function class_getMethodImplementation_stret10(cls:_Class; name:SEL):IMP; cdecl;
|
||||
begin
|
||||
//todo:
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function objc_allocateClassPair10(superclass:_Class; name:pchar; extraBytes:size_t):_Class; cdecl;
|
||||
var
|
||||
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 begin
|
||||
{$ifdef DEBUG}
|
||||
if not Assigned(superclass) then
|
||||
writeln('no super class!')
|
||||
else begin
|
||||
if Assigned(objc_lookUpClass(name)) then
|
||||
writeln('the class ', name, ' already exists')
|
||||
else
|
||||
writeln('this situation is impossible!');
|
||||
end;
|
||||
{$endif}
|
||||
Exit;
|
||||
end;
|
||||
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 := ObjCAllocMem(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 := ObjCAllocMem(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 := Pointer(TClassMethod1Reg.Create); // PPObjc_method_list1(AllocMethodReg); //AllocMem ( SizeOf(TClassMethod1Reg)) ;// SizeOf(Pobjc_method_list1));
|
||||
meta_class^.methodLists := Pointer(TClassMethod1Reg.Create); //PPObjc_method_list1(AllocMethodReg);
|
||||
|
||||
// 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;
|
||||
new_class^.ivars := Pointer(TClassIVar1Reg.Create);
|
||||
|
||||
Result := new_class;
|
||||
end;
|
||||
|
||||
procedure objc_registerClassPair10(aClass:_Class); cdecl;
|
||||
var
|
||||
meta_class : _Class1;
|
||||
new_class : _Class1;
|
||||
|
||||
MethodReg : TClassMethod1Reg;
|
||||
|
||||
iVarReg : TClassIVar1Reg;
|
||||
ivarslist : Pobjc_ivar_list1;
|
||||
sz : Integer;
|
||||
|
||||
procedure RegisterMethodList(reg: TClassMethod1Reg; cls1: _Class1);
|
||||
var
|
||||
mtdlist : Pobjc_method_list1;
|
||||
begin
|
||||
if not Assigned(reg) then Exit;
|
||||
cls1^.methodLists := ObjCAllocMem(sizeof(Pobjc_method_list1));
|
||||
mtdList := reg.AllocMethodList;
|
||||
if not Assigned(mtdlist)
|
||||
then cls1^.methodLists^ := Pointer(-1)
|
||||
else cls1^.methodLists^ := mtdlist;
|
||||
end;
|
||||
|
||||
begin
|
||||
new_class := _Class1(aClass);
|
||||
meta_class := _Class1(new_Class)^.isa;
|
||||
// Finally, register the class with the runtime.
|
||||
|
||||
MethodReg := TClassMethod1Reg(new_class^.methodLists);
|
||||
RegisterMethodList(MethodReg, new_class);
|
||||
MethodReg.Free;
|
||||
|
||||
MethodReg := TClassMethod1Reg(meta_class^.methodLists);
|
||||
RegisterMethodList(MethodReg, meta_class);
|
||||
MethodReg.Free;
|
||||
|
||||
iVarReg := TClassIVar1Reg(new_class^.ivars);
|
||||
ivarslist := iVarReg.AllocIVarsList(new_class^.instance_size, sz);
|
||||
new_class^.ivars := ivarslist;
|
||||
inc(new_class^.instance_size, sz);
|
||||
iVarReg.Free;
|
||||
|
||||
|
||||
if new_class <> nil then objc_addClass(new_class);
|
||||
end;
|
||||
|
||||
function objc_duplicateClass10(original:_Class; name:pchar; extraBytes:size_t):_Class; cdecl;
|
||||
begin
|
||||
//todo:
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
procedure objc_disposeClassPair10(cls:_Class); cdecl;
|
||||
begin
|
||||
//todo:
|
||||
end;
|
||||
|
||||
function class_addMethod10(cls:_Class; name:SEL; _imp:IMP; types:pchar):BOOL; cdecl;
|
||||
begin
|
||||
if not Assigned(cls) or not Assigned(name) or not Assigned(_imp) or not Assigned(types) then begin
|
||||
{$IFDEF DEBUG}
|
||||
write('* Bad params?: cls = ', Integer(cls));
|
||||
write(' name = ', PChar(name));
|
||||
write(' imp = ', Integer(_imp));
|
||||
writeln(' type = ', types);
|
||||
{$ENDIF}
|
||||
Result := false;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
{$IFDEF DEBUG}
|
||||
write('* method list = ', Integer(_Class1(cls)^.methodLists));
|
||||
if Assigned (TClassMethod1Reg(_Class1(cls)^.methodLists)) then
|
||||
writeln(', ', TClassMethod1Reg(_Class1(cls)^.methodLists).ClassName)
|
||||
else
|
||||
writeln;
|
||||
try
|
||||
{$ENDIF}
|
||||
TClassMethod1Reg(_Class1(cls)^.methodLists).AddMethod(name, _imp, types);
|
||||
{$IFDEF DEBUG}
|
||||
writeln('"',PChar(name), '" added successfully');
|
||||
except
|
||||
writeln('* exception while adding method');
|
||||
end;
|
||||
{$ENDIF}
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
function class_addIvar10(cls:_Class; name:pchar; size:size_t; alignment:uint8_t; types:pchar):BOOL; cdecl;
|
||||
var
|
||||
cls1 : _Class1;
|
||||
begin
|
||||
if (alignment <> 1) or (class_isMetaClass10(cls)) then begin
|
||||
Result := false;
|
||||
Exit;
|
||||
end;
|
||||
cls1 := _Class1(cls);
|
||||
TClassIVar1Reg(cls1^.ivars).AddIVar(name, size, alignment, types);
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
function class_addProtocol10(cls:_Class; protocol:pProtocol):BOOL; cdecl;
|
||||
begin
|
||||
//todo:
|
||||
Result := false;
|
||||
end;
|
||||
|
||||
|
||||
function method_getName10(m:Method):SEL; cdecl;
|
||||
begin
|
||||
Result := Method1(m)^.method_name;
|
||||
end;
|
||||
|
||||
function method_getImplementation10(m:Method):IMP; cdecl;
|
||||
begin
|
||||
Result := IMP(Method1(m)^.method_imp);
|
||||
end;
|
||||
|
||||
function method_getTypeEncoding10(m:Method):Pchar; cdecl;
|
||||
begin
|
||||
Result := IMP(Method1(m)^.method_types);
|
||||
end;
|
||||
|
||||
function method_copyReturnType10(m:Method):Pchar; cdecl;
|
||||
begin
|
||||
//todo:
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function method_copyArgumentType10(m:Method; index:dword):Pchar; cdecl;
|
||||
begin
|
||||
//todo:
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function method_setImplementation10(m:Method; _imp:IMP):IMP; cdecl;
|
||||
begin
|
||||
//todo:! ???? check!
|
||||
Result := IMP(Method1(m)^.method_imp);
|
||||
Method1(m)^.method_imp := IMP1(_imp);
|
||||
end;
|
||||
|
||||
function ivar_getName10(v:Ivar):Pchar; cdecl;
|
||||
begin
|
||||
Result := IVar1(v)^.ivar_name;
|
||||
end;
|
||||
|
||||
function ivar_getTypeEncoding10(v:Ivar):Pchar; cdecl;
|
||||
begin
|
||||
Result := IVar1(v)^.ivar_type;
|
||||
end;
|
||||
|
||||
function ivar_getOffset10(v:Ivar):ptrdiff_t; cdecl;
|
||||
begin
|
||||
Result := ptrdiff_t(IVar1(v)^.ivar_offset);
|
||||
end;
|
||||
|
||||
function sel_isEqual10(lhs:SEL; rhs:SEL):BOOL; cdecl;
|
||||
begin
|
||||
Result := lhs = rhs; //???
|
||||
end;
|
||||
|
||||
function objc_getProtocol10(name:pchar): PProtocol; cdecl;
|
||||
begin
|
||||
//todo:
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function objc_copyProtocolList10(outCount:pdword):PArrayPProtocol; cdecl;
|
||||
begin
|
||||
//todo:
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function InitializeObjCRtl10(const ObjCLibName: AnsiString): Boolean;
|
||||
var
|
||||
hnd : TLibHandle;
|
||||
begin
|
||||
hnd := LoadLibrary(ObjCLibName);
|
||||
Result := hnd <> 0;
|
||||
if not Result then Exit;
|
||||
|
||||
//Exceptions - are unchanged:
|
||||
LoadDefaultObjCExepction(hnd);
|
||||
//Synchronization - unchanged:
|
||||
LoadDefaultObjCSync(hnd);
|
||||
|
||||
// Instances
|
||||
|
||||
// The following functions are unchanged:
|
||||
Pointer(object_dispose) := GetProcedureAddress(hnd, 'object_dispose');
|
||||
Pointer(object_getClassName) := GetProcedureAddress(hnd, 'object_getClassName');
|
||||
Pointer(object_getIndexedIvars) := GetProcedureAddress(hnd, 'object_getIndexedIvars');
|
||||
Pointer(object_setInstanceVariable) := GetProcedureAddress(hnd, 'object_setInstanceVariable');
|
||||
Pointer(object_getInstanceVariable) := GetProcedureAddress(hnd, 'object_getInstanceVariable');
|
||||
|
||||
//The following function is modified:
|
||||
// needs wrapper?
|
||||
// object_copy (The nBytes parameter is changed from unsigned to size_t.)
|
||||
Pointer(object_copy) := GetProcedureAddress(hnd, 'object_copy');
|
||||
|
||||
//The following functions are added:
|
||||
object_getClass := @object_getClass10;
|
||||
object_setClass := @object_setClass10;
|
||||
object_getIvar := @object_getIvar10;
|
||||
object_setIvar := @object_setIVar10;
|
||||
|
||||
// The following functions are deprecated:
|
||||
//object_copyFromZone: deprecated in favor of object_copy
|
||||
//object_realloc
|
||||
//object_reallocFromZone: no substitute
|
||||
//_alloc: no substitute
|
||||
//_copy: no substitute
|
||||
//_realloc: no substitute
|
||||
//_dealloc: no substitute
|
||||
//_zoneAlloc: no substitute
|
||||
//_zoneRealloc: no substitute
|
||||
//_zoneCopy: no substitute
|
||||
//_error: no substitute
|
||||
|
||||
//Class Inspection
|
||||
|
||||
//The following functions are unchanged:
|
||||
Pointer(objc_getClassList) := GetProcedureAddress(hnd, 'objc_getClassList');
|
||||
Pointer(objc_lookUpClass) := GetProcedureAddress(hnd, 'objc_lookUpClass');
|
||||
Pointer(objc_getClass) := GetProcedureAddress(hnd, 'objc_getClass');
|
||||
Pointer(objc_getMetaClass) := GetProcedureAddress(hnd, 'objc_getMetaClass');
|
||||
Pointer(class_getVersion) := GetProcedureAddress(hnd, 'class_getVersion');
|
||||
Pointer(class_getInstanceVariable) := GetProcedureAddress(hnd, 'class_getInstanceVariable');
|
||||
Pointer(class_getInstanceMethod) := GetProcedureAddress(hnd, 'class_getInstanceMethod');
|
||||
Pointer(class_getClassMethod) := GetProcedureAddress(hnd, 'class_getClassMethod');
|
||||
|
||||
// The following function is modified:
|
||||
// needs wrapper?
|
||||
// class_createInstance: idxIvars parameter Changed from unsigned to size_t
|
||||
Pointer(class_createInstance) := GetProcedureAddress(hnd, 'class_createInstance');
|
||||
|
||||
// The following functions are added:
|
||||
class_getName:=@class_getName10;
|
||||
class_getSuperclass:=@class_getSuperclass10;
|
||||
class_isMetaClass:=@class_isMetaClass10;
|
||||
class_copyMethodList:=@class_copyMethodList10;
|
||||
class_getMethodImplementation:=@class_getMethodImplementation10;
|
||||
class_getMethodImplementation_stret:=@class_getMethodImplementation_stret10;
|
||||
class_respondsToSelector:=@class_respondsToSelector10;
|
||||
class_conformsToProtocol:=@class_conformsToProtocol10;
|
||||
class_copyProtocolList:=@class_copyProtocolList10;
|
||||
class_copyIvarList:=@class_copyIvarList10;
|
||||
|
||||
//The following functions are deprecated:
|
||||
//objc_getClasses: deprecated in favor of objc_getClassList
|
||||
//class_createInstanceFromZone: deprecated in favor of class_createInstance
|
||||
//class_nextMethodList: deprecated in favor of new class_copyMethodList
|
||||
//class_lookupMethod: deprecated in favor of class_getMethodImplementation
|
||||
//class_respondsToMethod: deprecated in favor of class_respondsToSelector
|
||||
|
||||
//The following function is used only by ZeroLink:
|
||||
//objc_getRequiredClass
|
||||
|
||||
// Class Manipulation
|
||||
|
||||
//The following function is unchanged:
|
||||
Pointer(class_setVersion) := GetProcedureAddress(hnd, 'class_setVersion');
|
||||
|
||||
//The following functions are added:
|
||||
objc_allocateClassPair := @objc_allocateClassPair10;
|
||||
objc_registerClassPair := @objc_registerClassPair10;
|
||||
objc_duplicateClass := @objc_duplicateClass10;
|
||||
class_addMethod := @class_addMethod10;
|
||||
class_addIvar := @class_addIvar10;
|
||||
class_addProtocol := @class_addProtocol10;
|
||||
|
||||
//The following functions are deprecated:
|
||||
//objc_addClass: deprecated in favor of objc_allocateClassPair and objc_registerClassPair
|
||||
//class_addMethods: deprecated in favor of new class_addMethod
|
||||
//class_removeMethods: deprecated with no substitute
|
||||
//class_poseAs: deprecated in favor of categories and method_setImplementation
|
||||
|
||||
|
||||
//Methods
|
||||
|
||||
//The following function is unchanged:
|
||||
Pointer(method_getNumberOfArguments) := GetProcedureAddress(hnd, 'method_getNumberOfArguments');
|
||||
|
||||
//The following functions are added:
|
||||
method_getName := @method_getName10;
|
||||
method_getImplementation := @method_getImplementation10;
|
||||
method_getTypeEncoding := @method_getTypeEncoding10;
|
||||
method_copyReturnType := @method_copyReturnType10;
|
||||
method_copyArgumentType := @method_copyArgumentType10;
|
||||
method_setImplementation := @method_setImplementation10;
|
||||
|
||||
//The following functions are deprecated:
|
||||
//method_getArgumentInfo
|
||||
//method_getSizeOfArguments
|
||||
|
||||
|
||||
//Instance Variables
|
||||
|
||||
//The following functions are added:
|
||||
ivar_getName := @ivar_getName10;
|
||||
ivar_getTypeEncoding := @ivar_getTypeEncoding10;
|
||||
ivar_getOffset := @ivar_getOffset10;
|
||||
|
||||
//Selectors
|
||||
//The following functions are unchanged:
|
||||
Pointer(sel_getName) := GetProcedureAddress(hnd, 'sel_getName');
|
||||
Pointer(sel_registerName) := GetProcedureAddress(hnd, 'sel_registerName');
|
||||
Pointer(sel_getUid) := GetProcedureAddress(hnd, 'sel_getUid');
|
||||
|
||||
//The following function is added:
|
||||
sel_isEqual := @sel_isEqual10;
|
||||
|
||||
//The following function is deprecated:
|
||||
//sel_isMapped: deprecated with no substitute
|
||||
|
||||
|
||||
//Runtime
|
||||
//The following functions are deprecated favor of dyld:
|
||||
//objc_loadModules
|
||||
//objc_loadModule
|
||||
//objc_unloadModules
|
||||
|
||||
//The following functions are deprecated:
|
||||
//objc_setClassHandler: deprecated with no substitute
|
||||
//objc_setMultithreaded: deprecated with no substitute
|
||||
|
||||
//The following previously undocumented functions are deprecated with no substitute:
|
||||
//objc_getOrigClass, _objc_create_zone, _objc_error, _objc_flush_caches,
|
||||
//_objc_resolve_categories_for_class, _objc_setClassLoader,_ objc_setNilReceiver,
|
||||
//_objc_getNilReceiver,_ objcInit
|
||||
|
||||
//The following undocumented functions are unchanged:
|
||||
//_objc_getFreedObjectClass, instrumentObjcMessageSends, _objc_debug_class_hash
|
||||
//_class_printDuplicateCacheEntries, _class_printMethodCaches, _class_printMethodCacheStatistics
|
||||
|
||||
|
||||
//Messaging
|
||||
LoadDefaultObjCMessaging(hnd);
|
||||
|
||||
|
||||
//The following functions are removed:objc_msgSendv Given an argument list, send a message with a simple return value.
|
||||
//objc_msgSendv_stret Given an argument list, send a message with a data-structure return value.
|
||||
//objc_msgSendv_fpret Given an argument list, send a message with a floating point return value.
|
||||
|
||||
//Protocols
|
||||
//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');
|
||||
//Pointer(class_addMethods) := GetProcedureAddress(hnd, 'objc_addMethods');
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -1,160 +0,0 @@
|
||||
{
|
||||
objcrtl20.pas
|
||||
|
||||
Copyright (C) 2009 Dmitry Boyarintsev
|
||||
|
||||
This unit is implementation for dynamic Objective-C Run-time Library based on run-time version 2.0
|
||||
headers included with XCode 3.1.2
|
||||
The original copyright note of is kept on each include file
|
||||
}
|
||||
|
||||
unit objcrtl20;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
objcrtl, dynlibs;
|
||||
|
||||
function InitializeObjcRtl20(const ObjCLibName: AnsiString): Boolean;
|
||||
|
||||
implementation
|
||||
|
||||
function InitializeObjcRtl20(const ObjCLibName: AnsiString): Boolean;
|
||||
var
|
||||
hnd : TLibHandle;
|
||||
begin
|
||||
hnd := LoadLibrary(ObjCLibName);
|
||||
Result := hnd <> 0;
|
||||
if not Result then Exit;
|
||||
|
||||
LoadDefaultObjCExepction(hnd);
|
||||
LoadDefaultObjCSync(hnd);
|
||||
|
||||
Pointer(sel_getName) := GetProcedureAddress(hnd, 'sel_getName');
|
||||
Pointer(sel_registerName) := GetProcedureAddress(hnd, 'sel_registerName');
|
||||
Pointer(object_getClassName) := GetProcedureAddress(hnd, 'object_getClassName');
|
||||
Pointer(object_getIndexedIvars) := GetProcedureAddress(hnd, 'object_getIndexedIvars');
|
||||
|
||||
Pointer(sel_isMapped) := GetProcedureAddress(hnd, 'sel_isMapped');
|
||||
Pointer(sel_getUid) := GetProcedureAddress(hnd, 'sel_getUid');
|
||||
|
||||
Pointer(object_copy) := GetProcedureAddress(hnd, 'object_copy');
|
||||
Pointer(object_dispose) := GetProcedureAddress(hnd, 'object_dispose');
|
||||
|
||||
Pointer(object_getClass) := GetProcedureAddress(hnd, 'object_getClass');
|
||||
Pointer(object_setClass) := GetProcedureAddress(hnd, 'object_setClass');
|
||||
|
||||
Pointer(object_getIvar) := GetProcedureAddress(hnd, 'object_getIvar');
|
||||
Pointer(object_setIvar) := GetProcedureAddress(hnd, 'object_setIvar');
|
||||
|
||||
Pointer(object_setInstanceVariable) := GetProcedureAddress(hnd, 'object_setInstanceVariable');
|
||||
Pointer(object_getInstanceVariable) := GetProcedureAddress(hnd, 'object_getInstanceVariable');
|
||||
|
||||
Pointer(objc_getClass) := GetProcedureAddress(hnd, 'objc_getClass');
|
||||
Pointer(objc_getMetaClass) := GetProcedureAddress(hnd, 'objc_getMetaClass');
|
||||
Pointer(objc_lookUpClass) := GetProcedureAddress(hnd, 'objc_lookUpClass');
|
||||
Pointer(objc_getRequiredClass) := GetProcedureAddress(hnd, 'objc_getRequiredClass');
|
||||
Pointer(objc_getFutureClass) := GetProcedureAddress(hnd, 'objc_getFutureClass');
|
||||
Pointer(objc_setFutureClass) := GetProcedureAddress(hnd, 'objc_setFutureClass');
|
||||
Pointer(objc_getClassList) := GetProcedureAddress(hnd, 'objc_getClassList');
|
||||
|
||||
Pointer(objc_getProtocol) := GetProcedureAddress(hnd, 'objc_getProtocol');
|
||||
Pointer(objc_copyProtocolList) := GetProcedureAddress(hnd, 'objc_copyProtocolList');
|
||||
|
||||
Pointer(class_getName) := GetProcedureAddress(hnd, 'class_getName');
|
||||
Pointer(class_isMetaClass) := GetProcedureAddress(hnd, 'class_isMetaClass');
|
||||
Pointer(class_getSuperclass) := GetProcedureAddress(hnd, 'class_getSuperclass');
|
||||
Pointer(class_setSuperclass) := GetProcedureAddress(hnd, 'class_setSuperclass');
|
||||
|
||||
Pointer(class_getVersion) := GetProcedureAddress(hnd, 'class_getVersion');
|
||||
Pointer(class_setVersion) := GetProcedureAddress(hnd, 'class_setVersion');
|
||||
|
||||
Pointer(class_getInstanceSize) := GetProcedureAddress(hnd, 'class_getInstanceSize');
|
||||
|
||||
Pointer(class_getInstanceVariable) := GetProcedureAddress(hnd, 'class_getInstanceVariable');
|
||||
Pointer(class_getClassVariable) := GetProcedureAddress(hnd, 'class_getClassVariable');
|
||||
Pointer(class_copyIvarList) := GetProcedureAddress(hnd, 'class_copyIvarList');
|
||||
|
||||
Pointer(class_getInstanceMethod) := GetProcedureAddress(hnd, 'class_getInstanceMethod');
|
||||
Pointer(class_getClassMethod) := GetProcedureAddress(hnd, 'class_getClassMethod');
|
||||
Pointer(class_getMethodImplementation) := GetProcedureAddress(hnd, 'class_getMethodImplementation');
|
||||
Pointer(class_getMethodImplementation_stret) := GetProcedureAddress(hnd, 'class_getMethodImplementation_stret');
|
||||
Pointer(class_respondsToSelector) := GetProcedureAddress(hnd, 'class_respondsToSelector');
|
||||
Pointer(class_copyMethodList) := GetProcedureAddress(hnd, 'class_copyMethodList');
|
||||
|
||||
Pointer(class_conformsToProtocol) := GetProcedureAddress(hnd, 'class_conformsToProtocol');
|
||||
Pointer(class_copyProtocolList) := GetProcedureAddress(hnd, 'class_copyProtocolList');
|
||||
|
||||
Pointer(class_getProperty) := GetProcedureAddress(hnd, 'class_getProperty');
|
||||
Pointer(class_copyPropertyList) := GetProcedureAddress(hnd, 'class_copyPropertyList');
|
||||
|
||||
Pointer(class_getIvarLayout) := GetProcedureAddress(hnd, 'class_getIvarLayout');
|
||||
Pointer(class_getWeakIvarLayout) := GetProcedureAddress(hnd, 'class_getWeakIvarLayout');
|
||||
|
||||
Pointer(class_createInstance) := GetProcedureAddress(hnd, 'class_createInstance');
|
||||
|
||||
Pointer(objc_allocateClassPair) := GetProcedureAddress(hnd, 'objc_allocateClassPair');
|
||||
Pointer(objc_registerClassPair) := GetProcedureAddress(hnd, 'objc_registerClassPair');
|
||||
Pointer(objc_duplicateClass) := GetProcedureAddress(hnd, 'objc_duplicateClass');
|
||||
Pointer(objc_disposeClassPair) := GetProcedureAddress(hnd, 'objc_disposeClassPair');
|
||||
|
||||
Pointer(class_addMethod) := GetProcedureAddress(hnd, 'class_addMethod');
|
||||
Pointer(class_replaceMethod) := GetProcedureAddress(hnd, 'class_replaceMethod');
|
||||
Pointer(class_addIvar) := GetProcedureAddress(hnd, 'class_addIvar');
|
||||
Pointer(class_addProtocol) := GetProcedureAddress(hnd, 'class_addProtocol');
|
||||
Pointer(class_setIvarLayout) := GetProcedureAddress(hnd, 'class_setIvarLayout');
|
||||
Pointer(class_setWeakIvarLayout) := GetProcedureAddress(hnd, 'class_setWeakIvarLayout');
|
||||
|
||||
Pointer(method_getName) := GetProcedureAddress(hnd, 'method_getName');
|
||||
Pointer(method_getImplementation) := GetProcedureAddress(hnd, 'method_getImplementation');
|
||||
Pointer(method_getTypeEncoding) := GetProcedureAddress(hnd, 'method_getTypeEncoding');
|
||||
|
||||
Pointer(method_getNumberOfArguments) := GetProcedureAddress(hnd, 'method_getNumberOfArguments');
|
||||
Pointer(method_copyReturnType) := GetProcedureAddress(hnd, 'method_copyReturnType');
|
||||
Pointer(method_copyArgumentType) := GetProcedureAddress(hnd, 'method_copyArgumentType');
|
||||
Pointer(method_getReturnType) := GetProcedureAddress(hnd, 'method_getReturnType');
|
||||
Pointer(method_getArgumentType) := GetProcedureAddress(hnd, 'method_getArgumentType');
|
||||
Pointer(method_getDescription) := GetProcedureAddress(hnd, 'method_getDescription');
|
||||
|
||||
Pointer(method_setImplementation) := GetProcedureAddress(hnd, 'method_setImplementation');
|
||||
Pointer(method_exchangeImplementations) := GetProcedureAddress(hnd, 'method_exchangeImplementations');
|
||||
|
||||
Pointer(ivar_getName) := GetProcedureAddress(hnd, 'ivar_getName');
|
||||
Pointer(ivar_getTypeEncoding) := GetProcedureAddress(hnd, 'ivar_getTypeEncoding');
|
||||
Pointer(ivar_getOffset) := GetProcedureAddress(hnd, 'ivar_getOffset');
|
||||
|
||||
Pointer(property_getName) := GetProcedureAddress(hnd, 'property_getName');
|
||||
Pointer(property_getAttributes) := GetProcedureAddress(hnd, 'property_getAttributes');
|
||||
|
||||
Pointer(protocol_conformsToProtocol) := GetProcedureAddress(hnd, 'protocol_conformsToProtocol');
|
||||
Pointer(protocol_isEqual) := GetProcedureAddress(hnd, 'protocol_isEqual');
|
||||
Pointer(protocol_getMethodDescription) := GetProcedureAddress(hnd, 'protocol_getMethodDescription');
|
||||
Pointer(protocol_copyMethodDescriptionList) := GetProcedureAddress(hnd, 'protocol_copyMethodDescriptionList');
|
||||
Pointer(protocol_getProperty) := GetProcedureAddress(hnd, 'protocol_getProperty');
|
||||
Pointer(protocol_copyPropertyList) := GetProcedureAddress(hnd, 'protocol_copyPropertyList');
|
||||
Pointer(protocol_copyProtocolList) := GetProcedureAddress(hnd, 'protocol_copyProtocolList');
|
||||
|
||||
Pointer(objc_copyImageNames) := GetProcedureAddress(hnd, 'objc_copyImageNames');
|
||||
Pointer(class_getImageName) := GetProcedureAddress(hnd, 'class_getImageName');
|
||||
Pointer(objc_copyClassNamesForImage) := GetProcedureAddress(hnd, 'objc_copyClassNamesForImage');
|
||||
|
||||
Pointer(sel_isEqual) := GetProcedureAddress(hnd, 'sel_isEqual');
|
||||
Pointer(objc_enumerationMutation) := GetProcedureAddress(hnd, 'objc_enumerationMutation');
|
||||
Pointer(objc_setEnumerationMutationHandler) := GetProcedureAddress(hnd, 'objc_setEnumerationMutationHandler');
|
||||
Pointer(objc_setForwardHandler) := GetProcedureAddress(hnd, 'objc_setForwardHandler');
|
||||
|
||||
//Messaging
|
||||
LoadDefaultObjCMessaging(hnd);
|
||||
|
||||
Pointer(method_invoke) := GetProcedureAddress(hnd, 'method_invoke');
|
||||
Pointer(method_invoke_stret) := GetProcedureAddress(hnd, 'method_invoke_stret');
|
||||
Pointer(objc_collect) := GetProcedureAddress(hnd, 'objc_collect');
|
||||
Pointer(objc_collectingEnabled) := GetProcedureAddress(hnd, 'objc_collectingEnabled');
|
||||
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
@ -1,16 +0,0 @@
|
||||
unit objcrtliPhoneOS;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
objcrtl, objcrtl20;
|
||||
|
||||
implementation
|
||||
|
||||
initialization
|
||||
InitializeObjcRtl20(DefaultObjCLibName);
|
||||
|
||||
end.
|
||||
|
||||
@ -1,191 +0,0 @@
|
||||
{
|
||||
Objective-C rtl Test application. by dmitry boyarintsev s2009
|
||||
|
||||
Should compile and run with no problems
|
||||
program output should look like:
|
||||
|
||||
Objective-C runtime initialized successfuly
|
||||
-init method
|
||||
called newMethod1
|
||||
called newMethod2, a = 5; b = 4
|
||||
get double = 1.33300000000000E+000
|
||||
get float = 3.12500000000000E+000
|
||||
test successfully complete
|
||||
}
|
||||
|
||||
program objcrtltest;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
objcrtl20, objcrtl10, objcrtl, objcrtlutils;
|
||||
|
||||
{.$linkframework AppKit}
|
||||
{$linkframework Foundation}
|
||||
|
||||
type
|
||||
TSubStructure = packed record
|
||||
a,b,c,d: byte;
|
||||
end;
|
||||
|
||||
PSmallRecord = ^TSmallRecord;
|
||||
TSmallRecord = packed record
|
||||
a,b,c: byte;
|
||||
//d : Integer;
|
||||
d: byte;
|
||||
sub: TSubStructure;
|
||||
end;
|
||||
|
||||
const
|
||||
newClassName = 'NSMyObject';
|
||||
overrideMethod = 'init';
|
||||
overrideMethodEnc = '@@:';
|
||||
|
||||
newMethod1 = 'newMethod1';
|
||||
newMethod1Enc = 'v@:';
|
||||
|
||||
newMethod2 = 'newMethod2::';
|
||||
newMethod2Enc = 'v@:ii';
|
||||
|
||||
newMethod3 = 'getDouble';
|
||||
newMethod3Enc = 'd@:';
|
||||
|
||||
newMethod4 = 'getFloat';
|
||||
newMethod4Enc = 'f@:';
|
||||
|
||||
newMethod5 = 'getSmallRecord';
|
||||
newMethod5Enc = '{TSmallRecord=cccc{TSubStructure=cccc}}@:';
|
||||
|
||||
varName = 'myvar';
|
||||
|
||||
function imp_init(self: id; _cmd: SEL): id; cdecl;
|
||||
var
|
||||
sp : objc_super;
|
||||
begin
|
||||
writeln('-init method');
|
||||
sp := super(self);
|
||||
Result := objc_msgSendSuper(@sp, selector(overrideMethod), []);
|
||||
end;
|
||||
|
||||
procedure imp_newMethod1(self: id; _cmd: SEL); cdecl;
|
||||
begin
|
||||
writeln('called newMethod1');
|
||||
end;
|
||||
procedure imp_newMethod2(self: id; _cmd: SEL; a, b: Integer); cdecl;
|
||||
begin
|
||||
writeln('called newMethod2, a = ', a, '; b = ', b);
|
||||
end;
|
||||
|
||||
function imp_newMethod3(self: id; _cmd: SEL): Double; cdecl;
|
||||
begin
|
||||
Result := 1.333;
|
||||
end;
|
||||
|
||||
function imp_newMethod4(self: id; _cmd: SEL): Single; cdecl;
|
||||
begin
|
||||
Result := 3.125;
|
||||
end;
|
||||
|
||||
function imp_getSmallRec(seld: id; _cmd: SEL): TSmallRecord; cdecl;
|
||||
begin
|
||||
Result.a := 121;
|
||||
Result.b := 68;
|
||||
Result.c := 22;
|
||||
Result.d := 5;
|
||||
end;
|
||||
|
||||
|
||||
procedure RegisterSubclass(NewClassName: PChar);
|
||||
var
|
||||
cl : _Class;
|
||||
b : Boolean;
|
||||
begin
|
||||
cl := objc_allocateClassPair(objc_getClass('NSObject'), NewClassName, 0);
|
||||
b := class_addMethod(cl, selector(OverrideMethod), @imp_init, overrideMethodEnc) and
|
||||
class_addMethod(cl, selector(newMethod1), @imp_newMethod1, newMethod1Enc) and
|
||||
class_addMethod(cl, selector(newMethod2), @imp_newMethod2, newMethod2Enc) and
|
||||
class_addMethod(cl, selector(newMethod3), @imp_newMethod3, newMethod3Enc) and
|
||||
class_addMethod(cl, selector(newMethod4), @imp_newMethod4, newMethod4Enc) and
|
||||
class_addMethod(cl, selector(newMethod5), @imp_getSmallRec, newMethod5Enc);
|
||||
if not b then
|
||||
writeln('failed to add/override some method(s)');
|
||||
|
||||
if not class_addIvar(cl, varName, sizeof(TObject), 1, _C_PASOBJ) then
|
||||
writeln('failed to add variable ', varName);
|
||||
|
||||
objc_registerClassPair(cl);
|
||||
end;
|
||||
|
||||
var
|
||||
obj : id;
|
||||
objvar : Ivar;
|
||||
|
||||
stret : TSmallRecord;
|
||||
varobj : TObject;
|
||||
|
||||
{$WARNINGS OFF} // cdecl'ared functions have no high parameter
|
||||
type
|
||||
TgetSmallRecord = function (obj: id; cmd: Sel; arg: array of const): TSmallRecord; cdecl;
|
||||
{$WARNINGS ON}
|
||||
|
||||
begin
|
||||
// if InitializeObjcRtl20(DefaultObjCLibName) then // should be used of OSX 10.5 and iPhoneOS
|
||||
|
||||
if InitializeObjcRtl10(DefaultObjCLibName) then // should be used of OSX 10.4 and lower
|
||||
writeln('Objective-C runtime initialized successfuly')
|
||||
else begin
|
||||
writeln('failed to initialize Objective-C runtime');
|
||||
Halt;
|
||||
end;
|
||||
|
||||
RegisterSubclass(newClassName);
|
||||
writeln('registered');
|
||||
|
||||
obj := AllocAndInit(newClassName);
|
||||
{obj := alloc(newClassName);
|
||||
objc_msgSend(obj, selector(overrideMethod), []);}
|
||||
|
||||
writeln('sizeof(TSmallRecord) = ', sizeof(TSmallRecord));
|
||||
|
||||
// this must be resolved at code-time (or compiler-time), not run-time
|
||||
{$WARNINGS OFF} // unreachable code
|
||||
if sizeof(TSmallRecord) in [1,2,4,8] then
|
||||
stret := TgetSmallRecord(objc_msgSend_stretreg)(obj, selector(newMethod5), [])
|
||||
else
|
||||
stret := TgetSmallRecord(objc_msgSend_stret)(obj, selector(newMethod5), []);
|
||||
{$WARNINGS ON}
|
||||
|
||||
//writeln('p = ', Integer(p));
|
||||
|
||||
//stret :=
|
||||
writeln('stret.a = ', stret.a);
|
||||
writeln('stret.b = ', stret.b);
|
||||
writeln('stret.c = ', stret.c);
|
||||
writeln('stret.d = ', stret.d);
|
||||
|
||||
objc_msgSend(obj, selector(newMethod1), []);
|
||||
objc_msgSend(obj, selector(newMethod2), [5, 4]);
|
||||
|
||||
writeln('get double = ', objc_msgSend_fpret(obj, selector(newMethod3), []));
|
||||
writeln('get float = ', objc_msgSend_fpret(obj, selector(newMethod4), []));
|
||||
|
||||
objvar := class_getInstanceVariable( object_getClass(obj), varName);
|
||||
varobj := TObject.Create;
|
||||
|
||||
writeln('var Value = ', Integer(object_getIvar(obj, objvar)));
|
||||
writeln('setting new Value = ', Integer(varobj));
|
||||
object_setIvar(obj, objvar, varobj);
|
||||
writeln('var Value = ', Integer(object_getIvar(obj, objvar)));
|
||||
|
||||
writeln('var offset = ', Integer(ivar_getOffset(objvar)));
|
||||
writeln('var name = ', ivar_getName(objvar));
|
||||
writeln('var type = ', ivar_getTypeEncoding(objvar));
|
||||
|
||||
release(obj);
|
||||
|
||||
varobj.Free;
|
||||
|
||||
writeln('test successfully complete');
|
||||
end.
|
||||
|
||||
|
||||
@ -1,65 +0,0 @@
|
||||
unit objcrtlutils;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
objcrtl;
|
||||
|
||||
function alloc(classname: PChar): id; inline;
|
||||
function allocex(classname: PChar; extraBytes: Integer): id; inline;
|
||||
function objcclass(classname: PChar): _class; inline;
|
||||
function selector(cmdname: PChar): SEL; inline;
|
||||
procedure release(objc: id); inline;
|
||||
function AllocAndInit(classname: PChar): id; inline;
|
||||
function AllocAndInitEx(classname: PChar; extraBytes: Integer): id; inline;
|
||||
function super(obj: id): objc_super;
|
||||
|
||||
implementation
|
||||
|
||||
function super(obj: id): objc_super;
|
||||
begin
|
||||
Result.reciever := obj;
|
||||
Result.class_ := class_getSuperclass(object_getClass(obj));
|
||||
end;
|
||||
|
||||
function allocex(classname: PChar; extraBytes: Integer): id; inline;
|
||||
begin
|
||||
Result := class_createInstance( objcclass(classname), extraBytes);
|
||||
end;
|
||||
|
||||
function alloc(classname: PChar): id; inline;
|
||||
begin
|
||||
Result := allocex(classname, 0);
|
||||
// Result := objc_msgSend( objc_getClass(classname), selector('alloc'), []);
|
||||
end;
|
||||
|
||||
function objcclass(classname: PChar): _class; inline;
|
||||
begin
|
||||
Result := _class(objc_getClass(classname));
|
||||
end;
|
||||
|
||||
function selector(cmdname: PChar): SEL; inline;
|
||||
begin
|
||||
Result := sel_registerName(cmdname);
|
||||
end;
|
||||
|
||||
procedure release(objc: id); inline;
|
||||
begin
|
||||
objc_msgSend(objc, selector('release'), []);
|
||||
end;
|
||||
|
||||
function AllocAndInit(classname: PChar): id; inline;
|
||||
begin
|
||||
Result:= objc_msgSend( alloc( classname ), selector('init'), []);
|
||||
end;
|
||||
|
||||
function AllocAndInitEx(classname: PChar; extraBytes: Integer): id; inline;
|
||||
begin
|
||||
Result := objc_msgSend( allocEx( classname, extraBytes ), selector('init'), []);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user