From cd5dcc278e7a05240d00329d56bce35a9c8d45a2 Mon Sep 17 00:00:00 2001 From: michael Date: Sat, 15 Aug 2020 07:25:48 +0000 Subject: [PATCH 01/25] * Check unit alias possibility git-svn-id: trunk@46441 - --- packages/fcl-passrc/src/paswrite.pp | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/packages/fcl-passrc/src/paswrite.pp b/packages/fcl-passrc/src/paswrite.pp index a6c177f1ac..6fdfa654eb 100644 --- a/packages/fcl-passrc/src/paswrite.pp +++ b/packages/fcl-passrc/src/paswrite.pp @@ -43,6 +43,8 @@ type ); TPasWriterOptions = Set of TPasWriterOption; + TOnUnitAlias = function(const UnitName : String) : String of Object; + TPasWriter = class private FCurrentLineNumber : Integer; @@ -51,6 +53,7 @@ type FForwardClasses: TStrings; FLineEnding: String; FLineNumberWidth: Integer; + FOnUnitAlias: TOnUnitAlias; FOPtions: TPasWriterOptions; FStream: TStream; FIndentSize : Integer; @@ -63,6 +66,7 @@ type FInImplementation : Boolean; procedure SetForwardClasses(AValue: TStrings); procedure SetIndentSize(AValue: Integer); + function CheckUnitAlias(const AUnitName : String) : String; protected procedure DisableHintsWarnings; procedure PrepareDeclSectionInStruct(const ADeclSection: string); @@ -132,6 +136,7 @@ type procedure wrtln;overload; deprecated ; property Stream: TStream read FStream; Published + Property OnUnitAlias : TOnUnitAlias Read FOnUnitAlias Write FOnUnitAlias; Property Options : TPasWriterOptions Read FOPtions Write FOptions; Property IndentSize : Integer Read FIndentSize Write SetIndentSize; Property LineEnding : String Read FLineEnding Write FLineEnding; @@ -478,7 +483,7 @@ end; procedure TPasWriter.WriteUnit(aModule: TPasModule); begin - AddLn('unit ' + AModule.SafeName + ';'); + AddLn('unit ' + CheckUnitAlias(AModule.SafeName) + ';'); if Assigned(AModule.GlobalDirectivesSection) then begin AddLn; @@ -556,7 +561,7 @@ Var Add(', ') else Add('uses '); - Add(AName); + Add(CheckUnitAlias(AName)); if (AUnitFile<>Nil) then Add(' in '+GetExpr(AUnitFile)); Inc(c); @@ -1490,6 +1495,14 @@ begin FIndentStep:=StringOfChar(' ',aValue); end; +function TPasWriter.CheckUnitAlias(const AUnitName: String): String; +begin + if Assigned(FOnUnitAlias) then + Result := FOnUnitAlias(AUnitName) + else + Result := AUnitName; +end; + function TPasWriter.HasOption(aOption: TPasWriterOption): Boolean; begin Result:=(aOption in FOptions) From 9e3574027cd5be4006af88fcbaa3e264ea9427ee Mon Sep 17 00:00:00 2001 From: michael Date: Sat, 15 Aug 2020 07:26:44 +0000 Subject: [PATCH 02/25] * unit alias possibility git-svn-id: trunk@46442 - --- utils/pas2js/libstub.pp | 9 ++++++++- utils/pas2js/stubcreator.pp | 38 +++++++++++++++++++++++++++++++++---- 2 files changed, 42 insertions(+), 5 deletions(-) diff --git a/utils/pas2js/libstub.pp b/utils/pas2js/libstub.pp index f8d3a9eb1f..5235f0bd5b 100644 --- a/utils/pas2js/libstub.pp +++ b/utils/pas2js/libstub.pp @@ -147,6 +147,12 @@ begin Move(C[1],AErrorClass^,L); end; +Procedure SetStubCreatorUnitAliasCallBack(P : PStubCreator; ACallBack : TUnitAliasCallBack; CallBackData : Pointer); stdcall; +begin + TStubCreator(P).OnUnitAlias:=ACallBack; + TStubCreator(P).OnUnitAliasData:=CallBackData; +end; + exports // Stub creator GetStubCreator, @@ -160,7 +166,8 @@ exports GetStubCreatorLastError, AddStubCreatorDefine, AddStubCreatorForwardClass, - ExecuteStubCreator; + ExecuteStubCreator, + SetStubCreatorUnitAliasCallBack; end. diff --git a/utils/pas2js/stubcreator.pp b/utils/pas2js/stubcreator.pp index f4a71ca437..39e0ce4aec 100644 --- a/utils/pas2js/stubcreator.pp +++ b/utils/pas2js/stubcreator.pp @@ -36,6 +36,8 @@ type TWriteCallBack = Procedure (Data : Pointer; AFileData : PAnsiChar; AFileDataLen: Int32); stdcall; TWriteEvent = Procedure(AFileData : String) of object; + TUnitAliasCallBack = Function (Data: Pointer; AUnitName: PAnsiChar; + var AUnitNameMaxLen: Int32): boolean; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF}; { TStubCreator } @@ -45,6 +47,7 @@ type FHeaderStream: TStream; FIncludePaths: TStrings; FInputFile: String; + FOnUnitAliasData: Pointer; FOnWrite: TWriteEvent; FOnWriteCallBack: TWriteCallBack; FOutputFile: String; @@ -60,10 +63,12 @@ type FCallBackData : Pointer; FLastErrorClass : String; FLastError : String; + FOnUnitAlias : TUnitAliasCallBack; procedure SetDefines(AValue: TStrings); procedure SetIncludePaths(AValue: TStrings); procedure SetOnWrite(AValue: TWriteEvent); procedure SetWriteCallback(AValue: TWriteCallBack); + function CheckUnitAlias(const AUnitName: String): String; Protected procedure DoExecute;virtual; Procedure DoWriteEvent; virtual; @@ -81,9 +86,10 @@ type // OutputStream can be used combined with write callbacks. Property OutputStream : TStream Read FOutputStream Write FOutputStream; Property HeaderStream : TStream Read FHeaderStream Write FHeaderStream; + Property OnUnitAlias: TUnitAliasCallBack read FOnUnitAlias Write FOnUnitAlias; + Property OnUnitAliasData : Pointer Read FOnUnitAliasData Write FOnUnitAliasData; Property OnWriteCallBack : TWriteCallBack Read FOnWriteCallBack Write SetWriteCallback; Property CallbackData : Pointer Read FCallBackData Write FCallBackData; - Published Property Defines : TStrings Read FDefines Write SetDefines; Property ConfigFileName : String Read FConfigFile Write FConfigFile; @@ -97,6 +103,8 @@ type Implementation +uses Math; + ResourceString SErrNoDestGiven = 'No destination file specified.'; SErrNoSourceParsed = 'Parsing produced no file.'; @@ -131,6 +139,23 @@ begin FWriteStream:=TStringStream.Create(''); end; +function TStubCreator.CheckUnitAlias(const AUnitName: String): String; +const + MAX_UNIT_NAME_LENGTH = 255; + +var + UnitMaxLenthName: Integer; + +begin + Result := AUnitName; + UnitMaxLenthName := Max(MAX_UNIT_NAME_LENGTH, Result.Length); + + SetLength(Result, UnitMaxLenthName); + + if FOnUnitAlias(OnUnitAliasData, @Result[1], UnitMaxLenthName) then + Result := LeftStr(PChar(Result), UnitMaxLenthName); +end; + procedure TStubCreator.DoWriteEvent; Var @@ -279,7 +304,7 @@ end; -Function TStubCreator.GetModule : TPasModule; +function TStubCreator.GetModule: TPasModule; Var SE : TSimpleEngine; @@ -327,7 +352,8 @@ begin end; end; -function TStubCreator.MaybeGetFileStream(AStream: TStream; const AFileName: String; AfileMode : Word) : TStream; +function TStubCreator.MaybeGetFileStream(AStream: TStream; + const AFileName: String; aFileMode: Word): TStream; begin If Assigned(AStream) then Result:=AStream @@ -359,7 +385,7 @@ begin end; -procedure TStubCreator.WriteModule(M : TPAsModule); +procedure TStubCreator.WriteModule(M: TPasModule); Var F,H : TStream; @@ -386,6 +412,10 @@ begin W:=TPasWriter.Create(F); W.Options:=FOptions; U:=FExtraUnits; + + if Assigned(FOnUnitAlias) then + W.OnUnitAlias:=@CheckUnitAlias; + if Pos(LowerCase(DTypesUnit),LowerCase(U)) = 0 then begin if (U<>'') then From cca2933e254089b6202486d7872c3dfd51b4318c Mon Sep 17 00:00:00 2001 From: michael Date: Sat, 15 Aug 2020 07:30:23 +0000 Subject: [PATCH 03/25] * Remove hints (by Henrique Werlang) git-svn-id: trunk@46443 - --- packages/fcl-passrc/src/paswrite.pp | 2 -- 1 file changed, 2 deletions(-) diff --git a/packages/fcl-passrc/src/paswrite.pp b/packages/fcl-passrc/src/paswrite.pp index 6fdfa654eb..8079455bcb 100644 --- a/packages/fcl-passrc/src/paswrite.pp +++ b/packages/fcl-passrc/src/paswrite.pp @@ -853,9 +853,7 @@ end; procedure TPasWriter.WriteRecordType(AType: TPasRecordType); Var - I : Integer; Temp : String; - el : TPasElement; begin Temp:='record'; From c7841139f477ee89ad8afb8cdcecb906ba42005a Mon Sep 17 00:00:00 2001 From: michael Date: Sat, 15 Aug 2020 07:31:43 +0000 Subject: [PATCH 04/25] * Expose ExtraUnits, remove hardcoded DTypesUnit, patch by Henrique Werlang (bug ID 37570) git-svn-id: trunk@46444 - --- utils/pas2js/libstub.pp | 6 ++++++ utils/pas2js/stubcreator.pp | 14 ++------------ 2 files changed, 8 insertions(+), 12 deletions(-) diff --git a/utils/pas2js/libstub.pp b/utils/pas2js/libstub.pp index 5235f0bd5b..4d8a3ff063 100644 --- a/utils/pas2js/libstub.pp +++ b/utils/pas2js/libstub.pp @@ -153,6 +153,11 @@ begin TStubCreator(P).OnUnitAliasData:=CallBackData; end; +Procedure AddStubCreatorExtraUnit(P : PStubCreator; AUnitName : PAnsiChar); stdcall; +begin + TStubCreator(P).ExtraUnits:=AUnitName; +end; + exports // Stub creator GetStubCreator, @@ -166,6 +171,7 @@ exports GetStubCreatorLastError, AddStubCreatorDefine, AddStubCreatorForwardClass, + AddStubCreatorExtraUnit, ExecuteStubCreator, SetStubCreatorUnitAliasCallBack; diff --git a/utils/pas2js/stubcreator.pp b/utils/pas2js/stubcreator.pp index 39e0ce4aec..8b5402b3bf 100644 --- a/utils/pas2js/stubcreator.pp +++ b/utils/pas2js/stubcreator.pp @@ -19,9 +19,6 @@ interface uses Classes, SysUtils, strutils, inifiles, pscanner, pparser, pastree, iostream, paswrite; -Const - DTypesUnit = 'jsdelphisystem'; - type { We have to override abstract TPasTreeContainer methods } @@ -90,6 +87,7 @@ type Property OnUnitAliasData : Pointer Read FOnUnitAliasData Write FOnUnitAliasData; Property OnWriteCallBack : TWriteCallBack Read FOnWriteCallBack Write SetWriteCallback; Property CallbackData : Pointer Read FCallBackData Write FCallBackData; + Property ExtraUnits : String Read FExtraUnits write FExtraUnits; Published Property Defines : TStrings Read FDefines Write SetDefines; Property ConfigFileName : String Read FConfigFile Write FConfigFile; @@ -390,7 +388,6 @@ procedure TStubCreator.WriteModule(M: TPasModule); Var F,H : TStream; W : TPasWriter; - U : String; begin W:=Nil; @@ -411,18 +408,11 @@ begin end; W:=TPasWriter.Create(F); W.Options:=FOptions; - U:=FExtraUnits; + W.ExtraUnits:=FExtraUnits; if Assigned(FOnUnitAlias) then W.OnUnitAlias:=@CheckUnitAlias; - if Pos(LowerCase(DTypesUnit),LowerCase(U)) = 0 then - begin - if (U<>'') then - U:=','+U; - U:=DTypesUnit+U; - end; - W.ExtraUnits:=U; if FIndentSize<>-1 then W.IndentSize:=FIndentSize; if FLineNumberWidth>0 then From 25b14f0bef43990a795c4ffc0984c77e8edbfc90 Mon Sep 17 00:00:00 2001 From: michael Date: Sat, 15 Aug 2020 07:34:43 +0000 Subject: [PATCH 05/25] * Calling conventions in casing as in Delphi, patch by Henrique Werlang, bug ID #37571 git-svn-id: trunk@46445 - --- packages/fcl-passrc/src/pastree.pp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/packages/fcl-passrc/src/pastree.pp b/packages/fcl-passrc/src/pastree.pp index 3c86be368d..1cd85ff610 100644 --- a/packages/fcl-passrc/src/pastree.pp +++ b/packages/fcl-passrc/src/pastree.pp @@ -1750,7 +1750,7 @@ const cPasMemberHint : Array[TPasMemberHint] of string = ( 'deprecated', 'library', 'platform', 'experimental', 'unimplemented' ); cCallingConventions : Array[TCallingConvention] of string = - ( '', 'Register','Pascal','CDecl','StdCall','OldFPCCall','SafeCall','SysCall','MWPascal', + ( '', 'Register','Pascal','cdecl','stdcall','OldFPCCall','safecall','SysCall','MWPascal', 'HardFloat','SysV_ABI_Default','SysV_ABI_CDecl', 'MS_ABI_Default','MS_ABI_CDecl', 'VectorCall'); @@ -4208,7 +4208,7 @@ end; function TPasClassOfType.GetDeclaration (full : boolean) : string; begin - Result:='Class of '+DestType.SafeName; + Result:='class of '+DestType.SafeName; If Full then Result:=FixTypeDecl(Result); end; From bcde18f8797fc1a0b06819ced39907433d367c83 Mon Sep 17 00:00:00 2001 From: ondrej Date: Sat, 15 Aug 2020 08:26:42 +0000 Subject: [PATCH 06/25] sql parser: fallback for all parser keywords to identifiers/functions if they are used in an expression (e.g. LEFT was affected) git-svn-id: trunk@46446 - --- packages/fcl-db/src/sql/fpsqlparser.pas | 9 ++++++--- packages/fcl-db/tests/tcparser.pas | 26 +++++++++++++++++++++++++ 2 files changed, 32 insertions(+), 3 deletions(-) diff --git a/packages/fcl-db/src/sql/fpsqlparser.pas b/packages/fcl-db/src/sql/fpsqlparser.pas index 893fef5b9a..645c07feae 100644 --- a/packages/fcl-db/src/sql/fpsqlparser.pas +++ b/packages/fcl-db/src/sql/fpsqlparser.pas @@ -2880,7 +2880,10 @@ begin Result:=TSQLAsteriskExpression(CreateElement(TSQLAsteriskExpression,APArent)); GetNextToken; end; - tsqlIdentifier: + else + // some keywords (FirstKeyword..LastKeyWord) can also be functions/identifiers (LEFT, RIGHT) + // To-Do: remove some of them if necessary + if CurrentToken in [tsqlIdentifier, FirstKeyword..LastKeyWord] then begin N:=CurrentTokenString; If (GetNextToken<>tsqlBraceOpen) then @@ -2941,10 +2944,10 @@ begin TSQLFunctionCallExpression(Result).IDentifier:=N; TSQLFunctionCallExpression(Result).Arguments:=L; end; - end; + end else UnexpectedToken; - end; + end; except FreeAndNil(Result); Raise; diff --git a/packages/fcl-db/tests/tcparser.pas b/packages/fcl-db/tests/tcparser.pas index fc62c71650..de6b617cc9 100644 --- a/packages/fcl-db/tests/tcparser.pas +++ b/packages/fcl-db/tests/tcparser.pas @@ -450,6 +450,7 @@ type procedure TestAggregateAvgDistinct; procedure TestUpperConst; procedure TestUpperError; + procedure TestLeft; procedure TestGenID; procedure TestGenIDError1; procedure TestGenIDError2; @@ -4778,6 +4779,31 @@ begin AssertAggregateExpression(H.Left,afCount,'C',aoNone); end; +procedure TTestSelectParser.TestLeft; + +Var + E : TSQLFunctionCallExpression; + L : TSQLLiteralExpression; + S : TSQLStringLiteral; + I : TSQLIntegerLiteral; + +begin + TestSelect('SELECT LEFT(''abc'', 1) FROM A'); + AssertEquals('One field',1,Select.Fields.Count); + AssertEquals('One table',1,Select.Tables.Count); + AssertTable(Select.Tables[0],'A'); + CheckClass(Select.Fields[0],TSQLSelectField); + E:=TSQLFunctionCallExpression(CheckClass(TSQLSelectField(Select.Fields[0]).Expression,TSQLFunctionCallExpression)); + AssertEquals('LEFT function name','LEFT',E.Identifier); + AssertEquals('Two function elements',2,E.Arguments.Count); + L:=TSQLLiteralExpression(CheckClass(E.Arguments[0],TSQLLiteralExpression)); + S:=TSQLStringLiteral(CheckClass(L.Literal,TSQLStringLiteral)); + AssertEquals('Correct string constant','abc',S.Value); + L:=TSQLLiteralExpression(CheckClass(E.Arguments[1],TSQLLiteralExpression)); + I:=TSQLIntegerLiteral(CheckClass(L.Literal,TSQLIntegerLiteral)); + AssertEquals('Correct integer constant',1,I.Value); +end; + procedure TTestSelectParser.TestNoTable; Var From 313790502da4de79b8c7b67c1d5e5df59025e923 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A1roly=20Balogh?= Date: Sat, 15 Aug 2020 09:07:30 +0000 Subject: [PATCH 07/25] * linux-m68k: depend on FPU defines to compile FPU code, instead of CPU68020. also, minor cosmetics git-svn-id: trunk@46447 - --- rtl/linux/m68k/sighnd.inc | 3 +-- rtl/linux/m68k/sighndh.inc | 4 ++-- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/rtl/linux/m68k/sighnd.inc b/rtl/linux/m68k/sighnd.inc index 2aee7f14e4..d1af950965 100644 --- a/rtl/linux/m68k/sighnd.inc +++ b/rtl/linux/m68k/sighnd.inc @@ -62,8 +62,7 @@ Procedure ResetFPU; var l_fpucw : longint; begin - -{$ifdef CPU68020} +{$if defined(FPU68881) or defined(FPUCOLDFIRE)} asm fmove.l fpcr,l_fpucw end; diff --git a/rtl/linux/m68k/sighndh.inc b/rtl/linux/m68k/sighndh.inc index 4109c02ba0..52a54c29b0 100644 --- a/rtl/linux/m68k/sighndh.inc +++ b/rtl/linux/m68k/sighndh.inc @@ -23,8 +23,8 @@ type pfpstate = ^tfpstate; tfpstate = record - pcr,psr,fpiaddr : longint; - fpreg : array [0..7] of tfpreg; + pcr,psr,fpiaddr : longint; + fpreg : array [0..7] of tfpreg; end; { as defined in asm_m68k/signal.h } From ad7c3d9a098dd5d354390c3497e95681b2ee0f73 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Sat, 15 Aug 2020 12:14:45 +0000 Subject: [PATCH 08/25] * don't convert lea to add/inc/dec/sub if there's a symbol in the reference o fixes make cycle on Darwin/i386 git-svn-id: trunk@46448 - --- compiler/x86/aoptx86.pas | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/compiler/x86/aoptx86.pas b/compiler/x86/aoptx86.pas index d037776bb4..301379df75 100644 --- a/compiler/x86/aoptx86.pas +++ b/compiler/x86/aoptx86.pas @@ -1788,14 +1788,16 @@ unit aoptx86; InternalError(2020072501); { do not mess with the stack point as adjusting it by lea is recommend, except if we optimize for size } - if (taicpu(p).oper[1]^.reg=NR_STACK_POINTER_REG) and + if (p.oper[1]^.reg=NR_STACK_POINTER_REG) and not(cs_opt_size in current_settings.optimizerswitches) then exit; with p.oper[0]^.ref^ do begin - if (base <> p.oper[1]^.reg) or (index <> NR_NO) then - Exit(False); + if (base <> p.oper[1]^.reg) or + (index <> NR_NO) or + assigned(symbol) then + exit; l:=offset; if (l=1) and UseIncDec then From cc14f066771b4f7814b8295a2f85e037fc14f6bf Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Sat, 15 Aug 2020 15:13:08 +0000 Subject: [PATCH 09/25] * when a function returns a value in a register, but normally that type would never be put in that kind of register by the compiler, store it to memory to avoid issues down the line o fixes tcalext6 on darwin/i386 git-svn-id: trunk@46449 - --- compiler/ncgcal.pas | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/compiler/ncgcal.pas b/compiler/ncgcal.pas index 967499914c..2a0ea8e848 100644 --- a/compiler/ncgcal.pas +++ b/compiler/ncgcal.pas @@ -623,6 +623,18 @@ implementation assigned(funcretnode) then hlcg.gen_load_cgpara_loc(current_asmdata.CurrAsmList,realresdef,retloc,location,false); + if ((location.loc=LOC_REGISTER) and + not realresdef.is_intregable) or + ((location.loc in [LOC_FPUREGISTER,LOC_MMREGISTER]) and + (not realresdef.is_fpuregable or + ((location.loc=LOC_MMREGISTER)<>use_vectorfpu(realresdef)))) then + begin + hlcg.location_force_mem(current_asmdata.CurrAsmList,location,realresdef); + { may have been record returned in a floating point register (-> location.size + will be the size of the fpuregister instead of the int size of the record) } + location.size:=def_cgsize(realresdef); + end; + { copy value to the final location if this was already provided to the callnode. This must be done after the call node, because the location can also be used as parameter and may not be finalized yet } From a9f9ee43afcec2574201c15dfcc860db6741d191 Mon Sep 17 00:00:00 2001 From: marco Date: Sat, 15 Aug 2020 15:21:38 +0000 Subject: [PATCH 10/25] * fix for mantis 37573 by Sergey Larin. Manually chain coinitialize* running into the initproc chain, executing it depth first to make it as late as possible. git-svn-id: trunk@46450 - --- packages/winunits-base/src/comobj.pp | 25 +++++++++++++++++++------ 1 file changed, 19 insertions(+), 6 deletions(-) diff --git a/packages/winunits-base/src/comobj.pp b/packages/winunits-base/src/comobj.pp index 0f01378f46..33f51d7925 100644 --- a/packages/winunits-base/src/comobj.pp +++ b/packages/winunits-base/src/comobj.pp @@ -325,6 +325,7 @@ unit ComObj; CoResumeClassObjects : TCoResumeClassObjectsProc = nil; CoSuspendClassObjects : TCoSuspendClassObjectsProc = nil; CoInitFlags : Longint = -1; + CoInitDisable : Boolean = False; {$ifdef DEBUG_COM} var printcom : boolean=true; @@ -1877,6 +1878,20 @@ const Initialized : boolean = false; var Ole32Dll : HModule; + SaveInitProc : CodePointer; + +procedure InitComObj; +begin + if SaveInitProc<>nil then + TProcedure(SaveInitProc)(); + if not CoInitDisable then +{$ifndef wince} + if (CoInitFlags=-1) or not(assigned(ComObj.CoInitializeEx)) then + Initialized:=Succeeded(CoInitialize(nil)) + else +{$endif wince} + Initialized:=Succeeded(ComObj.CoInitializeEx(nil, CoInitFlags)); +end; initialization Uninitializing:=false; @@ -1893,12 +1908,10 @@ initialization end; if not(IsLibrary) then -{$ifndef wince} - if (CoInitFlags=-1) or not(assigned(comobj.CoInitializeEx)) then - Initialized:=Succeeded(CoInitialize(nil)) - else -{$endif wince} - Initialized:=Succeeded(comobj.CoInitializeEx(nil, CoInitFlags)); + begin + SaveInitProc:=InitProc; + InitProc:=@InitComObj; + end; SafeCallErrorProc:=@SafeCallErrorHandler; VarDispProc:=@ComObjDispatchInvoke; From db49df38bc3dfe24081ba24795dba42d022cc3f0 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Sat, 15 Aug 2020 16:56:39 +0000 Subject: [PATCH 11/25] fcl-passrc: resolver: started hub for shared values git-svn-id: trunk@46451 - --- packages/fcl-passrc/src/pasresolver.pp | 41 +++++++++++++++++++++--- packages/fcl-passrc/tests/tcresolver.pas | 5 +++ 2 files changed, 42 insertions(+), 4 deletions(-) diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 873f703ab7..1c406d9bc9 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -1423,10 +1423,21 @@ type //ToDo: proStaticArrayConcat, // concat works with static arrays, returning a dynamic array proProcTypeWithoutIsNested, // proc types can use nested procs without 'is nested' proMethodAddrAsPointer, // can assign @method to a pointer - proSafecallAllowsDefault // allow assigning a default calling convetnion to a SafeCall proc + proSafecallAllowsDefault // allow assigning a default calling convention to a SafeCall proc ); TPasResolverOptions = set of TPasResolverOption; + { TPasResolverHub } + + TPasResolverHub = class + private + FOwner: TObject; + public + constructor Create(TheOwner: TObject); + property Owner: TObject read FOwner; + end; + TPasResolverHubClass = class of TPasResolverHub; + TPasResolverStep = ( prsInit, prsParsing, @@ -1480,6 +1491,7 @@ type FDefaultScope: TPasDefaultScope; FDynArrayMaxIndex: TMaxPrecInt; FDynArrayMinIndex: TMaxPrecInt; + FHub: TPasResolverHub; FLastCreatedData: array[TResolveDataListKind] of TResolveData; FLastElement: TPasElement; FLastMsg: string; @@ -2363,10 +2375,12 @@ type function FindLocalBuiltInSymbol(El: TPasElement): TPasElement; virtual; function GetFirstSection(WithUnitImpl: boolean): TPasSection; function GetLastSection: TPasSection; + function GetParentSection(El: TPasElement): TPasSection; function FindUsedUnitInSection(aMod: TPasModule; Section: TPasSection): TPasUsesUnit; function GetShiftAndMaskForLoHiFunc(BaseType: TResolverBaseType; isLoFunc: Boolean; out Mask: LongWord): Integer; public + property Hub: TPasResolverHub read FHub write FHub; // options property Options: TPasResolverOptions read FOptions write FOptions; property AnonymousElTypePostfix: String read FAnonymousElTypePostfix @@ -2381,15 +2395,15 @@ type property ExprEvaluator: TResExprEvaluator read fExprEvaluator; property DynArrayMinIndex: TMaxPrecInt read FDynArrayMinIndex write FDynArrayMinIndex; property DynArrayMaxIndex: TMaxPrecInt read FDynArrayMaxIndex write FDynArrayMaxIndex; + property StoreSrcColumns: boolean read FStoreSrcColumns write FStoreSrcColumns; { + If true Line and Column is mangled together in TPasElement.SourceLineNumber. + Use method UnmangleSourceLineNumber to extract. } // parsed values property DefaultNameSpace: String read FDefaultNameSpace; property RootElement: TPasModule read FRootElement write SetRootElement; property Step: TPasResolverStep read FStep; property ActiveHelpers: TPRHelperEntryArray read FActiveHelpers; // scopes - property StoreSrcColumns: boolean read FStoreSrcColumns write FStoreSrcColumns; { - If true Line and Column is mangled together in TPasElement.SourceLineNumber. - Use method UnmangleSourceLineNumber to extract. } property Scopes[Index: integer]: TPasScope read GetScopes; property ScopeCount: integer read FScopeCount; property TopScope: TPasScope read FTopScope; @@ -3063,6 +3077,13 @@ begin str(a,Result); end; +{ TPasResolverHub } + +constructor TPasResolverHub.Create(TheOwner: TObject); +begin + FOwner:=TheOwner; +end; + { TPRSpecializedItem } destructor TPRSpecializedItem.Destroy; @@ -11780,6 +11801,8 @@ var C: TClass; ModScope: TPasModuleScope; begin + if Hub=nil then + RaiseNotYetImplemented(20200815182122,El); if TopScope<>DefaultScope then RaiseInvalidScopeForElement(20160922163504,El); ModScope:=TPasModuleScope(PushScope(El,FScopeClass_Module)); @@ -29229,6 +29252,16 @@ begin Result:=Module.InterfaceSection; end; +function TPasResolver.GetParentSection(El: TPasElement): TPasSection; +begin + while El<>nil do + begin + if El is TPasSection then exit(TPasSection(El)); + El:=El.Parent; + end; + Result:=nil; +end; + function TPasResolver.FindUsedUnitInSection(aMod: TPasModule; Section: TPasSection): TPasUsesUnit; var diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas index 938e3becb8..942e81b128 100644 --- a/packages/fcl-passrc/tests/tcresolver.pas +++ b/packages/fcl-passrc/tests/tcresolver.pas @@ -112,6 +112,7 @@ type TCustomTestResolver = Class(TTestParser) Private + FHub: TPasResolverHub; {$IF defined(VerbosePasResolver) or defined(VerbosePasResolverMem)} FStartElementRefCount: int64; {$ENDIF} @@ -173,6 +174,7 @@ type procedure StartUnit(NeedSystemUnit: boolean); property Modules[Index: integer]: TTestEnginePasResolver read GetModules; property ModuleCount: integer read GetModuleCount; + property Hub: TPasResolverHub read FHub; property ResolverEngine: TTestEnginePasResolver read FResolverEngine; property MsgCount: integer read GetMsgCount; property Msgs[Index: integer]: TTestResolverMessage read GetMsgs; @@ -1060,6 +1062,7 @@ begin FStartElementRefCount:=TPasElement.GlobalRefCount; {$ENDIF} FModules:=TObjectList.Create(true); + FHub:=TPasResolverHub.Create(Self); inherited SetUp; Parser.Options:=Parser.Options+[po_ResolveStandardTypes]; Scanner.OnDirective:=@OnScannerDirective; @@ -1096,6 +1099,7 @@ begin FModules.OwnsObjects:=true; FreeAndNil(FModules);// free all other modules end; + FreeAndNil(FHub); {$IFDEF VerbosePasResolverMem} writeln('TTestResolver.TearDown inherited'); {$ENDIF} @@ -2171,6 +2175,7 @@ begin Result.AddObjFPCBuiltInIdentifiers; Result.OnFindUnit:=@OnPasResolverFindUnit; Result.OnLog:=@OnPasResolverLog; + Result.Hub:=Hub; FModules.Add(Result); end; From 7e8b9122ddd15896013e9b63ec216e3730008742 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Sat, 15 Aug 2020 16:57:11 +0000 Subject: [PATCH 12/25] pastojs: started hub for shared values git-svn-id: trunk@46452 - --- packages/pastojs/src/fppas2js.pp | 47 ++++++++++++++++++++++++++ packages/pastojs/src/pas2jscompiler.pp | 9 +++-- packages/pastojs/tests/tcgenerics.pas | 1 + packages/pastojs/tests/tcmodules.pas | 6 ++++ 4 files changed, 61 insertions(+), 2 deletions(-) diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 54dea17e0e..993e8c02aa 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -1369,6 +1369,11 @@ type property TargetProcessor: TPasToJsProcessor read FTargetProcessor write FTargetProcessor; end; + { TPas2JSResolverHub } + + TPas2JSResolverHub = class(TPasResolverHub) + end; + { TPas2JSResolver } TPas2JSResolver = class(TPasResolver) @@ -1473,6 +1478,7 @@ type // generic/specialize procedure SpecializeGenericImpl(SpecializedItem: TPRSpecializedItem); override; + function SpecializeNeedsDelay(SpecializedItem: TPRSpecializedItem): TPasElement; protected const cJSValueConversion = 2*cTypeConversion; @@ -4900,6 +4906,47 @@ begin end; end; +function TPas2JSResolver.SpecializeNeedsDelay( + SpecializedItem: TPRSpecializedItem): TPasElement; +// finds first specialize param defined later than the generic +// For example: generic in the unit interface, param in implementation +// or param in another unit, not used by the generic +var + Gen: TPasElement; + GenMod, ParamMod: TPasModule; + Params: TPasTypeArray; + Param: TPasType; + i: Integer; + GenSection, ParamSection: TPasSection; +begin + Result:=nil; + Gen:=SpecializedItem.GenericEl; + GenSection:=GetParentSection(Gen); + if not (GenSection is TInterfaceSection) then + exit; // generic in unit implementation/program/library -> params cannot be defined a later section + GenMod:=GenSection.GetModule; + + Params:=SpecializedItem.Params; + for i:=0 to length(Params)-1 do + begin + Param:=ResolveAliasType(Params[i],false); + if Param.ClassType=TPasUnresolvedSymbolRef then + continue; // built-in type + ParamSection:=GetParentSection(Param); + if ParamSection=GenSection then continue; + // not in same section + ParamMod:=ParamSection.GetModule; + if ParamMod=GenMod then + exit(Param); // generic in unit interface, specialize in implementation + // param in another unit + if ParamSection is TImplementationSection then + exit(Param); // generic in unit interface, specialize in another(later) implementation + // param in another unit interface + + //xxx + end; +end; + function TPas2JSResolver.AddJSBaseType(const aName: string; Typ: TPas2jsBaseType ): TResElDataPas2JSBaseType; var diff --git a/packages/pastojs/src/pas2jscompiler.pp b/packages/pastojs/src/pas2jscompiler.pp index fee300594b..41bf8e577e 100644 --- a/packages/pastojs/src/pas2jscompiler.pp +++ b/packages/pastojs/src/pas2jscompiler.pp @@ -500,6 +500,7 @@ type FPostProcessorSupport: TPas2JSPostProcessorSupport; FPrecompileGUID: TGUID; FReadingModules: TFPList; // list of TPas2jsCompilerFile ordered by uses sections + FResolverHub: TPas2JSResolverHub; FRTLVersionCheck: TP2jsRTLVersionCheck; FSrcMapBaseDir: string; FSrcMapSourceRoot: string; @@ -680,14 +681,15 @@ type property DefaultNamespace: String read GetDefaultNamespace; property Defines: TStrings read FDefines; property FS: TPas2jsFS read FFS write SetFS; - property OwnsFS: boolean read FOwnsFS write FOwnsFS; + property OwnsFS: boolean read FOwnsFS write FOwnsFS; // true = auto free FS when compiler is freed property FileCount: integer read GetFileCount; - property InterfaceType: TPasClassInterfaceType read FInterfaceType write FInterfaceType; + property InterfaceType: TPasClassInterfaceType read FInterfaceType write FInterfaceType; // default interface type property Log: TPas2jsLogger read FLog; property MainFile: TPas2jsCompilerFile read FMainFile; property ModeSwitches: TModeSwitches read FModeSwitches write SetModeSwitches; property Options: TP2jsCompilerOptions read FOptions write SetOptions; property ConverterGlobals: TPasToJSConverterGlobals read FConverterGlobals write SetConverterGlobals; + property ResolverHub: TPas2JSResolverHub read FResolverHub; property ParamMacros: TPas2jsMacroEngine read FParamMacros; property PrecompileGUID: TGUID read FPrecompileGUID write FPrecompileGUID; property RTLVersionCheck: TP2jsRTLVersionCheck read FRTLVersionCheck write FRTLVersionCheck; @@ -965,6 +967,7 @@ begin FPasResolver.OnCheckSrcName:=@OnResolverCheckSrcName; FPasResolver.OnLog:=@OnPasResolverLog; FPasResolver.Log:=Log; + FPasResolver.Hub:=aCompiler.ResolverHub; FPasResolver.AddObjFPCBuiltInIdentifiers(btAllJSBaseTypes,bfAllJSBaseProcs); FIsMainFile:=Compiler.FS.SameFileName(Compiler.MainSrcFile,PasFilename); for ub in TUsedBySection do @@ -4191,6 +4194,7 @@ constructor TPas2jsCompiler.Create; begin FOptions:=DefaultP2jsCompilerOptions; FConverterGlobals:=TPasToJSConverterGlobals.Create(Self); + FResolverHub:=TPas2JSResolverHub.Create(Self); FNamespaces:=TStringList.Create; FDefines:=TStringList.Create; FInsertFilenames:=TStringList.Create; @@ -4232,6 +4236,7 @@ destructor TPas2jsCompiler.Destroy; FreeAndNil(FPostProcessorSupport); FreeAndNil(FConfigSupport); ConverterGlobals:=nil; + FreeAndNil(FResolverHub); ClearDefines; FreeAndNil(FDefines); diff --git a/packages/pastojs/tests/tcgenerics.pas b/packages/pastojs/tests/tcgenerics.pas index cbe5e96bdd..94f9b6be42 100644 --- a/packages/pastojs/tests/tcgenerics.pas +++ b/packages/pastojs/tests/tcgenerics.pas @@ -67,6 +67,7 @@ type procedure TestGenProc_TypeInfo; procedure TestGenProc_Infer_Widen; procedure TestGenProc_Infer_PassAsArg; + // ToDo: delay create: type TRec=record end; ... r:=GenProc(); // ToDo: FuncName:= instead of Result:= // generic methods diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index f7c1eeeaca..7049a4391a 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -111,6 +111,7 @@ type FExpectedErrorNumber: integer; FFilename: string; FFileResolver: TStreamResolver; + FHub: TPas2JSResolverHub; FJSImplementationSrc: TJSSourceElements; FJSImplementationUses: TJSArrayLiteral; FJSInitBody: TJSFunctionBody; @@ -216,6 +217,7 @@ type public constructor Create; override; destructor Destroy; override; + property Hub: TPas2JSResolverHub read FHub; property Source: TStringList read FSource; property FileResolver: TStreamResolver read FFileResolver; property Scanner: TPas2jsPasScanner read FScanner; @@ -1310,6 +1312,8 @@ begin inherited SetUp; FSkipTests:=false; FSource:=TStringList.Create; + + FHub:=TPas2JSResolverHub.Create(Self); FModules:=TObjectList.Create(true); FFilename:='test1.pp'; @@ -1404,6 +1408,7 @@ begin ReleaseAndNil(TPasElement(FModule){$IFDEF CheckPasTreeRefCount},'CreateElement'{$ENDIF}); FEngine:=nil; end; + FreeAndNil(FHub); inherited TearDown; {$IFDEF EnablePasTreeGlobalRefCount} @@ -1558,6 +1563,7 @@ begin Result.AddObjFPCBuiltInIdentifiers(btAllJSBaseTypes,bfAllJSBaseProcs); Result.OnFindUnit:=@OnPasResolverFindUnit; Result.OnLog:=@OnPasResolverLog; + Result.Hub:=Hub; FModules.Add(Result); end; From 18b8b9c566f597015de7e0c3a03ac98cedc2a6fb Mon Sep 17 00:00:00 2001 From: florian Date: Sat, 15 Aug 2020 18:29:26 +0000 Subject: [PATCH 13/25] * do not apply range test optimization if the variable is a string being compared against a char constants, resolves #37476 git-svn-id: trunk@46453 - --- .gitattributes | 1 + compiler/nadd.pas | 6 ++++-- tests/webtbf/tw37476.pp | 5 +++++ 3 files changed, 10 insertions(+), 2 deletions(-) create mode 100644 tests/webtbf/tw37476.pp diff --git a/.gitattributes b/.gitattributes index 551cd6bc0b..70b988380e 100644 --- a/.gitattributes +++ b/.gitattributes @@ -16559,6 +16559,7 @@ tests/webtbf/tw3740.pp svneol=native#text/plain tests/webtbf/tw37460.pp svneol=native#text/pascal tests/webtbf/tw37462.pp svneol=native#text/pascal tests/webtbf/tw37475.pp svneol=native#text/pascal +tests/webtbf/tw37476.pp svneol=native#text/pascal tests/webtbf/tw3790.pp svneol=native#text/plain tests/webtbf/tw3812.pp svneol=native#text/plain tests/webtbf/tw3930a.pp svneol=native#text/plain diff --git a/compiler/nadd.pas b/compiler/nadd.pas index 87a17ee985..27f604188c 100644 --- a/compiler/nadd.pas +++ b/compiler/nadd.pas @@ -1326,7 +1326,9 @@ implementation (right.nodetype in [ltn,lten,gtn,gten]) and (not might_have_sideeffects(left)) and (not might_have_sideeffects(right)) and - is_range_test(taddnode(left),taddnode(right),vl,cl,cr) then + is_range_test(taddnode(left),taddnode(right),vl,cl,cr) and + { avoid optimization being applied to ( charconst1) and (= 'A') and (a <= 'F'); + +begin +end. From 154ada9e86cd4b6b42857d97437caedbd4d0104e Mon Sep 17 00:00:00 2001 From: yury Date: Sun, 16 Aug 2020 10:34:23 +0000 Subject: [PATCH 14/25] * 8086: enable cs_force_far_calls when m_nested_procvars is enabled. * 8086: when the compiler mode switches to a non-TP mode, enable cs_force_far_calls. git-svn-id: trunk@46454 - --- compiler/scanner.pas | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/compiler/scanner.pas b/compiler/scanner.pas index ba953b53e6..42dbe0495d 100644 --- a/compiler/scanner.pas +++ b/compiler/scanner.pas @@ -460,6 +460,16 @@ implementation end; end; end; + +{$ifdef i8086} + { enable cs_force_far_calls when m_nested_procvars is enabled } + if switch=m_nested_procvars then + begin + include(current_settings.localswitches,cs_force_far_calls); + if changeinit then + include(init_settings.localswitches,cs_force_far_calls); + end; +{$endif i8086} end; @@ -605,12 +615,18 @@ implementation end; {$ifdef i8086} - { Do not force far calls in the TP mode by default } + { Do not force far calls in the TP mode by default, force it in other modes } if (m_tp7 in current_settings.modeswitches) then begin exclude(current_settings.localswitches,cs_force_far_calls); if changeinit then exclude(init_settings.localswitches,cs_force_far_calls); + end + else + begin + include(current_settings.localswitches,cs_force_far_calls); + if changeinit then + include(init_settings.localswitches,cs_force_far_calls); end; {$endif i8086} From 721e89fafde6662c200a5efc3d67bc5480e4386e Mon Sep 17 00:00:00 2001 From: yury Date: Sun, 16 Aug 2020 10:45:45 +0000 Subject: [PATCH 15/25] * msdos: Force names of external routines to be all uppercase only in TP mode. git-svn-id: trunk@46455 - --- compiler/pdecsub.pas | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index df39eaeb1b..b276e04d83 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -3178,9 +3178,14 @@ const result:=target_info.Cprefix+tprocdef(pd).procsym.realname else result:=pd.procsym.realname; +{$ifdef i8086} + { Turbo Pascal expects names of external routines + to be all uppercase } if (target_info.system=system_i8086_msdos) and + (m_tp7 in current_settings.modeswitches) and (pd.proccalloption=pocall_pascal) then result:=UpCase(result); +{$endif i8086} end; end; end; From 2ab7cceeaae9b79a984bf6b8041f70c207511753 Mon Sep 17 00:00:00 2001 From: yury Date: Sun, 16 Aug 2020 10:48:10 +0000 Subject: [PATCH 16/25] * Added the $F+ switch (forced far calls) for some TP mode tests. git-svn-id: trunk@46456 - --- tests/tbs/tb0184.pp | 1 + tests/tbs/tb0218.pp | 1 + tests/tbs/tb0251.pp | 1 + tests/tbs/tb0433.pp | 1 + tests/test/cg/taddr2.pp | 1 + tests/test/tprocvar2.pp | 2 +- tests/webtbs/tw2059.pp | 1 + tests/webtbs/tw2268.pp | 1 + 8 files changed, 8 insertions(+), 1 deletion(-) diff --git a/tests/tbs/tb0184.pp b/tests/tbs/tb0184.pp index 1bdee473be..7ffa199abb 100644 --- a/tests/tbs/tb0184.pp +++ b/tests/tbs/tb0184.pp @@ -2,6 +2,7 @@ { in tp mode can't use the procvar in writeln OK 0.99.11 (PFV) } {$ifdef fpc}{$mode tp}{$endif} +{$F+} type tmpproc=function:longint; diff --git a/tests/tbs/tb0218.pp b/tests/tbs/tb0218.pp index 4ef475c9fa..1ab6b87eac 100644 --- a/tests/tbs/tb0218.pp +++ b/tests/tbs/tb0218.pp @@ -2,6 +2,7 @@ { problem with procvars in tp mode OK 0.99.11 (PM) } {$mode tp} +{$F+} type proc = procedure(a : longint); procedure test(b : longint); diff --git a/tests/tbs/tb0251.pp b/tests/tbs/tb0251.pp index 1d4ffb782c..d13f0f5391 100644 --- a/tests/tbs/tb0251.pp +++ b/tests/tbs/tb0251.pp @@ -2,6 +2,7 @@ { @procvar in tp mode bugss OK 0.99.13 (PFV) } {$ifdef fpc}{$mode tp}{$endif} +{$F+} function ReturnString: string; begin diff --git a/tests/tbs/tb0433.pp b/tests/tbs/tb0433.pp index 32a939837d..9f1be83c86 100644 --- a/tests/tbs/tb0433.pp +++ b/tests/tbs/tb0433.pp @@ -4,6 +4,7 @@ type codepointer = pointer; {$endif fpc} +{$F+} function times2(x : longint) : longint; diff --git a/tests/test/cg/taddr2.pp b/tests/test/cg/taddr2.pp index eedf7e72cc..da6cc2d4a8 100644 --- a/tests/test/cg/taddr2.pp +++ b/tests/test/cg/taddr2.pp @@ -16,6 +16,7 @@ program taddr; {$ifdef fpc} {$mode tp} {$endif} +{$F+} procedure testprocvar; begin diff --git a/tests/test/tprocvar2.pp b/tests/test/tprocvar2.pp index 4962a3d636..a63318887d 100644 --- a/tests/test/tprocvar2.pp +++ b/tests/test/tprocvar2.pp @@ -1,7 +1,7 @@ -{$F+} {$ifdef fpc} {$mode tp} {$endif fpc} +{$F+} type tproc = procedure; diff --git a/tests/webtbs/tw2059.pp b/tests/webtbs/tw2059.pp index 727ea29288..045b416f20 100644 --- a/tests/webtbs/tw2059.pp +++ b/tests/webtbs/tw2059.pp @@ -1,4 +1,5 @@ {$mode tp} +{$F+} type ProcType = procedure(s:string); GetProcType = function(s:string;var Proc:ProcType):boolean; diff --git a/tests/webtbs/tw2268.pp b/tests/webtbs/tw2268.pp index f512c5f1ea..4b82c295e9 100644 --- a/tests/webtbs/tw2268.pp +++ b/tests/webtbs/tw2268.pp @@ -2,6 +2,7 @@ { Submitted by "marco" on 2002-12-19 } { e-mail: marco@freepascal.org } {$ifdef fpc}{$mode TP}{$endif} +{$F+} function P1:longint; begin end; function P2:longint; begin end; From f26735fc778f7f1a9ce234c93f1fad5002fa04f2 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Sun, 16 Aug 2020 12:29:31 +0000 Subject: [PATCH 17/25] * execute the tempinitcode whent the tempcreate node gets processed rather than when the first temprefnode to it gets processed. Solves the issue the foreachnodestatic processes the tempinitcode when seeing the tempcreatenode and ignores it when seeing temprefnodes, even though it may actually be executed/generated for the temprefnode. It's impossible to easily process it for the "correct" temprefnode (since there may be multiple temprefnodes for the same tempcreatenode) o fixes tarray12 for Darwin/i386 and Linux/i386 git-svn-id: trunk@46457 - --- compiler/nbas.pas | 13 ++----------- compiler/ncgbas.pas | 22 +++++++++------------- compiler/nutils.pas | 7 +------ 3 files changed, 12 insertions(+), 30 deletions(-) diff --git a/compiler/nbas.pas b/compiler/nbas.pas index 85a70494c8..f599d04eb8 100644 --- a/compiler/nbas.pas +++ b/compiler/nbas.pas @@ -140,25 +140,16 @@ interface even if the creator didn't mind) } ti_addr_taken, - { temps can get an extra node tree that contains the value to which - they should be initialised when they are created. this initialisation - has to be performed right before the first reference to the temp. - this flag indicates that the ttempcreatenode has been - processed by pass_generate_code, but that the first ttemprefnode - hasn't yet and hence will have to perform the initialisation - } - ti_executeinitialisation, { in case an expression like "inc(x[func()],1)" is translated into a regular addition, you have to create a temp to hold the address representing x[func()], since otherwise func() will be called twice and that can spell trouble in case it has side effects. on platforms - without pointers, we cannot just take the address though. this flag - has to be combined with ti_executeinitialisation above and will, + without pointers, we cannot just take the address though. This flag will, rather than loading the value at the calculated location and store it in the temp, keep a copy of the calculated location if possible and required (not possible for regvars, because SSA may change their register, but not required for them either since calculating their - location has no side-effects + location has no side-effects) } ti_reference, { this temp only allows reading (makes it possible to safely use as diff --git a/compiler/ncgbas.pas b/compiler/ncgbas.pas index ccb4b59df0..b86c7917f8 100644 --- a/compiler/ncgbas.pas +++ b/compiler/ncgbas.pas @@ -510,20 +510,7 @@ interface end; includetempflag(ti_valid); if assigned(tempinfo^.tempinitcode) then - includetempflag(ti_executeinitialisation); - end; - - -{***************************************************************************** - TTEMPREFNODE -*****************************************************************************} - - procedure tcgtemprefnode.pass_generate_code; - begin - if ti_executeinitialisation in tempflags then begin - { avoid recursion } - excludetempflag(ti_executeinitialisation); secondpass(tempinfo^.tempinitcode); if (ti_reference in tempflags) then begin @@ -549,6 +536,15 @@ interface hlcg.g_reference_loc(current_asmdata.CurrAsmList,tempinfo^.typedef,tempinfo^.tempinitcode.location,tempinfo^.location); end; end; + end; + + +{***************************************************************************** + TTEMPREFNODE +*****************************************************************************} + + procedure tcgtemprefnode.pass_generate_code; + begin { check if the temp is valid } if not(ti_valid in tempflags) then internalerror(200108231); diff --git a/compiler/nutils.pas b/compiler/nutils.pas index d05fac310a..0e504b71d5 100644 --- a/compiler/nutils.pas +++ b/compiler/nutils.pas @@ -1442,12 +1442,7 @@ implementation (vo_volatile in tabstractvarsym(tloadnode(n).symtableentry).varoptions) ) ) - ) or - { foreachonode does not recurse into the init code for temprefnode as this is done for - by the tempcreatenode but the considered tree might not contain the tempcreatenode so play - save and recurce into the init code if there is any } - ((n.nodetype=temprefn) and (ti_executeinitialisation in ttemprefnode(n).tempflags) and - might_have_sideeffects(ttemprefnode(n).tempinfo^.tempinitcode,pmhs_flags(arg)^)) then + ) then result:=fen_norecurse_true end; From 8d3ef67218bc4c3583177afd75b1f3efb119e703 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Sun, 16 Aug 2020 12:29:35 +0000 Subject: [PATCH 18/25] - disable {$optimization on} setting so the (fp)make settings are used git-svn-id: trunk@46458 - --- packages/regexpr/src/regexpr.pas | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/packages/regexpr/src/regexpr.pas b/packages/regexpr/src/regexpr.pas index 2e433aadb5..dc66cbeff7 100644 --- a/packages/regexpr/src/regexpr.pas +++ b/packages/regexpr/src/regexpr.pas @@ -56,7 +56,8 @@ interface {$BOOLEVAL OFF} {$EXTENDEDSYNTAX ON} {$LONGSTRINGS ON} -{$OPTIMIZATION ON} +{ use optimization settings passed via fpmake/make } +{OPTIMIZATION ON} // ======== Define options for TRegExpr engine {$DEFINE UseFirstCharSet} // Enable optimization, which finds possible first chars of input string From a88288bab3803476bfa3e54c432f8cc3ed264b0f Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Sun, 16 Aug 2020 12:46:21 +0000 Subject: [PATCH 19/25] - reverted r46457, accidentally committed (breaks -Oooptcse) git-svn-id: trunk@46459 - --- compiler/nbas.pas | 13 +++++++++++-- compiler/ncgbas.pas | 22 +++++++++++++--------- compiler/nutils.pas | 7 ++++++- 3 files changed, 30 insertions(+), 12 deletions(-) diff --git a/compiler/nbas.pas b/compiler/nbas.pas index f599d04eb8..85a70494c8 100644 --- a/compiler/nbas.pas +++ b/compiler/nbas.pas @@ -140,16 +140,25 @@ interface even if the creator didn't mind) } ti_addr_taken, + { temps can get an extra node tree that contains the value to which + they should be initialised when they are created. this initialisation + has to be performed right before the first reference to the temp. + this flag indicates that the ttempcreatenode has been + processed by pass_generate_code, but that the first ttemprefnode + hasn't yet and hence will have to perform the initialisation + } + ti_executeinitialisation, { in case an expression like "inc(x[func()],1)" is translated into a regular addition, you have to create a temp to hold the address representing x[func()], since otherwise func() will be called twice and that can spell trouble in case it has side effects. on platforms - without pointers, we cannot just take the address though. This flag will, + without pointers, we cannot just take the address though. this flag + has to be combined with ti_executeinitialisation above and will, rather than loading the value at the calculated location and store it in the temp, keep a copy of the calculated location if possible and required (not possible for regvars, because SSA may change their register, but not required for them either since calculating their - location has no side-effects) + location has no side-effects } ti_reference, { this temp only allows reading (makes it possible to safely use as diff --git a/compiler/ncgbas.pas b/compiler/ncgbas.pas index b86c7917f8..ccb4b59df0 100644 --- a/compiler/ncgbas.pas +++ b/compiler/ncgbas.pas @@ -510,7 +510,20 @@ interface end; includetempflag(ti_valid); if assigned(tempinfo^.tempinitcode) then + includetempflag(ti_executeinitialisation); + end; + + +{***************************************************************************** + TTEMPREFNODE +*****************************************************************************} + + procedure tcgtemprefnode.pass_generate_code; + begin + if ti_executeinitialisation in tempflags then begin + { avoid recursion } + excludetempflag(ti_executeinitialisation); secondpass(tempinfo^.tempinitcode); if (ti_reference in tempflags) then begin @@ -536,15 +549,6 @@ interface hlcg.g_reference_loc(current_asmdata.CurrAsmList,tempinfo^.typedef,tempinfo^.tempinitcode.location,tempinfo^.location); end; end; - end; - - -{***************************************************************************** - TTEMPREFNODE -*****************************************************************************} - - procedure tcgtemprefnode.pass_generate_code; - begin { check if the temp is valid } if not(ti_valid in tempflags) then internalerror(200108231); diff --git a/compiler/nutils.pas b/compiler/nutils.pas index 0e504b71d5..d05fac310a 100644 --- a/compiler/nutils.pas +++ b/compiler/nutils.pas @@ -1442,7 +1442,12 @@ implementation (vo_volatile in tabstractvarsym(tloadnode(n).symtableentry).varoptions) ) ) - ) then + ) or + { foreachonode does not recurse into the init code for temprefnode as this is done for + by the tempcreatenode but the considered tree might not contain the tempcreatenode so play + save and recurce into the init code if there is any } + ((n.nodetype=temprefn) and (ti_executeinitialisation in ttemprefnode(n).tempflags) and + might_have_sideeffects(ttemprefnode(n).tempinfo^.tempinitcode,pmhs_flags(arg)^)) then result:=fen_norecurse_true end; From b4139720e60b86e64780e535c74176676ee2b67f Mon Sep 17 00:00:00 2001 From: yury Date: Sun, 16 Aug 2020 13:27:56 +0000 Subject: [PATCH 20/25] * RTTI: Offset of record fields is defined as SizeInt not ptruint. git-svn-id: trunk@46460 - --- compiler/ncgrtti.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/ncgrtti.pas b/compiler/ncgrtti.pas index b8683e9704..aad03c9e9e 100644 --- a/compiler/ncgrtti.pas +++ b/compiler/ncgrtti.pas @@ -623,7 +623,7 @@ implementation begin sym:=tsym(fields[i]); write_rtti_reference(tcb,tfieldvarsym(sym).vardef,rt); - tcb.emit_ord_const(tfieldvarsym(sym).fieldoffset,ptruinttype); + tcb.emit_ord_const(tfieldvarsym(sym).fieldoffset,sizeuinttype); end; fields.free; end; From f72f021da42839f838f8161a5d186becd1f21368 Mon Sep 17 00:00:00 2001 From: florian Date: Sun, 16 Aug 2020 16:26:39 +0000 Subject: [PATCH 21/25] + AAarch64: FMovFMov2FMov optimization git-svn-id: trunk@46461 - --- compiler/aarch64/aoptcpu.pas | 40 +++++++++++++++++++++++++++++++++++- 1 file changed, 39 insertions(+), 1 deletion(-) diff --git a/compiler/aarch64/aoptcpu.pas b/compiler/aarch64/aoptcpu.pas index a3cb01f2f5..25f9dbbcea 100644 --- a/compiler/aarch64/aoptcpu.pas +++ b/compiler/aarch64/aoptcpu.pas @@ -50,6 +50,7 @@ Interface function RemoveSuperfluousFMov(const p: tai; movp: tai; const optimizer: string): boolean; function OptPass1STP(var p: tai): boolean; function OptPass1Mov(var p: tai): boolean; + function OptPass1FMov(var p: tai): Boolean; End; Implementation @@ -60,6 +61,16 @@ Implementation cgutils, verbose; +{$ifdef DEBUG_AOPTCPU} + const + SPeepholeOptimization: shortstring = 'Peephole Optimization: '; +{$else DEBUG_AOPTCPU} + { Empty strings help the optimizer to remove string concatenations that won't + ever appear to the user on release builds. [Kit] } + const + SPeepholeOptimization = ''; +{$endif DEBUG_AOPTCPU} + function CanBeCond(p : tai) : boolean; begin result:=(p.typ=ait_instruction) and (taicpu(p).condition=C_None); @@ -490,6 +501,31 @@ Implementation end; + function TCpuAsmOptimizer.OptPass1FMov(var p: tai): Boolean; + var + hp1: tai; + begin + { + change + fmov reg0,reg1 + fmov reg1,reg0 + into + fmov reg0,reg1 + } + Result := False; + while GetNextInstruction(p, hp1) and + MatchInstruction(hp1, A_FMOV, [taicpu(p).condition], [taicpu(p).oppostfix]) and + MatchOperand(taicpu(p).oper[0]^, taicpu(hp1).oper[1]^) and + MatchOperand(taicpu(p).oper[1]^, taicpu(hp1).oper[0]^) do + begin + asml.Remove(hp1); + hp1.free; + DebugMsg(SPeepholeOptimization + 'FMovFMov2FMov done', p); + Result:=true; + end; + end; + + function TCpuAsmOptimizer.OptPostCMP(var p : tai): boolean; var hp1,hp2: tai; @@ -580,7 +616,9 @@ Implementation if GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and RemoveSuperfluousFMov(p, hp1, 'FOpFMov2FOp') then Result:=true; - end + end; + A_FMOV: + Result:=OptPass1FMov(p); else ; end; From 324deca817a97a8513ffe60bda659485b739a734 Mon Sep 17 00:00:00 2001 From: yury Date: Sun, 16 Aug 2020 17:08:00 +0000 Subject: [PATCH 22/25] * wlib: Explicitly specify the smallest possible record align to reduce the size of .a files. git-svn-id: trunk@46462 - --- compiler/link.pas | 6 +++--- compiler/systems.pas | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/compiler/link.pas b/compiler/link.pas index f7d52d7e7d..6a1278e645 100644 --- a/compiler/link.pas +++ b/compiler/link.pas @@ -882,7 +882,7 @@ Implementation if (target_ar.id in [ar_gnu_ar_scripted,ar_sdcc_sdar_scripted]) then writeln(script, 'CREATE ' + current_module.staticlibfilename) else { wlib case } - writeln(script,'-q -fo -c -b '+ + writeln(script,'-q -p=16 -fo -c -b '+ maybequoted(current_module.staticlibfilename)); current := TCmdStrListItem(SmartLinkOFiles.First); while current <> nil do @@ -1743,8 +1743,8 @@ Implementation ar_watcom_wlib_omf_info : tarinfo = ( id : ar_watcom_wlib_omf; addfilecmd : '+'; - arfirstcmd : 'wlib -q -fo -c -b -n -o=$OUTPUTLIB $LIB $FILES'; - arcmd : 'wlib -q -fo -c -b -o=$OUTPUTLIB $LIB $FILES'; + arfirstcmd : 'wlib -q -p=16 -fo -c -b -n -o=$OUTPUTLIB $LIB $FILES'; + arcmd : 'wlib -q -p=16 -fo -c -b -o=$OUTPUTLIB $LIB $FILES'; arfinishcmd : '' ); diff --git a/compiler/systems.pas b/compiler/systems.pas index d068ee7506..b7795df192 100644 --- a/compiler/systems.pas +++ b/compiler/systems.pas @@ -100,8 +100,8 @@ interface tarinfo = record id : tar; addfilecmd : string[10]; - arfirstcmd : string[50]; - arcmd : string[50]; + arfirstcmd : string[60]; + arcmd : string[60]; arfinishcmd : string[11]; end; From 66e682dfdd0d61ff6ed172e40df4fbaa8d10e0d8 Mon Sep 17 00:00:00 2001 From: florian Date: Sun, 16 Aug 2020 21:05:15 +0000 Subject: [PATCH 23/25] * Xtensa: patch by Christo Crause: add support for windowed ABI stack dump, resolves #37583 git-svn-id: trunk@46463 - --- rtl/freertos/consoleio.pp | 2 +- rtl/freertos/system.pp | 2 + rtl/xtensa/xtensa.inc | 115 +++++++++++++++++++++++++++++++++++--- 3 files changed, 109 insertions(+), 10 deletions(-) diff --git a/rtl/freertos/consoleio.pp b/rtl/freertos/consoleio.pp index 24f17e101a..27a34d616d 100644 --- a/rtl/freertos/consoleio.pp +++ b/rtl/freertos/consoleio.pp @@ -169,7 +169,7 @@ finalization Writeln(pstdout^,'Runtime error ',Errorcode,' at $',hexstr(erroraddr)); { to get a nice symify } Writeln(pstdout^,BackTraceStrFunc(Erroraddr)); - dump_stack(pstdout^,ErrorBase); + dump_stack(pstdout^,ErrorBase,erroraddr); Writeln(pstdout^,''); End; SysFlushStdIO; diff --git a/rtl/freertos/system.pp b/rtl/freertos/system.pp index 069f2ccf22..07681b7418 100644 --- a/rtl/freertos/system.pp +++ b/rtl/freertos/system.pp @@ -208,6 +208,7 @@ const calculated_cmdline:Pchar=nil; {***************************************************************************** Misc. System Dependent Functions *****************************************************************************} +{$ifndef FPC_SYSTEM_HAS_STACKTOP} var _stack_top: record end; external name '_stack_top'; @@ -215,6 +216,7 @@ function StackTop: pointer; begin StackTop:=@_stack_top; end; +{$endif FPC_SYSTEM_HAS_STACKTOP} procedure haltproc;cdecl;external name '_haltproc'; diff --git a/rtl/xtensa/xtensa.inc b/rtl/xtensa/xtensa.inc index 2353e90530..f9dfce89e4 100644 --- a/rtl/xtensa/xtensa.inc +++ b/rtl/xtensa/xtensa.inc @@ -31,27 +31,114 @@ begin SysInitFPU; end; +{$ifdef fpc_abi_windowed} +const + // Minimum call8 calls to force register spilling to stack for caller of forceSpilledRegs + spillcount = 6; + +procedure forceSpilledRegs(n: uint32); assembler; public name 'forcespilledregs'; + label + done, fin; + asm + beqz a2, done + addi a10, a2, -1 + call8 forcespilledregs + done: + bnez a2, fin + movi a15, 0 + fin: + end; + +procedure fixCodeAddress(var addr: pointer); + begin + // Check if valid code address + if ptruint(addr) and $C0000000 >= $40000000 then + begin + // Replace windowed call prefix + addr:=codepointer((ptruint(addr)and$00FFFFFF) or $40000000); + // Rewind to call instruction address + dec(addr,3); + end + else + addr:=nil; + end; +{$endif fpc_abi_windowed} {$IFNDEF INTERNAL_BACKTRACE} -{$define FPC_SYSTEM_HAS_GET_FRAME} -function get_frame:pointer;assembler;nostackframe; - asm - end; + {$define FPC_SYSTEM_HAS_GET_FRAME} + function get_frame:pointer;assembler; + label + done; + asm + {$ifdef fpc_abi_windowed} + // Force registers to spill onto stack + movi a10, spillcount + call8 forcespilledregs + // now get frame pointer of caller + addi a2, a1, -12 + l32i a2, a2, 0 + done: + {$else} + mov a2, a1 + {$endif} + end; {$ENDIF not INTERNAL_BACKTRACE} {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR} -function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;assembler;nostackframe; - asm +function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer; + begin + {$ifdef fpc_abi_windowed} + forceSpilledRegs(spillcount); + if (ptruint(framebp)>$3ff00000)and(ptruint(framebp)<$40000000) then + begin + get_caller_addr:=pointer((framebp-16)^); + fixCodeAddress(get_caller_addr); + end + else + get_caller_addr:=nil; + {$else} + get_caller_addr:=nil; + {$endif} end; - {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME} -function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;assembler;nostackframe; - asm +function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer; + begin + {$ifdef fpc_abi_windowed} + if (ptruint(framebp)>$3ff00000)and(ptruint(framebp)<$40000000) then + begin + forceSpilledRegs(spillcount); + get_caller_frame:=pointer((framebp-12)^); + end + else + get_caller_frame:=nil; + {$else} + get_caller_frame:=nil; + {$endif} end; +{$ifdef fpc_abi_windowed} + {$define FPC_SYSTEM_HAS_GET_CALLER_STACKINFO} + procedure get_caller_stackinfo(var framebp : pointer; var addr : codepointer); + begin + if (ptruint(framebp)>$3ff00000)and(ptruint(framebp)<$40000000) then + begin + forceSpilledRegs(spillcount); + addr:=codepointer((framebp-16)^); + framebp := pointer((framebp-12)^); + fixCodeAddress(addr); + end + else + begin + addr:=nil; + framebp:=nil; + end; + end; +{$endif fpc_abi_windowed} + + {$define FPC_SYSTEM_HAS_SPTR} Function Sptr : pointer;assembler; asm @@ -59,6 +146,16 @@ Function Sptr : pointer;assembler; end; +{$define FPC_SYSTEM_HAS_STACKTOP} +// Interim fix for now, set to large address +// TODO: provide more realistic value, possibly by inspecting stack pointer +// when main or task is started +function StackTop: pointer; + begin + StackTop:=pointer($3fffffff); + end; + + function InterLockedDecrement (var Target: longint) : longint; var temp_sreg : byte; From f9ddc3ac66d587eb8547bc09d33e855db16b033e Mon Sep 17 00:00:00 2001 From: florian Date: Sun, 16 Aug 2020 21:41:56 +0000 Subject: [PATCH 24/25] + Xtensa: L32IMov2L32I optimization git-svn-id: trunk@46464 - --- compiler/xtensa/aoptcpu.pas | 63 +++++++++++++++++++++++++++---------- 1 file changed, 47 insertions(+), 16 deletions(-) diff --git a/compiler/xtensa/aoptcpu.pas b/compiler/xtensa/aoptcpu.pas index ea0ee10cd1..d10946be14 100644 --- a/compiler/xtensa/aoptcpu.pas +++ b/compiler/xtensa/aoptcpu.pas @@ -43,6 +43,8 @@ Interface function InstructionLoadsFromReg(const reg: TRegister; const hp: tai): boolean;override; function GetNextInstructionUsingReg(Current : tai; out Next : tai; reg : TRegister) : Boolean; procedure DebugMsg(const s : string; p : tai); + + function PeepHoleOptPass1Cpu(var p: tai): boolean; override; private function RemoveSuperfluousMove(const p: tai; movp: tai; const optimizer: string): boolean; End; @@ -145,6 +147,23 @@ Implementation Result := false; if not ((assigned(hp)) and (hp.typ = ait_instruction)) then exit; + + if Result then + exit; + + case p.opcode of + A_B, + A_S16I,A_S32C1I,A_S32E,A_S32I,A_S32RI,A_S8I: + exit; + else + ; + end; + case p.oper[0]^.typ of + top_reg: + Result := (p.oper[0]^.reg = reg) ; + else + ; + end; end; @@ -192,7 +211,6 @@ Implementation begin Result:=false; if MatchInstruction(movp, A_MOV, [PF_None,PF_N]) and - (taicpu(p).ops>=3) and { We can't optimize if there is a shiftop } (taicpu(movp).ops=2) and MatchOperand(taicpu(movp).oper[1]^, taicpu(p).oper[0]^.reg) and @@ -200,10 +218,10 @@ Implementation not(RegUsedBetween(taicpu(movp).oper[0]^.reg,p,movp)) and { Take care to only do this for instructions which REALLY load to the first register. Otherwise - str reg0, [reg1] + s* reg0, [reg1] mov reg2, reg0 will be optimized to - str reg2, [reg1] + s* reg2, [reg1] } RegLoadedWithNewValue(taicpu(p).oper[0]^.reg, p) then begin @@ -239,25 +257,38 @@ Implementation { finally get rid of the mov } taicpu(p).loadreg(0,taicpu(movp).oper[0]^.reg); - { Remove preindexing and postindexing for LDR in some cases. - For example: - ldr reg2,[reg1, xxx]! - mov reg1,reg2 - must be translated to: - ldr reg1,[reg1, xxx] - - Preindexing must be removed there, since the same register is used as the base and as the target. - Such case is not allowed for ARM CPU and produces crash. } - //if (taicpu(p).opcode = A_LDR) and (taicpu(p).oper[1]^.typ = top_ref) - // and (taicpu(movp).oper[0]^.reg = taicpu(p).oper[1]^.ref^.base) - //then - // taicpu(p).oper[1]^.ref^.addressmode:=AM_OFFSET; asml.remove(movp); movp.free; end; end; end; + + function TCpuAsmOptimizer.PeepHoleOptPass1Cpu(var p: tai): boolean; + var + hp1: tai; + begin + result := false; + case p.typ of + ait_instruction: + begin + case taicpu(p).opcode of + A_L32I: + begin + if GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and + RemoveSuperfluousMove(p, hp1, 'L32IMov2L32I') then + Result:=true; + end; + else + ; + end; + end + else + ; + end + end; + + begin casmoptimizer:=TCpuAsmOptimizer; End. From 86360152650fffd6720af949cd52579a735badd2 Mon Sep 17 00:00:00 2001 From: florian Date: Sun, 16 Aug 2020 21:48:30 +0000 Subject: [PATCH 25/25] + Xtensa: consider also floating point stores in TCpuAsmOptimizer.RegLoadedWithNewValue git-svn-id: trunk@46465 - --- compiler/xtensa/aoptcpu.pas | 1 + 1 file changed, 1 insertion(+) diff --git a/compiler/xtensa/aoptcpu.pas b/compiler/xtensa/aoptcpu.pas index d10946be14..c3c593cc0a 100644 --- a/compiler/xtensa/aoptcpu.pas +++ b/compiler/xtensa/aoptcpu.pas @@ -153,6 +153,7 @@ Implementation case p.opcode of A_B, + A_SSI,A_SSIU,A_SSX,A_SSXU, A_S16I,A_S32C1I,A_S32E,A_S32I,A_S32RI,A_S8I: exit; else