* More pluggability of the RTL. Mantis 15124

git-svn-id: trunk@14212 -
2025-09-12 18:31:53 +02:00 · 2009-11-18 21:16:12 +00:00 · 2009-11-18 21:16:12 +00:00 · 4104d9f481
commit 4104d9f481
parent 17062d667c
5 changed files with 97 additions and 18 deletions
--- 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}


--- 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
--- 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,11 +162,14 @@ 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;
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
  {$ifndef VER2_2}
    tkUstring :
      begin
@ -168,9 +184,12 @@ begin
        PPointer(Data)^:=nil;
      end;
  {$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,8 +215,11 @@ 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)^);
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
  {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
    tkWstring :
      fpc_WideStr_Incr_Ref(PPointer(Data)^);
@ -202,17 +228,24 @@ begin
    tkUstring :
      fpc_UnicodeStr_Incr_Ref(PPointer(Data)^);
  {$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,8 +258,11 @@ 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)^);
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
  {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
    tkWstring:
      fpc_WideStr_Decr_Ref(PPointer(Data)^);
@ -235,17 +271,24 @@ begin
    tkUString:
      fpc_UnicodeStr_Decr_Ref(PPointer(Data)^);
  {$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,12 +309,15 @@ 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;
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}
+{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
  {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
    tkWstring:
      fpc_WideStr_Assign(PPointer(Dest)^,PPointer(Src)^);
@ -280,6 +326,7 @@ begin
    tkUstring:
      fpc_UnicodeStr_Assign(PPointer(Dest)^,PPointer(Src)^);
  {$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;

--- 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);
--- 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