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

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

Browse Source 
git-svn-id: trunk@43931 -
This commit is contained in:
florian 2020-01-13 21:20:03 +00:00
parent 91f416fa80
commit 931d4dcfee
6 changed files with 62 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
compiler/psub.pas
View File

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

12
packages/rtl-extra/src/inc/sortalgs.pp
View File

@ -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(

68
rtl/inc/objpash.inc
View File

@ -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
*****************************************************************************}

6
rtl/inc/rtti.inc
View File

@ -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

5
rtl/inc/sortbase.pp
View File

@ -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(

2
rtl/inc/systemh.inc
View File

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