paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 14:09:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ objcrtl package by Dmitry Boyarintsev: interface for the Mac OS X

Browse Source 
Objective-C run time 1.0 and 2.0, for 32 bit platforms

git-svn-id: trunk@13122 -
This commit is contained in:
Jonas Maebe 2009-05-09 20:24:21 +00:00
parent 0597c300f4
commit 14558c3388
14 changed files with 4285 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
.gitattributes vendored
View File

@ -3636,6 +3636,17 @@ packages/numlib/tests/test.bat svneol=native#text/plain
packages/numlib/tests/test.pas svneol=native#text/plain
packages/numlib/tests/timer.pas svneol=native#text/plain
packages/numlib/tests/turte.pas svneol=native#text/plain
packages/objcrtl/Makefile svneol=native#text/plain
packages/objcrtl/Makefile.fpc svneol=native#text/plain
packages/objcrtl/Package.fpc svneol=native#text/plain
packages/objcrtl/examples/objcrtltest.pas svneol=native#text/plain
packages/objcrtl/fpmake.pp svneol=native#text/plain
packages/objcrtl/src/objcrtl.pas svneol=native#text/plain
packages/objcrtl/src/objcrtl10.pas svneol=native#text/plain
packages/objcrtl/src/objcrtl20.pas svneol=native#text/plain
packages/objcrtl/src/objcrtliphoneos.pas svneol=native#text/plain
packages/objcrtl/src/objcrtlmacosx.pas svneol=native#text/plain
packages/objcrtl/src/objcrtlutils.pas svneol=native#text/plain
packages/odbc/Makefile svneol=native#text/plain
packages/odbc/Makefile.fpc svneol=native#text/plain
packages/odbc/README.txt svneol=native#text/plain

56
packages/Makefile
View File

