paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-12 18:31:53 +02:00
Code Issues Packages Projects Releases Wiki Activity

* More pluggability of the RTL. Mantis 15124

Browse Source 
git-svn-id: trunk@14212 -
This commit is contained in:
marco 2009-11-18 21:16:12 +00:00
parent 17062d667c
commit 4104d9f481
5 changed files with 97 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
rtl/inc/compproc.inc
View File

@ -589,7 +589,9 @@ procedure fpc_intf_assign_by_iid(var D: pointer; const S: pointer; const iid: TG
function fpc_intf_as(const S: pointer; const iid: TGUID): IInterface; compilerproc;
function fpc_class_as_intf(const S: pointer; const iid: TGUID): IInterface; compilerproc;
function fpc_class_as_corbaintf(const S: pointer; const iid: Shortstring): Pointer; compilerproc;
{$ifdef FPC_HAS_FEATURE_VARIANTS}
procedure fpc_dispatch_by_id(Result: Pointer; const Dispatch: pointer;DispDesc: Pointer; Params: Pointer); compilerproc;
{$endif FPC_HAS_FEATURE_VARIANTS}
{$endif FPC_HAS_FEATURE_CLASSES}

2
rtl/inc/objpas.inc
View File

@ -13,6 +13,7 @@
**********************************************************************}
{$ifdef FPC_HAS_FEATURE_VARIANTS}
procedure DoDispCallByIDError(res : Pointer; const disp : IDispatch;desc : PDispDesc; params : Pointer);
begin
handleerrorframe(RuntimeErrorExitCodes[reVarDispatch],get_frame);
@ -26,6 +27,7 @@
begin
TDispProc(DispCallByIDProc)(Result,IDispatch(Dispatch),DispDesc,Params);
end;
{$endif FPC_HAS_FEATURE_VARIANTS}
{****************************************************************************
Internal Routines called from the Compiler

87
rtl/inc/rtti.inc
View File

@ -133,15 +133,28 @@ end;
Procedure fpc_Initialize (Data,TypeInfo : pointer);[Public,Alias : 'FPC_INITIALIZE']; compilerproc;
begin
case PByte(TypeInfo)^ of
tkAstring,tkWstring,tkUString,tkInterface,tkDynArray:
{$ifdef FPC_HAS_FEATURE_DYNARRAYS}
tkDynArray,
{$endif FPC_HAS_FEATURE_DYNARRAYS}
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
tkAstring,
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
tkWstring,tkUString,
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
tkInterface:
PPchar(Data)^:=Nil;
tkArray:
arrayrtti(data,typeinfo,@int_initialize);
{$ifdef FPC_HAS_FEATURE_OBJECTS}
tkObject,
{$endif FPC_HAS_FEATURE_OBJECTS}
tkRecord:
recordrtti(data,typeinfo,@int_initialize);
{$ifdef FPC_HAS_FEATURE_VARIANTS}
tkVariant:
variant_init(PVarData(Data)^);
{$endif FPC_HAS_FEATURE_VARIANTS}
end;
end;
@ -149,28 +162,34 @@ end;
Procedure fpc_finalize (Data,TypeInfo: Pointer);[Public,Alias : 'FPC_FINALIZE']; compilerproc;
begin
case PByte(TypeInfo)^ of
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
tkAstring :
begin
fpc_AnsiStr_Decr_Ref(PPointer(Data)^);
PPointer(Data)^:=nil;
end;
{$ifndef VER2_2}
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$ifndef VER2_2}
tkUstring :
begin
fpc_UnicodeStr_Decr_Ref(PPointer(Data)^);
PPointer(Data)^:=nil;
end;
{$endif VER2_2}
{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
{$endif VER2_2}
{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
tkWstring :
begin
fpc_WideStr_Decr_Ref(PPointer(Data)^);
PPointer(Data)^:=nil;
end;
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
tkArray :
arrayrtti(data,typeinfo,@int_finalize);
{$ifdef FPC_HAS_FEATURE_OBJECTS}
tkObject,
{$endif FPC_HAS_FEATURE_OBJECTS}
tkRecord:
recordrtti(data,typeinfo,@int_finalize);
tkInterface:
@ -178,13 +197,17 @@ begin
Intf_Decr_Ref(PPointer(Data)^);
PPointer(Data)^:=nil;
end;
{$ifdef FPC_HAS_FEATURE_DYNARRAYS}
tkDynArray:
begin
fpc_dynarray_decr_ref(PPointer(Data)^,TypeInfo);
PPointer(Data)^:=nil;
end;
{$endif FPC_HAS_FEATURE_DYNARRAYS}
{$ifdef FPC_HAS_FEATURE_VARIANTS}
tkVariant:
variant_clear(PVarData(Data)^);
{$endif FPC_HAS_FEATURE_VARIANTS}
end;
end;
@ -192,27 +215,37 @@ end;
Procedure fpc_Addref (Data,TypeInfo : Pointer); [Public,alias : 'FPC_ADDREF']; compilerproc;
begin
case PByte(TypeInfo)^ of
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
tkAstring :
fpc_AnsiStr_Incr_Ref(PPointer(Data)^);
{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
tkWstring :
fpc_WideStr_Incr_Ref(PPointer(Data)^);
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
{$ifndef VER2_2}
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
{$ifndef VER2_2}
tkUstring :
fpc_UnicodeStr_Incr_Ref(PPointer(Data)^);
{$endif VER2_2}
{$endif VER2_2}
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
tkArray :
arrayrtti(data,typeinfo,@int_addref);
{$ifdef FPC_HAS_FEATURE_OBJECTS}
tkobject,
{$endif FPC_HAS_FEATURE_OBJECTS}
tkrecord :
recordrtti(data,typeinfo,@int_addref);
{$ifdef FPC_HAS_FEATURE_DYNARRAYS}
tkDynArray:
fpc_dynarray_incr_ref(PPointer(Data)^);
{$endif FPC_HAS_FEATURE_DYNARRAYS}
tkInterface:
Intf_Incr_Ref(PPointer(Data)^);
{$ifdef FPC_HAS_FEATURE_VARIANTS}
tkVariant:
variant_addref(pvardata(Data)^);
{$endif FPC_HAS_FEATURE_DYNARRAYS}
end;
end;
@ -225,27 +258,37 @@ Procedure fpc_DecRef (Data, TypeInfo : Pointer);[Public,alias : 'FPC_DECREF'];
begin
case PByte(TypeInfo)^ of
{ see AddRef for comment about below construct (JM) }
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
tkAstring:
fpc_AnsiStr_Decr_Ref(PPointer(Data)^);
{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
tkWstring:
fpc_WideStr_Decr_Ref(PPointer(Data)^);
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
{$ifndef VER2_2}
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
{$ifndef VER2_2}
tkUString:
fpc_UnicodeStr_Decr_Ref(PPointer(Data)^);
{$endif VER2_2}
{$endif VER2_2}
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
tkArray:
arrayrtti(data,typeinfo,@fpc_systemDecRef);
{$ifdef FPC_HAS_FEATURE_OBJECTS}
tkobject,
{$endif FPC_HAS_FEATURE_OBJECTS}
tkrecord:
recordrtti(data,typeinfo,@fpc_systemDecRef);
{$ifdef FPC_HAS_FEATURE_DYNARRAYS}
tkDynArray:
fpc_dynarray_decr_ref(PPointer(Data)^,TypeInfo);
{$endif FPC_HAS_FEATURE_DYNARRAYS}
tkInterface:
Intf_Decr_Ref(PPointer(Data)^);
{$ifdef FPC_HAS_FEATURE_VARIANTS}
tkVariant:
variant_clear(pvardata(data)^);
{$endif FPC_HAS_FEATURE_VARIANTS}
end;
end;
@ -266,20 +309,24 @@ var
begin
result:=sizeof(pointer);
case PByte(TypeInfo)^ of
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
tkAstring:
begin
fpc_AnsiStr_Incr_Ref(PPointer(Src)^);
fpc_AnsiStr_Decr_Ref(PPointer(Dest)^);
PPointer(Dest)^:=PPointer(Src)^;
end;
{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
tkWstring:
fpc_WideStr_Assign(PPointer(Dest)^,PPointer(Src)^);
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
{$ifndef VER2_2}
{$endif FPC_WIDESTRING_EQUAL_UNICODESTRING}
{$ifndef VER2_2}
tkUstring:
fpc_UnicodeStr_Assign(PPointer(Dest)^,PPointer(Src)^);
{$endif VER2_2}
{$endif VER2_2}
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
tkArray:
begin
Temp:=PByte(TypeInfo);
@ -303,7 +350,9 @@ begin
fpc_Copy_internal(Src+(I*size),Dest+(I*size),Info);
Result:=size*count;
end;
{$ifdef FPC_HAS_FEATURE_OBJECTS}
tkobject,
{$endif FPC_HAS_FEATURE_OBJECTS}
tkrecord:
begin
Temp:=PByte(TypeInfo);
@ -338,23 +387,27 @@ begin
if result>expectedoffset then
move((Src+expectedoffset)^,(Dest+expectedoffset)^,Result-expectedoffset);
end;
{$ifdef FPC_HAS_FEATURE_DYNARRAYS}
tkDynArray:
begin
fpc_dynarray_Incr_Ref(PPointer(Src)^);
fpc_dynarray_Decr_Ref(PPointer(Dest)^,typeinfo);
PPointer(Dest)^:=PPointer(Src)^;
end;
{$endif FPC_HAS_FEATURE_DYNARRAYS}
tkInterface:
begin
Intf_Incr_Ref(PPointer(Src)^);
Intf_Decr_Ref(PPointer(Dest)^);
PPointer(Dest)^:=PPointer(Src)^;
end;
{$ifdef FPC_HAS_FEATURE_VARIANTS}
tkVariant:
begin
VarCopyProc(pvardata(dest)^,pvardata(src)^);
result:=sizeof(tvardata);
end;
{$endif FPC_HAS_FEATURE_VARIANTS}
end;
end;

4
rtl/inc/system.inc
View File

@ -378,7 +378,7 @@ function aligntoptr(p : pointer) : pointer;inline;
{$ifdef FPC_HAS_FEATURE_RTTI}
{$i rtti.inc}
{$endif FPC_HAS_FEATURE_VARIANTS}
{$endif FPC_HAS_FEATURE_RTTI}
{$if defined(FPC_HAS_FEATURE_RANDOM)}
@ -1322,8 +1322,10 @@ end;
Directory Handling
*****************************************************************************}
{$ifdef FPC_HAS_FEATURE_FILEIO}
{ OS dependent dir functions }
{$i sysdir.inc}
{$endif FPC_HAS_FEATURE_FILEIO}
{$if defined(FPC_HAS_FEATURE_FILEIO) and defined(FPC_HAS_FEATURE_ANSISTRINGS)}
Procedure getdir(drivenr:byte;Var dir:ansistring);

20
rtl/objpas/objpas.pp
View File

@ -48,31 +48,41 @@ Var
Compatibility routines.
****************************************************************************}
{$ifdef FPC_HAS_FEATURE_FILEIO}
{ Untyped file support }
Procedure AssignFile(out f:File;const Name:string);
Procedure AssignFile(out f:File;p:pchar);
Procedure AssignFile(out f:File;c:char);
Procedure CloseFile(var f:File);
{$endif FPC_HAS_FEATURE_FILEIO}
{$ifdef FPC_HAS_FEATURE_TEXTIO}
{ Text file support }
Procedure AssignFile(out t:Text;const s:string);
Procedure AssignFile(out t:Text;p:pchar);
Procedure AssignFile(out t:Text;c:char);
Procedure CloseFile(Var t:Text);
{$endif FPC_HAS_FEATURE_TEXTIO}
{$ifdef FPC_HAS_FEATURE_FILEIO}
{ Typed file supoort }
Procedure AssignFile(out f:TypedFile;const Name:string);
Procedure AssignFile(out f:TypedFile;p:pchar);
Procedure AssignFile(out f:TypedFile;c:char);
{$endif FPC_HAS_FEATURE_FILEIO}
{$ifdef FPC_HAS_FEATURE_COMMANDARGS}
{ ParamStr should return also an ansistring }
Function ParamStr(Param : Integer) : Ansistring;
{$endif FPC_HAS_FEATURE_COMMANDARGS}
{$ifdef FPC_HAS_FEATURE_FILEIO}
Procedure MkDir(const s:ansistring);overload;
Procedure RmDir(const s:ansistring);overload;
Procedure ChDir(const s:ansistring);overload;
{$endif FPC_HAS_FEATURE_FILEIO}
{****************************************************************************
Resource strings.
@ -108,6 +118,7 @@ Var
Compatibility routines.
****************************************************************************}
{$ifdef FPC_HAS_FEATURE_FILEIO}
Procedure MkDirpchar(s: pchar;len:sizeuint);[IOCheck]; external name 'FPC_SYS_MKDIR';
Procedure ChDirpchar(s: pchar;len:sizeuint);[IOCheck]; external name 'FPC_SYS_CHDIR';
Procedure RmDirpchar(s: pchar;len:sizeuint);[IOCheck]; external name 'FPC_SYS_RMDIR';
@ -138,7 +149,9 @@ begin
{ Catch Runtime error/Exception }
System.Close(f);
end;
{$endif FPC_HAS_FEATURE_FILEIO}
{$ifdef FPC_HAS_FEATURE_TEXTIO}
{ Text file support }
Procedure AssignFile(out t:Text;const s:string);
@ -165,7 +178,9 @@ begin
{ Catch Runtime error/Exception }
System.Close(T);
end;
{$endif FPC_HAS_FEATURE_TEXTIO}
{$ifdef FPC_HAS_FEATURE_FILEIO}
{ Typed file support }
Procedure AssignFile(out f:TypedFile;const Name:string);
@ -185,7 +200,9 @@ Procedure AssignFile(out f:TypedFile;c:char);
begin
system.Assign (F,C);
end;
{$endif FPC_HAS_FEATURE_FILEIO}
{$ifdef FPC_HAS_FEATURE_COMMANDARGS}
Function ParamStr(Param : Integer) : Ansistring;
Var Len : longint;
@ -213,8 +230,10 @@ begin
else
paramstr:='';
end;
{$endif FPC_HAS_FEATURE_COMMANDARGS}
{$ifdef FPC_HAS_FEATURE_FILEIO}
Procedure MkDir(const s:ansistring);
begin
mkdirpchar(pchar(s),length(s));
@ -229,6 +248,7 @@ Procedure ChDir(const s:ansistring);
begin
ChDirpchar(pchar(s),length(s));
end;
{$endif FPC_HAS_FEATURE_FILEIO}
{ ---------------------------------------------------------------------
ResourceString support