* ensure the rtl and the packages for embedded compile with features exceptions and classes disabled

git-svn-id: trunk@43931 -

compiler/psub.pas

@@ -932,7 +932,8 @@ implementation
            (pi_needs_implicit_finally in flags) and
            { but it's useless in init/final code of units }
            not(procdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) and
-           not(target_info.system in systems_garbage_collected_managed_types) then
+           not(target_info.system in systems_garbage_collected_managed_types) and
+           (f_exceptions in features) then
           begin
             { Any result of managed type must be returned in parameter }
             if is_managed_type(procdef.returndef) and
@@ -969,7 +970,7 @@ implementation
             { constructors need destroy-on-exception code even if they don't
               have managed variables/temps }
             maybe_add_constructor_wrapper(code,
-              cs_implicit_exceptions in current_settings.moduleswitches);
+              (cs_implicit_exceptions in current_settings.moduleswitches) and (f_exceptions in features));
             current_filepos:=entrypos;
             addstatement(newstatement,code);
             current_filepos:=exitpos;

packages/rtl-extra/src/inc/sortalgs.pp

@@ -349,7 +349,10 @@ begin
     exit;
 
   GetMem(TempBuf, ItemSize);
+  
+{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
   try
+{$endif FPC_HAS_FEATURE_EXCEPTIONS}
     HeapSize := ItemCount;
     for I := HeapSort_Parent(ItemCount - 1) downto 0 do
       Heapify(I);
@@ -361,9 +364,13 @@ begin
       Dec(HeapSize);
       Heapify(0);
     end;
+{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
   finally
+{$endif FPC_HAS_FEATURE_EXCEPTIONS}  
     FreeMem(TempBuf, ItemSize);
+{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
   end;
+{$endif FPC_HAS_FEATURE_EXCEPTIONS}
 end;
 
 procedure HeapSort_ItemList_CustomItemExchanger_Context(
@@ -959,11 +966,16 @@ begin
   if not Assigned(Items) or (ItemCount < 2) or (ItemSize < 1) then
     exit;
   GetMem(TempBuf, ItemSize);
+{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
   try
     IntroSort(0, ItemCount - 1, 2*IntLog2(ItemCount));
   finally
     FreeMem(TempBuf, ItemSize);
   end;
+{$else FPC_HAS_FEATURE_EXCEPTIONS}
+  IntroSort(0, ItemCount - 1, 2*IntLog2(ItemCount));
+  FreeMem(TempBuf, ItemSize);
+{$endif FPC_HAS_FEATURE_EXCEPTIONS}
 end;
 
 procedure IntroSort_ItemList_CustomItemExchanger_Context(

rtl/inc/objpash.inc

@@ -29,6 +29,35 @@
                             Basic Types/constants
 *****************************************************************************}
 
+    type
+      TextFile = Text;
+
+      PGuid = ^TGuid;
+      TGuid = packed record
+         case integer of
+            1 : (
+                 Data1 : DWord;
+                 Data2 : word;
+                 Data3 : word;
+                 Data4 : array[0..7] of byte;
+                );
+            2 : (
+                 D1 : DWord;
+                 D2 : word;
+                 D3 : word;
+                 D4 : array[0..7] of byte;
+                );
+            3 : ( { uuid fields according to RFC4122 }
+                 time_low : dword;			// The low field of the timestamp
+                 time_mid : word;                      // The middle field of the timestamp
+                 time_hi_and_version : word;           // The high field of the timestamp multiplexed with the version number
+                 clock_seq_hi_and_reserved : byte;     // The high field of the clock sequence multiplexed with the variant
+                 clock_seq_low : byte;                 // The low field of the clock sequence
+                 node : array[0..5] of byte;           // The spatially unique node identifier
+                );
+      end;
+
+{$ifdef FPC_HAS_FEATURE_CLASSES}
     const
        vmtInstanceSize         = 0;
        vmtParent               = sizeof(SizeInt)*2;
@@ -68,8 +97,6 @@
        E_NOTIMPL     = hresult($80004001);
 
      type
-       TextFile = Text;
-
        { now the let's declare the base classes for the class object
          model. The compiler expects TObject and IUnknown to be defined
          first as forward classes }
@@ -130,31 +157,6 @@
          property vParent: PVmt read GetvParent;
        end;
 
-       PGuid = ^TGuid;
-       TGuid = packed record
-          case integer of
-             1 : (
-                  Data1 : DWord;
-                  Data2 : word;
-                  Data3 : word;
-                  Data4 : array[0..7] of byte;
-                 );
-             2 : (
-                  D1 : DWord;
-                  D2 : word;
-                  D3 : word;
-                  D4 : array[0..7] of byte;
-                 );
-             3 : ( { uuid fields according to RFC4122 }
-                  time_low : dword;			// The low field of the timestamp
-                  time_mid : word;                      // The middle field of the timestamp
-                  time_hi_and_version : word;           // The high field of the timestamp multiplexed with the version number
-                  clock_seq_hi_and_reserved : byte;     // The high field of the clock sequence multiplexed with the variant
-                  clock_seq_low : byte;                 // The low field of the clock sequence
-                  node : array[0..5] of byte;           // The spatially unique node identifier
-                 );
-       end;
-
        // This enumerate is found both in the rtl and compiler. Do not change the order of the fields.
        tinterfaceentrytype = (etStandard,
          etVirtualMethodResult,
@@ -467,6 +469,11 @@
       Calling this method is only valid within an except block. }
     procedure ReleaseExceptionObject;
 
+  const
+    { for safe as operator support }
+    IObjectInstance: TGuid = '{D91C9AF4-3C93-420F-A303-BF5BA82BFD23}';
+{$endif FPC_HAS_FEATURE_CLASSES}
+
 {*****************************************************************************
                               Array of const support
 *****************************************************************************}
@@ -515,8 +522,10 @@
            vtString        : (VString: PShortString);
            vtPointer       : (VPointer: Pointer);
            vtPChar         : (VPChar: PAnsiChar);
+{$ifdef FPC_HAS_FEATURE_CLASSES}
            vtObject        : (VObject: TObject);
            vtClass         : (VClass: TClass);
+{$endif FPC_HAS_FEATURE_CLASSES}
            vtPWideChar     : (VPWideChar: PWideChar);
            vtAnsiString    : (VAnsiString: Pointer);
            vtCurrency      : (VCurrency: PCurrency);
@@ -533,11 +542,6 @@
   var
     DispCallByIDProc : codepointer;
 
-  const
-    { for safe as operator support }
-    IObjectInstance: TGuid = '{D91C9AF4-3C93-420F-A303-BF5BA82BFD23}';
-
-
 {*****************************************************************************
                               Resourcestring support
 *****************************************************************************}

rtl/inc/rtti.inc

@@ -262,8 +262,10 @@ begin
         recordrtti(data,typeinfo,@int_finalize);
       end;
 {$endif VER3_0}
+{$ifdef FPC_HAS_FEATURE_CLASSES}
     tkInterface:
       Intf_Decr_Ref(PPointer(Data)^);
+{$endif FPC_HAS_FEATURE_CLASSES}
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
     tkDynArray:
       fpc_dynarray_clear(PPointer(Data)^,TypeInfo);
@@ -315,8 +317,10 @@ begin
     tkDynArray:
       fpc_dynarray_incr_ref(PPointer(Data)^);
 {$endif FPC_HAS_FEATURE_DYNARRAYS}
+{$ifdef FPC_HAS_FEATURE_CLASSES}
     tkInterface:
       Intf_Incr_Ref(PPointer(Data)^);
+{$endif FPC_HAS_FEATURE_CLASSES}
 {$ifdef FPC_HAS_FEATURE_VARIANTS}
     tkVariant:
       variant_addref(pvardata(Data)^);
@@ -434,8 +438,10 @@ begin
     tkDynArray:
       fpc_dynarray_assign(PPointer(Dest)^,PPointer(Src)^,typeinfo);
 {$endif FPC_HAS_FEATURE_DYNARRAYS}
+{$ifdef FPC_HAS_FEATURE_CLASSES}
     tkInterface:
       fpc_intf_assign(PPointer(Dest)^,PPointer(Src)^);
+{$endif FPC_HAS_FEATURE_CLASSES}
 {$ifdef FPC_HAS_FEATURE_VARIANTS}
     tkVariant:
       begin

rtl/inc/sortbase.pp

@@ -297,11 +297,16 @@ begin
   if not Assigned(Items) or (ItemCount < 2) or (ItemSize < 1) then
     exit;
   GetMem(TempBuf, ItemSize);
+{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
   try
     QuickSort(0, ItemCount - 1);
   finally
     FreeMem(TempBuf, ItemSize);
   end;
+{$else FPC_HAS_FEATURE_EXCEPTIONS}
+  QuickSort(0, ItemCount - 1);
+  FreeMem(TempBuf, ItemSize);
+{$endif FPC_HAS_FEATURE_EXCEPTIONS}
 end;
 
 procedure QuickSort_ItemList_CustomItemExchanger_Context(

rtl/inc/systemh.inc

@@ -1639,9 +1639,7 @@ const
                        Object Pascal support
 *****************************************************************************}
 
-{$ifdef FPC_HAS_FEATURE_CLASSES}
 {$i objpash.inc}
-{$endif FPC_HAS_FEATURE_CLASSES}
 
 {*****************************************************************************
                            Variant support