@ -1,5 +1,5 @@
#
# Don't edit, this file is generated by FPCMake Version 2.0.0 [2009/03/15]
# Don't edit, this file is generated by FPCMake Version 2.0.0 [2009/05/09]
#
default: all
MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded
@ -302,7 +302,7 @@ ifeq ($(FULL_TARGET),i386-wdosx)
override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-process unzip regexpr chm fcl-res libgd symbolic
endif
ifeq ($(FULL_TARGET),i386-darwin)
override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-process unzip regexpr chm fcl-res libgd symbolic fv fcl-web fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick libpng gdbm tcl syslog libcurl bfd aspell utmp fftw pcap openssl numlib iconvenc graph univint sdl opengl x11 cairo gtk1 gtk2 librsvg fpgtk xforms gnome1 httpd13 httpd20 httpd22 imlib opengles
override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-process unzip regexpr chm fcl-res libgd symbolic fv fcl-web fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick libpng gdbm tcl syslog libcurl bfd aspell utmp fftw pcap openssl numlib iconvenc graph univint sdl opengl x11 cairo gtk1 gtk2 librsvg fpgtk xforms gnome1 httpd13 httpd20 httpd22 imlib opengles objcrtl
endif
ifeq ($(FULL_TARGET),i386-emx)
override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-process unzip regexpr chm fcl-res libgd symbolic fv zlib libpng x11 tcl fpgtk rexx os2units gtk1 imlib
@ -359,7 +359,7 @@ ifeq ($(FULL_TARGET),powerpc-macos)
override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-process unzip regexpr chm fcl-res libgd symbolic
endif
ifeq ($(FULL_TARGET),powerpc-darwin)
override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-process unzip regexpr chm fcl-res libgd symbolic fv fcl-web fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick libpng gdbm tcl syslog libcurl bfd aspell utmp fftw pcap openssl numlib iconvenc graph univint sdl opengl x11 cairo gtk1 gtk2 librsvg fpgtk xforms gnome1 httpd13 httpd20 httpd22 imlib
override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-process unzip regexpr chm fcl-res libgd symbolic fv fcl-web fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick libpng gdbm tcl syslog libcurl bfd aspell utmp fftw pcap openssl numlib iconvenc graph univint sdl opengl x11 cairo gtk1 gtk2 librsvg fpgtk xforms gnome1 httpd13 httpd20 httpd22 imlib objcrtl
endif
ifeq ($(FULL_TARGET),powerpc-morphos)
override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-process unzip regexpr chm fcl-res libgd symbolic fv opengl
@ -401,7 +401,7 @@ ifeq ($(FULL_TARGET),arm-palmos)
override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-process unzip regexpr chm fcl-res libgd symbolic palmunits
endif
ifeq ($(FULL_TARGET),arm-darwin)
override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-process unzip regexpr chm fcl-res libgd symbolic fv fcl-web fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick libpng gdbm tcl syslog libcurl bfd aspell utmp fftw pcap openssl numlib iconvenc httpd13 httpd20 httpd22 opengles
override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-process unzip regexpr chm fcl-res libgd symbolic fv fcl-web fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick libpng gdbm tcl syslog libcurl bfd aspell utmp fftw pcap openssl numlib iconvenc httpd13 httpd20 httpd22 opengles objcrtl
endif
ifeq ($(FULL_TARGET),arm-wince)
override TARGET_DIRS+=hash pasjpeg paszlib fpmkunit fcl-xml fcl-base fcl-db fcl-image fcl-net fcl-passrc fcl-registry fcl-fpcunit fcl-json fcl-process unzip regexpr chm fcl-res libgd symbolic winceunits httpd22 fcl-web tcl fftw unzip zlib sqlite mysql ibase postgres oracle odbc sdl openssl oggvorbis numlib
@ -2262,6 +2262,7 @@ TARGET_DIRS_HTTPD20=1
TARGET_DIRS_HTTPD22=1
TARGET_DIRS_IMLIB=1
TARGET_DIRS_OPENGLES=1
TARGET_DIRS_OBJCRTL=1
endif
ifeq ($(FULL_TARGET),i386-emx)
TARGET_DIRS_HASH=1
@ -3052,6 +3053,7 @@ TARGET_DIRS_HTTPD13=1
TARGET_DIRS_HTTPD20=1
TARGET_DIRS_HTTPD22=1
TARGET_DIRS_IMLIB=1
TARGET_DIRS_OBJCRTL=1
endif
ifeq ($(FULL_TARGET),powerpc-morphos)
TARGET_DIRS_HASH=1
@ -3767,6 +3769,7 @@ TARGET_DIRS_HTTPD13=1
TARGET_DIRS_HTTPD20=1
TARGET_DIRS_HTTPD22=1
TARGET_DIRS_OPENGLES=1
TARGET_DIRS_OBJCRTL=1
endif
ifeq ($(FULL_TARGET),arm-wince)
TARGET_DIRS_HASH=1
@ -8192,6 +8195,51 @@ opengles:
$(MAKE) -C opengles all
.PHONY: opengles_all opengles_debug opengles_smart opengles_release opengles_units opengles_examples opengles_shared opengles_install opengles_sourceinstall opengles_exampleinstall opengles_distinstall opengles_zipinstall opengles_zipsourceinstall opengles_zipexampleinstall opengles_zipdistinstall opengles_clean opengles_distclean opengles_cleanall opengles_info opengles_makefiles opengles
endif
ifdef TARGET_DIRS_OBJCRTL
objcrtl_all:
$(MAKE) -C objcrtl all
objcrtl_debug:
$(MAKE) -C objcrtl debug
objcrtl_smart:
$(MAKE) -C objcrtl smart
objcrtl_release:
$(MAKE) -C objcrtl release
objcrtl_units:
$(MAKE) -C objcrtl units
objcrtl_examples:
$(MAKE) -C objcrtl examples
objcrtl_shared:
$(MAKE) -C objcrtl shared
objcrtl_install:
$(MAKE) -C objcrtl install
objcrtl_sourceinstall:
$(MAKE) -C objcrtl sourceinstall
objcrtl_exampleinstall:
$(MAKE) -C objcrtl exampleinstall
objcrtl_distinstall:
$(MAKE) -C objcrtl distinstall
objcrtl_zipinstall:
$(MAKE) -C objcrtl zipinstall
objcrtl_zipsourceinstall:
$(MAKE) -C objcrtl zipsourceinstall
objcrtl_zipexampleinstall:
$(MAKE) -C objcrtl zipexampleinstall
objcrtl_zipdistinstall:
$(MAKE) -C objcrtl zipdistinstall
objcrtl_clean:
$(MAKE) -C objcrtl clean
objcrtl_distclean:
$(MAKE) -C objcrtl distclean
objcrtl_cleanall:
$(MAKE) -C objcrtl cleanall
objcrtl_info:
$(MAKE) -C objcrtl info
objcrtl_makefiles:
$(MAKE) -C objcrtl makefiles
objcrtl:
$(MAKE) -C objcrtl all
.PHONY: objcrtl_all objcrtl_debug objcrtl_smart objcrtl_release objcrtl_units objcrtl_examples objcrtl_shared objcrtl_install objcrtl_sourceinstall objcrtl_exampleinstall objcrtl_distinstall objcrtl_zipinstall objcrtl_zipsourceinstall objcrtl_zipexampleinstall objcrtl_zipdistinstall objcrtl_clean objcrtl_distclean objcrtl_cleanall objcrtl_info objcrtl_makefiles objcrtl
endif
ifdef TARGET_DIRS_AMUNITS
amunits_all:
$(MAKE) -C amunits all

