From 1f20cfe9914e98c799383028c2f8f165b0094e4e Mon Sep 17 00:00:00 2001 From: pierre Date: Mon, 4 Nov 2019 08:50:42 +0000 Subject: [PATCH] Merge of several commits related to enhancements in PPU writing and more precisely to cross reading/writing fixes. ------------------------------------------------------------------------ r41896 | pierre | 2019-04-18 14:08:03 +0000 (Thu, 18 Apr 2019) | 15 lines Integrate patch from bug report 35409. Add possibiliy to throw InternalError for unhandled case values inside tentryfile, But avoid adding dependency on verbose unit as this would break ppudump handling of ppu files. Add RaiseAssertion virtual method to tentryfile class. Call RaiseAssertion in tentryfile methods where an internal error is wanted. Override RaiseAssertion method in symtype.pas unit to call InternalError. Add new class tppudumpfile to override RaiseAssertion in utils/ppuutils/ppudump.pp unit. ------------------------------------------------------------------------ --- Merging r41896 into '.': U compiler/entfile.pas U compiler/pcp.pas U compiler/symtype.pas U compiler/utils/ppuutils/ppudump.pp --- Recording mergeinfo for merge of r41896 into '.': U . ------------------------------------------------------------------------ r42111 | pierre | 2019-05-20 22:06:57 +0000 (Mon, 20 May 2019) | 1 line List TSettings partially and improve generic output ------------------------------------------------------------------------ --- Merging r42111 into '.': G compiler/utils/ppuutils/ppudump.pp --- Recording mergeinfo for merge of r42111 into '.': G . ------------------------------------------------------------------------ r42322 | pierre | 2019-07-03 13:35:05 +0000 (Wed, 03 Jul 2019) | 1 line Systematically include fpcdefs.inc at sart of all units used by compiler ------------------------------------------------------------------------ --- Merging r42322 into '.': U compiler/aarch64/cpuinfo.pas U compiler/arm/cpuinfo.pas U compiler/avr/cpuinfo.pas U compiler/ccharset.pas U compiler/generic/cpuinfo.pas U compiler/jvm/cpuinfo.pas U compiler/m68k/cpuinfo.pas U compiler/macho.pas U compiler/machoutils.pas U compiler/mips/cpuinfo.pas G compiler/pcp.pas U compiler/powerpc/cpuinfo.pas U compiler/powerpc64/cpuinfo.pas U compiler/systems/i_wii.pas --- Recording mergeinfo for merge of r42322 into '.': G . ------------------------------------------------------------------------ r42323 | pierre | 2019-07-04 15:24:49 +0000 (Thu, 04 Jul 2019) | 7 lines * Set ControllerSupport to false for sparc/sparc64 and x86_64 CPUs. This boolean must only be set to true if TControllerType is not simply (ct_none) * ppu.pas: Increment CurrentPPULongVersion constant as the above modification changes the number of fields of the TSettings record that is saved to PPU in ST_LOADSETTINGS field. { not mereged } ------------------------------------------------------------------------ --- Merging r42323 into '.': C compiler/ppu.pas { not mereged } U compiler/sparc/cpuinfo.pas U compiler/sparc64/cpuinfo.pas U compiler/x86_64/cpuinfo.pas --- Recording mergeinfo for merge of r42323 into '.': G . ------------------------------------------------------------------------ r42324 | pierre | 2019-07-04 15:25:40 +0000 (Thu, 04 Jul 2019) | 1 line Correctly read saved tsettings ------------------------------------------------------------------------ --- Merging r42324 into '.': C compiler/utils/ppuutils/ppudump.pp --- Recording mergeinfo for merge of r42324 into '.': G . Summary of conflicts: Text conflicts: 1 ------------------------------------------------------------------------ r42325 | marcus | 2019-07-04 16:49:26 +0000 (Thu, 04 Jul 2019) | 1 line Fixed ppudump compilation on big endian platforms after r42324 ------------------------------------------------------------------------ --- Merging r42325 into '.': G compiler/utils/ppuutils/ppudump.pp --- Recording mergeinfo for merge of r42325 into '.': G . ------------------------------------------------------------------------ r42353 | svenbarth | 2019-07-12 16:25:33 +0000 (Fri, 12 Jul 2019) | 1 line * write an entry name for the property options ------------------------------------------------------------------------ --- Merging r42353 into '.': G compiler/utils/ppuutils/ppudump.pp --- Recording mergeinfo for merge of r42353 into '.': G . ------------------------------------------------------------------------ r42354 | svenbarth | 2019-07-12 16:25:36 +0000 (Fri, 12 Jul 2019) | 1 line * write a name for the none property access entry (looks nicer than a "(Nil)" at the start of the line) ------------------------------------------------------------------------ --- Merging r42354 into '.': G compiler/utils/ppuutils/ppudump.pp --- Recording mergeinfo for merge of r42354 into '.': G . ------------------------------------------------------------------------ r42527 | pierre | 2019-07-29 05:33:00 +0000 (Mon, 29 Jul 2019) | 22 lines Fix recordtoken writing into ppu files to allow correct handling in cross-configuration with different endianess. The code has been modified to use the same scheme as the writing of the other parts of the ppu, i.e. change_endian filed has been added also to tscannerfile class of scanner unit. This field is then used to swap values that required endianess conversion. * scanner.pas: change_endian filed added to tscannerfile class. The value of this field is set as the same field in tentryfile class of entfile unit. Token read and write methods converted to use change_endian field. * ppu.pas: Increase CurrentPPILongVersion * utils/ppuutils/ppudump.pp: Remove unneeded FPC_BIG_ENDIAN code which was needed because tokens were previously written using a different rule. ------------------------------------------------------------------------ --- Merging r42527 into '.': C compiler/ppu.pas U compiler/scanner.pas G compiler/utils/ppuutils/ppudump.pp --- Recording mergeinfo for merge of r42527 into '.': G . Summary of conflicts: Text conflicts: 1 ------------------------------------------------------------------------ r42528 | pierre | 2019-07-29 11:54:27 +0000 (Mon, 29 Jul 2019) | 1 line Changed paths: M /trunk/compiler/scanner.pas Try to fix bug introduced in previous commit #42527, hopefully fixing bug report 35902 ------------------------------------------------------------------------ --- Merging r42528 into '.': G compiler/scanner.pas --- Recording mergeinfo for merge of r42528 into '.': G .------------------------------------------------------------------------ r42530 | pierre | 2019-07-29 16:40:58 +0000 (Mon, 29 Jul 2019) | 8 lines Try to fix ppudump for generic/inline. * entfile.pas: Differenciate ibsymtableoptions and ibrecsymtableoptions. * ppu.pas: Increase ppu unit CurrentPPULongVersion value. * utils/ppuutils/ppudump.pp: Add current_symtable_options variable. Change readsymtableoptions from procedure to function returning the new tsymtableoptions. ------------------------------------------------------------------------ --- Merging r42530 into '.': G compiler/entfile.pas G compiler/ppu.pas G compiler/utils/ppuutils/ppudump.pp --- Recording mergeinfo for merge of r42530 into '.': G . ------------------------------------------------------------------------ r42583 | pierre | 2019-08-05 09:15:12 +0000 (Mon, 05 Aug 2019) | 1 line Reorganize token buffer output to be able to use it for generics and inlined functions ------------------------------------------------------------------------ --- Merging r42583 into '.': G compiler/utils/ppuutils/ppudump.pp --- Recording mergeinfo for merge of r42583 into '.': G . ------------------------------------------------------------------------ r42591 | pierre | 2019-08-06 06:32:52 +0000 (Tue, 06 Aug 2019) | 1 line Add mode and optimizer switches names, and check that no unknown switch is set ------------------------------------------------------------------------ --- Merging r42591 into '.': G compiler/utils/ppuutils/ppudump.pp --- Recording mergeinfo for merge of r42591 into '.': G . ------------------------------------------------------------------------ r42596 | pierre | 2019-08-06 21:32:51 +0000 (Tue, 06 Aug 2019) | 1 line Fix gettokenbufshortint, as shortint is one byte long, not two ------------------------------------------------------------------------ --- Merging r42596 into '.': G compiler/utils/ppuutils/ppudump.pp --- Recording mergeinfo for merge of r42596 into '.': G . ------------------------------------------------------------------------ r42609 | pierre | 2019-08-09 09:29:50 +0000 (Fri, 09 Aug 2019) | 1 line Correct size of asizeint, which is still 4-byte long even when CpuAddrBitSize is 16 as for avr and i8086 ------------------------------------------------------------------------ --- Merging r42609 into '.': G compiler/utils/ppuutils/ppudump.pp --- Recording mergeinfo for merge of r42609 into '.': G . ------------------------------------------------------------------------ r42670 | pierre | 2019-08-13 06:20:23 +0000 (Tue, 13 Aug 2019) | 1 line Reduce cpu-os dependency on real constant printout by using system.str ------------------------------------------------------------------------ --- Merging r42670 into '.': G compiler/utils/ppuutils/ppudump.pp --- Recording mergeinfo for merge of r42670 into '.': G . ------------------------------------------------------------------------ r42906 | pierre | 2019-09-02 16:00:15 +0000 (Mon, 02 Sep 2019) | 1 line Fix problems with big endian systems without 80-bit floating point support ------------------------------------------------------------------------ --- Merging r42906 into '.': G compiler/utils/ppuutils/ppudump.pp --- Recording mergeinfo for merge of r42906 into '.': G . git-svn-id: branches/fixes_3_2@43387 - --- compiler/aarch64/cpuinfo.pas | 2 + compiler/arm/cpuinfo.pas | 2 + compiler/avr/cpuinfo.pas | 2 + compiler/ccharset.pas | 2 + compiler/entfile.pas | 34 +- compiler/generic/cpuinfo.pas | 2 + compiler/jvm/cpuinfo.pas | 2 + compiler/m68k/cpuinfo.pas | 2 + compiler/macho.pas | 4 +- compiler/machoutils.pas | 6 +- compiler/mips/cpuinfo.pas | 2 + compiler/pcp.pas | 11 +- compiler/powerpc/cpuinfo.pas | 2 + compiler/powerpc64/cpuinfo.pas | 2 + compiler/ppu.pas | 6 +- compiler/scanner.pas | 70 +- compiler/sparc/cpuinfo.pas | 2 +- compiler/sparc64/cpuinfo.pas | 2 +- compiler/symtype.pas | 6 + compiler/systems/i_wii.pas | 2 + compiler/utils/ppuutils/ppudump.pp | 1353 +++++++++++++++++++++++----- compiler/x86_64/cpuinfo.pas | 2 +- 22 files changed, 1210 insertions(+), 308 deletions(-) diff --git a/compiler/aarch64/cpuinfo.pas b/compiler/aarch64/cpuinfo.pas index dcd0203fd2..d5fdf9f813 100644 --- a/compiler/aarch64/cpuinfo.pas +++ b/compiler/aarch64/cpuinfo.pas @@ -14,6 +14,8 @@ Unit CPUInfo; +{$i fpcdefs.inc} + Interface uses diff --git a/compiler/arm/cpuinfo.pas b/compiler/arm/cpuinfo.pas index 8c65a365c0..f7b76d02b2 100644 --- a/compiler/arm/cpuinfo.pas +++ b/compiler/arm/cpuinfo.pas @@ -14,6 +14,8 @@ Unit CPUInfo; +{$i fpcdefs.inc} + Interface uses diff --git a/compiler/avr/cpuinfo.pas b/compiler/avr/cpuinfo.pas index 2f325bcb76..4a605773e2 100644 --- a/compiler/avr/cpuinfo.pas +++ b/compiler/avr/cpuinfo.pas @@ -14,6 +14,8 @@ Unit CPUInfo; +{$i fpcdefs.inc} + Interface uses diff --git a/compiler/ccharset.pas b/compiler/ccharset.pas index 2f7a0e1aee..99ee1831dd 100644 --- a/compiler/ccharset.pas +++ b/compiler/ccharset.pas @@ -16,6 +16,8 @@ {$mode objfpc} unit ccharset; +{$i fpcdefs.inc} + interface type diff --git a/compiler/entfile.pas b/compiler/entfile.pas index 5dcb7ea859..9501f8193a 100644 --- a/compiler/entfile.pas +++ b/compiler/entfile.pas @@ -122,9 +122,9 @@ const ibmainname = 90; ibsymtableoptions = 91; - ibrecsymtableoptions = 91; ibpackagefiles = 92; ibpackagename = 93; + ibrecsymtableoptions = 94; { target-specific things } iblinkotherframeworks = 100; ibjvmnamespace = 101; @@ -231,6 +231,7 @@ type procedure resetfile;virtual;abstract; function getheadersize:longint;virtual;abstract; function getheaderaddr:pentryheader;virtual;abstract; + procedure RaiseAssertion(Code: Longint); virtual; public entrytyp : byte; size : integer; @@ -379,6 +380,13 @@ begin end; +procedure tentryfile.RaiseAssertion(Code: Longint); +begin + { It's down to descendent classes to raise an internal error as desired. [Kit] } + error := true; +end; + + procedure tentryfile.closefile; begin if mode<>0 then @@ -739,12 +747,16 @@ begin result:=0; end; {$else not generic_cpu} - result:=4; case sizeof(aint) of 8: result:=getint64; 4: result:=getlongint; 2: result:=smallint(getword); 1: result:=shortint(getbyte); + else + begin + RaiseAssertion(2019041801); + result:=0; + end; end; {$endif not generic_cpu} end; @@ -783,9 +795,12 @@ begin 4: result:=asizeint(getlongint); 2: result:=asizeint(getword); 1: result:=asizeint(getbyte); - else + else + begin + RaiseAssertion(2019041802); result:=0; -end; + end; + end; {$endif not generic_cpu} end; @@ -816,7 +831,10 @@ begin 2: result:=getword; 1: result:=getbyte; else - result:=0; + begin + RaiseAssertion(2019041803); + result:=0; + end; end; {$endif not generic_cpu} end; @@ -865,12 +883,16 @@ begin result:=0; end; {$else not generic_cpu} - result:=4; case sizeof(aword) of 8: result:=getqword; 4: result:=getdword; 2: result:=getword; 1: result:=getbyte; + else + begin + RaiseAssertion(2019041804); + result:=0; + end; end; {$endif not generic_cpu} end; diff --git a/compiler/generic/cpuinfo.pas b/compiler/generic/cpuinfo.pas index f2cd3e7603..a9889c97c4 100644 --- a/compiler/generic/cpuinfo.pas +++ b/compiler/generic/cpuinfo.pas @@ -15,6 +15,8 @@ Unit CPUInfo; +{$i fpcdefs.inc} + Interface uses diff --git a/compiler/jvm/cpuinfo.pas b/compiler/jvm/cpuinfo.pas index e315d6cd4e..3cd6bd1fe9 100644 --- a/compiler/jvm/cpuinfo.pas +++ b/compiler/jvm/cpuinfo.pas @@ -14,6 +14,8 @@ Unit cpuinfo; +{$i fpcdefs.inc} + Interface uses diff --git a/compiler/m68k/cpuinfo.pas b/compiler/m68k/cpuinfo.pas index 88d6363883..4323a8d747 100644 --- a/compiler/m68k/cpuinfo.pas +++ b/compiler/m68k/cpuinfo.pas @@ -14,6 +14,8 @@ Unit CPUInfo; +{$i fpcdefs.inc} + Interface uses diff --git a/compiler/macho.pas b/compiler/macho.pas index 8cc343b534..e832813093 100644 --- a/compiler/macho.pas +++ b/compiler/macho.pas @@ -24,7 +24,9 @@ unit macho; { converted by Dmitry Boyarintsev 2009 } -{$mode objfpc}{$H+} +{$i fpcdefs.inc} + +{$H+} interface diff --git a/compiler/machoutils.pas b/compiler/machoutils.pas index b9060b3127..fd9961bbeb 100644 --- a/compiler/machoutils.pas +++ b/compiler/machoutils.pas @@ -23,9 +23,11 @@ unit machoutils; -interface +{$i fpcdefs.inc} -{$mode objfpc}{$h+} +{$h+} + +interface uses macho; diff --git a/compiler/mips/cpuinfo.pas b/compiler/mips/cpuinfo.pas index 22053f1361..146313136f 100644 --- a/compiler/mips/cpuinfo.pas +++ b/compiler/mips/cpuinfo.pas @@ -14,6 +14,8 @@ Unit CPUInfo; +{$i fpcdefs.inc} + Interface uses diff --git a/compiler/pcp.pas b/compiler/pcp.pas index b1f96cde07..a9012317fe 100644 --- a/compiler/pcp.pas +++ b/compiler/pcp.pas @@ -21,7 +21,9 @@ } unit pcp; -{$mode objfpc}{$H+} +{$i fpcdefs.inc} + +{$H+} interface @@ -66,6 +68,7 @@ interface procedure newheader;override; function readheader:longint;override; procedure resetfile;override; + procedure RaiseAssertion(Code: Longint); override; public procedure writeheader;override; function checkpcpid:boolean; @@ -89,6 +92,12 @@ uses result:=@header; end; + procedure tpcpfile.RaiseAssertion(Code: Longint); + begin + // InternalError(nb); + inherited RaiseAssertion(Code); + end; + procedure tpcpfile.newheader; var s : string; diff --git a/compiler/powerpc/cpuinfo.pas b/compiler/powerpc/cpuinfo.pas index 5ac23b56a5..97c17544c7 100644 --- a/compiler/powerpc/cpuinfo.pas +++ b/compiler/powerpc/cpuinfo.pas @@ -14,6 +14,8 @@ Unit CPUInfo; +{$i fpcdefs.inc} + Interface uses diff --git a/compiler/powerpc64/cpuinfo.pas b/compiler/powerpc64/cpuinfo.pas index 6d1f6b369a..968e2726d0 100644 --- a/compiler/powerpc64/cpuinfo.pas +++ b/compiler/powerpc64/cpuinfo.pas @@ -14,6 +14,8 @@ unit CPUInfo; +{$i fpcdefs.inc} + interface uses diff --git a/compiler/ppu.pas b/compiler/ppu.pas index 1c86e7ff0a..4846a7de9d 100644 --- a/compiler/ppu.pas +++ b/compiler/ppu.pas @@ -43,7 +43,11 @@ type {$endif Test_Double_checksum} const - CurrentPPUVersion = 206; + { only update this version if something change in the tppuheader: + * the unit flags listed below + * the format of the header itslf + This number cannot become bigger than 255 (it's stored in a byte) } + CurrentPPUVersion = 207; { unit flags } uf_init = $000001; { unit has initialization section } diff --git a/compiler/scanner.pas b/compiler/scanner.pas index b489dee639..583397ea3b 100644 --- a/compiler/scanner.pas +++ b/compiler/scanner.pas @@ -145,6 +145,8 @@ interface { true, if we are parsing preprocessor expressions } in_preproc_comp_expr : boolean; + { true if cross-compiling for a CPU in opposite endianess} + change_endian_for_tokens : boolean; constructor Create(const fn:string; is_macro: boolean = false); destructor Destroy;override; @@ -284,7 +286,7 @@ implementation symbase,symtable,symtype,symsym,symconst,symdef,defutil, { This is needed for tcputype } cpuinfo, - fmodule, + fmodule,fppu, { this is needed for $I %CURRENTROUTINE%} procinfo {$if FPC_FULLVERSION<20700} @@ -2698,7 +2700,11 @@ type lasttoken:=NOTOKEN; nexttoken:=NOTOKEN; ignoredirectives:=TFPHashList.Create; - end; + if (current_module is tppumodule) and assigned(tppumodule(current_module).ppufile) then + change_endian_for_tokens:=tppumodule(current_module).ppufile.change_endian + else + change_endian_for_tokens:=false; + end; procedure tscannerfile.firstfile; @@ -2870,17 +2876,11 @@ type procedure tscannerfile.tokenwritesizeint(val : asizeint); begin -{$ifdef FPC_BIG_ENDIAN} - val:=swapendian(val); -{$endif} recordtokenbuf.write(val,sizeof(asizeint)); end; procedure tscannerfile.tokenwritelongint(val : longint); begin -{$ifdef FPC_BIG_ENDIAN} - val:=swapendian(val); -{$endif} recordtokenbuf.write(val,sizeof(longint)); end; @@ -2891,17 +2891,11 @@ type procedure tscannerfile.tokenwriteword(val : word); begin -{$ifdef FPC_BIG_ENDIAN} - val:=swapendian(val); -{$endif} recordtokenbuf.write(val,sizeof(word)); end; procedure tscannerfile.tokenwritelongword(val : longword); begin -{$ifdef FPC_BIG_ENDIAN} - val:=swapendian(val); -{$endif} recordtokenbuf.write(val,sizeof(longword)); end; @@ -2910,9 +2904,8 @@ type val : asizeint; begin replaytokenbuf.read(val,sizeof(asizeint)); -{$ifdef FPC_BIG_ENDIAN} - val:=swapendian(val); -{$endif} + if change_endian_for_tokens then + val:=swapendian(val); result:=val; end; @@ -2921,9 +2914,8 @@ type val : longword; begin replaytokenbuf.read(val,sizeof(longword)); -{$ifdef FPC_BIG_ENDIAN} - val:=swapendian(val); -{$endif} + if change_endian_for_tokens then + val:=swapendian(val); result:=val; end; @@ -2932,9 +2924,8 @@ type val : longint; begin replaytokenbuf.read(val,sizeof(longint)); -{$ifdef FPC_BIG_ENDIAN} - val:=swapendian(val); -{$endif} + if change_endian_for_tokens then + val:=swapendian(val); result:=val; end; @@ -2959,9 +2950,8 @@ type val : smallint; begin replaytokenbuf.read(val,sizeof(smallint)); -{$ifdef FPC_BIG_ENDIAN} - val:=swapendian(val); -{$endif} + if change_endian_for_tokens then + val:=swapendian(val); result:=val; end; @@ -2970,9 +2960,8 @@ type val : word; begin replaytokenbuf.read(val,sizeof(word)); -{$ifdef FPC_BIG_ENDIAN} - val:=swapendian(val); -{$endif} + if change_endian_for_tokens then + val:=swapendian(val); result:=val; end; @@ -2989,16 +2978,13 @@ type end; procedure tscannerfile.tokenreadset(var b;size : longint); -{$ifdef FPC_BIG_ENDIAN} var i : longint; -{$endif} begin replaytokenbuf.read(b,size); -{$ifdef FPC_BIG_ENDIAN} - for i:=0 to size-1 do - Pbyte(@b)[i]:=reverse_byte(Pbyte(@b)[i]); -{$endif} + if change_endian_for_tokens then + for i:=0 to size-1 do + Pbyte(@b)[i]:=reverse_byte(Pbyte(@b)[i]); end; procedure tscannerfile.tokenwriteenum(var b;size : longint); @@ -3007,22 +2993,8 @@ type end; procedure tscannerfile.tokenwriteset(var b;size : longint); -{$ifdef FPC_BIG_ENDIAN} - var - i: longint; - tmpset: array[0..31] of byte; -{$endif} begin -{$ifdef FPC_BIG_ENDIAN} - { satisfy DFA because it assumes that size may be 0 and doesn't know that - recordtokenbuf.write wouldn't use tmpset in that case } - tmpset[0]:=0; - for i:=0 to size-1 do - tmpset[i]:=reverse_byte(Pbyte(@b)[i]); - recordtokenbuf.write(tmpset,size); -{$else} recordtokenbuf.write(b,size); -{$endif} end; diff --git a/compiler/sparc/cpuinfo.pas b/compiler/sparc/cpuinfo.pas index 6a881cedd9..b5ca38e63d 100644 --- a/compiler/sparc/cpuinfo.pas +++ b/compiler/sparc/cpuinfo.pas @@ -65,7 +65,7 @@ type Const { Is there support for dealing with multiple microcontrollers available } { for this platform? } - ControllerSupport = true; + ControllerSupport = false; { We know that there are fields after sramsize but we don't care about this warning } diff --git a/compiler/sparc64/cpuinfo.pas b/compiler/sparc64/cpuinfo.pas index de54a3f1e9..37e8dc5e44 100644 --- a/compiler/sparc64/cpuinfo.pas +++ b/compiler/sparc64/cpuinfo.pas @@ -63,7 +63,7 @@ type Const { Is there support for dealing with multiple microcontrollers available } { for this platform? } - ControllerSupport = true; + ControllerSupport = false; { We know that there are fields after sramsize but we don't care about this warning } diff --git a/compiler/symtype.pas b/compiler/symtype.pas index 5ebd24d231..78f7486e8b 100644 --- a/compiler/symtype.pas +++ b/compiler/symtype.pas @@ -206,6 +206,8 @@ interface procedure putderef(const d:tderef); procedure putpropaccesslist(p:tpropaccesslist); procedure putasmsymbol(s:tasmsymbol); + protected + procedure RaiseAssertion(Code: Longint); override; end; {$ifdef MEMDEBUG} @@ -887,6 +889,10 @@ implementation Message(unit_f_ppu_read_error); end; + procedure tcompilerppufile.RaiseAssertion(Code: Longint); + begin + InternalError(Code); + end; procedure tcompilerppufile.getguid(var g: tguid); begin diff --git a/compiler/systems/i_wii.pas b/compiler/systems/i_wii.pas index f11adb90f1..38077a8210 100644 --- a/compiler/systems/i_wii.pas +++ b/compiler/systems/i_wii.pas @@ -21,6 +21,8 @@ { This unit implements support information structures for the Nintendo Wii. } unit i_wii; +{$i fpcdefs.inc} + interface uses diff --git a/compiler/utils/ppuutils/ppudump.pp b/compiler/utils/ppuutils/ppudump.pp index 13de5f70a4..6f4c9f0bfd 100644 --- a/compiler/utils/ppuutils/ppudump.pp +++ b/compiler/utils/ppuutils/ppudump.pp @@ -22,17 +22,20 @@ program ppudump; {$i fpcdefs.inc} {$H+} +{$packenum 1} {$define IN_PPUDUMP} uses { do NOT add symconst or globtype to make merging easier } { do include symconst and globtype now before splitting 2.5 PM 2011-06-15 } + cutils, SysUtils, constexp, symconst, ppu, entfile, systems, + cpuinfo, globals, globtype, widestr, @@ -83,6 +86,29 @@ const { 18 } 'sparc64' ); + CpuHasController : array[tsystemcpu] of boolean = + ( + { 0 } false {'none'}, + { 1 } false {'i386'}, + { 2 } false {'m68k'}, + { 3 } false {'alpha (obsolete)'}, + { 4 } false {'powerpc'}, + { 5 } false {'sparc'}, + { 6 } false {'vis (obsolete)'}, + { 7 } false {'ia64 (obsolete)'}, + { 8 } false {'x86_64'}, + { 9 } false {'mipseb'}, + { 10 } true {'arm'}, + { 11 } false {'powerpc64'}, + { 12 } true {'avr'}, + { 13 } true {'mipsel'}, + { 14 } false {'jvm'}, + { 15 } false {'i8086'}, + { 16 } false {'aarch64'}, + { 17 } false {'wasm'}, + { 18 } false {'sparc64'} + ); + { List of all supported system-cpu couples } const Targets : array[tsystem] of string[26]=( @@ -207,11 +233,205 @@ type ST_LINE, ST_COLUMN, ST_FILEINDEX, - ST_LOADMESSAGES); + ST_LOADMESSAGES, + ST_INVALID); +type + tcpu_i386 = ( + cpu_variant_i386_none, + cpu_variant_386, + cpu_variant_486, + cpu_variant_Pentium, + cpu_variant_Pentium2, + cpu_variant_Pentium3, + cpu_variant_Pentium4, + cpu_variant_PentiumM, + cpu_variant_core_i, + cpu_variant_core_avx, + cpu_variant_core_avx2); + + tcpu_m68k = ( + cpu_variant_m68k_none, + cpu_variant_MC68000, + cpu_variant_MC68020, + cpu_variant_MC68040, + cpu_variant_MC68060, + cpu_variant_isa_a, + cpu_variant_isa_a_p, + cpu_variant_isa_b, + cpu_variant_isa_c, + cpu_variant_cfv4e + ); + + tcpu_powerpc = ( + cpu_variant_powerpc_none, + cpu_variant_ppc604, + cpu_variant_ppc750, + cpu_variant_ppc7400, + cpu_variant_ppc970 + ); + + tcpu_sparc = ( + cpu_variant_sparc_none, + cpu_variant_SPARC_V7, + cpu_variant_SPARC_V8, + cpu_variant_SPARC_V9 + ); + + tcpu_x86_64 = ( + cpu_variant_x86_64_none, + cpu_variant_athlon64, + cpu_variant_x86_64_core_i, + cpu_variant_x86_64_core_avx, + cpu_variant_x86_64_core_avx2 + ); + + tcpu_mipseb = ( + cpu_variant_mipseb_none, + cpu_variant_mips1, + cpu_variant_mips2, + cpu_variant_mips3, + cpu_variant_mips4, + cpu_variant_mips5, + cpu_variant_mips32, + cpu_variant_mips32r2, + cpu_variant_pic32mx + ); + + tcpu_arm = ( + cpu_variant_arm_none, + cpu_variant_armv3, + cpu_variant_armv4, + cpu_variant_armv4t, + cpu_variant_armv5, + cpu_variant_armv5t, + cpu_variant_armv5te, + cpu_variant_armv5tej, + cpu_variant_armv6, + cpu_variant_armv6k, + cpu_variant_armv6t2, + cpu_variant_armv6z, + cpu_variant_armv6m, + cpu_variant_armv7, + cpu_variant_armv7a, + cpu_variant_armv7r, + cpu_variant_armv7m, + cpu_variant_armv7em + ); + + tcpu_powerpc64 = ( + cpu_variant_powerpc64_none, + cpu_variant_powerpc64_ppc970 + ); + + tcpu_avr = ( + cpu_variant_avr_none, + cpu_variant_avr1, + cpu_variant_avr2, + cpu_variant_avr25, + cpu_variant_avr3, + cpu_variant_avr31, + cpu_variant_avr35, + cpu_variant_avr4, + cpu_variant_avr5, + cpu_variant_avr51, + cpu_variant_avr6 + ); + + tcpu_mipsel = tcpu_mipseb; + + tcpu_jvm = ( + cpu_variant_jvm_none, + { jvm, same as cpu_none } + cpu_variant_jvm, + { jvm byte code to be translated into Dalvik bytecode: more type- + sensitive } + cpu_variant_dalvik + ); + + tcpu_i8086 = ( + cpu_variant_i8086_none, + cpu_variant_8086, + cpu_variant_186, + cpu_variant_286, + cpu_variant_i8086_386, + cpu_variant_i8086_486, + cpu_variant_i8086_Pentium, + cpu_variant_i8086_Pentium2, + cpu_variant_i8086_Pentium3, + cpu_variant_i8086_Pentium4, + cpu_variant_i8086_PentiumM + ); + + tcpu_aarch64 = ( + cpu_variant_aarch64_none, + cpu_variant_armv8 + ); + + tcpu_wasm = ( + cpu_variant_wasm_none); + + tcpu_sparc64 = ( + cpu_variant_sparc64_none, + cpu_variant_SPARC64_V9 + ); + + + tcpu_type = record + case tsystemcpu of + cpu_no: { 0 } + (); + cpu_i386: { 1 } + (cpu_i386 : tcpu_i386;); + cpu_m68k: { 2 } + (cpu_m68k : tcpu_m68k;); + obsolete_cpu_alpha: { 3 } + (); + cpu_powerpc: { 4 } + (cpu_powerpc : tcpu_powerpc;); + cpu_sparc: { 5 } + (cpu_sparc : tcpu_sparc;); + obsolete_cpu_vm: { 6 } + (); + obsolete_cpu_ia64: { 7 } + (); + cpu_x86_64: { 8 } + (cpu_x86_64 : tcpu_x86_64;); + cpu_mipseb: { 9 } + (cpu_mipseb : tcpu_mipseb;); + cpu_arm: { 10 } + (cpu_arm : tcpu_arm;); + cpu_powerpc64: { 11 } + (cpu_powerpc64 : tcpu_powerpc64;); + cpu_avr: { 12 } + (cpu_avr : tcpu_avr;); + cpu_mipsel: { 13 } + (cpu_mipsel : tcpu_mipsel;); + cpu_jvm: { 14 } + (cpu_jvm : tcpu_jvm;); + cpu_i8086: { 15 } + (cpu_i8086 : tcpu_i8086;); + cpu_aarch64: { 16 } + (cpu_aarch64 : tcpu_aarch64;); + cpu_wasm: { 17 } + (cpu_wasm : tcpu_wasm;); + cpu_sparc64: { 18 } + (cpu_sparc64 : tcpu_sparc64;); + end; + + + TPpuModuleDef = class(TPpuUnitDef) + // ModuleFlags: tmoduleflags; { not yet merged } + end; + +type + tppudumpfile = class(tppufile) + protected + procedure RaiseAssertion(Code: Longint); override; + end; var - ppufile : tppufile; + ppufile : tppudumpfile; ppuversion : dword; space : string; verbose : longint; @@ -223,6 +443,11 @@ var CurUnit: TPpuUnitDef; SkipVersionCheck: boolean; +var + { needed during tobjectdef parsing... } + current_defoptions : tdefoptions; + current_objectoptions : tobjectoptions; + current_symtable_options : tsymtableoptions; {**************************************************************************** Helper Routines @@ -241,17 +466,20 @@ type case byte of 0: (bytes: Array[0..9] of byte); 1: (words: Array[0..4] of word); +{$ifdef FPC_LITTLE_ENDIAN} 2: (cards: Array[0..1] of cardinal; w: word); +{$else not FPC_LITTLE_ENDIAN} + 2: (w:word; cards: Array[0..1] of cardinal); +{$endif not FPC_LITTLE_ENDIAN} end; const maxDigits = 17; - function Real80bitToStr(var e : TSplit80bitReal) : string; + function Real80bitToStr(var e : TSplit80bitReal;var ext : extended) : string; var Temp : string; new : TSplit80bitReal; fraczero, expmaximal, sign, outside_double : boolean; exp : smallint; - ext : extended; d : double; i : longint; mantval : qword; @@ -274,7 +502,11 @@ const exp:=(e.w and $7fff) - 16383 - 63; fraczero := (e.cards[0] = 0) and ((e.cards[1] and $7fffffff) = 0); +{$ifdef FPC_LITTLE_ENDIAN} mantval := qword(e.cards[0]) or (qword(e.cards[1]) shl 32); +{$else not FPC_LITTLE_ENDIAN} + mantval := (qword(e.cards[0]) shl 32) or qword(e.cards[1]); +{$endif not FPC_LITTLE_ENDIAN} if expMaximal then if fraczero then if sign then @@ -304,10 +536,15 @@ const if (mantval<>0) and (d=0.0) then outside_double:=true; if outside_double then - Temp:='Extended value outside double bound' + begin + Temp:='Extended value outside double bound'; + ext:=0.0; + end else - system.str(d,temp); - + begin + ext:=d; + system.str(d,temp); + end; end; result:=temp; @@ -329,6 +566,17 @@ Begin SetHasErrors; End; +procedure StrAppend(var st : string; const st2 : string); +begin + st:=st+st2; +end; + +procedure tppudumpfile.RaiseAssertion(Code: Longint); +begin + WriteError('Internal Error ' + ToStr(Code)); + inherited RaiseAssertion(Code); +end; + Procedure WriteWarning(const S : string); var ss: string; @@ -682,7 +930,7 @@ begin readmanagementoperatoroptions(space,'Fields have MOPs'); end; -procedure readsymtableoptions(const s: string); +function readsymtableoptions(const s: string) : tsymtableoptions; type tsymtblopt=record mask : tsymtableoption; @@ -727,16 +975,27 @@ begin else write('none'); writeln; + readsymtableoptions:=options; end; procedure readdefinitions(const s:string; ParentDef: TPpuContainerDef); forward; procedure readsymbols(const s:string; ParentDef: TPpuContainerDef = nil); forward; procedure readsymtable(const s: string; ParentDef: TPpuContainerDef = nil); +var + stored_symtable_options : tsymtableoptions; begin - readsymtableoptions(s); + stored_symtable_options:=current_symtable_options; + current_symtable_options:=readsymtableoptions(s); readdefinitions(s, ParentDef); readsymbols(s, ParentDef); + current_symtable_options:=stored_symtable_options; +end; + +procedure readrecordsymtable(const s: string; ParentDef: TPpuContainerDef = nil); +begin + readrecsymtableoptions; + readsymtable(s, ParentDef); end; Procedure ReadLinkContainer(const prefix:string); @@ -1535,10 +1794,823 @@ begin end; end; +procedure displaytokenbuffer(tokenbuf : pbyte;tokenbufsize : longint); +type + ptoken=^ttoken; + pmsgstate =^tmsgstate; var - { needed during tobjectdef parsing... } - current_defoptions : tdefoptions; - current_objectoptions : tobjectoptions; + tbi : longint; + state : tmsgstate; + prev_settings, new_settings : Tsettings; + nb, msgvalue, mesgnb : longint; + + + function readtoken: ttoken; + var + b,b2 : byte; + begin + b:=tokenbuf[tbi]; + inc(tbi); + if (b and $80)<>0 then + begin + b2:=tokenbuf[tbi]; + inc(tbi); + result:=ttoken(((b and $7f) shl 8) or b2); + end + else + result:=ttoken(b); + end; + + function gettokenbufdword : dword; + var + var32 : dword; + begin + var32:=unaligned(pdword(@tokenbuf[tbi])^); + inc(tbi,sizeof(dword)); + if ppufile.change_endian then + var32:=swapendian(var32); + result:=var32; + end; + + function gettokenbufword : word; + var + var16 : word; + begin + var16:=unaligned(pword(@tokenbuf[tbi])^); + inc(tbi,sizeof(word)); + if ppufile.change_endian then + var16:=swapendian(var16); + result:=var16; + end; + + function gettokenbuflongint : longint; + var + var32 : longint; + begin + var32:=unaligned(plongint(@tokenbuf[tbi])^); + inc(tbi,sizeof(longint)); + if ppufile.change_endian then + var32:=swapendian(var32); + result:=var32; + end; + + function gettokenbufshortint : shortint; + var + var8 : shortint; + begin + var8:=pshortint(@tokenbuf[tbi])^; + inc(tbi,sizeof(shortint)); + result:=var8; + end; + + procedure tokenreadset(var b;size : longint); + var + i : longint; + begin + move(tokenbuf[tbi],b,size); + inc(tbi,size); + if ppufile.change_endian then + for i:=0 to size-1 do + Pbyte(@b)[i]:=reverse_byte(Pbyte(@b)[i]); + end; + + function gettokenbufbyte : byte; + begin + result:=pbyte(@tokenbuf[tbi])^; + inc(tbi); + end; + + function tokenreadenum(size : longint) : longword; + begin + if size=1 then + result:=gettokenbufbyte + else if size=2 then + result:=gettokenbufword + else if size=4 then + result:=gettokenbufdword; + end; + + + + function gettokenbufsizeint : int64; + var + var64 : int64; + var32 : longint; + var16 : smallint; + + begin + if CpuAddrBitSize[cpu]=64 then + begin + var64:=unaligned(pint64(@tokenbuf[tbi])^); + inc(tbi,sizeof(int64)); + if ppufile.change_endian then + var64:=swapendian(var64); + result:=var64; + end + else if CpuAddrBitSize[cpu]=32 then + begin + var32:=unaligned(plongint(@tokenbuf[tbi])^); + inc(tbi,sizeof(longint)); + if ppufile.change_endian then + var32:=swapendian(var32); + result:=var32; + end + else if CpuAddrBitSize[cpu]=16 then + begin + { ASizeInt is still a longint, see globtype.pas unit } + var32:=unaligned(plongint(@tokenbuf[tbi])^); + inc(tbi,sizeof(longint)); + if ppufile.change_endian then + var32:=swapendian(var32); + result:=var32; + end + else + begin + WriteError('Wrong CpuAddrBitSize'); + result:=0; + end; + end; + + procedure tokenreadsettings(var asettings : tsettings; expected_size : asizeint); + + { This procedure + needs to be changed whenever + globals.tsettings type is changed, + the problem is that no error will appear + before tests with generics are tested. PM } + + var + startpos, endpos : longword; + begin + { WARNING all those fields need to be in the correct + order otherwise cross_endian PPU reading will fail } + startpos:=tbi; + with asettings do + begin + alignment.procalign:=gettokenbuflongint; + alignment.loopalign:=gettokenbuflongint; + alignment.jumpalign:=gettokenbuflongint; + alignment.constalignmin:=gettokenbuflongint; + alignment.constalignmax:=gettokenbuflongint; + alignment.varalignmin:=gettokenbuflongint; + alignment.varalignmax:=gettokenbuflongint; + alignment.localalignmin:=gettokenbuflongint; + alignment.localalignmax:=gettokenbuflongint; + alignment.recordalignmin:=gettokenbuflongint; + alignment.recordalignmax:=gettokenbuflongint; + alignment.maxCrecordalign:=gettokenbuflongint; + tokenreadset(globalswitches,sizeof(globalswitches)); + tokenreadset(targetswitches,sizeof(targetswitches)); + tokenreadset(moduleswitches,sizeof(moduleswitches)); + tokenreadset(localswitches,sizeof(localswitches)); + tokenreadset(modeswitches,sizeof(modeswitches)); + tokenreadset(optimizerswitches,sizeof(optimizerswitches)); + tokenreadset(genwpoptimizerswitches,sizeof(genwpoptimizerswitches)); + tokenreadset(dowpoptimizerswitches,sizeof(dowpoptimizerswitches)); + tokenreadset(debugswitches,sizeof(debugswitches)); + { 0: old behaviour for sets <=256 elements + >0: round to this size } + setalloc:=gettokenbufshortint; + packenum:=gettokenbufshortint; + + packrecords:=gettokenbufshortint; + maxfpuregisters:=gettokenbufshortint; + + cputype:=tcputype(tokenreadenum(sizeof(tcputype))); + optimizecputype:=tcputype(tokenreadenum(sizeof(tcputype))); + fputype:=tfputype(tokenreadenum(sizeof(tfputype))); + asmmode:=tasmmode(tokenreadenum(sizeof(tasmmode))); + interfacetype:=tinterfacetypes(tokenreadenum(sizeof(tinterfacetypes))); + defproccall:=tproccalloption(tokenreadenum(sizeof(tproccalloption))); + { tstringencoding is word type, + thus this should be OK here } + sourcecodepage:=tstringEncoding(gettokenbufword); + + minfpconstprec:=tfloattype(tokenreadenum(sizeof(tfloattype))); + + disabledircache:=boolean(gettokenbufbyte); + +{ TH: Since the field was conditional originally, it was not stored in PPUs. } +{ While adding ControllerSupport constant, I decided not to store ct_none } +{ on targets not supporting controllers, but this might be changed here and } +{ in tokenwritesettings in the future to unify the PPU structure and handling } +{ of this field in the compiler. } +{$PUSH} + {$WARN 6018 OFF} (* Unreachable code due to compile time evaluation *) + if CpuHasController[cpu] then + controllertype:=tcontrollertype(tokenreadenum(sizeof(tcontrollertype))) + else + ControllerType:=ct_none; +{$POP} + endpos:=tbi; + if endpos-startpos<>expected_size then + Writeln(['Wrong size of Settings read-in: ',expected_size,' expected, but got ',endpos-startpos]); + end; + end; + procedure dump_new_settings; +(* tsettings = record + alignment : talignmentinfo; + globalswitches : tglobalswitches; + targetswitches : ttargetswitches; + moduleswitches : tmoduleswitches; + localswitches : tlocalswitches; + modeswitches : tmodeswitches; + optimizerswitches : toptimizerswitches; + { generate information necessary to perform these wpo's during a subsequent compilation } + genwpoptimizerswitches: twpoptimizerswitches; + { perform these wpo's using information generated during a previous compilation } + dowpoptimizerswitches: twpoptimizerswitches; + debugswitches : tdebugswitches; + { 0: old behaviour for sets <=256 elements + >0: round to this size } + setalloc, + packenum : shortint; + + packrecords : shortint; + maxfpuregisters : shortint; + + cputype, + optimizecputype, + asmcputype : tcputype; + fputype : tfputype; + asmmode : tasmmode; + interfacetype : tinterfacetypes; + defproccall : tproccalloption; + sourcecodepage : tstringencoding; + + minfpconstprec : tfloattype; + + disabledircache : boolean; + + tlsmodel : ttlsmodel; + +{$if defined(i8086)} + x86memorymodel : tx86memorymodel; +{$endif defined(i8086)} + +{$if defined(ARM)} + instructionset : tinstructionset; +{$endif defined(ARM)} + +{$if defined(LLVM) and not defined(GENERIC_CPU)} + llvmversion: tllvmversion; +{$endif defined(LLVM) and not defined(GENERIC_CPU)} + + { CPU targets with microcontroller support can add a controller specific unit } + controllertype : tcontrollertype; + + { WARNING: this pointer cannot be written as such in record token } + pmessage : pmessagestaterecord; + end; *) + +const + targetswitchname : array[ttargetswitch] of string[30] = + { global target-specific switches } + ('Target None', {ts_none} + { generate code that results in smaller TOCs than normal (AIX) } + 'Small TOC', {ts_small_toc} + { for the JVM target: generate integer array initializations via string + constants in order to reduce the generated code size (Java routines + are limited to 64kb of bytecode) } + 'JVM compact int array init', {ts_compact_int_array_init} + { for the JVM target: intialize enum fields in constructors with the + enum class instance corresponding to ordinal value 0 (not done by + default because this initialization can only be performed after the + inherited constructors have run, and if they call a virtual method + of the current class, then this virtual method may already have + initialized that field with another value and the constructor + initialization will result in data loss } + 'JVM enum field init', {ts_jvm_enum_field_init} + { when automatically generating getters/setters for properties, use + these strings as prefixes for the generated getters/setter names } + 'Auto getter prefix', {ts_auto_getter_prefix} + 'Auto setter prefix', {ts_auto_setter_predix} + 'Thumb interworking', {ts_thumb_interworking,} + { lowercase the first character of routine names, used to generate + names that are compliant with Java coding standards from code + written according to Delphi coding standards } + 'LowerCase proc start', {ts_lowercase_proc_start,} + { initialise local variables on the JVM target so you won't get + accidental uses of uninitialised values } + 'Init locals', {ts_init_locals} + { emit a CLD instruction before using the x86 string instructions } + 'Emit CLD instruction', {ts_cld} + { increment BP before pushing it in the function prologue and decrement + it after popping it in the function epilogue, iff the function is + going to terminate with a far ret. Thus, the BP value pushed on the + stack becomes odd if the function is far and even if the function is + near. This allows walking the BP chain on the stack and e.g. + obtaining a stack trace even if the program uses a mixture of near + and far calls. This is also required for Win16 real mode, because it + allows Windows to move code segments around (in order to defragment + memory) and then walk through the stacks of all running programs and + update the segment values of the segment that has moved. } + 'Use odd BP for far procs' {ts_x86_far_procs_push_odd_bp} + ); + moduleswitchname : array[tmoduleswitch] of string[40] = + ('Module None', {cs_modulenone,} + { parser } + 'Floating Point Emulation',{ cs_fp_emulation} + 'Extended syntax', {cs_extsyntax} + 'Open string', {cs_openstring} + { support } + 'Goto allowed', {cs_support_goto} + 'Macro support', {cs_support_macro} + 'C operator support', {cs_support_c_operators} + { generation } + 'Profile', {cs_profile} + 'Debug information', {cs_debuginfo} + 'Compilation of System unit', {cs_compilesystem} + 'Line information', {cs_lineinfo} + 'Implicit exceptions', {cs_implicit_exceptions} + 'Explicit CodePage', {cs_explicit_codepage} + 'System CodePage', {cs_system_codepage} + { linking } + 'Create smart units', {cs_create_smart} + 'Create dynamic', {cs_create_dynamic} + 'Create PIC code', {cs_create_pic} + { browser switches are back } + 'Browser', {cs_browser} + 'Local Browser', {cs_local_browser} + { target specific } + 'Executable Stack', {cs_executable_stack} + { i8086 specific } + 'Hude code', {cs_huge_code} + 'Win16 smart callbacks', {cs_win16_smartcallbacks} + { Record usage of checkpointer experimental feature } + 'CheckPointer used' {cs_checkpointer_called} + ); + globalswitchname : array[tglobalswitch] of string[50] = + ('Global None',{cs_globalnone} + { parameter switches } + 'Check unit name', {cs_check_unit_name} + 'Constructor name', {cs_constructor_name} + 'Support exceptions',{cs_support_exceptions} + 'Support Objective-C pas',{ cs_support_c_objectivepas} + 'Transparent file names', {cs_transparent_file_names} + { units } + 'Load Objpas Unit', {cs_load_objpas_unit} + 'Load GPC unit', {cs_load_gpc_unit} + 'Load FPCKylix unit', {cs_load_fpcylix_unit} + 'Support Vectors', {cs_support_vectors} + { debuginfo } + 'Use HeapTRc unit', {cs_use_heaptrc} + 'Use line information', {cs_use_lineinfo} + 'Use GDB Valgrind', {cs_gdb_valgrind} + 'No regalloc', {cs_no_regalloc} + 'Stabs preserve cases', {cs_stabs_preservecase} + { assembling } + 'Leave assembler file', {cs_asm_leave} + 'Use external assembler', {cs_asm_extern} + 'Use pipes to call assembler', {cs_asm_pipe} + 'Add source infos into assembler files', {cs_asm_source} + 'Add register allocation into assembler files', {cs_asm_regalloc} + 'Add temporary allocation into assmebler files', {cs_asm_tempalloc} + 'Add node information into assembler files', {cs_asm_nodes} + 'Adapt assembler call to GNU version <= 2.25', {cs_asm_pre_binutils_2_25} + { linking } + 'Skip linking stage', {cs_link_nolink} + 'Link static', {cs_link_static} + 'Link smart', {cs_link_smart} + 'Link shared', {cs_link_shared} + 'Link deffile', {cs_link_deffile} + 'Strip after linking', {cs_link_strip} + 'Use linker static flag',{cs_link_staticflag} + 'Link on target OS',{cs_link_on_target} + 'Use external linker', {cs_link_extern} + 'Link opt vtable', {cs_link_opt_vtable} + 'Link opt used sections', {cs_link_opt_used_sections} + 'Link debug to separate file',{cs_link_separate_dbg_file} + 'Create linker map', {cs_link_map} + 'Link to pthread', {cs_link_pthread} + 'Link no default lib order', {cs_link_no_default_lib_order} + 'Link using native linker', {cs_link_native} + 'Link for GNU linker version <=2.19', {cs_link_pre_binutils_2_19} + 'Link using vlink' {cs_link_vlink} + ); + localswitchname : array[tlocalswitch] of string[50] = + { Switches which can be changed locally } + ('Local None', {cs_localnone} + { codegen } + 'Check overflow', {cs_check_overflow} + 'Check range', {cs_check_range} + 'Check object error', {cs_check_object} + 'Check I/O error', {cs_check_io} + 'Check stack', {cs_check_stack} + 'Check pointer', {cs_checkpointer} + 'Check ordinal size', {cs_check_ordinal_size} + 'Generate stackframes', {cs_generate_stackframes} + 'Do assertions', {cs_do_assertion} + 'Generate RTTI', {cs_generate_rtti} + 'Full boolean evaluaion', {cs_full_boolean_eval} + 'Typed constant are writable', {cs_typed_const_writable} + 'Allow calcuation on enum types', {cs_allow_enum_calc} + 'Do inline', {cs_do_inline} + 'Add FWAIT instruction for FPU 8087', {cs_fpu_fwait} + 'IEEE errors', {cs_ieee_errors} + 'Check low address loading', {cs_check_low_addr_load} + 'Imported data', {cs_imported_data} + 'Excess precision', {cs_excessprecision} + // 'Check fpu exceptions', {cs_check_fpu_exceptions} {not yet merged} + // 'Check all case coverage', {cs_check_all_case_coverage} {not yet merged} + { mmx } + 'Allow MMX instructions', {cs_mmx} + 'Use MMX saturation', {cs_mmx_saturation} + { parser } + 'Use typed addresses', {cs_typed_addresses} + 'Use strict var strings', {cs_strict_var_strings} + 'Use reference counted strings', {cs_refcountedstrings} + 'Use bit-packing', {cs_bitpacking} + 'Use var property setter', {cs_varpropsetter} + 'Use scoped enums',{cs_scopedenums} + 'Use pointer math', {cs_pointermath} + { macpas specific} + 'MACPAS exteranl variable', {cs_external_var} + 'MACPAS externally visible', {cs_externally_visible} + { jvm specific } + 'JVM check var copyout', {cs_check_var_copyout} + 'Zero based strings', {cs_zerobasedstrings} + { i8086 specific } + 'i8086 force FAR calls', {cs_force_far_calls} + 'i8086 huge pointer arithmetic', {cs_hugeptr_arithmetic_normalization} + 'i8086 huge pointer comparison' {cs_hugeptr_comparison_normalization} + ); + { Switches which can be changed by a mode (fpc,tp7,delphi) } + modeswitchname : array[tmodeswitch] of string[50] = + ('m_none', + { generic } + 'm_fpc','m_objfpc','m_delphi','m_tp7','m_mac','m_iso','m_extpas', + {$ifdef gpc_mode}'m_gpc',{$endif} + { more specific } + 'm_class', { delphi class model } + 'm_objpas', { load objpas unit } + 'm_result', { result in functions } + 'm_string_pchar', { pchar 2 string conversion } + 'm_cvar_support', { cvar variable directive } + 'm_nested_comment', { nested comments } + 'm_tp_procvar', { tp style procvars (no @ needed) } + 'm_mac_procvar', { macpas style procvars } + 'm_repeat_forward', { repeating forward declarations is needed } + 'm_pointer_2_procedure', { allows the assignement of pointers to + procedure variables } + 'm_autoderef', { does auto dereferencing of struct. vars } + 'm_initfinal', { initialization/finalization for units } + 'm_default_ansistring', { ansistring turned on by default } + 'm_out', { support the calling convention OUT } + 'm_default_para', { support default parameters } + 'm_hintdirective', { support hint directives } + 'm_duplicate_names', { allow locals/paras to have duplicate names of globals } + 'm_property', { allow properties } + 'm_default_inline', { allow inline proc directive } + 'm_except', { allow exception-related keywords } + 'm_objectivec1', { support interfacing with Objective-C (1.0) } + 'm_objectivec2', { support interfacing with Objective-C (2.0) } + 'm_nested_procvars', { support nested procedural variables } + 'm_non_local_goto', { support non local gotos (like iso pascal) } + 'm_advanced_records', { advanced record syntax with visibility sections, methods and properties } + 'm_isolike_unary_minus', { unary minus like in iso pascal: same precedence level as binary minus/plus } + 'm_systemcodepage', { use system codepage as compiler codepage by default, emit ansistrings with system codepage } + 'm_final_fields', { allows declaring fields as "final", which means they must be initialised + in the (class) constructor and are constant from then on (same as final + fields in Java) } + 'm_default_unicodestring', { makes the default string type in $h+ mode unicodestring rather than + ansistring; similarly, char becomes unicodechar rather than ansichar } + 'm_type_helpers', { allows the declaration of "type helper" for all supported types + (primitive types, records, classes, interfaces) } + 'm_blocks', { support for http://en.wikipedia.org/wiki/Blocks_(C_language_extension) } + 'm_isolike_io', { I/O as it required by an ISO compatible compiler } + 'm_isolike_program_para',{ program parameters as it required by an ISO compatible compiler } + 'm_isolike_mod', { mod operation as it is required by an iso compatible compiler } + 'm_array_operators' { use Delphi compatible array operators instead of custom ones ("+") } + // 'm_multi_helpers', { helpers can appear in multiple scopes simultaneously } {not yet merged} + // 'm_array2dynarray', { regular arrays can be implicitly converted to dynamic arrays } {not yet merged} + // 'm_prefixed_attributes' { enable attributes that are defined before the type they belong to } {not yet merged} + ); + { optimizer } + optimizerswitchname : array[toptimizerswitch] of string[50] = + ('cs_opt_none', + 'cs_opt_level1', + 'cs_opt_level2', + 'cs_opt_level3', + 'cs_opt_level4', + 'cs_opt_regvar', + 'cs_opt_uncertain', + 'cs_opt_size', + 'cs_opt_stackframe', + 'cs_opt_peephole', + 'cs_opt_loopunroll', + 'cs_opt_tailrecursion', + 'cs_opt_nodecse', + 'cs_opt_nodedfa', + 'cs_opt_loopstrength', + 'cs_opt_scheduler', + 'cs_opt_autoinline', + 'cs_useebp', + 'cs_userbp', + 'cs_opt_reorder_fields', + 'cs_opt_fastmath', + { Allow removing expressions whose result is not used, even when this + can change program behaviour (range check errors disappear', + access violations due to invalid pointer derefences disappear, ...). + Note: it does not (and must not) remove expressions that have + explicit side-effects, only implicit side-effects (like the ones + mentioned before) can disappear. + } + 'cs_opt_dead_values', + { compiler checks for empty procedures/methods and removes calls to them if possible } + 'cs_opt_remove_emtpy_proc', + 'cs_opt_constant_propagate', + 'cs_opt_dead_store_eliminate', + 'cs_opt_forcenostackframe', + 'cs_opt_use_load_modify_store' + ); + var + globalswitch : tglobalswitch; + targetswitch : ttargetswitch; + moduleswitch : tmoduleswitch; + localswitch : tlocalswitch; + modeswitch : tmodeswitch; + optimizerswitch : toptimizerswitch; + globalswitches : tglobalswitches; + targetswitches : ttargetswitches; + moduleswitches : tmoduleswitches; + localswitches : tlocalswitches; + modeswitches : tmodeswitches; + optimizerswitches : toptimizerswitches; + begin + {alignment : talignmentinfo;} + {talignmentinfo = packed record} + writeln('Procedure alignment: '+tostr(new_settings.alignment.procalign)); + writeln('Loop alignment: '+tostr(new_settings.alignment.loopalign)); + { alignment for labels after unconditional jumps, this must be a power of two } + writeln('Jump alignment: '+tostr(new_settings.alignment.jumpalign)); + { max. alignment for labels after unconditional jumps: + the compiler tries to align jumpalign, however, to do so it inserts at maximum jumpalignskipmax bytes or uses + the next smaller power of two of jumpalign } + // writeln('Jump skip max alignment: '+tostr(new_settings.alignment.jumpalignskipmax)); {not yet merged} + { alignment for labels where two flows of the program flow coalesce, this must be a power of two } + // writeln('Coalescence alignment: '+tostr(new_settings.alignment.coalescealign)); {not yet merged} + { max. alignment for labels where two flows of the program flow coalesce + the compiler tries to align to coalescealign, however, to do so it inserts at maximum coalescealignskipmax bytes or uses + the next smaller power of two of coalescealign } + // writeln('Coalescence skip max alignment: '+tostr(new_settings.alignment.coalescealignskipmax)); {not yet merged} + writeln('Const min alignment: '+tostr(new_settings.alignment.constalignmin)); + writeln('Const max alignment: '+tostr(new_settings.alignment.constalignmax)); + writeln('Var min alignment: '+tostr(new_settings.alignment.varalignmin)); + writeln('Var max alignment: '+tostr(new_settings.alignment.varalignmax)); + writeln('Local min alignment: '+tostr(new_settings.alignment.localalignmin)); + writeln('Local max alignment: '+tostr(new_settings.alignment.localalignmax)); + writeln('Min record alignment: '+tostr(new_settings.alignment.recordalignmin)); + writeln('Max record alignment: '+tostr(new_settings.alignment.recordalignmax)); + writeln('Max C record alignment: '+tostr(new_settings.alignment.maxCrecordalign)); + globalswitches:=new_settings.globalswitches; + for globalswitch:=low(tglobalswitch) to high(tglobalswitch) do + if globalswitch in globalswitches then + begin + writeln('global switch: '+globalswitchname[globalswitch]); + exclude(globalswitches,globalswitch); + end; + if (globalswitches <> []) then + writeln('Unknown global switch'); + targetswitches:=new_settings.targetswitches; + for targetswitch:=low(ttargetswitch) to high(ttargetswitch) do + if targetswitch in targetswitches then + begin + writeln('target switch: '+targetswitchname[targetswitch]); + exclude(targetswitches,targetswitch); + end; + if (targetswitches <> []) then + writeln('Unknown target switch'); + moduleswitches:=new_settings.moduleswitches; + for moduleswitch:=low(tmoduleswitch) to high(tmoduleswitch) do + if moduleswitch in moduleswitches then + begin + writeln('module switch: '+moduleswitchname[moduleswitch]); + exclude(moduleswitches,moduleswitch); + end; + if (moduleswitches <> []) then + writeln('Unknown module switch'); + localswitches:=new_settings.localswitches; + for localswitch:=low(tlocalswitch) to high(tlocalswitch) do + if localswitch in localswitches then + begin + writeln('local switch: '+localswitchname[localswitch]); + exclude(localswitches,localswitch); + end; + if (localswitches <> []) then + writeln('Unknown local switch'); + modeswitches:=new_settings.modeswitches; + for modeswitch:=low(tmodeswitch) to high(tmodeswitch) do + if modeswitch in modeswitches then + begin + writeln(['mode switch: ',modeswitchname[modeswitch]]); + exclude(modeswitches,modeswitch); + end; + if (modeswitches <> []) then + writeln('Unknown mode switch'); + optimizerswitches:=new_settings.optimizerswitches; + for optimizerswitch:=low(toptimizerswitch) to high(toptimizerswitch) do + if optimizerswitch in optimizerswitches then + begin + writeln(['optimizer switch: ',optimizerswitchname[optimizerswitch]]); + exclude(optimizerswitches,optimizerswitch); + end; + if (optimizerswitches <> []) then + writeln('Unknown optimizer switch'); + writeln(['Set allocation size ',new_settings.setalloc]); + writeln(['Pack enums ',new_settings.packenum]); + writeln(['Pack records ',new_settings.packrecords]); + writeln(['Max FPU registers ',new_settings.maxfpuregisters]); + + writeln(['CPU type ',new_settings.cputype]); + writeln(['CPU optimize type ',new_settings.optimizecputype]); + writeln(['FPU type ',new_settings.fputype]); + writeln(['ASM mode ',new_settings.asmmode]); + end; + +var + linestr,genstr : string; + token : ttoken; + copy_size, stbi, last_col, new_col : longint; + last_line,new_line : dword; + len : sizeint; + wstring : widestring; + astring : ansistring; +begin + tbi:=0; + last_line:=0; + last_col:=0; + linestr:=''; + genstr:=''; + fillchar(new_settings,sizeof(new_settings),#0); + fillchar(prev_settings,sizeof(prev_settings),#0); + write([space,' Tokens: ']); + while tbi_GENERICSPECIALTOKEN then + begin + if token <= high(ttoken) then + begin + write(arraytokeninfo[token].str); + if not (token in [_CWCHAR, _CWSTRING, _CSTRING, _CCHAR, + _INTCONST,_REALNUMBER, _ID]) then + StrAppend(linestr,lowercase(arraytokeninfo[token].str)); + end + else + begin + HasMoreInfos; + write('Error in Token List'); + break; + end; + {idtoken:=}readtoken; + end; + case token of + _CWCHAR, + _CWSTRING : + begin + len:=gettokenbufsizeint; + setlength(wstring,len); + move(tokenbuf[tbi],wstring[1],len*2); + write([' ''',wstring,'''']); + StrAppend(linestr,' '''); + StrAppend(linestr,wstring); + StrAppend(linestr,''''); + inc(tbi,len*2); + end; + _CSTRING: + begin + len:=gettokenbufsizeint; + setlength(astring,len); + if len>0 then + move(tokenbuf[tbi],astring[1],len); + write([' ''',astring,'''']); + StrAppend(linestr,' '''); + StrAppend(linestr,astring); + StrAppend(linestr,''''); + inc(tbi,len); + end; + _CCHAR: + begin + write([' ''',unaligned(pshortstring(@tokenbuf[tbi])^),'''']); + StrAppend(linestr,' '''); + StrAppend(linestr,unaligned(pshortstring(@tokenbuf[tbi])^)); + StrAppend(linestr,''''); + inc(tbi,tokenbuf[tbi]+1); + end; + _INTCONST, + _REALNUMBER : + begin + write([' ',unaligned(pshortstring(@tokenbuf[tbi])^)]); + StrAppend(linestr,unaligned(pshortstring(@tokenbuf[tbi])^)); + inc(tbi,tokenbuf[tbi]+1); + end; + _ID : + begin + write([' ',unaligned(pshortstring(@tokenbuf[tbi])^)]); + StrAppend(linestr,unaligned(pshortstring(@tokenbuf[tbi])^)); + inc(tbi,tokenbuf[tbi]+1); + end; + _GENERICSPECIALTOKEN: + begin + { Short version of column change, + byte or $80 used } + if (tokenbuf[tbi] and $80)<>0 then + begin + new_col:=tokenbuf[tbi] and $7f; + write(['Col: ',new_col]); + if length(linestr)0 then + begin + dump_new_settings; + writeln; + end + else + begin + writeln('Unchanged'); + end; + prev_settings:=new_settings; + end; + ST_LOADMESSAGES: + begin + inc(tbi); + mesgnb:=tokenbuf[tbi]; + writeln([space,mesgnb,' messages: ']); + inc(tbi); + for nb:=1 to mesgnb do + begin + msgvalue:=gettokenbufsizeint; + //inc(tbi,sizeof(sizeint)); + state:=tmsgstate(gettokenbufsizeint); + writeln(['#',msgvalue,' ',state]); + end; + end; + ST_LINE: + begin + inc(tbi); + new_line:=gettokenbufdword; + if (new_line<>last_line) then + begin + StrAppend(genstr,linestr+LineEnding); + linestr:=''; + end; + writeln(['Line: ',new_line]); + last_line:=new_line; + end; + ST_COLUMN: + begin + inc(tbi); + new_col:=gettokenbufword; + write(['Col: ',new_col]); + if length(linestr)0 then - begin - b2:=tokenbuf[tbi]; - inc(tbi); - result:=ttoken(((b and $7f) shl 8) or b2); - end - else - result:=ttoken(b); - end; - function gettokenbufdword : dword; - var - var32 : dword; - begin - var32:=unaligned(pdword(@tokenbuf[tbi])^); - inc(tbi,sizeof(dword)); - if ppufile.change_endian then - var32:=swapendian(var32); -{$ifdef FPC_BIG_ENDIAN} - { Tokens seems to be swapped to little endian in compiler code } - var32:=swapendian(var32); -{$endif} - result:=var32; - end; - - function gettokenbufword : word; - var - var16 : word; - begin - var16:=unaligned(pword(@tokenbuf[tbi])^); - inc(tbi,sizeof(word)); - if ppufile.change_endian then - var16:=swapendian(var16); -{$ifdef FPC_BIG_ENDIAN} - { Tokens seems to be swapped to little endian in compiler code } - var16:=swapendian(var16); -{$endif} - result:=var16; - end; - - - function gettokenbufsizeint : int64; - var - var64 : int64; - var32 : longint; - var16 : smallint; - - begin - if CpuAddrBitSize[cpu]=64 then - begin - var64:=unaligned(pint64(@tokenbuf[tbi])^); - inc(tbi,sizeof(int64)); - if ppufile.change_endian then - var64:=swapendian(var64); -{$ifdef FPC_BIG_ENDIAN} - { Tokens seems to be swapped to little endian in compiler code } - var64:=swapendian(var64); -{$endif} - result:=var64; - end - else if CpuAddrBitSize[cpu]=32 then - begin - var32:=unaligned(plongint(@tokenbuf[tbi])^); - inc(tbi,sizeof(longint)); - if ppufile.change_endian then - var32:=swapendian(var32); -{$ifdef FPC_BIG_ENDIAN} - { Tokens seems to be swapped to little endian in compiler code } - var32:=swapendian(var32); -{$endif} - result:=var32; - end - else if CpuAddrBitSize[cpu]=16 then - begin - var16:=unaligned(psmallint(@tokenbuf[tbi])^); - inc(tbi,sizeof(smallint)); - if ppufile.change_endian then - var16:=swapendian(var16); -{$ifdef FPC_BIG_ENDIAN} - { Tokens seems to be swapped to little endian in compiler code } - var16:=swapendian(var16); -{$endif} - result:=var16; - end - else - begin - WriteError('Wrong CpuAddrBitSize'); - result:=0; - end; - end; - begin i:=ppufile.getlongint; if Def <> nil then @@ -1792,118 +2758,7 @@ begin writeln([space,' Tokenbuffer size : ',tokenbufsize]); tokenbuf:=allocmem(tokenbufsize); ppufile.getdata(tokenbuf^,tokenbufsize); - tbi:=0; - write([space,' Tokens: ']); - while tbi_GENERICSPECIALTOKEN then - begin - if token <= high(ttoken) then - write(arraytokeninfo[token].str) - else - begin - HasMoreInfos; - write('Error in Token List'); - break; - end; - {idtoken:=}readtoken; - end; - case token of - _CWCHAR, - _CWSTRING : - begin - len:=gettokenbufsizeint; - setlength(wstring,len); - move(tokenbuf[tbi],wstring[1],len*2); - write([' ',wstring]); - inc(tbi,len*2); - end; - _CSTRING: - begin - len:=gettokenbufsizeint; - setlength(astring,len); - if len>0 then - move(tokenbuf[tbi],astring[1],len); - write([' ',astring]); - inc(tbi,len); - end; - _CCHAR, - _INTCONST, - _REALNUMBER : - begin - write([' ',unaligned(pshortstring(@tokenbuf[tbi])^)]); - inc(tbi,tokenbuf[tbi]+1); - end; - _ID : - begin - write([' ',unaligned(pshortstring(@tokenbuf[tbi])^)]); - inc(tbi,tokenbuf[tbi]+1); - end; - _GENERICSPECIALTOKEN: - begin - { Short version of column change, - byte or $80 used } - if (tokenbuf[tbi] and $80)<>0 then - begin - write(['Col: ',tokenbuf[tbi] and $7f]); - inc(tbi); - end - else - case tspecialgenerictoken(tokenbuf[tbi]) of - ST_LOADSETTINGS: - begin - inc(tbi); - write('Settings'); - { This does not load pmessage pointer } - new_settings.pmessage:=nil; - { TSettings size depends in target... - We first read the size of the copied part } - { Still not cross endian ready :( } - copy_size:=gettokenbufsizeint; - if copy_size < sizeof(tsettings)-sizeof(pointer) then - min_size:=copy_size - else - min_size:= sizeof(tsettings)-sizeof(pointer); - move(tokenbuf[tbi],new_settings, min_size); - inc(tbi,copy_size); - end; - ST_LOADMESSAGES: - begin - inc(tbi); - write('Messages:'); - mesgnb:=tokenbuf[tbi]; - inc(tbi); - for nb:=1 to mesgnb do - begin - {msgvalue:=}gettokenbufsizeint; - inc(tbi,sizeof(sizeint)); - //state:=tmsgstate(gettokenbufsizeint); - end; - end; - ST_LINE: - begin - inc(tbi); - write(['Line: ',gettokenbufdword]); - end; - ST_COLUMN: - begin - inc(tbi); - write(['Col: ',gettokenbufword]); - end; - ST_FILEINDEX: - begin - inc(tbi); - write(['File: ',gettokenbufword]); - end; - end; - end; - end; - - if tbi0 then begin - write ([space,' Declaration token buffer : TODO']); + space:=space + ' '; + write ([space,'Declaration token buffer : size = ',tokenbufsize]); tokenbuf:=allocmem(tokenbufsize); ppufile.getdata(tokenbuf^,tokenbufsize); + displaytokenbuffer(tokenbuf,tokenbufsize); freemem(tokenbuf); + delete(space,1,4); end; if po_syscall_has_libsym in procoptions then begin @@ -3289,7 +4152,9 @@ begin readsymtable('parast', TPpuProcDef(def)); { localst } if (pio_has_inlininginfo in implprocoptions) then - readsymtable('localst'); + readsymtable('inline localst'); + //else if (df_generic in defoptions) then + // readsymtable('generic localst'); { not yet merged } if (pio_has_inlininginfo in implprocoptions) then readnodetree; delete(space,1,4); @@ -3389,8 +4254,7 @@ begin if not(df_copied_def in current_defoptions) then begin space:=' '+space; - readrecsymtableoptions; - readsymtable('fields',TPpuRecordDef(def)); + readrecordsymtable('fields',TPpuRecordDef(def)); Delete(space,1,4); end; if not EndOfEntry then @@ -3509,8 +4373,7 @@ begin begin {read the record definitions and symbols} space:=' '+space; - readrecsymtableoptions; - readsymtable('fields',objdef); + readrecordsymtable('fields',objdef); Delete(space,1,4); end; if not EndOfEntry then @@ -3895,7 +4758,7 @@ begin { fix filename } if pos('.',filename)=0 then filename:=filename+'.ppu'; - ppufile:=tppufile.create(filename); + ppufile:=tppudumpfile.create(filename); if not ppufile.openfile then begin WriteError('IO-Error when opening : '+filename+', Skipping'); diff --git a/compiler/x86_64/cpuinfo.pas b/compiler/x86_64/cpuinfo.pas index c8aed365a2..08697e08fa 100644 --- a/compiler/x86_64/cpuinfo.pas +++ b/compiler/x86_64/cpuinfo.pas @@ -79,7 +79,7 @@ Type Const { Is there support for dealing with multiple microcontrollers available } { for this platform? } - ControllerSupport = true; + ControllerSupport = false; { Size of native extended type } extended_size = 10; { target cpu string (used by compiler options) }