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

fcl-passrc: parse $optimization

Browse Source 
git-svn-id: trunk@45586 -
This commit is contained in:
Mattias Gaertner 2020-06-05 15:45:06 +00:00
parent 35c5479f96
commit 837b782159
2 changed files with 123 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
packages/fcl-passrc/src/pasresolver.pp
View File

@ -2366,6 +2366,7 @@ type
function GetCombinedBaseType(const A, B: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
function IsElementSkipped(El: TPasElement): boolean; virtual;
function FindLocalBuiltInSymbol(El: TPasElement): TPasElement; virtual;
function GetFirstSection: TPasSection;
function GetLastSection: TPasSection;
function GetShiftAndMaskForLoHiFunc(BaseType: TResolverBaseType;
isLoFunc: Boolean; out Mask: LongWord): Integer;
@ -29156,6 +29157,23 @@ begin
Result:=nil;
end;
function TPasResolver.GetFirstSection: TPasSection;
var
Module: TPasModule;
begin
Result:=nil;
Module:=RootElement;
if Module=nil then exit;
if Module is TPasProgram then
Result:=TPasProgram(Module).ProgramSection
else if Module is TPasLibrary then
Result:=TPasLibrary(Module).LibrarySection
else if Module.InterfaceSection<>nil then
Result:=Module.InterfaceSection
else
Result:=Module.ImplementationSection;
end;
function TPasResolver.GetLastSection: TPasSection;
var
Module: TPasModule;

165
packages/fcl-passrc/src/pscanner.pp
View File

@ -821,6 +821,8 @@ type
procedure HandleMessageDirective(Param: String); virtual;
procedure HandleIncludeFile(Param: String); virtual;
procedure HandleResource(Param : string); virtual;
procedure HandleOptimizations(Param : string); virtual;
procedure DoHandleOptimization(OptName, OptValue: string); virtual;
procedure HandleUnDefine(Param: String); virtual;
@ -3416,6 +3418,47 @@ begin
end;
end;
procedure TPascalScanner.HandleOptimizations(Param: string);
// $optimization A,B-,C+
var
p, StartP, l: Integer;
OptName, Value: String;
begin
p:=1;
l:=length(Param);
while p<=l do
begin
// read next flag
// skip whitespace
while (p<=l) and (Param[p] in [' ',#9,#10,#13]) do
inc(p);
// read name
StartP:=p;
while (p<=l) and (Param[p] in ['a'..'z','A'..'Z','0'..'9','_']) do
inc(p);
if p=StartP then
Error(nWarnIllegalCompilerDirectiveX,sWarnIllegalCompilerDirectiveX,['optimization']);
OptName:=copy(Param,StartP,p-StartP);
// skip whitespace
while (p<=l) and (Param[p] in [' ',#9,#10,#13]) do
inc(p);
// read value
StartP:=p;
while (p<=l) and (Param[p]<>',') do
inc(p);
Value:=TrimRight(copy(Param,StartP,p-StartP));
DoHandleOptimization(OptName,Value);
inc(p);
end;
end;
procedure TPascalScanner.DoHandleOptimization(OptName, OptValue: string);
begin
// default: skip any optimization directive
if OptName='' then ;
if OptValue='' then ;
end;
function TPascalScanner.HandleMacro(AIndex : integer) : TToken;
Var
@ -4010,66 +4053,68 @@ begin
Handled:=true;
Param:=Trim(Param);
Case UpperCase(Directive) of
'ASSERTIONS':
DoBoolDirective(bsAssertions);
'DEFINE':
HandleDefine(Param);
'GOTO':
DoBoolDirective(bsGoto);
'DIRECTIVEFIELD':
HandleDispatchField(Param,vsDispatchField);
'DIRECTIVESTRFIELD':
HandleDispatchField(Param,vsDispatchStrField);
'ERROR':
HandleError(Param);
'HINT':
DoLog(mtHint,nUserDefined,SUserDefined,[Param]);
'HINTS':
DoBoolDirective(bsHints);
'I','INCLUDE':
Result:=HandleInclude(Param);
'INTERFACES':
HandleInterfaces(Param);
'LONGSTRINGS':
DoBoolDirective(bsLongStrings);
'MACRO':
DoBoolDirective(bsMacro);
'MESSAGE':
HandleMessageDirective(Param);
'MODE':
HandleMode(Param);
'MODESWITCH':
HandleModeSwitch(Param);
'NOTE':
DoLog(mtNote,nUserDefined,SUserDefined,[Param]);
'NOTES':
DoBoolDirective(bsNotes);
'OBJECTCHECKS':
DoBoolDirective(bsObjectChecks);
'OVERFLOWCHECKS','OV':
DoBoolDirective(bsOverflowChecks);
'POINTERMATH':
DoBoolDirective(bsPointerMath);
'R' :
HandleResource(Param);
'RANGECHECKS':
DoBoolDirective(bsRangeChecks);
'SCOPEDENUMS':
DoBoolDirective(bsScopedEnums);
'TYPEDADDRESS':
DoBoolDirective(bsTypedAddress);
'TYPEINFO':
DoBoolDirective(bsTypeInfo);
'UNDEF':
HandleUnDefine(Param);
'WARN':
HandleWarn(Param);
'WARNING':
DoLog(mtWarning,nUserDefined,SUserDefined,[Param]);
'WARNINGS':
DoBoolDirective(bsWarnings);
'WRITEABLECONST':
DoBoolDirective(bsWriteableConst);
'ASSERTIONS':
DoBoolDirective(bsAssertions);
'DEFINE':
HandleDefine(Param);
'GOTO':
DoBoolDirective(bsGoto);
'DIRECTIVEFIELD':
HandleDispatchField(Param,vsDispatchField);
'DIRECTIVESTRFIELD':
HandleDispatchField(Param,vsDispatchStrField);
'ERROR':
HandleError(Param);
'HINT':
DoLog(mtHint,nUserDefined,SUserDefined,[Param]);
'HINTS':
DoBoolDirective(bsHints);
'I','INCLUDE':
Result:=HandleInclude(Param);
'INTERFACES':
HandleInterfaces(Param);
'LONGSTRINGS':
DoBoolDirective(bsLongStrings);
'MACRO':
DoBoolDirective(bsMacro);
'MESSAGE':
HandleMessageDirective(Param);
'MODE':
HandleMode(Param);
'MODESWITCH':
HandleModeSwitch(Param);
'NOTE':
DoLog(mtNote,nUserDefined,SUserDefined,[Param]);
'NOTES':
DoBoolDirective(bsNotes);
'OBJECTCHECKS':
DoBoolDirective(bsObjectChecks);
'OPTIMIZATION':
HandleOptimizations(Param);
'OVERFLOWCHECKS','OV':
DoBoolDirective(bsOverflowChecks);
'POINTERMATH':
DoBoolDirective(bsPointerMath);
'R' :
HandleResource(Param);
'RANGECHECKS':
DoBoolDirective(bsRangeChecks);
'SCOPEDENUMS':
DoBoolDirective(bsScopedEnums);
'TYPEDADDRESS':
DoBoolDirective(bsTypedAddress);
'TYPEINFO':
DoBoolDirective(bsTypeInfo);
'UNDEF':
HandleUnDefine(Param);
'WARN':
HandleWarn(Param);
'WARNING':
DoLog(mtWarning,nUserDefined,SUserDefined,[Param]);
'WARNINGS':
DoBoolDirective(bsWarnings);
'WRITEABLECONST':
DoBoolDirective(bsWriteableConst);
else
Handled:=false;
end;