8
packages/Makefile.fpc
View File

@ -27,11 +27,11 @@ dirs_freebsd=fv fcl-web fcl-async ibase mysql ncurses zlib oracle odbc postgres
users iconvenc
dirs_darwin=fv fcl-web fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick \
libpng gdbm tcl syslog libcurl bfd aspell utmp fftw pcap openssl numlib iconvenc
dirs_i386_darwin=graph univint sdl opengl x11 cairo gtk1 gtk2 librsvg fpgtk xforms gnome1 httpd13 httpd20 httpd22 imlib opengles
dirs_powerpc_darwin=graph univint sdl opengl x11 cairo gtk1 gtk2 librsvg fpgtk xforms gnome1 httpd13 httpd20 httpd22 imlib
dirs_i386_darwin=graph univint sdl opengl x11 cairo gtk1 gtk2 librsvg fpgtk xforms gnome1 httpd13 httpd20 httpd22 imlib opengles objcrtl
dirs_powerpc_darwin=graph univint sdl opengl x11 cairo gtk1 gtk2 librsvg fpgtk xforms gnome1 httpd13 httpd20 httpd22 imlib objcrtl
dirs_x86_64_darwin=opengl x11 cairo gtk1 gtk2 librsvg fpgtk xforms gnome1 httpd13 httpd20 httpd22 imlib
dirs_powerpc64_darwin=opengl x11 cairo gtk1 gtk2 librsvg fpgtk xforms gnome1 httpd13 httpd20 httpd22 imlib
dirs_arm_darwin= httpd13 httpd20 httpd22 opengles
dirs_arm_darwin= httpd13 httpd20 httpd22 opengles objcrtl
dirs_solaris=fv fcl-web fcl-async ibase mysql ncurses zlib oracle odbc postgres sqlite pthreads imagemagick \
libpng x11 gdbm tcl syslog libcurl opengl cairo gtk1 bfd svgalib \
imlib utmp fpgtk xforms fftw pcap ggi openssl gnome1 httpd13 httpd20 httpd22 numlib
@ -328,4 +328,4 @@ fcl-xml_shared: iconvenc_shared
fcl-xml_smart: iconvenc_smart
fcl-xml_debug: iconvenc_debug
fcl-xml_release: iconvenc_release
endif
endif

2350
packages/objcrtl/Makefile Normal file
View File

File diff suppressed because it is too large Load Diff

23
packages/objcrtl/Makefile.fpc Executable file
View File

@ -0,0 +1,23 @@
#
# Makefile.fpc for objective-c runtime library bindings
#
[package]
name=obcjrtl
version=2.2.2
[target]
units=objcrtl objcrtl10 objcrtl20 objcrtliphoneos objcrtlmacosx objcrtlutils
[install]
fpcpackage=y
[default]
fpcdir=../..
[compiler]
includedir=src
sourcedir=src
[rules]
.NOTPARALLEL:

57
packages/objcrtl/Package.fpc Normal file
View File

