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) }