From 4104d9f4815a02f51614a29c29dd255991d143e9 Mon Sep 17 00:00:00 2001 From: marco Date: Wed, 18 Nov 2009 21:16:12 +0000 Subject: [PATCH] * More pluggability of the RTL. Mantis 15124 git-svn-id: trunk@14212 - --- rtl/inc/compproc.inc | 2 + rtl/inc/objpas.inc | 2 + rtl/inc/rtti.inc | 87 +++++++++++++++++++++++++++++++++++--------- rtl/inc/system.inc | 4 +- rtl/objpas/objpas.pp | 20 ++++++++++ 5 files changed, 97 insertions(+), 18 deletions(-) diff --git a/rtl/inc/compproc.inc b/rtl/inc/compproc.inc index 5debef971d..cda6dbf223 100644 --- a/rtl/inc/compproc.inc +++ b/rtl/inc/compproc.inc @@ -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} diff --git a/rtl/inc/objpas.inc b/rtl/inc/objpas.inc index 090a5a0e79..a5db4d9fbb 100644 --- a/rtl/inc/objpas.inc +++ b/rtl/inc/objpas.inc @@ -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 diff --git a/rtl/inc/rtti.inc b/rtl/inc/rtti.inc index 69a308c675..98ebb18ad2 100644 --- a/rtl/inc/rtti.inc +++ b/rtl/inc/rtti.inc @@ -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; diff --git a/rtl/inc/system.inc b/rtl/inc/system.inc index 6ee50ea1e3..2271915a79 100644 --- a/rtl/inc/system.inc +++ b/rtl/inc/system.inc @@ -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); diff --git a/rtl/objpas/objpas.pp b/rtl/objpas/objpas.pp index 30b4a205cf..5e9a71e823 100644 --- a/rtl/objpas/objpas.pp +++ b/rtl/objpas/objpas.pp @@ -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