@ -0,0 +1,57 @@
[package]
name=obcjrtl
version=2.2.2
[require]
packages=rtl
packages_os2_i386=
packages_emx_i386=
packages_embedded_i386=
packages_embedded_sparc=
packages_linux_armeb=
packages_freebsd_m68k=
packages_amiga_m68k=
packages_embedded_arm=
packages_netbsd_powerpc=
packages_macos_powerpc=
packages_linux_powerpc64=
packages_freebsd_i386=
packages_beos_i386=
packages_darwin_i386=
packages_morphos_powerpc=
packages_gba_arm=
packages_solaris_i386=
packages_symbian_i386=
packages_win64_x86_64=
packages_palmos_arm=
packages_darwin_powerpc64=
packages_netbsd_m68k=
packages_netwlibc_i386=
packages_linux_m68k=
packages_nds_arm=
packages_wince_i386=
packages_linux_powerpc=
packages_wince_arm=
packages_netbsd_sparc=
packages_embedded_x86_64=
packages_embedded_powerpc=
packages_linux_i386=
packages_win32_i386=
packages_embedded_m68k=
packages_haiku_i386=
packages_netware_i386=
packages_darwin_powerpc=
packages_linux_x86_64=
packages_amiga_powerpc=
packages_darwin_x86_64=
packages_palmos_m68k=
packages_linux_sparc=
packages_solaris_sparc=
packages_embeddedavr=
packages_embedded_armeb=
packages_linux_arm=
packages_embedded_powerpc64=
packages_symbian_arm=
packages_go32v2_i386=
packages_netbsd_i386=
packages_freebsd_x86_64=
packages_darwin_arm=

191
packages/objcrtl/examples/objcrtltest.pas Executable file
View File

@ -0,0 +1,191 @@
{
Objective-C rtl Test application by dmitry boyarintsev
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.

41
packages/objcrtl/fpmake.pp Executable file
View File

@ -0,0 +1,41 @@
{$ifndef ALLPACKAGES}
{$mode objfpc}{$H+}
program fpmake;
uses fpmkunit;
Var
P : TPackage;
begin
With Installer do
begin
{$endif ALLPACKAGES}
P:=AddPackage('objcrtl');
{$ifdef ALLPACKAGES}
P.Directory:='objcrtl';
{$endif ALLPACKAGES}
P.Version:='2.2.2-0';
P.Author := 'Library: Apple, header: Dmitry "skalogryz" Boyarintsev';
P.License := 'Library: Apple, header: LGPL with modification, ';
P.HomepageURL := 'www.freepascal.org';
P.Email := '';
P.Description := 'Objective-C Runtime-Library.';
P.NeedLibC:= false; // true for headers that indirectly link to libc?
P.SourcePath.Add('src');
P.Targets.AddUnit('objcrtl.pas');
P.Targets.AddUnit('objcrtl10.pas');
P.Targets.AddUnit('objcrtl20.pas');
P.Targets.AddUnit('objcrtliphoneos.pas');
P.Targets.AddUnit('objcrtlmacosx.pas');
P.Targets.AddUnit('objcrtlutils.pas');
P.ExamplePath.Add('examples');
P.Targets.AddExampleProgram('examples/objcrtltest.pas');
{$ifndef ALLPACKAGES}
Run;
end;
end.
{$endif ALLPACKAGES}

408
packages/objcrtl/src/objcrtl.pas Executable file
View File

@ -0,0 +1,408 @@
{
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.

833
packages/objcrtl/src/objcrtl10.pas Executable file
View File

@ -0,0 +1,833 @@
{
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.

160
packages/objcrtl/src/objcrtl20.pas Executable file
View File

@ -0,0 +1,160 @@
{
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.

26
packages/objcrtl/src/objcrtliphoneos.pas Executable file
View File

@ -0,0 +1,26 @@
{
objcrtliPhoneOS.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 objcrtliPhoneOS;
{$mode objfpc}{$H+}
interface
uses
objcrtl, objcrtl20;
implementation
initialization
InitializeObjcRtl20(DefaultObjCLibName);
end.

54
packages/objcrtl/src/objcrtlmacosx.pas Executable file
View File

@ -0,0 +1,54 @@
{
objcrtlmacosx.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 objcrtlMacOSX;
{$linkframework CoreServices}
{$mode macpas}
interface
uses
objcrtl, objcrtl10, objcrtl20;
implementation
type
SInt16 = Integer;
SInt32 = LongInt;
UInt32 = Longword;
FourCharCode = UInt32;
OSErr = SInt16;
OSType = FourCharCode;
const
noErr = 0;
gestaltSystemVersionMinor = FourCharCode('sys2'); { The minor system version number; in 10.4.17 this would be the decimal value 4 }
function Gestalt(selector: OSType; var response: SInt32): OSErr; mwpascal; external name '_Gestalt';
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}
begin
InitObjCRuntime;
end.

75
packages/objcrtl/src/objcrtlutils.pas Executable file
View File

@ -0,0 +1,75 @@
{
objcrtlutils.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 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.