From 25b7e1352bdbb978cf120748e483fde73a0acada Mon Sep 17 00:00:00 2001 From: michael Date: Wed, 1 Apr 2020 07:00:34 +0000 Subject: [PATCH 01/11] * Patch from Bart Broersma to fix bug ID #35022 git-svn-id: trunk@44477 - --- packages/fcl-registry/src/regini.inc | 22 +++++++++++----------- packages/fcl-registry/src/registry.pp | 14 ++++++++++++++ packages/fcl-registry/src/winreg.inc | 10 +++++++--- packages/fcl-registry/src/xmlreg.pp | 1 + packages/fcl-registry/src/xregreg.inc | 15 ++++++++++++++- 5 files changed, 47 insertions(+), 15 deletions(-) diff --git a/packages/fcl-registry/src/regini.inc b/packages/fcl-registry/src/regini.inc index e81d35f710..bef365e4c5 100644 --- a/packages/fcl-registry/src/regini.inc +++ b/packages/fcl-registry/src/regini.inc @@ -300,18 +300,18 @@ begin S:=Section; If (S<>'') and (S[1] = '\') then Delete(S,1,1); - if CreateSection then - CreateKey('\'+FPath+S); - if Section <> '' then + if CreateSection and (S<>'') then + CreateKey('\'+CurrentPath+'\'+S); + if S <> '' then + k:=GetKey('\'+CurrentPath+'\'+S) + else + k:=GetKey('\'+CurrentPath); + if k = 0 then begin - k:=GetKey('\'+FPath+S); - if k = 0 then - begin - Result:=False; - exit; - end; - SetCurrentKey(k); - end; + Result:=False; + exit; + end; + SetCurrentKey(k); Result:=True; end; diff --git a/packages/fcl-registry/src/registry.pp b/packages/fcl-registry/src/registry.pp index 9e3347176d..9b3a07ec13 100644 --- a/packages/fcl-registry/src/registry.pp +++ b/packages/fcl-registry/src/registry.pp @@ -57,6 +57,7 @@ type fRootKey: HKEY; fLazyWrite: Boolean; fCurrentPath: UnicodeString; + function FixPath(APath: UnicodeString): UnicodeString; function GetLastErrorMsg: string; function RegMultiSzDataToUnicodeStringArray(U: UnicodeString): TUnicodeStringArray; function ListToArray(List: TStrings; IsUtf8: Boolean): TUnicodeStringArray; @@ -632,6 +633,19 @@ begin ReadStringList(UnicodeString(Name), AList); end; +function TRegistry.FixPath(APath: UnicodeString): UnicodeString; +const + Delim={$ifdef XMLREG}'/'{$else}'\'{$endif}; +begin + //At this point we know the path is valid, since this is only called after OpenKey succeeded + //Just sanitize it + while (Pos(Delim+Delim,APath) > 0) do + APath := UnicodeStringReplace(APath, Delim+Delim,Delim,[rfReplaceAll]); + if (Length(APath) > 1) and (APath[Length(APath)] = Delim) then + System.Delete(APath, Length(APath), 1); + Result := APath; +end; + function TRegistry.RegMultiSzDataToUnicodeStringArray(U: UnicodeString): TUnicodeStringArray; var Len, i, p: Integer; diff --git a/packages/fcl-registry/src/winreg.inc b/packages/fcl-registry/src/winreg.inc index 20af80e7cc..28fd4f88ba 100644 --- a/packages/fcl-registry/src/winreg.inc +++ b/packages/fcl-registry/src/winreg.inc @@ -227,8 +227,12 @@ begin end; If Result then begin if RelativeKey(Key) then - S:=CurrentPath + Key - else + begin + if (Key>'') and (CurrentPath>'') and (CurrentPath[Length(CurrentPath)]<>'\') then + S:=CurrentPath + '\' + Key + else + S:=CurrentPath + Key; + end else S:=u; ChangeKey(Handle, S); end; @@ -325,7 +329,7 @@ procedure TRegistry.ChangeKey(Value: HKey; const Path: UnicodeString); begin CloseKey; FCurrentKey:=Value; - FCurrentPath:=Path; + FCurrentPath:=FixPath(Path); end; diff --git a/packages/fcl-registry/src/xmlreg.pp b/packages/fcl-registry/src/xmlreg.pp index 34fff7aa45..7b661e5922 100644 --- a/packages/fcl-registry/src/xmlreg.pp +++ b/packages/fcl-registry/src/xmlreg.pp @@ -81,6 +81,7 @@ Type // These interpret the Data buffer as unicode data Function GetValueDataUnicode(Name : UnicodeString; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean; Function SetValueDataUnicode(Name : UnicodeString; DataType : TDataType; Const Data; DataSize : Integer) : Boolean; + Property CurrentKey: UnicodeString read FCurrentKey; //used by TRegistry Property FileName : String Read FFileName Write SetFileName; Property RootKey : UnicodeString Read FRootKey Write SetRootkey; Property AutoFlush : Boolean Read FAutoFlush Write FAutoFlush; diff --git a/packages/fcl-registry/src/xregreg.inc b/packages/fcl-registry/src/xregreg.inc index fbd020bdde..e9a1989216 100644 --- a/packages/fcl-registry/src/xregreg.inc +++ b/packages/fcl-registry/src/xregreg.inc @@ -223,9 +223,22 @@ end; function TRegistry.OpenKey(const Key: UnicodeString; CanCreate: Boolean): Boolean; +var + S: UnicodeString; + P: SizeInt; begin Result:=TXmlRegistry(FSysData).SetKey(Key,CanCreate); FCurrentKey:=1; + If Result then begin + S:=TXmlRegistry(FSysData).CurrentKey; + if (S>'') then begin + //S starts with RootKey+'/' + P:=Pos('/',S); + if (P>0) then + System.Delete(S,1,P); + end; + ChangeKey(FCurrentKey, S); + end; end; function TRegistry.OpenKeyReadOnly(const Key: UnicodeString): Boolean; @@ -266,7 +279,7 @@ end; procedure TRegistry.ChangeKey(Value: HKey; const Path: UnicodeString); begin - + FCurrentPath:=FixPath(Path); end; function TRegistry.GetKeyNames: TUnicodeStringArray; From a24a4b97452db7179c91a5aedff174b876168d83 Mon Sep 17 00:00:00 2001 From: michael Date: Wed, 1 Apr 2020 07:06:01 +0000 Subject: [PATCH 02/11] * Patch from Bart Broersma to fix bug ID #36809 - test program git-svn-id: trunk@44478 - --- .gitattributes | 1 + tests/webtbs/tw0035022.pp | 187 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 188 insertions(+) create mode 100644 tests/webtbs/tw0035022.pp diff --git a/.gitattributes b/.gitattributes index 8f3302b02a..5445ac887c 100644 --- a/.gitattributes +++ b/.gitattributes @@ -16464,6 +16464,7 @@ tests/webtbf/uw8738b.pas svneol=native#text/plain tests/webtbs/Integer.ns.pp svneol=native#text/pascal tests/webtbs/Integer.pp svneol=native#text/pascal tests/webtbs/tu2002.pp svneol=native#text/plain +tests/webtbs/tw0035022.pp svneol=native#text/plain tests/webtbs/tw0555.pp svneol=native#text/plain tests/webtbs/tw0630.pp svneol=native#text/plain tests/webtbs/tw0701a.pp svneol=native#text/plain diff --git a/tests/webtbs/tw0035022.pp b/tests/webtbs/tw0035022.pp new file mode 100644 index 0000000000..e1a6d3ba90 --- /dev/null +++ b/tests/webtbs/tw0035022.pp @@ -0,0 +1,187 @@ +{ %TARGET=win32,win64,wince } + +program tw0035022; + +{$apptype console} +{$mode objfpc}{$h+} +{$ASSERTIONS ON} + +uses + registry, sysutils, classes; + +const + ROOT = 'Software'; + subFPCREGINITEST = 'FreePascalRegIniTest'; + subRegIni = 'RegIni'; + subStrings = 'FPCTESTString'; + fqFREEPASCALREGINITEST = Root + '\'+ subFPCREGINITEST; + fqFPCTESTRegIni = fqFREEPASCALREGINITEST + '\' + subRegIni; + fqFPCTESTStrings = fqFPCTESTRegIni+'\' + subStrings; + fqWrongFPCTESTStrings = Root + '\' + subStrings; + idString1 = 'String1'; + valValue1 = 'Value1'; + +procedure CheckCreate; +var + Reg: TRegistry; + S, SKey: String; + B: Boolean; +begin + write('CheckCreate: '); + Reg := TRegistry.Create(KEY_READ); + try + Reg.RootKey := HKEY_CURRENT_USER; + SKey := fqFPCTESTRegIni; + B := Reg.OpenKeyReadOnly(SKey); + Assert(B,format('Error: RegOpenKeyReadOnly(''%s'') failed.',[SKey])); + + SKey := subStrings; + B := Reg.OpenKeyReadOnly(Skey); + Assert(B,format('Error: RegOpenKeyReadOnly(''%s'') failed.',[fqFPCTESTStrings])); + + S := Reg.ReadString(idString1); + Assert(S=valValue1,format('ReadString(''%s''): expected '+'%s, but found: ''%s''',[idString1,valValue1,S])); + + Reg.CloseKey; + + writeln('OK'); + finally + Reg.Free; + end; + +end; + +procedure FindErroneousEntries; +var + Reg: TRegistry; + B: Boolean; +begin + write('FindErroneousEntries: '); + Reg := TRegistry.Create(KEY_READ); + try + B := Reg.OpenKeyReadOnly(fqWrongFPCTESTStrings); + Reg.CloseKey; + Assert(not B, format('RegOpenKeyReadOnly found %s, which at this point is unexpected.',[fqWrongFPCTESTStrings])); + writeln(' no erroneous entries found (OK).'); + finally + Reg.Free; + end; +end; + +procedure CreateTestEntries; +var + RegIni: TRegIniFile; + B: Boolean; + function TryOpenKey(Key: String; CanCreate: Boolean): Boolean; + begin + Result := RegIni.OpenKey(Key, CanCreate); + end; + + function TryWriteString(Section, Ident, Value: String): Boolean; + begin + Result := False; + try + RegIni.WriteString(Section, Ident, Value); + Result := True; + except + on E: Exception do + end; + end; + +begin + write('CreateTestEntries: '); + RegIni := TRegIniFile.Create(Root); + try + Assert(RegIni.CurrentPath=Root,'Expected: CurrenPath='+Root); + B := RegIni.CreateKey(subFPCREGINITEST); + Assert(B,format('Error: CreateKey(''%s'') failed.',[fqFREEPASCALREGINITEST])); + + B := TryOpenKey(subFPCREGINITEST,False); + Assert(B,format('Error: OpenKey(''%s'') failed.',[fqFREEPASCALREGINITEST])); + + Assert(RegIni.CurrentPath=fqFREEPASCALREGINITEST,'Expected: CurrenPath='+fqFREEPASCALREGINITEST); + + B := TryOpenKey(subRegIni,True); + Assert(B,format('Error: OpenKey(''%s'') failed.',[fqFPCTESTRegIni])); + Assert(RegIni.CurrentPath=fqFPCTESTRegIni,'Expected: CurrenPath='+fqFPCTESTRegIni); + + B := TryWriteString(subStrings,idString1,valValue1); + Assert(B,format('Error: WriteString(''%s'',''%s'',''%s'') failed.',[fqFPCTESTStrings,idString1,valValue1])); + + writeln('OK'); + finally + RegIni.Free; + end; + +end; + +procedure DeleteFPCTESTEntries; + procedure DeleteStrings; + var + Reg: TRegistry; + B: Boolean; + begin + Reg := TRegistry.Create(KEY_ALL_ACCESS); + try + Reg.RootKey := HKEY_CURRENT_USER; + if Reg.KeyExists(fqFPCTESTStrings) then + begin + B := Reg.OpenKey(fqFPCTESTStrings, False); + //writeln('OpenKey: ',B); + if B then + begin + B := not Reg.ValueExists(idString1) or Reg.DeleteValue(idString1); + Assert(B, format('Error DeleteValue(''%s'') in %s',[idString1,fqFPCTESTStrings])); + end; + Reg.CloseKey; + end; + + if Reg.KeyExists(fqWrongFPCTESTStrings) then + begin + B := Reg.OpenKey(fqWrongFPCTESTStrings, False); + //writeln('OpenKey: ',B); + if B then + begin + B := not Reg.ValueExists(idString1) or Reg.DeleteValue(idString1); + Assert(B, format('Error DeleteValue(''%s'') in %s',[idString1,fqWrongFPCTESTStrings])); + end; + Reg.CloseKey; + end; + finally + Reg.Free; + end; + end; + + procedure DeleteEmptyKey(Key: String); + var + Reg: TRegistry; + B: Boolean; + begin + Reg := TRegistry.Create(KEY_ALL_ACCESS); + try + Reg.RootKey := HKEY_CURRENT_USER; + if Reg.KeyExists(Key) then + begin + B := Reg.DeleteKey(Key); + Assert(B, format('Error DeleteKey(''%s'')',[Key])); + end; + finally + Reg.Free; + end; + end; + +begin + DeleteStrings; + DeleteEmptyKey(fqFPCTESTStrings); + DeleteEmptyKey(fqWrongFPCTESTStrings); + DeleteEmptyKey(fqFPCTESTRegIni); + DeleteEmptyKey(fqFREEPASCALREGINITEST); +end; + +begin + DeleteFPCTESTEntries; + CreateTestEntries; + CheckCreate; + FindErroneousEntries; + DeleteFPCTESTEntries; +end. From 3030ffb9c1c819a51d933e2475de6902f30eeb0e Mon Sep 17 00:00:00 2001 From: michael Date: Wed, 1 Apr 2020 07:33:46 +0000 Subject: [PATCH 03/11] * Apply patch from Serge Anvarov, change var to const for buffer param (bug ID 35106) git-svn-id: trunk@44479 - --- packages/fcl-registry/src/registry.pp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/packages/fcl-registry/src/registry.pp b/packages/fcl-registry/src/registry.pp index 9b3a07ec13..e47a98cd3f 100644 --- a/packages/fcl-registry/src/registry.pp +++ b/packages/fcl-registry/src/registry.pp @@ -160,8 +160,8 @@ type procedure RenameValue(const OldName, NewName: String); procedure WriteCurrency(const Name: UnicodeString; Value: Currency); procedure WriteCurrency(const Name: String; Value: Currency); - procedure WriteBinaryData(const Name: UnicodeString; var Buffer; BufSize: Integer); - procedure WriteBinaryData(const Name: String; var Buffer; BufSize: Integer); + procedure WriteBinaryData(const Name: UnicodeString; const Buffer; BufSize: Integer); + procedure WriteBinaryData(const Name: String; const Buffer; BufSize: Integer); procedure WriteBool(const Name: UnicodeString; Value: Boolean); procedure WriteBool(const Name: String; Value: Boolean); procedure WriteDate(const Name: UnicodeString; Value: TDateTime); @@ -794,12 +794,12 @@ begin Result:=ValueExists(UnicodeString(Name)); end; -procedure TRegistry.WriteBinaryData(const Name: UnicodeString; var Buffer; BufSize: Integer); +procedure TRegistry.WriteBinaryData(const Name: UnicodeString; const Buffer; BufSize: Integer); begin PutData(Name, @Buffer, BufSize, rdBinary); end; -procedure TRegistry.WriteBinaryData(const Name: String; var Buffer; +procedure TRegistry.WriteBinaryData(const Name: String; const Buffer; BufSize: Integer); begin WriteBinaryData(UnicodeString(Name), Buffer, BufSize); From aaaca28dcd94fbeb0ac03ed89f58f5c4767f6138 Mon Sep 17 00:00:00 2001 From: michael Date: Wed, 1 Apr 2020 07:39:14 +0000 Subject: [PATCH 04/11] * Patch from Serge Anvarov to simplify ReadDate/ReadTime (bug ID 35105) git-svn-id: trunk@44480 - --- packages/fcl-registry/src/registry.pp | 4 +--- packages/fcl-registry/src/winreg.inc | 2 -- 2 files changed, 1 insertion(+), 5 deletions(-) diff --git a/packages/fcl-registry/src/registry.pp b/packages/fcl-registry/src/registry.pp index e47a98cd3f..911aa983af 100644 --- a/packages/fcl-registry/src/registry.pp +++ b/packages/fcl-registry/src/registry.pp @@ -546,9 +546,7 @@ end; function TRegistry.ReadDate(const Name: UnicodeString): TDateTime; begin - Result:=Default(TDateTime); - ReadBinaryData(Name, Result, SizeOf(TDateTime)); - Result:=Trunc(Result); + Result:=Trunc(ReadDateTime(Name)); end; function TRegistry.ReadDate(const Name: String): TDateTime; diff --git a/packages/fcl-registry/src/winreg.inc b/packages/fcl-registry/src/winreg.inc index 28fd4f88ba..f4efdc88d3 100644 --- a/packages/fcl-registry/src/winreg.inc +++ b/packages/fcl-registry/src/winreg.inc @@ -423,8 +423,6 @@ Function TRegistry.SysPutData(const Name: UnicodeString; Buffer: Pointer; Var RegDataType: DWORD; - B : Pchar; - S : String; begin RegDataType:=RegDataWords[RegData]; From b2ddb43fa9709f511caac93c016733b9493059d4 Mon Sep 17 00:00:00 2001 From: michael Date: Wed, 1 Apr 2020 07:41:16 +0000 Subject: [PATCH 05/11] * Patch from Serge Anvarov to simplify ReadDate/ReadTime (bug ID 35105) git-svn-id: trunk@44481 - --- packages/fcl-registry/src/registry.pp | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/packages/fcl-registry/src/registry.pp b/packages/fcl-registry/src/registry.pp index 911aa983af..0379e51145 100644 --- a/packages/fcl-registry/src/registry.pp +++ b/packages/fcl-registry/src/registry.pp @@ -752,9 +752,7 @@ end; function TRegistry.ReadTime(const Name: UnicodeString): TDateTime; begin - Result:=Default(TDateTime); - ReadBinaryData(Name, Result, SizeOf(TDateTime)); - Result:=Frac(Result); + Result:=Frac(ReadDateTime(Name)); end; function TRegistry.ReadTime(const Name: String): TDateTime; From a630f93c7b5378454d59e7801cf57677839ab446 Mon Sep 17 00:00:00 2001 From: michael Date: Wed, 1 Apr 2020 07:44:21 +0000 Subject: [PATCH 06/11] * Apply patch from Serge Anvarov, explicitly mark some routines as not implemented (bug ID 35101) git-svn-id: trunk@44482 - --- packages/fcl-registry/src/registry.pp | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/packages/fcl-registry/src/registry.pp b/packages/fcl-registry/src/registry.pp index 0379e51145..7f11182b05 100644 --- a/packages/fcl-registry/src/registry.pp +++ b/packages/fcl-registry/src/registry.pp @@ -104,8 +104,8 @@ type function HasSubKeys: Boolean; function KeyExists(const Key: UnicodeString): Boolean; function KeyExists(const Key: String): Boolean; - function LoadKey(const Key, FileName: UnicodeString): Boolean; - function LoadKey(const Key, FileName: String): Boolean; + function LoadKey(const Key, FileName: UnicodeString): Boolean; unimplemented; + function LoadKey(const Key, FileName: String): Boolean; unimplemented; function OpenKey(const Key: UnicodeString; CanCreate: Boolean): Boolean; function OpenKey(const Key: String; CanCreate: Boolean): Boolean; function OpenKeyReadOnly(const Key: UnicodeString): Boolean; @@ -136,10 +136,10 @@ type function ReadTime(const Name: String): TDateTime; function RegistryConnect(const UNCName: UnicodeString): Boolean; function RegistryConnect(const UNCName: String): Boolean; - function ReplaceKey(const Key, FileName, BackUpFileName: UnicodeString): Boolean; - function ReplaceKey(const Key, FileName, BackUpFileName: String): Boolean; - function RestoreKey(const Key, FileName: UnicodeString): Boolean; - function RestoreKey(const Key, FileName: String): Boolean; + function ReplaceKey(const Key, FileName, BackUpFileName: UnicodeString): Boolean; unimplemented; + function ReplaceKey(const Key, FileName, BackUpFileName: String): Boolean; unimplemented; + function RestoreKey(const Key, FileName: UnicodeString): Boolean; unimplemented; + function RestoreKey(const Key, FileName: String): Boolean; unimplemented; function SaveKey(const Key, FileName: UnicodeString): Boolean; function SaveKey(const Key, FileName: String): Boolean; function UnLoadKey(const Key: UnicodeString): Boolean; @@ -154,8 +154,8 @@ type procedure GetValueNames(Strings: TStrings); //ToDo function GetValueNames: TUnicodeStringArray; - procedure MoveKey(const OldName, NewName: UnicodeString; Delete: Boolean); - procedure MoveKey(const OldName, NewName: String; Delete: Boolean); + procedure MoveKey(const OldName, NewName: UnicodeString; Delete: Boolean); unimplemented; + procedure MoveKey(const OldName, NewName: String; Delete: Boolean); unimplemented; procedure RenameValue(const OldName, NewName: UnicodeString); procedure RenameValue(const OldName, NewName: String); procedure WriteCurrency(const Name: UnicodeString; Value: Currency); @@ -251,7 +251,7 @@ type function ReadFloat(const Section, Name: string; Default: Double): Double; override; function ReadString(const Section, Name, Default: string): string; override; function ReadTime(const Section, Name: string; Default: TDateTime): TDateTime; override; - function ReadBinaryStream(const Section, Name: string; Value: TStream): Integer; override; + function ReadBinaryStream(const Section, Name: string; Value: TStream): Integer; override; unimplemented; procedure WriteDate(const Section, Name: string; Value: TDateTime); override; procedure WriteDateTime(const Section, Name: string; Value: TDateTime); override; procedure WriteFloat(const Section, Name: string; Value: Double); override; From b41c8342c859189350928b08def09ccee5318ea5 Mon Sep 17 00:00:00 2001 From: florian Date: Wed, 1 Apr 2020 20:08:20 +0000 Subject: [PATCH 07/11] * Xtensa: reduce stack usage git-svn-id: trunk@44492 - --- compiler/xtensa/cgcpu.pas | 7 +++++-- compiler/xtensa/cpupi.pas | 19 +++++-------------- 2 files changed, 10 insertions(+), 16 deletions(-) diff --git a/compiler/xtensa/cgcpu.pas b/compiler/xtensa/cgcpu.pas index a1fdbede87..efacf54ba4 100644 --- a/compiler/xtensa/cgcpu.pas +++ b/compiler/xtensa/cgcpu.pas @@ -633,8 +633,11 @@ implementation end else begin - { spill area } - inc(localsize,max(txtensaprocinfo(current_procinfo).maxcall,4)*4); + { default spill area } + inc(localsize,4*4); + { additional spill area? } + if pi_do_call in current_procinfo.flags then + inc(localsize,txtensaprocinfo(current_procinfo).maxcall*4); localsize:=align(localsize,current_settings.alignment.localalignmax); end; diff --git a/compiler/xtensa/cpupi.pas b/compiler/xtensa/cpupi.pas index 03a8cf6f44..b6d76fe349 100644 --- a/compiler/xtensa/cpupi.pas +++ b/compiler/xtensa/cpupi.pas @@ -65,7 +65,7 @@ unit cpupi; constructor txtensaprocinfo.create(aparent: tprocinfo); begin inherited create(aparent); - maxpushedparasize := 0; + maxpushedparasize:=0; if target_info.abi=abi_xtensa_windowed then begin callins:=A_CALL8; @@ -92,23 +92,15 @@ unit cpupi; localsize : aint; i : longint; begin - if (po_nostackframe in procdef.procoptions) then - begin - { maxpushedparasize sghould be zero, - if not we will get an error later. } - tg.setfirsttemp(maxpushedparasize); - exit; - end; + tg.setfirsttemp(maxpushedparasize); - if tg.direction = -1 then - tg.setfirsttemp(-(1+12)*4) - else - tg.setfirsttemp(maxpushedparasize); + if po_nostackframe in procdef.procoptions then + exit; { estimate stack frame size } if pi_estimatestacksize in flags then begin - stackframesize:=maxpushedparasize+32; + stackframesize:=maxpushedparasize; localsize:=0; for i:=0 to procdef.localst.SymList.Count-1 do if tsym(procdef.localst.SymList[i]).typ=localvarsym then @@ -126,7 +118,6 @@ unit cpupi; else inc(localsize,tabstractnormalvarsym(procdef.parast.SymList[i]).getsize); end; - inc(stackframesize,localsize); if pi_needs_implicit_finally in flags then From 1e0640c9e99f3c498d3ce4cb726589fac9662093 Mon Sep 17 00:00:00 2001 From: florian Date: Wed, 1 Apr 2020 20:08:21 +0000 Subject: [PATCH 08/11] * Xtensa: FreeRTOS uses windowed calling convention git-svn-id: trunk@44493 - --- compiler/systems/i_freertos.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/systems/i_freertos.pas b/compiler/systems/i_freertos.pas index 7254c5ada8..a36c696e29 100644 --- a/compiler/systems/i_freertos.pas +++ b/compiler/systems/i_freertos.pas @@ -714,7 +714,7 @@ unit i_freertos; first_parm_offset : 8; stacksize : 65536; stackalign : 16; - abi : abi_default; + abi : abi_xtensa_windowed; llvmdatalayout : 'e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-v128:64:128-a0:0:64-n32-S32'; ); From c2cf21d176a9a6db501940d2cd7931f1c651aa0d Mon Sep 17 00:00:00 2001 From: florian Date: Wed, 1 Apr 2020 20:08:22 +0000 Subject: [PATCH 09/11] + Xtensa: boolean registers * Xtensa: register numbers of floating point registers corrected git-svn-id: trunk@44494 - --- compiler/xtensa/rxtensacon.inc | 48 +++++++++++++++++++++----------- compiler/xtensa/rxtensadwa.inc | 16 +++++++++++ compiler/xtensa/rxtensanor.inc | 2 +- compiler/xtensa/rxtensanum.inc | 48 +++++++++++++++++++++----------- compiler/xtensa/rxtensarni.inc | 46 +++++++++++++++++++++---------- compiler/xtensa/rxtensasri.inc | 16 +++++++++++ compiler/xtensa/rxtensasta.inc | 16 +++++++++++ compiler/xtensa/rxtensastd.inc | 18 +++++++++++- compiler/xtensa/rxtensasup.inc | 16 +++++++++++ compiler/xtensa/xtensaatt.inc | 7 +++++ compiler/xtensa/xtensaop.inc | 7 +++++ compiler/xtensa/xtensareg.dat | 50 ++++++++++++++++++++++------------ 12 files changed, 224 insertions(+), 66 deletions(-) diff --git a/compiler/xtensa/rxtensacon.inc b/compiler/xtensa/rxtensacon.inc index 3a2ba0ec05..b73cbc9caf 100644 --- a/compiler/xtensa/rxtensacon.inc +++ b/compiler/xtensa/rxtensacon.inc @@ -16,19 +16,35 @@ NR_A12 = tregister($0100000c); NR_A13 = tregister($0100000d); NR_A14 = tregister($0100000e); NR_A15 = tregister($0100000f); -NR_F0 = tregister($01000000); -NR_F1 = tregister($01000001); -NR_F2 = tregister($01000002); -NR_F3 = tregister($01000003); -NR_F4 = tregister($01000004); -NR_F5 = tregister($01000005); -NR_F6 = tregister($01000006); -NR_F7 = tregister($01000007); -NR_F8 = tregister($01000008); -NR_F9 = tregister($01000009); -NR_F10 = tregister($0100000f); -NR_F11 = tregister($0100000b); -NR_F12 = tregister($0100000c); -NR_F13 = tregister($0100000d); -NR_F14 = tregister($0100000e); -NR_F15 = tregister($0100000f); +NR_F0 = tregister($02000000); +NR_F1 = tregister($02000001); +NR_F2 = tregister($02000002); +NR_F3 = tregister($02000003); +NR_F4 = tregister($02000004); +NR_F5 = tregister($02000005); +NR_F6 = tregister($02000006); +NR_F7 = tregister($02000007); +NR_F8 = tregister($02000008); +NR_F9 = tregister($02000009); +NR_F10 = tregister($0200000f); +NR_F11 = tregister($0200000b); +NR_F12 = tregister($0200000c); +NR_F13 = tregister($0200000d); +NR_F14 = tregister($0200000e); +NR_F15 = tregister($0200000f); +NR_B0 = tregister($05000000); +NR_B1 = tregister($05000001); +NR_B2 = tregister($05000002); +NR_B3 = tregister($05000003); +NR_B4 = tregister($05000004); +NR_B5 = tregister($05000005); +NR_B6 = tregister($05000006); +NR_B7 = tregister($05000007); +NR_B8 = tregister($05000008); +NR_B9 = tregister($05000009); +NR_B10 = tregister($0500000b); +NR_B11 = tregister($0500000b); +NR_B12 = tregister($0500000c); +NR_B13 = tregister($0500000d); +NR_B14 = tregister($0500000e); +NR_B15 = tregister($0500000b); diff --git a/compiler/xtensa/rxtensadwa.inc b/compiler/xtensa/rxtensadwa.inc index 618d4bb19e..4762ea3fb8 100644 --- a/compiler/xtensa/rxtensadwa.inc +++ b/compiler/xtensa/rxtensadwa.inc @@ -31,4 +31,20 @@ 12, 13, 14, +15, +0, +1, +2, +3, +4, +5, +6, +7, +8, +9, +10, +11, +12, +13, +14, 15 diff --git a/compiler/xtensa/rxtensanor.inc b/compiler/xtensa/rxtensanor.inc index c7fe732078..5d29d7d7e1 100644 --- a/compiler/xtensa/rxtensanor.inc +++ b/compiler/xtensa/rxtensanor.inc @@ -1,2 +1,2 @@ { don't edit, this file is generated from xtensareg.dat } -33 +49 diff --git a/compiler/xtensa/rxtensanum.inc b/compiler/xtensa/rxtensanum.inc index 08f0af9acc..fc640e5c12 100644 --- a/compiler/xtensa/rxtensanum.inc +++ b/compiler/xtensa/rxtensanum.inc @@ -16,19 +16,35 @@ tregister($0100000c), tregister($0100000d), tregister($0100000e), tregister($0100000f), -tregister($01000000), -tregister($01000001), -tregister($01000002), -tregister($01000003), -tregister($01000004), -tregister($01000005), -tregister($01000006), -tregister($01000007), -tregister($01000008), -tregister($01000009), -tregister($0100000f), -tregister($0100000b), -tregister($0100000c), -tregister($0100000d), -tregister($0100000e), -tregister($0100000f) +tregister($02000000), +tregister($02000001), +tregister($02000002), +tregister($02000003), +tregister($02000004), +tregister($02000005), +tregister($02000006), +tregister($02000007), +tregister($02000008), +tregister($02000009), +tregister($0200000f), +tregister($0200000b), +tregister($0200000c), +tregister($0200000d), +tregister($0200000e), +tregister($0200000f), +tregister($05000000), +tregister($05000001), +tregister($05000002), +tregister($05000003), +tregister($05000004), +tregister($05000005), +tregister($05000006), +tregister($05000007), +tregister($05000008), +tregister($05000009), +tregister($0500000b), +tregister($0500000b), +tregister($0500000c), +tregister($0500000d), +tregister($0500000e), +tregister($0500000b) diff --git a/compiler/xtensa/rxtensarni.inc b/compiler/xtensa/rxtensarni.inc index e721203de0..ecf7a5f1eb 100644 --- a/compiler/xtensa/rxtensarni.inc +++ b/compiler/xtensa/rxtensarni.inc @@ -1,34 +1,50 @@ { don't edit, this file is generated from xtensareg.dat } 0, 1, -17, 2, -18, 3, -19, 4, -20, 5, -21, 6, -22, 7, -23, 8, -24, 9, -25, 10, -26, 11, 12, -28, 13, -29, 14, -30, 15, -31, 16, +17, +18, +19, +20, +21, +22, +23, +24, +25, +26, +28, +29, +30, +31, 27, -32 +32, +33, +34, +35, +36, +37, +38, +39, +40, +41, +42, +43, +44, +48, +45, +46, +47 diff --git a/compiler/xtensa/rxtensasri.inc b/compiler/xtensa/rxtensasri.inc index 5e429be226..ab3b8df5bf 100644 --- a/compiler/xtensa/rxtensasri.inc +++ b/compiler/xtensa/rxtensasri.inc @@ -16,6 +16,22 @@ 8, 9, 10, +33, +34, +43, +44, +45, +46, +47, +48, +35, +36, +37, +38, +39, +40, +41, +42, 17, 18, 27, diff --git a/compiler/xtensa/rxtensasta.inc b/compiler/xtensa/rxtensasta.inc index 618d4bb19e..4762ea3fb8 100644 --- a/compiler/xtensa/rxtensasta.inc +++ b/compiler/xtensa/rxtensasta.inc @@ -31,4 +31,20 @@ 12, 13, 14, +15, +0, +1, +2, +3, +4, +5, +6, +7, +8, +9, +10, +11, +12, +13, +14, 15 diff --git a/compiler/xtensa/rxtensastd.inc b/compiler/xtensa/rxtensastd.inc index 4571764678..8c092ec126 100644 --- a/compiler/xtensa/rxtensastd.inc +++ b/compiler/xtensa/rxtensastd.inc @@ -31,4 +31,20 @@ 'f12', 'f13', 'f14', -'f15' +'f15', +'b0', +'b1', +'b2', +'b3', +'b4', +'b5', +'b6', +'b7', +'b8', +'b9', +'b10', +'b11', +'b12', +'b13', +'b14', +'b15' diff --git a/compiler/xtensa/rxtensasup.inc b/compiler/xtensa/rxtensasup.inc index 5fbbb75e10..0741a81eda 100644 --- a/compiler/xtensa/rxtensasup.inc +++ b/compiler/xtensa/rxtensasup.inc @@ -32,3 +32,19 @@ RS_F12 = $0c; RS_F13 = $0d; RS_F14 = $0e; RS_F15 = $0f; +RS_B0 = $00; +RS_B1 = $01; +RS_B2 = $02; +RS_B3 = $03; +RS_B4 = $04; +RS_B5 = $05; +RS_B6 = $06; +RS_B7 = $07; +RS_B8 = $08; +RS_B9 = $09; +RS_B10 = $0b; +RS_B11 = $0b; +RS_B12 = $0c; +RS_B13 = $0d; +RS_B14 = $0e; +RS_B15 = $0b; diff --git a/compiler/xtensa/xtensaatt.inc b/compiler/xtensa/xtensaatt.inc index 90d556e946..c9375d1af2 100644 --- a/compiler/xtensa/xtensaatt.inc +++ b/compiler/xtensa/xtensaatt.inc @@ -2,6 +2,7 @@ 'none', 'abs', 'add', +'add.s', 'addi', 'addmi', 'and', @@ -28,9 +29,14 @@ 'mov.s', 'movnez', 'movi', +'mul.s', 'mull', 'neg', +'neg.s', 'nop', +'oeq.s', +'ole.s', +'olt.s', 'or', 'ret', 'retw', @@ -47,6 +53,7 @@ 'ssl', 'ssr', 'sub', +'sub.s', 'xor' ); diff --git a/compiler/xtensa/xtensaop.inc b/compiler/xtensa/xtensaop.inc index 18ac2fd320..a4286eaa03 100644 --- a/compiler/xtensa/xtensaop.inc +++ b/compiler/xtensa/xtensaop.inc @@ -2,6 +2,7 @@ A_NONE, A_ABS, A_ADD, +A_ADD_S, A_ADDI, A_ADDMI, A_AND, @@ -28,9 +29,14 @@ A_MOV, A_MOV_S, A_MOVNEZ, A_MOVI, +A_MUL_S, A_MULL, A_NEG, +A_NEG_S, A_NOP, +A_OEQ_S, +A_OLE_S, +A_OLT_S, A_OR, A_RET, A_RETW, @@ -47,6 +53,7 @@ A_SSI, A_SSL, A_SSR, A_SUB, +A_SUB_S, A_XOR ); diff --git a/compiler/xtensa/xtensareg.dat b/compiler/xtensa/xtensareg.dat index ddd814cf54..1f2809ebbe 100644 --- a/compiler/xtensa/xtensareg.dat +++ b/compiler/xtensa/xtensareg.dat @@ -24,22 +24,38 @@ A14,$01,$00,$0e,a14,14,14 A15,$01,$00,$0f,a15,15,15 ; Floating point registers -F0,$01,$00,$00,f0,0,0 -F1,$01,$00,$01,f1,1,1 -F2,$01,$00,$02,f2,2,2 -F3,$01,$00,$03,f3,3,3 -F4,$01,$00,$04,f4,4,4 -F5,$01,$00,$05,f5,5,5 -F6,$01,$00,$06,f6,6,6 -F7,$01,$00,$07,f7,7,7 -F8,$01,$00,$08,f8,8,8 -F9,$01,$00,$09,f9,9,9 -F10,$01,$00,$0f,f10,10,10 -F11,$01,$00,$0b,f11,11,11 -F12,$01,$00,$0c,f12,12,12 -F13,$01,$00,$0d,f13,13,13 -F14,$01,$00,$0e,f14,14,14 -F15,$01,$00,$0f,f15,15,15 - +F0,$02,$00,$00,f0,0,0 +F1,$02,$00,$01,f1,1,1 +F2,$02,$00,$02,f2,2,2 +F3,$02,$00,$03,f3,3,3 +F4,$02,$00,$04,f4,4,4 +F5,$02,$00,$05,f5,5,5 +F6,$02,$00,$06,f6,6,6 +F7,$02,$00,$07,f7,7,7 +F8,$02,$00,$08,f8,8,8 +F9,$02,$00,$09,f9,9,9 +F10,$02,$00,$0f,f10,10,10 +F11,$02,$00,$0b,f11,11,11 +F12,$02,$00,$0c,f12,12,12 +F13,$02,$00,$0d,f13,13,13 +F14,$02,$00,$0e,f14,14,14 +F15,$02,$00,$0f,f15,15,15 +; Boolean registers +B0,$05,$00,$00,b0,0,0 +B1,$05,$00,$01,b1,1,1 +B2,$05,$00,$02,b2,2,2 +B3,$05,$00,$03,b3,3,3 +B4,$05,$00,$04,b4,4,4 +B5,$05,$00,$05,b5,5,5 +B6,$05,$00,$06,b6,6,6 +B7,$05,$00,$07,b7,7,7 +B8,$05,$00,$08,b8,8,8 +B9,$05,$00,$09,b9,9,9 +B10,$05,$00,$0b,b10,10,10 +B11,$05,$00,$0b,b11,11,11 +B12,$05,$00,$0c,b12,12,12 +B13,$05,$00,$0d,b13,13,13 +B14,$05,$00,$0e,b14,14,14 +B15,$05,$00,$0b,b15,15,15 From ba9e9305566658b3153f311fc09ce20eca55ab47 Mon Sep 17 00:00:00 2001 From: florian Date: Wed, 1 Apr 2020 20:08:23 +0000 Subject: [PATCH 10/11] * Xtensa: set fpu type dependending on the controller git-svn-id: trunk@44495 - --- compiler/options.pas | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/compiler/options.pas b/compiler/options.pas index a0f9459050..6bc42f364a 100644 --- a/compiler/options.pas +++ b/compiler/options.pas @@ -4238,8 +4238,7 @@ begin ((target_info.system in [system_arm_wince,system_arm_gba, system_m68k_amiga,system_m68k_atari, system_arm_nds,system_arm_embedded, - system_riscv32_embedded,system_riscv64_embedded,system_xtensa_embedded, - system_xtensa_freertos]) + system_riscv32_embedded,system_riscv64_embedded,system_xtensa_embedded]) {$ifdef arm} or (target_info.abi=abi_eabi) {$endif arm} @@ -4274,6 +4273,11 @@ begin end; {$endif i386} +{$ifdef xtensa} + if not(option.FPUSetExplicitly) then + init_settings.fputype:=embedded_controllers[init_settings.controllertype].fputype; +{$endif xtensa} + {$ifdef arm} case target_info.system of system_arm_darwin: From 07ee8948aaabccee33a1ad6f6ab51eaf4aa6f5a9 Mon Sep 17 00:00:00 2001 From: marco Date: Wed, 1 Apr 2020 21:12:10 +0000 Subject: [PATCH 11/11] * use a PO flag to run idle event. This allows both cases (slow, long term input, and short, quick input) to run without derivation of the class for runcommand. git-svn-id: trunk@44496 - --- packages/fcl-process/src/process.pp | 2 +- packages/fcl-process/src/processbody.inc | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/packages/fcl-process/src/process.pp b/packages/fcl-process/src/process.pp index 07d2a84999..0030584e08 100644 --- a/packages/fcl-process/src/process.pp +++ b/packages/fcl-process/src/process.pp @@ -27,7 +27,7 @@ Type poNoConsole,poNewConsole, poDefaultErrorMode,poNewProcessGroup, poDebugProcess,poDebugOnlyThisProcess, - poPassInput); + poPassInput,porunidle); TShowWindowOptions = (swoNone,swoHIDE,swoMaximize,swoMinimize,swoRestore,swoShow, swoShowDefault,swoShowMaximized,swoShowMinimized, diff --git a/packages/fcl-process/src/processbody.inc b/packages/fcl-process/src/processbody.inc index a6fa78cc05..7dca7b7650 100644 --- a/packages/fcl-process/src/processbody.inc +++ b/packages/fcl-process/src/processbody.inc @@ -562,7 +562,7 @@ begin if assigned(stderr) then gotoutputstderr:=ReadInputStream(StdErr,StdErrBytesRead,StdErrLength,StdErrString,1); - if not gotoutput and not gotoutputstderr and Assigned(FOnRunCommandEvent) Then + if (porunidle in options) and not gotoutput and not gotoutputstderr and Assigned(FOnRunCommandEvent) Then FOnRunCommandEvent(self,Nil,RunCommandIdle,''); end; // Get left output after end of execution