From bfd72ad5d5746c6370dcddbe11e4849e5df94c34 Mon Sep 17 00:00:00 2001 From: peter Date: Fri, 15 Nov 2002 01:58:45 +0000 Subject: [PATCH] * merged changes from 1.0.7 up to 04-11 - -V option for generating bug report tracing - more tracing for option parsing - errors for cdecl and high() - win32 import stabs - win32 records<=8 are returned in eax:edx (turned off by default) - heaptrc update - more info for temp management in .s file with EXTDEBUG --- compiler/aasmbase.pas | 32 +- compiler/aasmtai.pas | 122 +++- compiler/aggas.pas | 34 +- compiler/assemble.pas | 26 +- compiler/cgobj.pas | 28 +- compiler/comphook.pas | 50 +- compiler/defbase.pas | 40 +- compiler/finput.pas | 23 +- compiler/fppu.pas | 14 +- compiler/globals.pas | 66 +- compiler/i386/aasmcpu.pas | 18 +- compiler/i386/ag386int.pas | 40 +- compiler/i386/ag386nsm.pas | 26 +- compiler/i386/cpupara.pas | 40 +- compiler/i386/n386add.pas | 14 +- compiler/i386/n386cal.pas | 117 +-- compiler/i386/n386opt.pas | 16 +- compiler/i386/ra386.pas | 33 +- compiler/i386/ra386att.pas | 13 +- compiler/i386/ra386int.pas | 13 +- compiler/import.pas | 21 +- compiler/link.pas | 24 +- compiler/msg/errore.msg | 65 +- compiler/msgidx.inc | 27 +- compiler/msgtxt.inc | 368 +++++----- compiler/nadd.pas | 37 +- compiler/ncal.pas | 42 +- compiler/ncgbas.pas | 26 +- compiler/ncgcal.pas | 246 ++++--- compiler/ncgld.pas | 36 +- compiler/ncgmem.pas | 32 +- compiler/ncgutil.pas | 39 +- compiler/ninl.pas | 17 +- compiler/nld.pas | 27 +- compiler/nobj.pas | 25 +- compiler/options.pas | 1300 ++++++++++++++++++++-------------- compiler/pdecsub.pas | 111 ++- compiler/pdecvar.pas | 23 +- compiler/pmodules.pas | 40 +- compiler/pp.pas | 15 +- compiler/ppheap.pas | 87 ++- compiler/ppu.pas | 14 +- compiler/psub.pas | 36 +- compiler/script.pas | 53 +- compiler/symdef.pas | 88 ++- compiler/symtable.pas | 43 +- compiler/systems/t_linux.pas | 32 +- compiler/systems/t_win32.pas | 109 ++- compiler/tgobj.pas | 38 +- compiler/verbose.pas | 51 +- 50 files changed, 2613 insertions(+), 1224 deletions(-) diff --git a/compiler/aasmbase.pas b/compiler/aasmbase.pas index 5a1bdf413c..86f7ad5c50 100644 --- a/compiler/aasmbase.pas +++ b/compiler/aasmbase.pas @@ -57,13 +57,16 @@ interface { this need to be incremented with every symbol loading into the paasmoutput, thus in loadsym/loadref/const_symbol (PFV) } refs : longint; - {# Alternate symbol which can be used for 'renaming' needed for + { Alternate symbol which can be used for 'renaming' needed for inlining } altsymbol : tasmsymbol; + { pointer to objectdata that is the owner of this symbol } objectdata : pointer; - {# TRUE if the symbol is local for a procedure/function } + { pointer to the tai that is the owner of this symbol } + taiowner : pointer; + { TRUE if the symbol is local for a procedure/function } proclocal : boolean; - {# Is the symbol in the used list } + { Is the symbol in the used list } inusedlist : boolean; { assembler pass label is set, used for detecting multiple labels } pass : byte; @@ -254,6 +257,8 @@ implementation pass:=255; currbind:=AB_EXTERNAL; proclocal:=false; + altsymbol:=nil; + taiowner:=nil; end; function tasmsymbol.is_used:boolean; @@ -749,11 +754,9 @@ implementation if not assigned(p.altsymbol) then begin p.altsymbol:=tasmsymbol.create(name+'_'+tostr(nextaltnr),p.defbind,p.typ); - { also copy the amount of references } - p.altsymbol.refs:=p.refs; - inc(nextaltnr); - { add to the usedasmsymbollist, that list is used to reset the - altsymbol } + symbolsearch.insert(p.altsymbol); + { add also the original sym to the usedasmsymbollist, + that list is used to reset the altsymbol } if not p.inusedlist then usedasmsymbollist.insert(p); p.inusedlist:=true; @@ -783,6 +786,7 @@ implementation hp : tasmsymbol; begin hp:=tasmsymbol(usedasmsymbollist.first); + inc(nextaltnr); while assigned(hp) do begin with hp do @@ -863,7 +867,17 @@ implementation end. { $Log$ - Revision 1.9 2002-10-05 12:43:23 carl + Revision 1.10 2002-11-15 01:58:45 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.9 2002/10/05 12:43:23 carl * fixes for Delphi 6 compilation (warning : Some features do not work under Delphi) diff --git a/compiler/aasmtai.pas b/compiler/aasmtai.pas index 011a0ceea0..8b7642ecab 100644 --- a/compiler/aasmtai.pas +++ b/compiler/aasmtai.pas @@ -164,13 +164,15 @@ interface {$ifndef NOOPT} { pointer to record with optimizer info about this tai object } optinfo : pointer; -{$endif} +{$endif NOOPT} fileinfo : tfileposinfo; typ : taitype; constructor Create; constructor ppuload(t:taitype;ppufile:tcompilerppufile);virtual; procedure ppuwrite(ppufile:tcompilerppufile);virtual; procedure derefimpl;virtual; + { helper for checking symbol redefines } + procedure checkredefinesym(sym:tasmsymbol); end; taiclass = class of tai; @@ -188,6 +190,7 @@ interface destructor Destroy;override; constructor ppuload(t:taitype;ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override; + function getcopy:tlinkedlistitem;override; end; { Generates a common label } @@ -231,6 +234,7 @@ interface destructor Destroy; override; constructor ppuload(t:taitype;ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override; + function getcopy:tlinkedlistitem;override; end; { Generates an assembler comment } @@ -240,6 +244,7 @@ interface destructor Destroy; override; constructor ppuload(t:taitype;ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override; + function getcopy:tlinkedlistitem;override; end; @@ -287,6 +292,7 @@ interface constructor ppuload(t:taitype;ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override; procedure derefimpl;override; + function getcopy:tlinkedlistitem;override; end; { Generates a single float (32 bit real) } @@ -345,10 +351,16 @@ interface tai_tempalloc = class(tai) allocation : boolean; +{$ifdef EXTDEBUG} + problem : pstring; +{$endif EXTDEBUG} temppos, tempsize : longint; constructor alloc(pos,size:longint); constructor dealloc(pos,size:longint); +{$ifdef EXTDEBUG} + constructor allocinfo(pos,size:longint;const st:string); +{$endif EXTDEBUG} constructor ppuload(t:taitype;ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override; end; @@ -503,7 +515,7 @@ uses fileinfo:=aktfilepos; {$ifndef NOOPT} optinfo:=nil; -{$endif} +{$endif NOOPT} end; @@ -528,6 +540,18 @@ uses end; + procedure tai.checkredefinesym(sym:tasmsymbol); + begin + if assigned(sym.taiowner) then + begin + Message1(asmw_e_redefined_label,sym.name); + MessagePos(tai(sym.taiowner).fileinfo,asmw_e_first_defined_label); + end + else + sym.taiowner:=self; + end; + + {**************************************************************************** TAI_SECTION ****************************************************************************} @@ -564,6 +588,7 @@ uses inherited Create; typ:=ait_datablock; sym:=objectlibrary.newasmsymboltype(_name,AB_LOCAL,AT_DATA); + checkredefinesym(sym); { keep things aligned } if _size<=0 then _size:=4; @@ -577,6 +602,7 @@ uses inherited Create; typ:=ait_datablock; sym:=objectlibrary.newasmsymboltype(_name,AB_GLOBAL,AT_DATA); + checkredefinesym(sym); { keep things aligned } if _size<=0 then _size:=4; @@ -618,6 +644,7 @@ uses inherited Create; typ:=ait_symbol; sym:=_sym; + checkredefinesym(sym); size:=siz; is_global:=(sym.defbind=AB_GLOBAL); end; @@ -627,6 +654,7 @@ uses inherited Create; typ:=ait_symbol; sym:=objectlibrary.newasmsymboltype(_name,AB_LOCAL,AT_FUNCTION); + checkredefinesym(sym); size:=siz; is_global:=false; end; @@ -636,6 +664,7 @@ uses inherited Create; typ:=ait_symbol; sym:=objectlibrary.newasmsymboltype(_name,AB_GLOBAL,AT_FUNCTION); + checkredefinesym(sym); size:=siz; is_global:=true; end; @@ -645,6 +674,7 @@ uses inherited Create; typ:=ait_symbol; sym:=objectlibrary.newasmsymboltype(_name,AB_LOCAL,AT_DATA); + checkredefinesym(sym); size:=siz; is_global:=false; end; @@ -654,6 +684,7 @@ uses inherited Create; typ:=ait_symbol; sym:=objectlibrary.newasmsymboltype(_name,AB_GLOBAL,AT_DATA); + checkredefinesym(sym); size:=siz; is_global:=true; end; @@ -851,6 +882,13 @@ uses end; + function tai_const_symbol.getcopy:tlinkedlistitem; + begin + getcopy:=inherited getcopy; + { we need to increase the reference number } + inc(sym.refs); + end; + {**************************************************************************** TAI_real_32bit @@ -1019,6 +1057,17 @@ uses end; + function tai_string.getcopy : tlinkedlistitem; + var + p : tlinkedlistitem; + begin + p:=inherited getcopy; + getmem(tai_string(p).str,len+1); + move(str^,tai_string(p).str^,len+1); + getcopy:=p; + end; + + {**************************************************************************** TAI_LABEL ****************************************************************************} @@ -1028,6 +1077,7 @@ uses inherited Create; typ:=ait_label; l:=_l; + checkredefinesym(l); l.is_set:=true; is_global:=(l.defbind=AB_GLOBAL); end; @@ -1098,6 +1148,17 @@ uses end; + function tai_direct.getcopy : tlinkedlistitem; + var + p : tlinkedlistitem; + begin + p:=inherited getcopy; + getmem(tai_direct(p).str,strlen(str)+1); + move(str^,tai_direct(p).str^,strlen(str)+1); + getcopy:=p; + end; + + {**************************************************************************** tai_comment comment to be inserted in the assembler file ****************************************************************************} @@ -1140,6 +1201,17 @@ uses end; + function tai_comment.getcopy : tlinkedlistitem; + var + p : tlinkedlistitem; + begin + p:=inherited getcopy; + getmem(tai_comment(p).str,strlen(str)+1); + move(str^,tai_comment(p).str^,strlen(str)+1); + getcopy:=p; + end; + + {**************************************************************************** TAI_CUT ****************************************************************************} @@ -1186,12 +1258,12 @@ uses Tai_Marker ****************************************************************************} - Constructor Tai_Marker.Create(_Kind: TMarker); - Begin - Inherited Create; - typ := ait_marker; - Kind := _Kind; - End; + constructor Tai_Marker.Create(_Kind: TMarker); + begin + Inherited Create; + typ := ait_marker; + Kind := _Kind; + end; constructor Tai_Marker.ppuload(t:taitype;ppufile:tcompilerppufile); @@ -1219,6 +1291,9 @@ uses allocation:=true; temppos:=pos; tempsize:=size; +{$ifdef EXTDEBUG} + problem:=nil; +{$endif EXTDEBUG} end; @@ -1229,15 +1304,34 @@ uses allocation:=false; temppos:=pos; tempsize:=size; +{$ifdef EXTDEBUG} + problem:=nil; +{$endif EXTDEBUG} end; +{$ifdef EXTDEBUG} + constructor tai_tempalloc.allocinfo(pos,size:longint;const st:string); + begin + inherited Create; + typ:=ait_tempalloc; + allocation:=false; + temppos:=pos; + tempsize:=size; + problem:=stringdup(st); + end; +{$endif EXTDEBUG} + + constructor tai_tempalloc.ppuload(t:taitype;ppufile:tcompilerppufile); begin inherited ppuload(t,ppufile); temppos:=ppufile.getlongint; tempsize:=ppufile.getlongint; allocation:=boolean(ppufile.getbyte); +{$ifdef EXTDEBUG} + problem:=nil; +{$endif EXTDEBUG} end; @@ -1554,7 +1648,17 @@ uses end. { $Log$ - Revision 1.10 2002-11-09 15:38:03 carl + Revision 1.11 2002-11-15 01:58:45 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.10 2002/11/09 15:38:03 carl + NOOPT removed the optinfo field Revision 1.9 2002/10/05 12:43:23 carl diff --git a/compiler/aggas.pas b/compiler/aggas.pas index 3577937634..39272e1662 100644 --- a/compiler/aggas.pas +++ b/compiler/aggas.pas @@ -248,11 +248,11 @@ var if (infile.path^<>'') then begin AsmWriteLn(#9'.stabs "'+lower(BsToSlash(FixPath(infile.path^,false)))+'",'+ - tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount)); + tostr(curr_n)+',0,0,'+target_asm.labelprefix+'text'+ToStr(IncludeCount)); end; AsmWriteLn(#9'.stabs "'+lower(FixFileName(infile.name^))+'",'+ - tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount)); - AsmWriteLn('Ltext'+ToStr(IncludeCount)+':'); + tostr(curr_n)+',0,0,'+target_asm.labelprefix+'text'+ToStr(IncludeCount)); + AsmWriteLn(target_asm.labelprefix+'text'+ToStr(IncludeCount)+':'); inc(includecount); { force new line info } stabslastfileinfo.line:=-1; @@ -285,8 +285,8 @@ var exit; AsmLn; AsmWriteLn(ait_section2str(sec_code)); - AsmWriteLn(#9'.stabs "",'+tostr(n_sourcefile)+',0,0,Letext'); - AsmWriteLn('Letext:'); + AsmWriteLn(#9'.stabs "",'+tostr(n_sourcefile)+',0,0,'+target_asm.labelprefix+'etext'); + AsmWriteLn(target_asm.labelprefix+'etext:'); end; {$endif GDB} @@ -408,8 +408,16 @@ var ait_tempalloc : begin if (cs_asm_tempalloc in aktglobalswitches) then - AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+ - tostr(tai_tempalloc(hp).tempsize)+allocstr[tai_tempalloc(hp).allocation]); + begin +{$ifdef EXTDEBUG} + if assigned(tai_tempalloc(hp).problem) then + AsmWriteLn(target_asm.comment+tai_tempalloc(hp).problem^+' ('+tostr(tai_tempalloc(hp).temppos)+','+ + tostr(tai_tempalloc(hp).tempsize)+')') + else +{$endif EXTDEBUG} + AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+ + tostr(tai_tempalloc(hp).tempsize)+allocstr[tai_tempalloc(hp).allocation]); + end; end; ait_align : @@ -811,7 +819,17 @@ var end. { $Log$ - Revision 1.14 2002-10-30 21:01:14 peter + Revision 1.15 2002-11-15 01:58:45 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.14 2002/10/30 21:01:14 peter * always include lineno after fileswitch. valgrind requires this Revision 1.13 2002/10/05 12:43:23 carl diff --git a/compiler/assemble.pas b/compiler/assemble.pas index a7c27e5392..818ed2b6df 100644 --- a/compiler/assemble.pas +++ b/compiler/assemble.pas @@ -414,6 +414,12 @@ Implementation Message1(exec_i_assembling,name); end; s:=target_asm.asmcmd; +{$ifdef m68k} + if aktoptprocessor = MC68020 then + s:='-m68020 '+s + else + s:='-m68000 '+s; +{$endif} if (cs_link_on_target in aktglobalswitches) then begin Replace(s,'$ASM',ScriptFixFileName(AsmFile)); @@ -507,14 +513,14 @@ Implementation begin if SmartAsm then NextSmartName(Aplace); - {$ifdef unix} +{$ifdef unix} if DoPipe then begin Message1(exec_i_assembling_pipe,asmfile); POpen(outfile,'as -o '+objfile,'W'); end else - {$endif} +{$endif} begin Assign(outfile,asmfile); {$I-} @@ -535,11 +541,11 @@ Implementation l : longint; begin AsmFlush; - {$ifdef unix} +{$ifdef unix} if DoPipe then PClose(outfile) else - {$endif} +{$endif} begin {Touch Assembler time to ppu time is there is a ppufilename} if ppufilename<>'' then @@ -1615,7 +1621,17 @@ Implementation end. { $Log$ - Revision 1.45 2002-10-30 21:01:14 peter + Revision 1.46 2002-11-15 01:58:46 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.45 2002/10/30 21:01:14 peter * always include lineno after fileswitch. valgrind requires this Revision 1.44 2002/09/05 19:29:42 peter diff --git a/compiler/cgobj.pas b/compiler/cgobj.pas index eaa22cebcb..4e693185ba 100644 --- a/compiler/cgobj.pas +++ b/compiler/cgobj.pas @@ -298,6 +298,7 @@ unit cgobj; procedure g_maybe_loadself(list : taasmoutput);virtual; + procedure g_maybe_testself(list : taasmoutput);virtual; {# This should emit the opcode to copy len bytes from the source to destination, if loadref is true, it assumes that it first must load the source address from the memory location where @@ -1397,10 +1398,25 @@ unit cgobj; end; + procedure tcg.g_maybe_testself(list : taasmoutput); + var + OKLabel : tasmlabel; + begin + if (cs_check_object in aktlocalswitches) or + (cs_check_range in aktlocalswitches) then + begin + objectlibrary.getlabel(oklabel); + a_cmp_const_reg_label(list,OS_ADDR,OC_NE,0,SELF_POINTER_REG,oklabel); + a_call_name(list,'FPC_RANGEERROR'); + a_label(list,oklabel); + end; + end; + {***************************************************************************** Entry/Exit Code Functions *****************************************************************************} + procedure tcg.g_call_constructor_helper(list : taasmoutput); var href : treference; @@ -1604,7 +1620,17 @@ finalization end. { $Log$ - Revision 1.62 2002-10-16 19:01:43 peter + Revision 1.63 2002-11-15 01:58:46 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.62 2002/10/16 19:01:43 peter + $IMPLICITEXCEPTIONS switch to turn on/off generation of the implicit exception frames for procedures with initialized variables and for constructors. The default is on for compatibility diff --git a/compiler/comphook.pas b/compiler/comphook.pas index 6fac4171dc..e63caba972 100644 --- a/compiler/comphook.pas +++ b/compiler/comphook.pas @@ -85,10 +85,13 @@ type skip_error, use_stderr, use_redir, + use_bugreport, use_gccoutput, compiling_current : boolean; { Redirection support } redirfile : text; + { Special file for bug report } + reportbugfile : text; end; var status : tcompilerstatus; @@ -292,20 +295,33 @@ begin else hs:=s; end; + { only show when the level is required } + if ((status.verbosity and Level)=Level) then + begin {$ifdef FPC} - if status.use_stderr then - begin - writeln(stderr,hs); - flush(stderr); - end - else -{$endif} - begin - if status.use_redir then - writeln(status.redirfile,hs) + if status.use_stderr then + begin + writeln(stderr,hs); + flush(stderr); + end else - writeln(hs); +{$endif} + begin + if status.use_redir then + writeln(status.redirfile,hs) + else + writeln(hs); + end; end; + { include everything in the bugreport file } + if status.use_bugreport then + begin +{$ifdef FPC} + Write(status.reportbugfile,hexstr(level,8)+':'); + Writeln(status.reportbugfile,hs); +{$endif} + end; + {$ifdef DEBUG} def_gdb_stop(level); {$endif DEBUG} @@ -356,7 +372,17 @@ end; end. { $Log$ - Revision 1.20 2002-09-05 19:29:42 peter + Revision 1.21 2002-11-15 01:58:46 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.20 2002/09/05 19:29:42 peter * memdebug enhancements Revision 1.19 2002/05/18 13:34:06 peter diff --git a/compiler/defbase.pas b/compiler/defbase.pas index 5962da52dd..d8beb14a51 100644 --- a/compiler/defbase.pas +++ b/compiler/defbase.pas @@ -234,7 +234,7 @@ interface { if acp is cp_all the var const or nothing are considered equal } type - compare_type = ( cp_none, cp_value_equal_const, cp_all); + compare_type = ( cp_none, cp_value_equal_const, cp_all,cp_procvar); {# true, if two parameter lists are equal if acp is cp_none, all have to match exactly @@ -283,7 +283,7 @@ interface implementation uses - globtype,tokens,verbose, + globtype,tokens,systems,verbose, symtable; @@ -338,8 +338,6 @@ implementation end; - { compare_type = ( cp_none, cp_value_equal_const, cp_all); } - function equal_paras(paralist1,paralist2 : TLinkedList; acp : compare_type;allowdefaults:boolean) : boolean; var def1,def2 : TParaItem; @@ -364,7 +362,7 @@ implementation exit; end; end; - cp_all : + cp_all,cp_procvar : begin if not(is_equal(def1.paratype.def,def2.paratype.def)) or (def1.paratyp<>def2.paratyp) then @@ -413,6 +411,7 @@ implementation def1,def2 : TParaItem; doconv : tconverttype; p : pointer; + b : byte; begin def1:=TParaItem(paralist1.first); def2:=TParaItem(paralist2.first); @@ -435,12 +434,26 @@ implementation cp_all : begin if (isconvertable(def1.paratype.def,def2.paratype.def,doconv,callparan,false)=0) or - (def1.paratyp<>def2.paratyp) then + (def1.paratyp<>def2.paratyp) then begin convertable_paras:=false; exit; end; end; + cp_procvar : + begin + b:=isconvertable(def1.paratype.def,def2.paratype.def,doconv,callparan,false); + if (b=0) or + not(doconv in [tc_equal,tc_int_2_int]) or + (def1.paratyp<>def2.paratyp) or + (not is_special_array(def1.paratype.def) and + not is_special_array(def2.paratype.def) and + (def1.paratype.def.size<>def2.paratype.def.size)) then + begin + convertable_paras:=false; + exit; + end; + end; cp_none : begin if (isconvertable(def1.paratype.def,def2.paratype.def,doconv,callparan,false)=0) then @@ -491,7 +504,8 @@ implementation { check return value and para's and options, methodpointer is already checked parameters may also be convertable } if is_equal(def1.rettype.def,def2.rettype.def) and - (equal_paras(def1.para,def2.para,cp_all,false) or + (def1.para_size(target_info.alignment.paraalign)=def2.para_size(target_info.alignment.paraalign)) and + (equal_paras(def1.para,def2.para,cp_procvar,false) or ((not exact) and convertable_paras(def1.para,def2.para,cp_all))) and ((po_comp * def1.procoptions)= (po_comp * def2.procoptions)) then proc_to_procvar_equal:=true @@ -2026,7 +2040,17 @@ implementation end. { $Log$ - Revision 1.23 2002-10-20 15:34:16 peter + Revision 1.24 2002-11-15 01:58:46 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.23 2002/10/20 15:34:16 peter * removed df_unique flag. It breaks code. For a good type=type a def copy is required diff --git a/compiler/finput.pas b/compiler/finput.pas index 3b03b28010..90895b45b6 100644 --- a/compiler/finput.pas +++ b/compiler/finput.pas @@ -148,9 +148,10 @@ uses {$else Delphi} dos, {$endif Delphi} -{$ifdef HEAPTRC} +{$ifdef heaptrc} fmodule, -{$endif HEAPTRC} + ppheap, +{$endif heaptrc} globals,systems ; @@ -512,9 +513,9 @@ uses { update cache } cacheindex:=last_ref_index; cacheinputfile:=f; -{$ifdef HEAPTRC} - writeln(stderr,f.name^,' index ',current_module.unit_index*100000+f.ref_index); -{$endif HEAPTRC} +{$ifdef heaptrc} + ppheap_register_file(f.name^,current_module.unit_index*100000+f.ref_index); +{$endif heaptrc} end; @@ -686,7 +687,17 @@ uses end. { $Log$ - Revision 1.19 2002-10-20 14:49:31 peter + Revision 1.20 2002-11-15 01:58:46 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.19 2002/10/20 14:49:31 peter * store original source time in ppu so it can be compared instead of comparing with the ppu time diff --git a/compiler/fppu.pas b/compiler/fppu.pas index 13103c5523..8ff955950f 100644 --- a/compiler/fppu.pas +++ b/compiler/fppu.pas @@ -538,7 +538,7 @@ uses else { not assigned } if was_defined_at_startup and was_used then - Message2(unit_h_cond_not_set_in_last_compile,hs,mainsource^); + Message2(unit_h_cond_set_in_last_compile,hs,mainsource^); end; end; @@ -1319,7 +1319,17 @@ uses end. { $Log$ - Revision 1.25 2002-10-20 14:49:31 peter + Revision 1.26 2002-11-15 01:58:46 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.25 2002/10/20 14:49:31 peter * store original source time in ppu so it can be compared instead of comparing with the ppu time diff --git a/compiler/globals.pas b/compiler/globals.pas index b968ec93d3..b2adc6d4d3 100644 --- a/compiler/globals.pas +++ b/compiler/globals.pas @@ -200,9 +200,6 @@ interface stacksize : longint; {$Ifdef EXTDEBUG} - {$ifdef FPC} - EntryMemUsed : longint; - {$endif FPC} { parameter switches } debugstop : boolean; {$EndIf EXTDEBUG} @@ -287,11 +284,11 @@ interface procedure swap_qword(var q : qword); function UpdateAlignmentStr(s:string;var a:talignmentinfo):boolean; - - {# Routine to get the required alignment for size of data, which will + + {# Routine to get the required alignment for size of data, which will be placed in bss segment, according to the current alignment requirements } function var_align(siz: longint): longint; - {# Routine to get the required alignment for size of data, which will + {# Routine to get the required alignment for size of data, which will be placed in data/const segment, according to the current alignment requirements } function const_align(siz: longint): longint; @@ -307,6 +304,13 @@ implementation end; + procedure WarnNonExistingPath(const path : string); + begin + if assigned({$ifndef FPCPROCVAR}@{$endif}do_comment) then + do_comment(V_Hint,'Path "'+path+'" not found'); + end; + + function bstoslash(const s : string) : string; { return string s with all \ changed into / @@ -451,18 +455,27 @@ implementation Function FileExists ( Const F : String) : Boolean; -{$ifndef delphi} Var + res : boolean; +{$ifndef delphi} Info : SearchRec; {$endif} begin {$ifdef delphi} - FileExists:=sysutils.FileExists(f); + res:=sysutils.FileExists(f); {$else} findfirst(F,readonly+archive+hidden,info); - FileExists:=(doserror=0); + res:=(doserror=0); findclose(Info); {$endif delphi} + if assigned({$ifndef FPCPROVCAR}@{$endif}do_comment) then + begin + if res then + do_comment(V_Tried,'Searching file '+F+'... found') + else + do_comment(V_Tried,'Searching file '+F+'... not found'); + end; + FileExists:=res; end; @@ -737,6 +750,7 @@ implementation hs,hsd, CurrentDir, CurrPath : string; + subdirfound : boolean; dir : searchrec; hp : TStringListItem; @@ -802,25 +816,31 @@ implementation hs:=currpath; hsd:=SplitPath(hs); findfirst(hs,directory,dir); + subdirfound:=false; while doserror=0 do begin if (dir.name<>'.') and (dir.name<>'..') and ((dir.attr and directory)<>0) then begin + subdirfound:=true; currpath:=hsd+dir.name+source_info.dirsep; hp:=Find(currPath); if not assigned(hp) then AddCurrPath; end; findnext(dir); + if not subdirfound then + WarnNonExistingPath(currpath); end; FindClose(dir); end else begin if PathExists(currpath) then - addcurrpath; + addcurrpath + else + WarnNonExistingPath(currpath); end; until (s=''); end; @@ -1328,14 +1348,14 @@ implementation until false; UpdateAlignment(a,b); end; - - + + function var_align(siz: longint): longint; begin siz := size_2_align(siz); var_align := used_align(siz,aktalignment.varalignmin,aktalignment.varalignmax); end; - + function const_align(siz: longint): longint; begin siz := size_2_align(siz); @@ -1454,7 +1474,7 @@ implementation initasmmode:=asmmode_i386_att; {$endif i386} {$ifdef m68k} - initoptprocessor:=MC68000; + initoptprocessor:=MC68020; include(initmoduleswitches,cs_fp_emulation); initpackenum:=4; {$IFDEF testvarsets} @@ -1489,16 +1509,20 @@ implementation have_local_threadvars := false; end; -{$ifdef EXTDEBUG} -begin - {$ifdef FPC} - EntryMemUsed:=system.HeapSize-MemAvail; - {$endif FPC} -{$endif} end. { $Log$ - Revision 1.68 2002-11-09 15:38:39 carl + Revision 1.69 2002-11-15 01:58:47 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.68 2002/11/09 15:38:39 carl + added var_align/const_align routines Revision 1.67 2002/10/16 19:01:43 peter diff --git a/compiler/i386/aasmcpu.pas b/compiler/i386/aasmcpu.pas index aae14650cf..e0c2a3950e 100644 --- a/compiler/i386/aasmcpu.pas +++ b/compiler/i386/aasmcpu.pas @@ -759,11 +759,11 @@ implementation end; - { This check must be done with the operand in ATT order - i.e.after swapping in the intel reader - but before swapping in the NASM and TASM writers PM } procedure taicpu.CheckNonCommutativeOpcodes; begin + { we need ATT order } + SetOperandOrder(op_att); + if ((ops=2) and (oper[0].typ=top_reg) and (oper[1].typ=top_reg) and @@ -1874,7 +1874,17 @@ implementation end. { $Log$ - Revision 1.6 2002-10-31 13:28:32 pierre + Revision 1.7 2002-11-15 01:58:54 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.6 2002/10/31 13:28:32 pierre * correct last wrong fix for tw2158 Revision 1.5 2002/10/30 17:10:00 pierre diff --git a/compiler/i386/ag386int.pas b/compiler/i386/ag386int.pas index de0f9964fe..cc044bb5cf 100644 --- a/compiler/i386/ag386int.pas +++ b/compiler/i386/ag386int.pas @@ -327,6 +327,7 @@ interface procedure T386IntelAssembler.WriteTree(p:TAAsmoutput); const + allocstr : array[boolean] of string[10]=(' released',' allocated'); nolinetai =[ait_label, ait_regalloc,ait_tempalloc, {$ifdef GDB} @@ -410,8 +411,29 @@ interface AsmWritePChar(tai_comment(hp).str); AsmLn; End; - ait_regalloc, - ait_tempalloc : ; + + ait_regalloc : + begin + if (cs_asm_regalloc in aktglobalswitches) then + AsmWriteLn(target_asm.comment+'Register '+std_reg2str[tai_regalloc(hp).reg]+ + allocstr[tai_regalloc(hp).allocation]); + end; + + ait_tempalloc : + begin + if (cs_asm_tempalloc in aktglobalswitches) then + begin +{$ifdef EXTDEBUG} + if assigned(tai_tempalloc(hp).problem) then + AsmWriteLn(target_asm.comment+tai_tempalloc(hp).problem^+' ('+tostr(tai_tempalloc(hp).temppos)+','+ + tostr(tai_tempalloc(hp).tempsize)+')') + else +{$endif EXTDEBUG} + AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+ + tostr(tai_tempalloc(hp).tempsize)+allocstr[tai_tempalloc(hp).allocation]); + end; + end; + ait_section : begin if LasTSec<>sec_none then AsmWriteLn('_'+target_asm.secnames[LasTSec]+#9#9'ENDS'); @@ -572,8 +594,6 @@ interface ait_symbol_end : begin end; ait_instruction : begin - { Must be done with args in ATT order } - taicpu(hp).SetOperandOrder(op_att); taicpu(hp).CheckNonCommutativeOpcodes; { We need intel order, no At&t } taicpu(hp).SetOperandOrder(op_intel); @@ -824,7 +844,17 @@ initialization end. { $Log$ - Revision 1.28 2002-08-20 21:40:44 florian + Revision 1.29 2002-11-15 01:58:56 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.28 2002/08/20 21:40:44 florian + target macos for ppc added + frame work for mpw assembler output diff --git a/compiler/i386/ag386nsm.pas b/compiler/i386/ag386nsm.pas index e19f831e95..f137ce4c22 100644 --- a/compiler/i386/ag386nsm.pas +++ b/compiler/i386/ag386nsm.pas @@ -445,8 +445,16 @@ interface ait_tempalloc : begin if (cs_asm_tempalloc in aktglobalswitches) then - AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+ - tostr(tai_tempalloc(hp).tempsize)+allocstr[tai_tempalloc(hp).allocation]); + begin +{$ifdef EXTDEBUG} + if assigned(tai_tempalloc(hp).problem) then + AsmWriteLn(target_asm.comment+tai_tempalloc(hp).problem^+' ('+tostr(tai_tempalloc(hp).temppos)+','+ + tostr(tai_tempalloc(hp).tempsize)+')') + else +{$endif EXTDEBUG} + AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+ + tostr(tai_tempalloc(hp).tempsize)+allocstr[tai_tempalloc(hp).allocation]); + end; end; ait_section : @@ -630,8 +638,6 @@ interface ait_instruction : begin - { Must be done with args in ATT order } - taicpu(hp).SetOperandOrder(op_att); taicpu(hp).CheckNonCommutativeOpcodes; { We need intel order, no At&t } taicpu(hp).SetOperandOrder(op_intel); @@ -893,7 +899,17 @@ initialization end. { $Log$ - Revision 1.26 2002-08-18 20:06:28 peter + Revision 1.27 2002-11-15 01:58:56 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.26 2002/08/18 20:06:28 peter * inlining is now also allowed in interface * renamed write/load to ppuwrite/ppuload * tnode storing in ppu diff --git a/compiler/i386/cpupara.pas b/compiler/i386/cpupara.pas index b6ecb82b34..6258331f77 100644 --- a/compiler/i386/cpupara.pas +++ b/compiler/i386/cpupara.pas @@ -30,7 +30,7 @@ unit cpupara; uses cpubase, - symdef,paramgr; + symtype,symdef,paramgr; type { Returns the location for the nr-st 32 Bit int parameter @@ -39,6 +39,8 @@ unit cpupara; rtl are used. } ti386paramanager = class(tparamanager) + function ret_in_acc(def : tdef) : boolean;override; + function ret_in_param(def : tdef) : boolean;override; function getintparaloc(nr : longint) : tparalocation;override; procedure create_param_loc_info(p : tabstractprocdef);override; function getselflocation(p : tabstractprocdef) : tparalocation;override; @@ -49,6 +51,30 @@ unit cpupara; uses verbose; + function ti386paramanager.ret_in_acc(def : tdef) : boolean; + begin +{$ifdef TEST_WIN32_RECORDS} + { Win32 returns small records in the accumulator } + if ((target_info.system=system_i386_win32) and + (def.deftype=recorddef) and (def.size<=8)) then + result:=true + else +{$endif TEST_WIN32_RECORDS} + result:=inherited ret_in_acc(def); + end; + + function ti386paramanager.ret_in_param(def : tdef) : boolean; + begin +{$ifdef TEST_WIN32_RECORDS} + { Win32 returns small records in the accumulator } + if ((target_info.system=system_i386_win32) and + (def.deftype=recorddef) and (def.size<=8)) then + result:=false + else +{$endif TEST_WIN32_RECORDS} + result:=inherited ret_in_param(def); + end; + function ti386paramanager.getintparaloc(nr : longint) : tparalocation; begin end; @@ -73,7 +99,17 @@ begin end. { $Log$ - Revision 1.3 2002-08-09 07:33:04 florian + Revision 1.4 2002-11-15 01:58:56 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.3 2002/08/09 07:33:04 florian * a couple of interface related fixes Revision 1.2 2002/07/11 14:41:32 florian diff --git a/compiler/i386/n386add.pas b/compiler/i386/n386add.pas index 5ed11389bc..d33512c6b5 100644 --- a/compiler/i386/n386add.pas +++ b/compiler/i386/n386add.pas @@ -359,7 +359,7 @@ interface { or a function result, so simply check for a } { temp of 256 bytes(JM) } if not(tg.istemp(left.location.reference) and - (tg.SizeOfTemp(left.location.reference) = 256)) and + (tg.SizeOfTemp(exprasmlist,left.location.reference) = 256)) and not(nf_use_strconcat in flags) then begin tg.GetTemp(exprasmlist,256,tt_normal,href); @@ -1553,7 +1553,17 @@ begin end. { $Log$ - Revision 1.50 2002-10-20 13:11:27 jonas + Revision 1.51 2002-11-15 01:58:56 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.50 2002/10/20 13:11:27 jonas * re-enabled optimized version of comparisons with the empty string that I accidentally disabled in revision 1.26 diff --git a/compiler/i386/n386cal.pas b/compiler/i386/n386cal.pas index 53b7423872..20d4ae9234 100644 --- a/compiler/i386/n386cal.pas +++ b/compiler/i386/n386cal.pas @@ -29,7 +29,7 @@ interface { $define AnsiStrRef} uses - symdef,node,ncal; + symdef,node,ncal,ncgcal; type ti386callparanode = class(tcallparanode) @@ -38,7 +38,7 @@ interface para_alignment,para_offset : longint);override; end; - ti386callnode = class(tcallnode) + ti386callnode = class(tcgcallnode) procedure pass_2;override; end; @@ -182,7 +182,8 @@ implementation (left.nodetype=selfn)) then internalerror(200106041); end; - maybe_push_high; + if not push_from_left_to_right then + maybe_push_high; if (defcoll.paratyp=vs_out) and assigned(defcoll.paratype.def) and not is_class(defcoll.paratype.def) and @@ -200,6 +201,8 @@ implementation else cg.a_paramaddr_ref(exprasmlist,left.location.reference,paralocdummy); location_release(exprasmlist,left.location); + if push_from_left_to_right then + maybe_push_high; end else begin @@ -233,7 +236,8 @@ implementation internalerror(200204011); end; - maybe_push_high; + if not push_from_left_to_right then + maybe_push_high; inc(pushedparasize,4); if inlined then begin @@ -246,6 +250,8 @@ implementation else cg.a_paramaddr_ref(exprasmlist,left.location.reference,paralocdummy); location_release(exprasmlist,left.location); + if push_from_left_to_right then + maybe_push_high; end else begin @@ -277,7 +283,6 @@ implementation regs_to_push : tregisterset; unusedstate: pointer; pushed : tpushedsaved; - funcretref,refcountedtemp : treference; tmpreg : tregister; hregister : tregister; oldpushedparasize : longint; @@ -368,6 +373,7 @@ implementation tprocdef(procdefinition).parast.symtablelevel:=aktprocdef.localst.symtablelevel; if assigned(params) then begin + inlinecode.para_size:=tprocdef(procdefinition).para_size(para_alignment); tg.GetTemp(exprasmlist,inlinecode.para_size,tt_persistant,pararef); inlinecode.para_offset:=pararef.offset; end; @@ -746,6 +752,7 @@ implementation { class method needs current VMT } rg.getexplicitregisterint(exprasmlist,R_ESI); reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset); + cg.g_maybe_testself(exprasmlist); cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,self_pointer_reg); end; @@ -805,6 +812,7 @@ implementation { class method needs current VMT } rg.getexplicitregisterint(exprasmlist,R_ESI); reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset); + cg.g_maybe_testself(exprasmlist); cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,R_ESI); end else @@ -952,6 +960,7 @@ implementation begin { this is one point where we need vmt_offset (PM) } reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset); + cg.g_maybe_testself(exprasmlist); tmpreg:=cg.get_scratch_reg_address(exprasmlist); cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,tmpreg); reference_reset_base(href,tmpreg,0); @@ -1150,86 +1159,7 @@ implementation { handle function results } if (not is_void(resulttype.def)) then - begin - { structured results are easy to handle.... } - { needed also when result_no_used !! } - if paramanager.ret_in_param(resulttype.def) then - begin - location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def)); - location.reference.symbol:=nil; - location.reference:=funcretref; - end - else - { ansi/widestrings must be registered, so we can dispose them } - if is_ansistring(resulttype.def) or - is_widestring(resulttype.def) then - begin - location_reset(location,LOC_CREFERENCE,OS_ADDR); - location.reference:=refcountedtemp; - cg.a_reg_alloc(exprasmlist,accumulator); - cg.a_load_reg_ref(exprasmlist,OS_ADDR,accumulator,location.reference); - cg.a_reg_dealloc(exprasmlist,accumulator); - end - else - { we have only to handle the result if it is used } - if (nf_return_value_used in flags) then - begin - case resulttype.def.deftype of - enumdef, - orddef : - begin - cgsize:=def_cgsize(resulttype.def); - { an object constructor is a function with boolean result } - if (inlined or (right=nil)) and - (procdefinition.proctypeoption=potype_constructor) then - begin - if extended_new then - cgsize:=OS_INT - else - begin - cgsize:=OS_NO; - { this fails if popsize > 0 PM } - location_reset(location,LOC_FLAGS,OS_NO); - location.resflags:=F_NE; - end; - end; - - if cgsize<>OS_NO then - begin - location_reset(location,LOC_REGISTER,cgsize); - cg.a_reg_alloc(exprasmlist,accumulator); - if cgsize in [OS_64,OS_S64] then - begin - cg.a_reg_alloc(exprasmlist,accumulatorhigh); - location.registerhigh:=rg.getexplicitregisterint(exprasmlist,accumulatorhigh); - location.registerlow:=rg.getexplicitregisterint(exprasmlist,accumulator); - cg64.a_load64_reg_reg(exprasmlist,joinreg64(accumulator,accumulatorhigh), - location.register64); - end - else - begin - location.register:=rg.getexplicitregisterint(exprasmlist,accumulator); - hregister:=rg.makeregsize(accumulator,cgsize); - location.register:=rg.makeregsize(location.register,cgsize); - cg.a_load_reg_reg(exprasmlist,cgsize,cgsize,hregister,location.register); - end; - end; - end; - floatdef : - begin - location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def)); - location.register:=R_ST; - inc(trgcpu(rg).fpuvaroffset); - end; - else - begin - location_reset(location,LOC_REGISTER,OS_INT); - location.register:=rg.getexplicitregisterint(exprasmlist,accumulator); - cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,accumulator,location.register); - end; - end; - end; - end; + handle_return_value(inlined,extended_new); { perhaps i/o check ? } if iolabel<>nil then @@ -1271,7 +1201,8 @@ implementation end; if inlined then begin - tg.UnGetTemp(exprasmlist,returnref); + if (resulttype.def.size>0) then + tg.UnGetTemp(exprasmlist,returnref); tprocdef(procdefinition).parast.address_fixup:=store_parast_fixup; right:=inlinecode; end; @@ -1280,7 +1211,7 @@ implementation { from now on the result can be freed normally } if inlined and paramanager.ret_in_param(resulttype.def) then - tg.ChangeTempType(funcretref,tt_normal); + tg.ChangeTempType(exprasmlist,funcretref,tt_normal); { if return value is not used } if (not(nf_return_value_used in flags)) and (not is_void(resulttype.def)) then @@ -1311,7 +1242,17 @@ begin end. { $Log$ - Revision 1.73 2002-10-05 12:43:29 carl + Revision 1.74 2002-11-15 01:58:57 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.73 2002/10/05 12:43:29 carl * fixes for Delphi 6 compilation (warning : Some features do not work under Delphi) diff --git a/compiler/i386/n386opt.pas b/compiler/i386/n386opt.pas index 023f8081b0..b21c6216e7 100644 --- a/compiler/i386/n386opt.pas +++ b/compiler/i386/n386opt.pas @@ -97,7 +97,7 @@ begin { ti386addnode.pass_2 } secondpass(left); if not(tg.istemp(left.location.reference) and - (tg.sizeoftemp(left.location.reference) = 256)) and + (tg.sizeoftemp(exprasmlist,left.location.reference) = 256)) and not(nf_use_strconcat in flags) then begin tg.Gettemp(exprasmlist,256,tt_normal,href); @@ -205,7 +205,7 @@ begin { ti386addnode.pass_2 } secondpass(left); if not(tg.istemp(left.location.reference) and - (tg.sizeoftemp(left.location.reference) = 256)) and + (tg.sizeoftemp(exprasmlist,left.location.reference) = 256)) and not(nf_use_strconcat in flags) then begin tg.GetTemp(exprasmlist,256,tt_normal,href); @@ -248,7 +248,17 @@ end. { $Log$ - Revision 1.24 2002-08-23 16:14:49 peter + Revision 1.25 2002-11-15 01:58:57 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.24 2002/08/23 16:14:49 peter * tempgen cleanup * tt_noreuse temp type added that will be used in genentrycode diff --git a/compiler/i386/ra386.pas b/compiler/i386/ra386.pas index 6766359269..235ebd56fc 100644 --- a/compiler/i386/ra386.pas +++ b/compiler/i386/ra386.pas @@ -43,11 +43,13 @@ type end; T386Instruction=class(TInstruction) + OpOrder : TOperandOrder; { Operand sizes } procedure AddReferenceSizes; procedure SetInstructionOpsize; procedure CheckOperandSizes; procedure CheckNonCommutativeOpcodes; + procedure SwapOperands; { opcode adding } procedure ConcatInstruction(p : taasmoutput);override; end; @@ -227,6 +229,17 @@ end; T386Instruction *****************************************************************************} +procedure T386Instruction.SwapOperands; +begin + Inherited SwapOperands; + { mark the correct order } + if OpOrder=op_intel then + OpOrder:=op_att + else + OpOrder:=op_intel; +end; + + procedure T386Instruction.AddReferenceSizes; { this will add the sizes for references like [esi] which do not have the size set yet, it will take only the size if the other @@ -301,6 +314,8 @@ procedure T386Instruction.SetInstructionOpsize; begin if opsize<>S_NO then exit; + if (OpOrder=op_intel) then + SwapOperands; case ops of 0 : ; 1 : @@ -415,6 +430,8 @@ end; but before swapping in the NASM and TASM writers PM } procedure T386Instruction.CheckNonCommutativeOpcodes; begin + if (OpOrder=op_intel) then + SwapOperands; if ((ops=2) and (operands[1].opr.typ=OPR_REGISTER) and (operands[2].opr.typ=OPR_REGISTER) and @@ -461,6 +478,9 @@ var i,asize : longint; ai : taicpu; begin + if (OpOrder=op_intel) then + SwapOperands; + { Get Opsize } if (opsize<>S_NO) or (Ops=0) then siz:=opsize @@ -608,6 +628,7 @@ begin end; ai:=taicpu.op_none(opcode,siz); + ai.SetOperandOrder(OpOrder); ai.Ops:=Ops; for i:=1to Ops do begin @@ -669,7 +690,17 @@ end; end. { $Log$ - Revision 1.25 2002-10-31 13:28:32 pierre + Revision 1.26 2002-11-15 01:58:58 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.25 2002/10/31 13:28:32 pierre * correct last wrong fix for tw2158 Revision 1.24 2002/10/30 17:10:00 pierre diff --git a/compiler/i386/ra386att.pas b/compiler/i386/ra386att.pas index 25ad0c0ac3..e2f1e08c9f 100644 --- a/compiler/i386/ra386att.pas +++ b/compiler/i386/ra386att.pas @@ -1620,6 +1620,7 @@ procedure T386AttInstruction.InitOperands; var i : longint; begin + OpOrder:=op_att; for i:=1to max_operands do Operands[i]:=T386AttOperand.Create; end; @@ -2129,7 +2130,17 @@ finalization end. { $Log$ - Revision 1.31 2002-09-03 16:26:28 daniel + Revision 1.32 2002-11-15 01:58:58 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.31 2002/09/03 16:26:28 daniel * Make Tprocdef.defs protected Revision 1.30 2002/08/13 18:01:52 carl diff --git a/compiler/i386/ra386int.pas b/compiler/i386/ra386int.pas index 7e192a6bc2..395acdd82b 100644 --- a/compiler/i386/ra386int.pas +++ b/compiler/i386/ra386int.pas @@ -1613,6 +1613,7 @@ procedure T386IntelInstruction.InitOperands; var i : longint; begin + OpOrder:=op_intel; for i:=1 to 3 do Operands[i]:=T386IntelOperand.Create; end; @@ -1962,7 +1963,17 @@ finalization end. { $Log$ - Revision 1.35 2002-09-16 19:07:00 peter + Revision 1.36 2002-11-15 01:58:59 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.35 2002/09/16 19:07:00 peter * support [eax].constant as reference Revision 1.34 2002/09/03 16:26:28 daniel diff --git a/compiler/import.pas b/compiler/import.pas index aa3d4a6205..3bb8792637 100644 --- a/compiler/import.pas +++ b/compiler/import.pas @@ -29,7 +29,7 @@ uses cutils,cclasses, systems, aasmbase, - symsym; + symdef,symsym; type timported_item = class(TLinkedListItem) @@ -58,6 +58,7 @@ type constructor Create;virtual; destructor Destroy;override; procedure preparelib(const s:string);virtual; + procedure importproceduredef(aprocdef : tprocdef; const module:string;index:longint;const name:string);virtual; procedure importprocedure(const func,module:string;index:longint;const name:string);virtual; procedure importvariable(vs:tvarsym;const name,module:string);virtual; procedure generatelib;virtual; @@ -180,6 +181,12 @@ begin end; +procedure timportlib.importproceduredef(aprocdef : tprocdef; const module:string;index:longint;const name:string); +begin + importprocedure(aprocdef.mangledname, module, index, name); +end; + + procedure timportlib.importprocedure(const func,module:string;index:longint;const name:string); begin NotSupported; @@ -238,7 +245,17 @@ end; end. { $Log$ - Revision 1.20 2002-09-09 17:34:14 peter + Revision 1.21 2002-11-15 01:58:48 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.20 2002/09/09 17:34:14 peter * tdicationary.replace added to replace and item in a dictionary. This is only allowed for the same name * varsyms are inserted in symtable before the types are parsed. This diff --git a/compiler/link.pas b/compiler/link.pas index 7325d82bfd..279792ecf0 100644 --- a/compiler/link.pas +++ b/compiler/link.pas @@ -458,12 +458,14 @@ begin DoExec:=true; if not(cs_link_extern in aktglobalswitches) then begin - swapvectors; if useshell then - shell(command+' '+para) + shell(maybequoted(command)+' '+para) else - exec(command,para); - swapvectors; + begin + swapvectors; + exec(command,para); + swapvectors; + end; if (doserror<>0) then begin Message(exec_e_cant_call_linker); @@ -508,7 +510,7 @@ begin smartpath:=current_module.outputpath^+FixPath(FixFileName(current_module.modulename^)+target_info.smartext,false); SplitBinCmd(target_ar.arcmd,binstr,cmdstr); Replace(cmdstr,'$LIB',current_module.staticlibfilename^); - Replace(cmdstr,'$FILES',ScriptFixFileName(smartpath+current_module.asmprefix^+'*'+target_info.objext)); + Replace(cmdstr,'$FILES',FixFileName(smartpath+current_module.asmprefix^+'*'+target_info.objext)); success:=DoExec(FindUtil(binstr),cmdstr,false,true); { Clean up } if not(cs_asm_leave in aktglobalswitches) then @@ -650,7 +652,17 @@ initialization end. { $Log$ - Revision 1.32 2002-11-09 15:37:21 carl + Revision 1.33 2002-11-15 01:58:48 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.32 2002/11/09 15:37:21 carl - removed no longer used defines Revision 1.31 2002/09/07 15:25:02 peter diff --git a/compiler/msg/errore.msg b/compiler/msg/errore.msg index 07279c110f..6a3766a5b7 100644 --- a/compiler/msg/errore.msg +++ b/compiler/msg/errore.msg @@ -117,7 +117,7 @@ general_i_hint=01016_I_Hint: # # Scanner # -# 02057 is the last used one +# 02061 is the last used one # % \section{Scanner messages.} % This section lists the messages that the scanner emits. The scanner takes @@ -305,7 +305,7 @@ scan_e_string_exceeds_255_chars=02061_E_Constant strings can't be longer than 25 # # Parser # -# 03181 is the last used one +# 03188 is the last used one # % \section{Parser messages} % This section lists all parser messages. The parser takes care of the @@ -787,7 +787,7 @@ parser_e_cant_publish_that_property=03134_E_That kind of property can't be publi parser_w_empty_import_name=03135_W_Empty import name specified % Both index and name for the import are 0 or empty parser_e_empty_import_name=03136_W_An import name is required -% Some targets need a name for the imported procedure or a cdecl specifier +% Some targets need a name for the imported procedure or a \var{cdecl} specifier parser_e_used_proc_name_changed=03137_E_Function internal name changed after use of function % This is an internal error; please report any occurrences of this error % to the \fpc team. @@ -945,10 +945,22 @@ parser_e_no_procvarobj_const=03183_E_Typed constants of the type "procedure of o % class instance it operates on (which can not be known at compile time). parser_e_default_value_only_one_para=03184_E_Default value can only be assigned to one parameter parser_e_default_value_expected_for_para=03185_E_Default parameter required for "$1" +parser_w_unsupported_feature=03186_W_Use of unsupported feature! +% You're trying to force the compiler into doing something it cannot do yet. +parser_h_c_arrays_are_references=03187_H_C arrays are passed by reference +% Any array passed to a C functions is passed +% by a pointer (i.e. by reference). +parser_e_C_array_of_const_must_be_last=03188_E_C array of const must be the last argument +% You can not add any other argument after +% an \var{array of const} for \var{cdecl} functions, +% as the size pushed on stack for this arg is +% unknown. % \end{description} # # Type Checking # +# 04043 is the last used one +# % \section{Type checking errors} % This section lists all errors that can occur when type checking is % performed. @@ -1123,6 +1135,8 @@ type_w_string_too_long=04043_W_String literal has more characters than short str # # Symtable # +# 05042 is the last used one +# % \section{Symbol handling} % This section lists all the messages that concern the handling of symbols. % This means all things that have to do with procedure and variable names. @@ -1237,15 +1251,21 @@ sym_b_param_list=05039_B_Found declaration: $1 % You get this when you use the \var{-vb} switch. In case an overloaded % procedure is not found, then all candidate overloaded procedures are % listed, with their parameter lists. -sym_e_segment_too_large=05040_E_Data segment too large (max. 2GB) -% You get this when you declare an array whose size exceeds the 2GB limit. -sym_e_no_matching_implementation_found=05041_E_No matching implementation for interface method "$1" found +sym_e_segment_too_large=05040_E_Data element too large +% You get this when you declare a data element whose size exceeds the prescribed limit. +% (2 Gb on 80386+/68020+ processors) +sym_w_segment_too_large=05041_W_Data element might be too large +% You get this when you declare a data element which might cause invalid opcodes +% (which will be detected by the assembler) in 68000 mode. +sym_e_no_matching_implementation_found=05042_E_No matching implementation for interface method "$1" found % There was no matching method found which could implement the interface % method. Check argument types and result type of the methods. % \end{description} # # Codegenerator # +# 06040 is the last used one +# % \section{Code generator messages} % This section lists all messages that can be displayed if the code % generator encounters an error condition. @@ -1367,10 +1387,10 @@ cg_e_no_call_to_interrupt=06034_E_Direct call of interrupt procedure "$1" is not cg_e_can_access_element_zero=06035_E_Element zero of an ansi/wide- or longstring can't be accessed, use (set)length instead % You should use \var{setlength} to set the length of an ansi/wide/longstring % and \var{length} to get the length of such kinf of string -cg_e_include_not_implemented=06036_E_Include and exclude not implemented in this case -% \var{include} and \var{exclude} are only partially -% implemented for \var{i386} processors -% and not at all for \var{m68k} processors. +cg_e_paralimit_in_local_routine=06036_E_Parameter limit excedeed in local routine +% Your routine pushes too much parameters. Some processors pose limits +% on the parameters passed to a routine. You should pass some of your parameters +% by reference. cg_e_cannot_call_cons_dest_inside_with=06037_E_Constructors or destructors can not be called inside a 'with' clause % Inside a \var{With} clause you cannot call a constructor or destructor for the % object you have in the \var{with} clause. @@ -1565,7 +1585,7 @@ asmr_e_68020_mode_required=07097_E_68020 mode required # # Assembler/binary writers # -# 08015 is the last used one +# 08018 is the last used one # asmw_f_too_many_asm_files=08000_F_Too many assembler files asmw_f_assembler_output_not_supported=08001_F_Selected assembler output not supported @@ -1584,6 +1604,8 @@ asmw_e_undefined_label=08013_E_Asm: Undefined label $1 asmw_e_comp_not_supported=08014_E_Asm: Comp type not supported for this target asmw_e_extended_not_supported=08015_E_Asm: Extended type not supported for this target asmw_e_duplicate_label=08016_E_Asm: Duplicate label $1 +asmw_e_redefined_label=08017_E_Asm: Redefined label $1 +asmw_e_first_defined_label=08018_E_Asm: First defined here # # Executing linker/assembler @@ -1784,7 +1806,7 @@ unit_u_ppu_invalid_fpumode=10042_U_Using a unit which was not compiled with corr # # Options # -# 11029 is the last used one +# 11039 is the last used one # option_usage=11000_$1 [options] [options] # BeginOfTeX @@ -1862,7 +1884,20 @@ option_using_env=11027_T_Reading options from environment $1 option_handling_option=11028_D_Handling option "$1" % Debug info that an option is found and will be handled option_help_press_enter=11029__*** press enter *** -option_code_page_not_available=11030_E_Unknown code page +option_start_reading_configfile=11030_H_Start of reading config file $1 +% Starting of config file parsing. +option_end_reading_configfile=11031_H_End of reading config file $1 +% End of config file parsing. +option_interpreting_option=11032_D_interpreting option "$1" +option_interpreting_firstpass_option=11036_D_interpreting firstpass option "$1" +option_interpreting_file_option=11033_D_interpreting file option "$1" +option_read_config_file=11034_D_Reading config file "$1" +option_found_file=11035_D_found source file name "$1" +option_defining_symbol=11037_D_Defining symbol $1 +option_undefining_symbol=11038_D_Undefining symbol $1 +% Additional infos about options, displayed +% when you have debug option turned on. +option_code_page_not_available=11039_E_Unknown code page %\end{description} # EndOfTeX @@ -1986,6 +2021,7 @@ option_help_pages=11025_[ **2*_b : Show all procedure r : Rhide/GCC compatibility mode **2*_ declarations if an error x : Executable info (Win32 only) **2*_ occurs +**1V_write fpcdebug.txt file with lots of debugging info **1X_executable options: *L2Xc_link with the c library **2Xs_strip all symbols from executable @@ -2045,7 +2081,8 @@ option_help_pages=11025_[ 6*2Og_generate smaller code 6*2OG_generate faster code (default) 6*2Ox_optimize maximum (still BUGGY!!!) -6*2O2_set target processor to a MC68020+ +6*2O0_set target processor to a MC68000 +6*2O2_set target processor to a MC68020+ (default) 6*1R_assembler reading style: 6*2RMOT_read motorola style assembler 6*1T_Target operating system: diff --git a/compiler/msgidx.inc b/compiler/msgidx.inc index f376063318..3954cc21b4 100644 --- a/compiler/msgidx.inc +++ b/compiler/msgidx.inc @@ -263,6 +263,9 @@ const parser_e_no_procvarobj_const=03183; parser_e_default_value_only_one_para=03184; parser_e_default_value_expected_for_para=03185; + parser_w_unsupported_feature=03186; + parser_h_c_arrays_are_references=03187; + parser_e_C_array_of_const_must_be_last=03188; type_e_mismatch=04000; type_e_incompatible_types=04001; type_e_not_equal_types=04002; @@ -348,7 +351,8 @@ const sym_e_id_no_member=05038; sym_b_param_list=05039; sym_e_segment_too_large=05040; - sym_e_no_matching_implementation_found=05041; + sym_w_segment_too_large=05041; + sym_e_no_matching_implementation_found=05042; cg_e_break_not_allowed=06000; cg_e_continue_not_allowed=06001; cg_e_too_complex_expr=06002; @@ -384,7 +388,7 @@ const cg_e_no_code_for_inline_stored=06033; cg_e_no_call_to_interrupt=06034; cg_e_can_access_element_zero=06035; - cg_e_include_not_implemented=06036; + cg_e_paralimit_in_local_routine=06036; cg_e_cannot_call_cons_dest_inside_with=06037; cg_e_cannot_call_message_direct=06038; cg_e_goto_inout_of_exception_block=06039; @@ -504,6 +508,8 @@ const asmw_e_comp_not_supported=08014; asmw_e_extended_not_supported=08015; asmw_e_duplicate_label=08016; + asmw_e_redefined_label=08017; + asmw_e_first_defined_label=08018; exec_w_source_os_redefined=09000; exec_i_assembling_pipe=09001; exec_d_cant_create_asmfile=09002; @@ -609,14 +615,23 @@ const option_using_env=11027; option_handling_option=11028; option_help_press_enter=11029; - option_code_page_not_available=11030; + option_start_reading_configfile=11030; + option_end_reading_configfile=11031; + option_interpreting_option=11032; + option_interpreting_firstpass_option=11036; + option_interpreting_file_option=11033; + option_read_config_file=11034; + option_found_file=11035; + option_defining_symbol=11037; + option_undefining_symbol=11038; + option_code_page_not_available=11039; option_logo=11023; option_info=11024; option_help_pages=11025; - MsgTxtSize = 34465; + MsgTxtSize = 35103; MsgIdxMax : array[1..20] of longint=( - 17,62,186,44,42,41,98,17,35,43, - 31,1,1,1,1,1,1,1,1,1 + 17,62,189,44,43,41,98,19,35,43, + 40,1,1,1,1,1,1,1,1,1 ); diff --git a/compiler/msgtxt.inc b/compiler/msgtxt.inc index ad130ab77a..581ad87eef 100644 --- a/compiler/msgtxt.inc +++ b/compiler/msgtxt.inc @@ -1,7 +1,7 @@ {$ifdef Delphi} -const msgtxt : array[0..000143] of string[240]=( +const msgtxt : array[0..000146] of string[240]=( {$else Delphi} -const msgtxt : array[0..000143,1..240] of char=( +const msgtxt : array[0..000146,1..240] of char=( {$endif Delphi} '01000_T_Compiler: $1'#000+ '01001_D_Compiler OS: $1'#000+ @@ -298,296 +298,303 @@ const msgtxt : array[0..000143,1..240] of char=( 'initialized with NIL'#000+ '03184_E_Default value can only be assigned to one ','parameter'#000+ '03185_E_Default parameter required for "$1"'#000+ + '03186_W_Use of unsupported feature!'#000+ + '03187_H_C arrays are passed by reference'#000+ + '03188_E_C array of const must be the last argument'#000+ '04000_E_Type mismatch'#000+ - '04001_E_Incompatible types: got "$1" expected "$2"'#000+ + '04001_E_Incompatible types: got "$1"',' expected "$2"'#000+ '04002_E_Type mismatch between "$1" and "$2"'#000+ '04003_E_Type identifier expected'#000+ - '04004_E_Variable identifier expected',#000+ + '04004_E_Variable identifier expected'#000+ '04005_E_Integer expression expected, but got "$1"'#000+ '04006_E_Boolean expression expected, but got "$1"'#000+ - '04007_E_Ordinal expression expected'#000+ + '04007_E_Ord','inal expression expected'#000+ '04008_E_pointer type expected, but got "$1"'#000+ '04009_E_class type expected, but got "$1"'#000+ - '04010_E_Variable ','or type indentifier expected'#000+ + '04010_E_Variable or type indentifier expected'#000+ '04011_E_Can'#039't evaluate constant expression'#000+ - '04012_E_Set elements are not compatible'#000+ + '04012_E_Set elements are not compatible'#000, '04013_E_Operation not implemented for sets'#000+ '04014_W_Automatic type conversion from floating type to COMP which is '+ - 'an integer type',#000+ + 'an integer type'#000+ '04015_H_use DIV instead to get an integer result'#000+ '04016_E_string types doesn'#039't match, because of $V+ mode'#000+ - '04017_E_succ or pred on enums with assignments not possible'#000+ + '04017_','E_succ or pred on enums with assignments not possible'#000+ '04018_E_Can'#039't read or write variables of this type'#000+ - '04019_E_Can'#039't use readl','n or writeln on typed file'#000+ + '04019_E_Can'#039't use readln or writeln on typed file'#000+ '04020_E_Can'#039't use read or write on untyped file.'#000+ - '04021_E_Type conflict between set elements'#000+ + '04021_E_Type conflict between set el','ements'#000+ '04022_W_lo/hi(dword/qword) returns the upper/lower word/dword'#000+ '04023_E_Integer or real expression expected'#000+ - '04024_E_Wrong t','ype "$1" in array constructor'#000+ + '04024_E_Wrong type "$1" in array constructor'#000+ '04025_E_Incompatible type for arg no. $1: Got "$2", expected "$3"'#000+ - '04026_E_Method (variable) and Procedure (variable) are not compatible'#000+ - '04027_E_Illegal constant passed to internal math function'#000+ - '04028_E_Can'#039't ge','t the address of constants'#000+ - '04029_E_Argument can'#039't be assigned to'#000+ - '04030_E_Can'#039't assign local procedure/function to procedure variabl'+ + '04026_E_Method (','variable) and Procedure (variable) are not compatibl'+ 'e'#000+ + '04027_E_Illegal constant passed to internal math function'#000+ + '04028_E_Can'#039't get the address of constants'#000+ + '04029_E_Argument can'#039't be assigned to'#000+ + '04030_E_Can'#039't assign local procedure/function t','o procedure varia'+ + 'ble'#000+ '04031_E_Can'#039't assign values to an address'#000+ '04032_E_Can'#039't assign values to const variable'#000+ - '04033_E_Array type ','required'#000+ + '04033_E_Array type required'#000+ '04034_E_interface type expected, but got "$1"'#000+ - '04035_W_Mixing signed expressions and longwords gives a 64bit result'#000+ + '04035_W_Mixing signed expressions and longwords gives a 6','4bit result'+ + #000+ '04036_W_Mixing signed expressions and cardinals here may cause a range'+ ' check error'#000+ - '04037_E_Typecast has different si','ze ($1 -> $2) in assignment'#000+ + '04037_E_Typecast has different size ($1 -> $2) in assignment'#000+ '04038_E_enums with assignments can'#039't be used as array index'#000+ - '04039_E_Class types "$1" and "$2" are not related'#000+ + '04039_E_Class types "$1"',' and "$2" are not related'#000+ '04040_W_Class types "$1" and "$2" are not related'#000+ - '04041_E_Class or interface type expected, but got "$','1"'#000+ + '04041_E_Class or interface type expected, but got "$1"'#000+ '04042_E_Type "$1" is not completly defined'#000+ - '04043_W_String literal has more characters than short string length'#000+ + '04043_W_String literal has more characters than short string lengt','h'#000+ '05000_E_Identifier not found "$1"'#000+ '05001_F_Internal Error in SymTableStack()'#000+ '05002_E_Duplicate identifier "$1"'#000+ - '05003_H_Identifi','er already defined in $1 at line $2'#000+ + '05003_H_Identifier already defined in $1 at line $2'#000+ '05004_E_Unknown identifier "$1"'#000+ - '05005_E_Forward declaration not solved "$1"'#000+ + '05005_E_Forward declaration not solved "$1"'#000, '05006_F_Identifier type already defined as type'#000+ '05007_E_Error in type definition'#000+ '05008_E_Type identifier not defined'#000+ - '05009_E_For','ward type not resolved "$1"'#000+ + '05009_E_Forward type not resolved "$1"'#000+ '05010_E_Only static variables can be used in static methods or outside'+ ' methods'#000+ - '05011_E_Invalid call to tvarsym.mangledname()'#000+ + '05011','_E_Invalid call to tvarsym.mangledname()'#000+ '05012_F_record or class type expected'#000+ - '05013_E_Instances of classes or objects with an a','bstract method are '+ - 'not allowed'#000+ + '05013_E_Instances of classes or objects with an abstract method are no'+ + 't allowed'#000+ '05014_W_Label not defined "$1"'#000+ '05015_E_Label used but not defined "$1"'#000+ - '05016_E_Illegal label declaration'#000+ + '05016_E_Il','legal label declaration'#000+ '05017_E_GOTO and LABEL are not supported (use switch -Sg)'#000+ '05018_E_Label not found'#000+ - '05019_E_identifier isn',#039't a label'#000+ + '05019_E_identifier isn'#039't a label'#000+ '05020_E_label already defined'#000+ '05021_E_illegal type declaration of set elements'#000+ - '05022_E_Forward class definition not resolved "$1"'#000+ + '05022_E_Forward class ','definition not resolved "$1"'#000+ '05023_H_Unit "$1" not used in $2'#000+ '05024_H_Parameter "$1" not used'#000+ - '05025_N_Local variable "$1" not us','ed'#000+ + '05025_N_Local variable "$1" not used'#000+ '05026_H_Value parameter "$1" is assigned but never used'#000+ - '05027_N_Local variable "$1" is assigned but never used'#000+ + '05027_N_Local variable "$1" is assigned but never use','d'#000+ '05028_H_Local $1 "$2" is not used'#000+ '05029_N_Private field "$1.$2" is never used'#000+ - '05030_N_Private field "$1.$2" is assigned but ne','ver used'#000+ + '05030_N_Private field "$1.$2" is assigned but never used'#000+ '05031_N_Private method "$1.$2" never used'#000+ '05032_E_Set type expected'#000+ - '05033_W_Function result does not seem to be set'#000+ + '05033_W_Function result does not se','em to be set'#000+ '05034_W_Type "$1" is not aligned correctly in current record for C'#000+ '05035_E_Unknown record field identifier "$1"'#000+ - '050','36_W_Local variable "$1" does not seem to be initialized'#000+ + '05036_W_Local variable "$1" does not seem to be initialized'#000+ '05037_W_Variable "$1" does not seem to be initialized'#000+ - '05038_E_identifier idents no member "$1"'#000+ + '0','5038_E_identifier idents no member "$1"'#000+ '05039_B_Found declaration: $1'#000+ - '05040_E_Data segment too large (max. 2GB)'#000+ - '05041_E_No match','ing implementation for interface method "$1" found'#000+ + '05040_E_Data element too large'#000+ + '05041_W_Data element might be too large'#000+ + '05042_E_No matching implementation for interface method "$1" found'#000+ '06000_E_BREAK not allowed'#000+ - '06001_E_CONTINUE not allowed'#000+ + '06001_','E_CONTINUE not allowed'#000+ '06002_E_Expression too complicated - FPU stack overflow'#000+ '06003_E_Illegal expression'#000+ '06004_E_Invalid integer expression'#000+ - '06005_E_Illegal ','qualifier'#000+ + '06005_E_Illegal qualifier'#000+ '06006_E_High range limit < low range limit'#000+ - '06007_E_Illegal counter variable'#000+ + '06007_E_Illegal counter variab','le'#000+ '06008_E_Can'#039't determine which overloaded function to call'#000+ '06009_E_Parameter list size exceeds 65535 bytes'#000+ '06010_E_Illegal type conversion'#000+ - '06011_D_Conversi','on between ordinals and pointers is not portable acr'+ - 'oss platforms'#000+ - '06012_E_File types must be var parameters'#000+ + '06011_D_Conversion between ordinals and pointers is not portable acros'+ + 's platforms'#000+ + '06012_E_File type','s must be var parameters'#000+ '06013_E_The use of a far pointer isn'#039't allowed there'#000+ '06014_E_illegal call by reference parameters'#000+ - '06015_E_EXPORT declared functions ','can'#039't be called'#000+ - '06016_W_Possible illegal call of constructor or destructor (doesn'#039't'+ + '06015_E_EXPORT declared functions can'#039't be called'#000+ + '06016_W_Possible illegal call of constructor or destructor (doesn'#039't', ' match to this context)'#000+ '06017_N_Inefficient code'#000+ '06018_W_unreachable code'#000+ '06019_E_procedure call with stackframe ESP/SP'#000+ - '06020_E_Abstract methods can'#039't be cal','led directly'#000+ + '06020_E_Abstract methods can'#039't be called directly'#000+ '06021_F_Internal Error in getfloatreg(), allocation failure'#000+ - '06022_F_Unknown float type'#000+ + '06022_F_Un','known float type'#000+ '06023_F_SecondVecn() base defined twice'#000+ '06024_F_Extended cg68k not supported'#000+ '06025_F_32-bit unsigned not supported in MC68000 mode'#000+ - '06026_F_I','nternal Error in secondinline()'#000+ + '06026_F_Internal Error in secondinline()'#000+ '06027_D_Register $1 weight $2 $3'#000+ - '06028_E_Stack limit excedeed in local routine'#000+ + '06028_E_Stack limi','t excedeed in local routine'#000+ '06029_D_Stack frame is omitted'#000+ '06031_E_Object or class methods can'#039't be inline.'#000+ '06032_E_Procvar calls can'#039't be inline.'#000+ - '06033_E_No',' code for inline procedure stored'#000+ - '06034_E_Direct call of interrupt procedure "$1" is not possible'#000+ + '06033_E_No code for inline procedure stored'#000+ + '06034_E_Direct call of interrupt procedure "$1" i','s not possible'#000+ '06035_E_Element zero of an ansi/wide- or longstring can'#039't be acces'+ 'sed, use (set)length instead'#000+ - '06036_E_Include and exclude not implemented in ','this case'#000+ + '06036_E_Parameter limit excedeed in local routine'#000+ '06037_E_Constructors or destructors can not be called inside a '#039'wi'+ 'th'#039' clause'#000+ - '06038_E_Cannot call message handler method directly'#000+ + '060','38_E_Cannot call message handler method directly'#000+ '06039_E_Jump in or outside of an exception block'#000+ - '06040_E_Control flow statements aren'#039't allowed in a ','finally bloc'+ - 'k'#000+ + '06040_E_Control flow statements aren'#039't allowed in a finally block'#000+ '07000_D_Starting $1 styled assembler parsing'#000+ - '07001_D_Finished $1 styled assembler parsing'#000+ + '07001_D_Finished $1 styled asse','mbler parsing'#000+ '07002_E_Non-label pattern contains @'#000+ '07003_W_Override operator not supported'#000+ '07004_E_Error building record offset'#000+ - '07005_E_OFFSET used wi','thout identifier'#000+ + '07005_E_OFFSET used without identifier'#000+ '07006_E_TYPE used without identifier'#000+ - '07007_E_Cannot use local variable or parameters here'#000+ + '07007_E_Cannot use local variable or',' parameters here'#000+ '07008_E_need to use OFFSET here'#000+ '07009_E_need to use $ here'#000+ '07010_E_Cannot use multiple relocatable symbols'#000+ - '07011_E_Relocatable symbol',' can only be added'#000+ + '07011_E_Relocatable symbol can only be added'#000+ '07012_E_Invalid constant expression'#000+ - '07013_E_Relocatable symbol is not allowed'#000+ + '07013_E_Relocatable symbol is not a','llowed'#000+ '07014_E_Invalid reference syntax'#000+ '07015_E_You can not reach $1 from that code'#000+ '07016_E_Local symbols/labels aren'#039't allowed as references'#000+ - '07017_E_','Invalid base and index register usage'#000+ + '07017_E_Invalid base and index register usage'#000+ '07018_W_Possible error in object field handling'#000+ - '07019_E_Wrong scale factor specified'#000+ + '0701','9_E_Wrong scale factor specified'#000+ '07020_E_Multiple index register usage'#000+ '07021_E_Invalid operand type'#000+ '07022_E_Invalid string as opcode operand: $1'#000+ - '07023','_W_@CODE and @DATA not supported'#000+ + '07023_W_@CODE and @DATA not supported'#000+ '07024_E_Null label references are not allowed'#000+ - '07025_E_Divide by zero in asm evaluator'#000+ + '07025_E_Div','ide by zero in asm evaluator'#000+ '07026_E_Illegal expression'#000+ '07027_E_escape sequence ignored: $1'#000+ '07028_E_Invalid symbol reference'#000+ - '07029_W_Fwait can cause e','mulation problems with emu387'#000+ + '07029_W_Fwait can cause emulation problems with emu387'#000+ '07030_W_$1 without operand translated into $1P'#000+ - '07031_W_ENTER instruction is not supported by Linux kernel'#000+ + '07031_W_ENTER',' instruction is not supported by Linux kernel'#000+ '07032_W_Calling an overload function in assembler'#000+ '07033_E_Unsupported symbol type for operand'#000+ - '07034_E_Co','nstant value out of bounds'#000+ + '07034_E_Constant value out of bounds'#000+ '07035_E_Error converting decimal $1'#000+ - '07036_E_Error converting octal $1'#000+ + '07036_E_Error converting oc','tal $1'#000+ '07037_E_Error converting binary $1'#000+ '07038_E_Error converting hexadecimal $1'#000+ '07039_H_$1 translated to $2'#000+ - '07040_W_$1 is associated to an overloade','d function'#000+ + '07040_W_$1 is associated to an overloaded function'#000+ '07041_E_Cannot use SELF outside a method'#000+ - '07042_E_Cannot use OLDEBP outside a nested procedure'#000+ + '07042_E_Cannot use OLDEBP outside a ne','sted procedure'#000+ '07043_W_Procedures can'#039't return any value in asm code'#000+ '07044_E_SEG not supported'#000+ - '07045_E_Size suffix and destination or source size do n','ot match'#000+ + '07045_E_Size suffix and destination or source size do not match'#000+ '07046_W_Size suffix and destination or source size do not match'#000+ - '07047_E_Assembler syntax error'#000+ + '07047_E_Assembler',' syntax error'#000+ '07048_E_Invalid combination of opcode and operands'#000+ '07049_E_Assembler syntax error in operand'#000+ - '07050_E_Assembler syntax error in constant'#000, + '07050_E_Assembler syntax error in constant'#000+ '07051_E_Invalid String expression'#000+ '07052_W_constant with symbol $1 for not 32bit address'#000+ - '07053_E_Unrecognized opcode $1'#000+ + '07','053_E_Unrecognized opcode $1'#000+ '07054_E_Invalid or missing opcode'#000+ '07055_E_Invalid combination of prefix and opcode: $1'#000+ - '07056_E_Invalid combination of ove','rride and opcode: $1'#000+ + '07056_E_Invalid combination of override and opcode: $1'#000+ '07057_E_Too many operands on line'#000+ '07058_W_NEAR ignored'#000+ - '07059_W_FAR ignored'#000+ + '07059_W_FAR ig','nored'#000+ '07060_E_Duplicate local symbol $1'#000+ '07061_E_Undefined local symbol $1'#000+ '07062_E_Unknown label identifier $1'#000+ '07063_E_Invalid register name'#000+ - '07064_E_In','valid floating point register name'#000+ + '07064_E_Invalid floating point register name'#000+ '07065_E_NOR not supported'#000+ - '07066_W_Modulo not supported'#000+ + '07066_W_Modulo not supported'#000, '07067_E_Invalid floating point constant $1'#000+ '07068_E_Invalid floating point expression'#000+ '07069_E_Wrong symbol type'#000+ - '07070_E_Cannot index a local var or par','ameter with a register'#000+ + '07070_E_Cannot index a local var or parameter with a register'#000+ '07071_E_Invalid segment override expression'#000+ - '07072_W_Identifier $1 supposed external'#000+ + '07072_W_Identifier $1 s','upposed external'#000+ '07073_E_Strings not allowed as constants'#000+ '07074_No type of variable specified'#000+ '07075_E_assembler code not returned to text section'#000+ - '0707','6_E_Not a directive or local symbol $1'#000+ + '07076_E_Not a directive or local symbol $1'#000+ '07077_E_Using a defined name as a local label'#000+ - '07078_E_Dollar token is used without an identifier'#000+ + '07078','_E_Dollar token is used without an identifier'#000+ '07079_W_32bit constant created for address'#000+ '07080_N_.align is target specific, use .balign or .p2align'#000+ - '07','081_E_Can'#039't access fields directly for parameters'#000+ - '07082_E_Can'#039't access fields of objects/classes directly'#000+ + '07081_E_Can'#039't access fields directly for parameters'#000+ + '07082_E_Can'#039't access fields of objects/c','lasses directly'#000+ '07083_E_No size specified and unable to determine the size of the oper'+ 'ands'#000+ '07084_E_Cannot use RESULT in this function'#000+ - '07085_H_RESULT i','s register $1'#000+ + '07085_H_RESULT is register $1'#000+ '07086_W_"$1" without operand translated into "$1 %st,%st(1)"'#000+ - '07087_W_"$1 %st(n)" translated into "$1 %st,%st(n)"'#000+ + '07087_W_"$1 %st','(n)" translated into "$1 %st,%st(n)"'#000+ '07088_W_"$1 %st(n)" translated into "$1 %st(n),%st"'#000+ '07089_E_Char < not allowed here'#000+ - '07090_E_Char > not allowed he','re'#000+ + '07090_E_Char > not allowed here'#000+ '07091_W_XDEF not supported'#000+ '07092_E_Invalid XDEF syntax'#000+ '07093_W_ALIGN not supported'#000+ - '07094_E_Inc and Dec cannot be together'#000+ + '0709','4_E_Inc and Dec cannot be together'#000+ '07095_E_Invalid reglist for movem'#000+ '07096_E_Reglist invalid for opcode'#000+ '07097_E_68020 mode required'#000+ - '08000_F_Too many a','ssembler files'#000+ + '08000_F_Too many assembler files'#000+ '08001_F_Selected assembler output not supported'#000+ - '08002_F_Comp not supported'#000+ + '08002_F_Comp not supported'#000, '08003_F_Direct not support for binary writers'#000+ '08004_E_Allocating of data is only allowed in bss section'#000+ '08005_F_No binary writer selected'#000+ - '08006_E_Asm:',' Opcode $1 not in table'#000+ + '08006_E_Asm: Opcode $1 not in table'#000+ '08007_E_Asm: $1 invalid combination of opcode and operands'#000+ - '08008_E_Asm: 16 Bit references not supported'#000+ + '08008_E','_Asm: 16 Bit references not supported'#000+ '08009_E_Asm: Invalid effective address'#000+ '08010_E_Asm: Immediate or reference expected'#000+ - '08011_E_Asm: $1 value exceed','s bounds $2'#000+ + '08011_E_Asm: $1 value exceeds bounds $2'#000+ '08012_E_Asm: Short jump is out of range $1'#000+ '08013_E_Asm: Undefined label $1'#000+ - '08014_E_Asm: Comp type not supported for this target'#000+ + '080','14_E_Asm: Comp type not supported for this target'#000+ '08015_E_Asm: Extended type not supported for this target'#000+ '08016_E_Asm: Duplicate label $1'#000+ - '09000_W_Sou','rce operating system redefined'#000+ + '08017_E_Asm: Redefined label $1'#000+ + '08018_E_Asm: First defined here'#000+ + '09000_W_Source operating system redef','ined'#000+ '09001_I_Assembling (pipe) $1'#000+ '09002_E_Can'#039't create assember file: $1'#000+ '09003_E_Can'#039't create object file: $1'#000+ '09004_E_Can'#039't create archive file: $1'#000+ '09005_E_Assembler $1 not found, switching to external assembling'#000+ - '0','9006_T_Using assembler: $1'#000+ + '09006_T_Using assembler: $1',#000+ '09007_E_Error while assembling exitcode $1'#000+ '09008_E_Can'#039't call the assembler, error $1 switching to external a'+ 'ssembling'#000+ '09009_I_Assembling $1'#000+ '09010_I_Assembling smartlink $1'#000+ - '09011_W_Object $1 not found, Linking may',' fail !'#000+ - '09012_W_Library $1 not found, Linking may fail !'#000+ + '09011_W_Object $1 not found, Linking may fail !'#000+ + '09012_W_Library $1',' not found, Linking may fail !'#000+ '09013_E_Error while linking'#000+ '09014_E_Can'#039't call the linker, switching to external linking'#000+ '09015_I_Linking $1'#000+ '09016_E_Util $1 not found, switching to external linking'#000+ - '09017_T_Using util',' $1'#000+ - '09018_E_Creation of Executables not supported'#000+ + '09017_T_Using util $1'#000+ + '09018_E_Creation of Ex','ecutables not supported'#000+ '09019_E_Creation of Dynamic/Shared Libraries not supported'#000+ '09020_I_Closing script $1'#000+ '09021_E_resource compiler not found, switching to external mode'#000+ '09022_I_Compiling resource $1'#000+ - '09023_T_uni','t $1 can'#039't be static linked, switching to smart linki'+ + '09023_T_unit $1 can'#039't be static linke','d, switching to smart linki'+ 'ng'#000+ '09024_T_unit $1 can'#039't be smart linked, switching to static linking'+ #000+ '09025_T_unit $1 can'#039't be shared linked, switching to static linkin'+ 'g'#000+ '09026_E_unit $1 can'#039't be smart or static linked'#000+ - '0','9027_E_unit $1 can'#039't be shared or static linked'#000+ + '09027_E_unit $1 can'#039't be sh','ared or static linked'#000+ '09028_F_Can'#039't post process executable $1'#000+ '09029_F_Can'#039't open executable $1'#000+ '09030_X_Size of Code: $1 bytes'#000+ '09031_X_Size of initialized data: $1 bytes'#000+ - '09032_X_Size of uninitialized data: $1 bytes',#000+ - '09033_X_Stack space reserved: $1 bytes'#000+ + '09032_X_Size of uninitialized data: $1 bytes'#000+ + '09033_X_Stack space reser','ved: $1 bytes'#000+ '09034_X_Stack space commited: $1 bytes'#000+ '10000_T_Unitsearch: $1'#000+ '10001_T_PPU Loading $1'#000+ @@ -596,76 +603,85 @@ const msgtxt : array[0..000143,1..240] of char=( '10004_U_PPU Crc: $1'#000+ '10005_U_PPU Time: $1'#000+ '10006_U_PPU File too short'#000+ - '1000','7_U_PPU Invalid Header (no PPU at the begin)'#000+ + '10007_U_PPU Invalid Header (no',' PPU at the begin)'#000+ '10008_U_PPU Invalid Version $1'#000+ '10009_U_PPU is compiled for an other processor'#000+ '10010_U_PPU is compiled for an other target'#000+ '10011_U_PPU Source: $1'#000+ '10012_U_Writing $1'#000+ '10013_F_Can'#039't Write PPU-File'#000+ - '10','014_F_Error reading PPU-File'#000+ + '10014_F_Error reading PPU-Fi','le'#000+ '10015_F_unexpected end of PPU-File'#000+ '10016_F_Invalid PPU-File entry: $1'#000+ '10017_F_PPU Dbx count problem'#000+ '10018_E_Illegal unit name: $1'#000+ '10019_F_Too much units'#000+ '10020_F_Circular unit reference between $1 and $2'#000+ - '10021_F_','Can'#039't compile unit $1, no sources available'#000+ + '10021_F_Can'#039't compile unit $1, no ','sources available'#000+ '10022_F_Can'#039't find unit $1'#000+ '10023_W_Unit $1 was not found but $2 exists'#000+ '10024_F_Unit $1 searched but $2 found'#000+ '10025_W_Compiling the system unit requires the -Us switch'#000+ - '10026_F_There were $1 errors ','compiling module, stopping'#000+ + '10026_F_There were $1 errors compiling module, stopping',#000+ '10027_U_Load from $1 ($2) unit $3'#000+ '10028_U_Recompiling $1, checksum changed for $2'#000+ '10029_U_Recompiling $1, source found only'#000+ '10030_U_Recompiling unit, static lib is older than ppufile'#000+ - '10031_U_Recompiling unit, shar','ed lib is older than ppufile'#000+ + '10031_U_Recompiling unit, shared lib is older than ppufi','le'#000+ '10032_U_Recompiling unit, obj and asm are older than ppufile'#000+ '10033_U_Recompiling unit, obj is older than asm'#000+ '10034_U_Parsing interface of $1'#000+ '10035_U_Parsing implementation of $1'#000+ '10036_U_Second load for unit $1'#000+ - '1','0037_U_PPU Check file $1 time $2'#000+ + '10037_U_PPU Check file $1 t','ime $2'#000+ '10038_H_Conditional $1 was not set at startup in last compilation of $'+ '2'#000+ '10039_H_Conditional $1 was set at startup in last compilation of $2'#000+ '10040_W_Can'#039't recompile unit $1, but found modifed include files'#000+ - '10','041_H_File $1 is newer than Release PPU file $2'#000+ + '10041_H_File $1 is newer tha','n Release PPU file $2'#000+ '10042_U_Using a unit which was not compiled with correct FPU mode'#000+ '11000_$1 [options] [options]'#000+ '11001_W_Only one source file supported'#000+ - '11002_W_DEF file can be created only for OS/2'#000, - '11003_E_nested response files are not supported'#000+ + '11002_W_DEF file can be created only for OS/2'#000+ + '11003_E_nested response fi','les are not supported'#000+ '11004_F_No source file name in command line'#000+ '11005_N_No option inside $1 config file'#000+ '11006_E_Illegal parameter: $1'#000+ '11007_H_-? writes help pages'#000+ '11008_F_Too many config files nested'#000+ - '11009_F_Unab','le to open file $1'#000+ - '11010_D_Reading further options from $1'#000+ + '11009_F_Unable to open file $1'#000+ + '11010_D','_Reading further options from $1'#000+ '11011_W_Target is already set to: $1'#000+ '11012_W_Shared libs not supported on DOS platform, reverting to static'+ #000+ '11013_F_too many IF(N)DEFs'#000+ '11014_F_too many ENDIFs'#000+ - '11015_F_open condition','al at the end of the file'#000+ + '11015_F_open conditional at the end of the file'#000, '11016_W_Debug information generation is not supported by this executab'+ 'le'#000+ '11017_H_Try recompiling with -dGDB'#000+ '11018_E_You are using the obsolete switch $1'#000+ '11019_E_You are using the obsolete switch $1, please use $2'#000+ - '1','1020_N_Switching assembler to default source writing assembler'#000+ + '11020_N_Switching assembler',' to default source writing assembler'#000+ '11021_W_Assembler output selected "$1" is not compatible with "$2"'#000+ '11022_W_"$1" assembler use forced'#000+ '11026_T_Reading options from file $1'#000+ - '11027_T_Reading options from environmen','t $1'#000+ - '11028_D_Handling option "$1"'#000+ + '11027_T_Reading options from environment $1'#000+ + '11028_D_Handling opti','on "$1"'#000+ '11029__*** press enter ***'#000+ - '11030_E_Unknown code page'#000+ + '11030_H_Start of reading config file $1'#000+ + '11031_H_End of reading config file $1'#000+ + '11032_D_interpreting option "$1"'#000+ + '11036_D_interpreting firstpass option "$1"'#000+ + '11033_D_interpreting file option "$1"'#000+ + '11034_D_Readi','ng config file "$1"'#000+ + '11035_D_found source file name "$1"'#000+ + '11037_D_Defining symbol $1'#000+ + '11038_D_Undefining symbol $1'#000+ + '11039_E_Unknown code page'#000+ '11023_Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#010+ - 'Copyright (c) 1993-2002 by Florian Klaempfl'#000+ - '11024_Free Pascal Compiler version $FPCV','ER'#010+ + 'Copyright (c) 1993-2002 by Floria','n Klaempfl'#000+ + '11024_Free Pascal Compiler version $FPCVER'#010+ #010+ 'Compiler Date : $FPCDATE'#010+ 'Compiler Target: $FPCTARGET'#010+ @@ -676,168 +692,170 @@ const msgtxt : array[0..000143,1..240] of char=( 'This program comes under the GNU General Public Licence'#010+ 'For more information read COPYING.FPC'#010+ #010+ - 'Report bugs,suggestions etc to:'#010+ - ' bugr','ep@freepascal.org'#000+ + 'Re','port bugs,suggestions etc to:'#010+ + ' bugrep@freepascal.org'#000+ '11025_**0*_put + after a boolean switch option to enable it, - to disa'+ 'ble it'#010+ '**1a_the compiler doesn'#039't delete the generated assembler file'#010+ - '**2al_list sourcecode lines in assembler file'#010+ - '**2ar_list register allocation/releas','e info in assembler file'#010+ + '**2al_list sourcecode lines in a','ssembler file'#010+ + '**2ar_list register allocation/release info in assembler file'#010+ '**2at_list temp allocation/release info in assembler file'#010+ '**1b_generate browser info'#010+ '**2bl_generate local symbol info'#010+ '**1B_build all modules'#010+ - '**1C_code generation options:'#010+ - '**2CD_create also dynamic library (not su','pported)'#010+ + '**1C_code generation',' options:'#010+ + '**2CD_create also dynamic library (not supported)'#010+ '**2Ch_ bytes heap (between 1023 and 67107840)'#010+ '**2Ci_IO-checking'#010+ '**2Cn_omit linking stage'#010+ '**2Co_check overflow of integer operations'#010+ '**2Cr_range checking'#010+ - '**2CR_verify object method call validity'#010+ - '**2Cs_set stack size to '#010, + '**2CR_verify object m','ethod call validity'#010+ + '**2Cs_set stack size to '#010+ '**2Ct_stack checking'#010+ '**2CX_create also smartlinked library'#010+ '**1d_defines the symbol '#010+ '*O1D_generate a DEF file'#010+ '*O2Dd_set description to '#010+ '*O2Dw_PM application'#010+ - '**1e_set path to executable'#010+ + '**1e_set path to e','xecutable'#010+ '**1E_same as -Cn'#010+ - '**1F_set file names a','nd paths:'#010+ + '**1F_set file names and paths:'#010+ '**2FD_sets the directory where to search for compiler utilities'#010+ '**2Fe_redirect error output to '#010+ '**2FE_set exe/unit output path to '#010+ - '**2Fi_adds to include path'#010+ + '**2Fi_adds to include path',#010+ '**2Fl_adds to library path'#010+ - '*L2FL_uses as dynamic linker'#010+ + '*L2FL_uses as dynamic linker'#010+ '**2Fo_adds to object path'#010+ '**2Fr_load error message file '#010+ '**2Fu_adds to unit path'#010+ '**2FU_set unit output path to , overrides -FE'#010+ - '*g1g_generate debugger information:'#010+ + '*g1g_generate de','bugger information:'#010+ '*g2gg_use gsym'#010+ '*g2gd_use dbx'#010+ - '*g','2gh_use heap trace unit (for memory leak debugging)'#010+ + '*g2gh_use heap trace unit (for memory leak debugging)'#010+ '*g2gl_use line info unit to show more info for backtraces'#010+ '*g2gc_generate checks for pointers'#010+ '**1i_information'#010+ - '**2iD_return compiler date'#010+ + '**2iD_return compiler date'#010, '**2iV_return compiler version'#010+ - '**2iSO_return compile','r OS'#010+ + '**2iSO_return compiler OS'#010+ '**2iSP_return compiler processor'#010+ '**2iTO_return target OS'#010+ '**2iTP_return target processor'#010+ '**1I_adds to include path'#010+ '**1k_Pass to the linker'#010+ '**1l_write logo'#010+ - '**1n_don'#039't read the default config file'#010+ - '**1o_change the name of ','the executable produced to '#010+ + '**1n_don'#039't read ','the default config file'#010+ + '**1o_change the name of the executable produced to '#010+ '**1pg_generate profile code for gprof (defines FPC_PROFILE)'#010+ '*L1P_use pipes instead of creating temporary assembler files'#010+ '**1S_syntax options:'#010+ - '**2S2_switch some Delphi 2 extensions on'#010+ - '**2Sc_supports operator','s like C (*=,+=,/= and -=)'#010+ + '**2S2_switch ','some Delphi 2 extensions on'#010+ + '**2Sc_supports operators like C (*=,+=,/= and -=)'#010+ '**2Sa_include assertion code.'#010+ '**2Sd_tries to be Delphi compatible'#010+ '**2Se_compiler stops after the errors (default is 1)'#010+ '**2Sg_allow LABEL and GOTO'#010+ - '**2Sh_Use ansistrings'#010+ + '**2Sh_Use',' ansistrings'#010+ '**2Si_support C++ styled INLINE'#010+ - '**2Sm_','support macros like C (global)'#010+ + '**2Sm_support macros like C (global)'#010+ '**2So_tries to be TP/BP 7.0 compatible'#010+ '**2Sp_tries to be gpc compatible'#010+ '**2Ss_constructor name must be init (destructor must be done)'#010+ - '**2St_allow static keyword in objects'#010+ - '**1s_don'#039't call assembler and linker ','(only with -a)'#010+ + '**2St_allow static keywo','rd in objects'#010+ + '**1s_don'#039't call assembler and linker (only with -a)'#010+ '**2st_Generate script to link on target'#010+ '**2sh_Generate script to link on host'#010+ '**1u_undefines the symbol '#010+ '**1U_unit options:'#010+ '**2Un_don'#039't check the unit name'#010+ - '**2Ur_generate release unit files'#010+ + '**2Ur_genera','te release unit files'#010+ '**2Us_compile a system unit'#010+ - '*','*1v_Be verbose. is a combination of the following letters:'#010+ + '**1v_Be verbose. is a combination of the following letters:'#010+ '**2*_e : Show errors (default) d : Show debug info'#010+ '**2*_w : Show warnings u : Show unit info'#010+ - '**2*_n : Show notes t : Show tried/used file','s'#010+ + '**2*_n : S','how notes t : Show tried/used files'#010+ '**2*_h : Show hints m : Show defined macros'#010+ '**2*_i : Show general info p : Show compiled procedures'#010+ '**2*_l : Show linenumbers c : Show conditionals'#010+ - '**2*_a : Show everything 0 : Show nothin','g (except errors'+ + '*','*2*_a : Show everything 0 : Show nothing (except errors'+ ')'#010+ '**2*_b : Show all procedure r : Rhide/GCC compatibility mode'#010+ '**2*_ declarations if an error x : Executable info (Win32 only)'#010+ '**2*_ occurs'#010+ + '**1V_write fpcd','ebug.txt file with lots of debugging info'#010+ '**1X_executable options:'#010+ '*L2Xc_link with the c library'#010+ - '**2Xs_strip',' all symbols from executable'#010+ + '**2Xs_strip all symbols from executable'#010+ '**2XD_try to link dynamic (defines FPC_LINK_DYNAMIC)'#010+ - '**2XS_try to link static (default) (defines FPC_LINK_STATIC)'#010+ + '**2XS_try to link static (default) (defin','es FPC_LINK_STATIC)'#010+ '**2XX_try to link smart (defines FPC_LINK_SMART)'#010+ - '**0*_Processor specific opti','ons:'#010+ + '**0*_Processor specific options:'#010+ '3*1A_output format:'#010+ '3*2Aas_assemble using GNU AS'#010+ '3*2Aasaout_assemble using GNU AS for aout (Go32v1)'#010+ - '3*2Anasmcoff_coff (Go32v2) file using Nasm'#010+ + '3*2Anasmcoff_coff (Go32v','2) file using Nasm'#010+ '3*2Anasmelf_elf32 (Linux) file using Nasm'#010+ '3*2Anasmobj_obj file using Nasm'#010+ - '3*2Amasm_obj fi','le using Masm (Microsoft)'#010+ + '3*2Amasm_obj file using Masm (Microsoft)'#010+ '3*2Atasm_obj file using Tasm (Borland)'#010+ '3*2Acoff_coff (Go32v2) using internal writer'#010+ - '3*2Apecoff_pecoff (Win32) using internal writer'#010+ + '3*2Apecoff_pecoff (Win','32) using internal writer'#010+ '3*1R_assembler reading style:'#010+ '3*2Ratt_read AT&T style assembler'#010+ - '3*2Rintel_read ','Intel style assembler'#010+ + '3*2Rintel_read Intel style assembler'#010+ '3*2Rdirect_copy assembler text directly to assembler file'#010+ '3*1O_optimizations:'#010+ '3*2Og_generate smaller code'#010+ - '3*2OG_generate faster code (default)'#010+ + '3','*2OG_generate faster code (default)'#010+ '3*2Or_keep certain variables in registers'#010+ - '3*2Ou_enable uncertain optimiz','ations (see docs)'#010+ + '3*2Ou_enable uncertain optimizations (see docs)'#010+ '3*2O1_level 1 optimizations (quick optimizations)'#010+ '3*2O2_level 2 optimizations (-O1 + slower optimizations)'#010+ - '3*2O3_level 3 optimizations (-O2 repeatedly, max 5 times)'#010+ + '3*2O3_l','evel 3 optimizations (-O2 repeatedly, max 5 times)'#010+ '3*2Op_target processor:'#010+ - '3*3Op1_set target processor to',' 386/486'#010+ + '3*3Op1_set target processor to 386/486'#010+ '3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#010+ '3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#010+ - '3*1T_Target operating system:'#010+ + '3*1T_Target',' operating system:'#010+ '3*2TGO32V2_version 2 of DJ Delorie DOS extender'#010+ '3*2TWDOSX DOS 32 Bit Extender'#010+ - '3*2TLINUX_L','inux'#010+ + '3*2TLINUX_Linux'#010+ '3*2Tnetware_Novell Netware Module (experimental)'#010+ '3*2TOS2_OS/2 2.x'#010+ '3*2TSUNOS_SunOS/Solaris'#010+ '3*2TWin32_Windows 32 Bit'#010+ - '3*1W_Win32 target options'#010+ + '3*1W_Win3','2 target options'#010+ '3*2WB_Set Image base to Hexadecimal value'#010+ '3*2WC_Specify console type application'#010+ - '3*2','WD_Use DEFFILE to export functions of DLL or EXE'#010+ + '3*2WD_Use DEFFILE to export functions of DLL or EXE'#010+ '3*2WF_Specify full-screen type application (OS/2 only)'#010+ - '3*2WG_Specify graphic type application'#010+ + '3*2WG_Specify graphic type a','pplication'#010+ '3*2WN_Do not generate relocation code (necessary for debugging)'#010+ '3*2WR_Generate relocation code'#010+ - '6*','1A_output format'#010+ + '6*1A_output format'#010+ '6*2Aas_Unix o-file using GNU AS'#010+ '6*2Agas_GNU Motorola assembler'#010+ '6*2Amit_MIT Syntax (old GAS)'#010+ - '6*2Amot_Standard Motorola assembler'#010+ + '6*2Amot_Standard Mot','orola assembler'#010+ '6*1O_optimizations:'#010+ '6*2Oa_turn on the optimizer'#010+ '6*2Og_generate smaller code'#010+ - '6*2OG_generate f','aster code (default)'#010+ + '6*2OG_generate faster code (default)'#010+ '6*2Ox_optimize maximum (still BUGGY!!!)'#010+ - '6*2O2_set target processor to a MC68020+'#010+ + '6*2O0_set target processor to a MC68000'#010+ + '6*2O2_set target processor to a',' MC68020+ (default)'#010+ '6*1R_assembler reading style:'#010+ '6*2RMOT_read motorola style assembler'#010+ '6*1T_Target operating system:'#010+ '6*2TAMIGA_Commodore Amiga'#010+ - '6*2TATAR','I_Atari ST/STe/TT'#010+ + '6*2TATARI_Atari ST/STe/TT'#010+ '6*2TMACOS_Macintosh m68k'#010+ '6*2TLINUX_Linux-68k'#010+ '6*2TPALMOS_PalmOS'#010+ - '**1*_'#010+ + '*','*1*_'#010+ '**1?_shows this help'#010+ '**1h_shows this help without waiting'#000 ); diff --git a/compiler/nadd.pas b/compiler/nadd.pas index 147bd40d14..5ba772e854 100644 --- a/compiler/nadd.pas +++ b/compiler/nadd.pas @@ -70,7 +70,7 @@ implementation symconst,symtype,symdef,symsym,symtable,defbase, cgbase, htypechk,pass_1, - nmat,ncnv,ncon,nset,nopt,ncal,ninl, + nbas,nmat,ncnv,ncon,nset,nopt,ncal,ninl, {$ifdef state_tracking} nstate, {$endif} @@ -206,8 +206,8 @@ implementation Message(parser_e_division_by_zero); case rt of ordconstn: - tordconstnode(right).value := 1; - realconstn: + tordconstnode(right).value := 1; + realconstn: trealconstnode(right).value_real := 1.0; end; end; @@ -318,7 +318,10 @@ implementation t:=crealconstnode.create(lvd/rvd,pbestrealtype^); end; else - CGMessage(type_e_mismatch); + begin + CGMessage(type_e_mismatch); + t:=cnothingnode.create; + end; end; result:=t; exit; @@ -350,9 +353,7 @@ implementation t:=crealconstnode.create(exp(ln(lvd)*rvd),pbestrealtype^); end; slashn : - begin - t:=crealconstnode.create(lvd/rvd,pbestrealtype^); - end; + t:=crealconstnode.create(lvd/rvd,pbestrealtype^); ltn : t:=cordconstnode.create(ord(lvdrvd),booltype,true); else - CGMessage(type_e_mismatch); + begin + CGMessage(type_e_mismatch); + t:=cnothingnode.create; + end; end; result:=t; exit; @@ -404,6 +408,11 @@ implementation t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)=0),booltype,true); unequaln : t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<>0),booltype,true); + else + begin + CGMessage(type_e_mismatch); + t:=cnothingnode.create; + end; end; donewidestring(ws1); donewidestring(ws2); @@ -1828,7 +1837,17 @@ begin end. { $Log$ - Revision 1.68 2002-10-08 16:50:43 jonas + Revision 1.69 2002-11-15 01:58:50 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.68 2002/10/08 16:50:43 jonas * fixed web bug 2136 Revision 1.67 2002/10/05 00:47:03 peter diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 175c16617e..dd36a03ee7 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -28,6 +28,12 @@ unit ncal; interface +{$ifdef DEBUG} + {$ifdef i386} + {$define TEST_WIN32_RECORDS} + {$endif i386} +{$endif DEBUG} + uses node, {$ifdef state_tracking} @@ -334,19 +340,19 @@ implementation not( (from_def.deftype=objectdef) and (to_def.deftype=objectdef) and - + (( (tobjectdef(from_def).is_related(tobjectdef(to_def))) and - (m_delphi in aktmodeswitches) and + (m_delphi in aktmodeswitches) and (tobjectdef(from_def).objecttype=odt_object) and (tobjectdef(to_def).objecttype=odt_object) ) or - + ( (tobjectdef(from_def).is_related(tobjectdef(to_def))) and (not (m_delphi in aktmodeswitches)) )) - + ) and { passing a single element to a openarray of the same type } not( @@ -2314,8 +2320,7 @@ implementation CGMessage(cg_e_unable_inline_object_methods); if assigned(right) and (right.nodetype<>procinlinen) then CGMessage(cg_e_unable_inline_procvar); - { nodetype:=procinlinen; } - if not assigned(right) then + if not assigned(inlinecode) then begin if assigned(tprocdef(procdefinition).code) then inlinecode:=cprocinlinenode.create(tprocdef(procdefinition)) @@ -2345,11 +2350,21 @@ implementation { get a register for the return value } if (not is_void(resulttype.def)) then begin - if paramanager.ret_in_param(resulttype.def) then +{$ifdef TEST_WIN32_RECORDS} + if (target_info.system=system_i386_win32) and + (resulttype.def.deftype=recorddef) then begin + { for win32 records returned in EDX:EAX, we + move them to memory after ... } location.loc:=LOC_CREFERENCE; end else +{$endif TEST_WIN32_RECORDS} + if paramanager.ret_in_param(resulttype.def) then + begin + location.loc:=LOC_CREFERENCE; + end + else { ansi/widestrings must be registered, so we can dispose them } if is_ansistring(resulttype.def) or is_widestring(resulttype.def) then @@ -2631,6 +2646,7 @@ implementation result:=nil; end; + function tprocinlinenode.docompare(p: tnode): boolean; begin docompare := @@ -2646,7 +2662,17 @@ begin end. { $Log$ - Revision 1.106 2002-10-14 18:20:30 carl + Revision 1.107 2002-11-15 01:58:50 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.106 2002/10/14 18:20:30 carl * var parameter checking for classes and interfaces in Delphi mode Revision 1.105 2002/10/06 21:02:17 peter diff --git a/compiler/ncgbas.pas b/compiler/ncgbas.pas index 485b4c2dff..d90b436920 100644 --- a/compiler/ncgbas.pas +++ b/compiler/ncgbas.pas @@ -113,17 +113,9 @@ interface if p.proclocal then begin if not assigned(p.altsymbol) then - begin - { generatealtsymbol will also increase the refs } - objectlibrary.GenerateAltSymbol(p); - end - else - begin - { increase the refs, they will be decreased when the - asmnode is destroyed } - inc(p.refs); - end; + objectlibrary.GenerateAltSymbol(p); p:=p.altsymbol; + inc(p.refs); end; end; @@ -279,7 +271,7 @@ interface procedure tcgtempdeletenode.pass_2; begin if release_to_normal then - tg.ChangeTempType(tempinfo^.ref,tt_normal) + tg.ChangeTempType(exprasmlist,tempinfo^.ref,tt_normal) else tg.UnGetTemp(exprasmlist,tempinfo^.ref); end; @@ -296,7 +288,17 @@ begin end. { $Log$ - Revision 1.23 2002-08-23 16:14:48 peter + Revision 1.24 2002-11-15 01:58:51 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.23 2002/08/23 16:14:48 peter * tempgen cleanup * tt_noreuse temp type added that will be used in genentrycode diff --git a/compiler/ncgcal.pas b/compiler/ncgcal.pas index 3021f50ce4..e446b907d8 100644 --- a/compiler/ncgcal.pas +++ b/compiler/ncgcal.pas @@ -29,6 +29,7 @@ interface { $define AnsiStrRef} uses + cpubase, symdef,node,ncal; type @@ -39,15 +40,21 @@ interface end; tcgcallnode = class(tcallnode) - procedure pass_2;override; + protected + funcretref : treference; + refcountedtemp : treference; + procedure handle_return_value(inlined,extended_new:boolean); procedure load_framepointer;virtual;abstract; procedure extra_interrupt_code;virtual; + public + procedure pass_2;override; end; tcgprocinlinenode = class(tprocinlinenode) procedure pass_2;override; end; + implementation uses @@ -63,12 +70,12 @@ implementation gdb, {$endif GDB} cginfo,cgbase,pass_2, - cpuinfo,cpubase,cpupi,aasmbase,aasmtai,aasmcpu, + cpuinfo,cpupi,aasmbase,aasmtai,aasmcpu, nmem,nld,ncnv, {$ifdef i386} cga, {$endif i386} - ncgutil,cgobj,tgobj,regvars,rgobj,rgcpu,cgcpu; + cg64f32,ncgutil,cgobj,tgobj,regvars,rgobj,rgcpu,cgcpu; {***************************************************************************** TCGCALLPARANODE @@ -189,7 +196,8 @@ implementation (left.nodetype=selfn)) then internalerror(200106041); end; - maybe_push_high; + if not push_from_left_to_right then + maybe_push_high; if (defcoll.paratyp=vs_out) and assigned(defcoll.paratype.def) and not is_class(defcoll.paratype.def) and @@ -207,6 +215,8 @@ implementation else cg.a_paramaddr_ref(exprasmlist,left.location.reference,defcoll.paraloc); location_release(exprasmlist,left.location); + if push_from_left_to_right then + maybe_push_high; end else begin @@ -245,7 +255,8 @@ implementation internalerror(200204011); end; - maybe_push_high; + if not push_from_left_to_right then + maybe_push_high; inc(pushedparasize,4); if inlined then begin @@ -258,6 +269,8 @@ implementation else cg.a_paramaddr_ref(exprasmlist,left.location.reference,defcoll.paraloc); location_release(exprasmlist,left.location); + if push_from_left_to_right then + maybe_push_high; end else begin @@ -294,12 +307,125 @@ implementation {$endif i386} end; + + + procedure tcgcallnode.handle_return_value(inlined,extended_new:boolean); + var + cgsize : tcgsize; + hregister : tregister; + begin + { structured results are easy to handle.... } + { needed also when result_no_used !! } + if paramanager.ret_in_param(resulttype.def) then + begin + location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def)); + location.reference.symbol:=nil; + location.reference:=funcretref; + end + else + { ansi/widestrings must be registered, so we can dispose them } + if is_ansistring(resulttype.def) or + is_widestring(resulttype.def) then + begin + location_reset(location,LOC_CREFERENCE,OS_ADDR); + location.reference:=refcountedtemp; + cg.a_reg_alloc(exprasmlist,accumulator); + cg.a_load_reg_ref(exprasmlist,OS_ADDR,accumulator,location.reference); + cg.a_reg_dealloc(exprasmlist,accumulator); + end + else + { we have only to handle the result if it is used } + if (nf_return_value_used in flags) then + begin + case resulttype.def.deftype of + enumdef, + orddef : + begin + cgsize:=def_cgsize(resulttype.def); + { an object constructor is a function with boolean result } + if (inlined or (right=nil)) and + (procdefinition.proctypeoption=potype_constructor) then + begin +{$ifdef x86} + if extended_new then + cgsize:=OS_INT + else + begin + cgsize:=OS_NO; + { this fails if popsize > 0 PM } + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=F_NE; + end; +{$else x86} + cgsize:=OS_INT +{$endif x86} + end; + + if cgsize<>OS_NO then + begin + location_reset(location,LOC_REGISTER,cgsize); + cg.a_reg_alloc(exprasmlist,accumulator); +{$ifndef cpu64bit} + if cgsize in [OS_64,OS_S64] then + begin + cg.a_reg_alloc(exprasmlist,accumulatorhigh); + location.registerhigh:=rg.getexplicitregisterint(exprasmlist,accumulatorhigh); + location.registerlow:=rg.getexplicitregisterint(exprasmlist,accumulator); + cg64.a_load64_reg_reg(exprasmlist,joinreg64(accumulator,accumulatorhigh), + location.register64); + end + else +{$endif cpu64bit} + begin + location.register:=rg.getexplicitregisterint(exprasmlist,accumulator); + hregister:=rg.makeregsize(accumulator,cgsize); + location.register:=rg.makeregsize(location.register,cgsize); + cg.a_load_reg_reg(exprasmlist,cgsize,cgsize,hregister,location.register); + end; + end; + end; + floatdef : + begin + location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def)); + location.register:=R_ST; +{$ifdef x86} + inc(trgcpu(rg).fpuvaroffset); +{$endif x86} + end; +{$ifdef TEST_WIN32_RECORDS} + recorddef : + begin + if (target_info.system=system_i386_win32) then + begin + location_reset(location,LOC_REFERENCE,def_cgsize(resulttype.def)); + tg.GetTemp(exprasmlist,resulttype.size,tt_normal,location); +{$ifndef cpu64bit} + if cgsize in [OS_64,OS_S64] then + cg64.a_load64_reg_loc(exprasmlist,joinreg64(accumulator,accumulatorhigh),location) + else +{$endif cpu64bit} + cg.a_load_reg_loc(exprasmlist,accumulator,location); + end + else + internalerror(200211141); + end; +{$endif TEST_WIN32_RECORDS} + else + begin + location_reset(location,LOC_REGISTER,OS_INT); + location.register:=rg.getexplicitregisterint(exprasmlist,accumulator); + cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,accumulator,location.register); + end; + end; + end; + end; + + procedure tcgcallnode.pass_2; var regs_to_push : tregisterset; unusedstate: pointer; pushed : tpushedsaved; - funcretref,refcountedtemp : treference; tmpreg : tregister; hregister : tregister; hregister64 : tregister64; @@ -392,6 +518,7 @@ implementation tprocdef(procdefinition).parast.symtablelevel:=aktprocdef.localst.symtablelevel; if assigned(params) then begin + inlinecode.para_size:=tprocdef(procdefinition).para_size(para_alignment); tg.GetTemp(exprasmlist,inlinecode.para_size,tt_persistant,pararef); inlinecode.para_offset:=pararef.offset; end; @@ -540,7 +667,8 @@ implementation end; { Allocate return value for inlined routines } - if inlined then + if inlined and + (resulttype.def.size>0) then begin tg.GetTemp(exprasmlist,Align(resulttype.def.size,aktalignment.paraalign),tt_persistant,returnref); inlinecode.retoffset:=returnref.offset; @@ -777,6 +905,7 @@ implementation { class method needs current VMT } rg.getexplicitregisterint(exprasmlist,R_ESI); reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset); + cg.a_maybe_testself(exprasmlist); cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,self_pointer_reg); end; @@ -836,6 +965,7 @@ implementation { class method needs current VMT } rg.getexplicitregisterint(exprasmlist,R_ESI); reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset); + cg.a_maybe_testself(exprasmlist); cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,R_ESI); end else @@ -942,6 +1072,7 @@ implementation begin { this is one point where we need vmt_offset (PM) } reference_reset_base(href,R_ESI,tprocdef(procdefinition)._class.vmt_offset); + cg.a_maybe_testself(exprasmlist); tmpreg:=cg.get_scratch_reg_address(exprasmlist); cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,tmpreg); reference_reset_base(href,tmpreg,0); @@ -1143,89 +1274,7 @@ implementation { handle function results } if (not is_void(resulttype.def)) then - begin - { structured results are easy to handle.... } - { needed also when result_no_used !! } - if paramanager.ret_in_param(resulttype.def) then - begin - location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def)); - location.reference:=funcretref; - end - else - { ansi/widestrings must be registered, so we can dispose them } - if is_ansistring(resulttype.def) or - is_widestring(resulttype.def) then - begin - location_reset(location,LOC_CREFERENCE,OS_ADDR); - location.reference:=refcountedtemp; - cg.a_reg_alloc(exprasmlist,accumulator); - cg.a_load_reg_ref(exprasmlist,OS_ADDR,accumulator,location.reference); - cg.a_reg_dealloc(exprasmlist,accumulator); - end - else - { we have only to handle the result if it is used } - if (nf_return_value_used in flags) and paramanager.ret_in_reg(resulttype.def) then - begin - resultloc:=paramanager.getfuncresultloc(resulttype.def); -{$ifdef dummy} - { an object constructor is a function with boolean result } - if (inlined or (right=nil)) and - (procdefinition.proctypeoption=potype_constructor) then - begin - if extended_new then - cgsize:=OS_INT - else - begin - cgsize:=OS_NO; - { this fails if popsize > 0 PM } - location_reset(location,LOC_FLAGS,OS_NO); - location.resflags:=F_NE; - end; - end; -{$endif dummy} - cgsize:=resultloc.size; - case resultloc.loc of - LOC_REGISTER: - begin - location_reset(location,LOC_REGISTER,cgsize); -{$ifndef cpu64bit} - if cgsize in [OS_64,OS_S64] then - begin - cg64.a_reg_alloc(exprasmlist,resultloc.register64); - { FIX ME !!! - location.register:=rg.getexplicitregisterint(exprasmlist,resultloc.register64); - } - location.register64.reglo:=rg.getexplicitregisterint(exprasmlist,resultloc.register64.reglo); - location.register64.reghi:=rg.getexplicitregisterint(exprasmlist,resultloc.register64.reghi); - cg64.a_load64_reg_reg(exprasmlist,resultloc.register64,location.register64); - end - else -{$endif cpu64bit} - begin - cg.a_reg_alloc(exprasmlist,resultloc.register); - location.register:=rg.getexplicitregisterint(exprasmlist,resultloc.register); - hregister:=rg.makeregsize(resultloc.register,cgsize); - location.register:=rg.makeregsize(location.register,cgsize); - cg.a_load_reg_reg(exprasmlist,cgsize,cgsize,hregister,location.register); - end; - end; - LOC_FPUREGISTER: - begin - location_reset(location,LOC_FPUREGISTER,cgsize); - cg.a_reg_alloc(exprasmlist,resultloc.register); - location.register:=rg.getexplicitregisterfpu(exprasmlist,resultloc.register); - cg.a_loadfpu_reg_reg(exprasmlist,resultloc.register,location.register); - if (resultloc.register <> location.register) then - cg.a_reg_dealloc(exprasmlist,resultloc.register); -{$ifdef x86} - inc(trgcpu(rg).fpuvaroffset); -{$endif x86} - end; - else - internalerror(2002081701); - end; - end; - end; + handle_return_value(inlined,extended_new); { perhaps i/o check ? } if iolabel<>nil then @@ -1270,7 +1319,8 @@ implementation end; if inlined then begin - tg.ungettemp(exprasmlist,pararef); + if (resulttype.def.size>0) then + tg.UnGetTemp(exprasmlist,returnref); tprocdef(procdefinition).parast.address_fixup:=store_parast_fixup; right:=inlinecode; end; @@ -1279,7 +1329,7 @@ implementation { from now on the result can be freed normally } if inlined and paramanager.ret_in_param(resulttype.def) then - tg.ChangeTempType(funcretref,tt_normal); + tg.ChangeTempType(exprasmlist,funcretref,tt_normal); { if return value is not used } if (not(nf_return_value_used in flags)) and (not is_void(resulttype.def)) then @@ -1492,7 +1542,17 @@ begin end. { $Log$ - Revision 1.25 2002-10-05 12:43:25 carl + Revision 1.26 2002-11-15 01:58:51 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.25 2002/10/05 12:43:25 carl * fixes for Delphi 6 compilation (warning : Some features do not work under Delphi) diff --git a/compiler/ncgld.pas b/compiler/ncgld.pas index 9f0f1969f6..8e23352472 100644 --- a/compiler/ncgld.pas +++ b/compiler/ncgld.pas @@ -827,8 +827,11 @@ implementation u64bit: vtype:=vtQWord; end; - freetemp:=false; - vaddr:=true; + if not(nf_cargs in flags) then + begin + freetemp:=false; + vaddr:=true; + end; end else if (lt.deftype=enumdef) or is_integer(lt) then @@ -850,8 +853,11 @@ implementation floatdef : begin vtype:=vtExtended; - vaddr:=true; - freetemp:=false; + if not(nf_cargs in flags) then + begin + freetemp:=false; + vaddr:=true; + end; end; procvardef, pointerdef : @@ -905,10 +911,16 @@ implementation location_release(exprasmlist,hp.left.location); if freetemp then location_freetemp(exprasmlist,hp.left.location); + inc(pushedparasize,pointer_size); end else - cg.a_param_loc(exprasmlist,hp.left.location,paralocdummy); - inc(pushedparasize,pointer_size); + if vtype in [vtInt64,vtQword,vtExtended] then + push_value_para(hp.left,false,true,0,4,paralocdummy) + else + begin + cg.a_param_loc(exprasmlist,hp.left.location,paralocdummy); + inc(pushedparasize,pointer_size); + end; end else begin @@ -977,7 +989,17 @@ begin end. { $Log$ - Revision 1.35 2002-10-14 19:44:13 peter + Revision 1.36 2002-11-15 01:58:51 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.35 2002/10/14 19:44:13 peter * (hacked) new threadvar relocate code Revision 1.34 2002/10/13 11:22:06 florian diff --git a/compiler/ncgmem.pas b/compiler/ncgmem.pas index 5c5888d80c..8415344e03 100644 --- a/compiler/ncgmem.pas +++ b/compiler/ncgmem.pas @@ -258,7 +258,8 @@ implementation end; end; if (cs_gdb_heaptrc in aktglobalswitches) and - (cs_checkpointer in aktglobalswitches) then + (cs_checkpointer in aktglobalswitches) and + not(cs_compilesystem in aktmoduleswitches) then begin cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(1)); cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER'); @@ -345,6 +346,8 @@ implementation var tmpreg: tregister; usetemp,with_expr_in_temp : boolean; + symtable : twithsymtable; + i : integer; {$ifdef GDB} withstartlabel,withendlabel : tasmlabel; pp : pchar; @@ -392,15 +395,22 @@ implementation location_release(exprasmlist,left.location); + symtable:=withsymtable; + for i:=1 to tablecount do + begin + if (left.nodetype=loadn) and + (tloadnode(left).symtable=aktprocdef.localst) then + symtable.direct_with:=true; + symtable.withnode:=self; + symtable:=twithsymtable(symtable.next); + end; + { if the with expression is stored in a temp } { area we must make it persistent and shouldn't } { release it (FK) } if (left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) and tg.istemp(left.location.reference) then - begin - tg.ChangeTempType(left.location.reference,tt_persistant); - with_expr_in_temp:=true; - end + with_expr_in_temp:=tg.ChangeTempType(exprasmlist,left.location.reference,tt_persistant) else with_expr_in_temp:=false; @@ -887,7 +897,17 @@ begin end. { $Log$ - Revision 1.31 2002-10-09 20:24:47 florian + Revision 1.32 2002-11-15 01:58:51 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.31 2002/10/09 20:24:47 florian + range checking for dyn. arrays Revision 1.30 2002/10/07 21:30:45 peter diff --git a/compiler/ncgutil.pas b/compiler/ncgutil.pas index fabd711d2c..67ab0a5a96 100644 --- a/compiler/ncgutil.pas +++ b/compiler/ncgutil.pas @@ -1147,7 +1147,17 @@ implementation begin uses_acc:=true; cg.a_reg_alloc(list,accumulator); - cg.a_load_ref_reg(list,cgsize,href,accumulator); +{$ifndef cpu64bit} + { Win32 can return records in EAX:EDX } + if cgsize in [OS_64,OS_S64] then + begin + uses_acchi:=true; + cg.a_reg_alloc(list,accumulatorhigh); + cg64.a_load64_ref_reg(list,href,joinreg64(accumulator,accumulatorhigh)); + end + else +{$endif cpu64bit} + cg.a_load_ref_reg(list,cgsize,href,accumulator); end end; end; @@ -1362,7 +1372,13 @@ implementation { initialize profiling for win32 } if (target_info.system in [system_i386_win32,system_i386_wdosx]) and (cs_profile in aktmoduleswitches) then - cg.a_call_name(list,'__monstartup'); + begin + reference_reset_symbol(href,objectlibrary.newasmsymbol('etext'),0); + cg.a_paramaddr_ref(list,href,paraloc); + reference_reset_symbol(href,objectlibrary.newasmsymbol('__image_base__'),0); + cg.a_paramaddr_ref(list,href,paraloc); + cg.a_call_name(list,'monstartup'); + end; { initialize units } cg.a_call_name(list,'FPC_INITIALIZEUNITS'); @@ -1617,7 +1633,12 @@ implementation if (not DLLsource) and (not inlined) and (aktprocdef.proctypeoption=potype_proginit) then - cg.a_call_name(list,'FPC_DO_EXIT'); + begin + {if (target_info.system=system_i386_win32) and + (cs_profile in aktmoduleswitches) then + cg.a_call_name(list,'__mcleanup'); } + cg.a_call_name(list,'FPC_DO_EXIT'); + end; { handle return value, this is not done for assembler routines when they didn't reference the result variable } @@ -1846,7 +1867,17 @@ implementation end. { $Log$ - Revision 1.58 2002-11-10 19:07:45 mazen + Revision 1.59 2002-11-15 01:58:51 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.58 2002/11/10 19:07:45 mazen * SPARC calling mechanism almost OK (as in GCC./mppcsparc ) Revision 1.57 2002/11/03 20:22:40 mazen diff --git a/compiler/ninl.pas b/compiler/ninl.pas index 5eee2dcaf6..a4386a3902 100644 --- a/compiler/ninl.pas +++ b/compiler/ninl.pas @@ -1531,6 +1531,11 @@ implementation is_array_of_const(left.resulttype.def) then begin srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+tvarsym(tloadnode(left).symtableentry).name); + if not assigned(srsym) then + begin + CGMessage(cg_e_illegal_expression); + goto myexit; + end; hp:=caddnode.create(addn,cloadnode.create(srsym,tloadnode(left).symtable), cordconstnode.create(1,s32bittype,false)); result:=hp; @@ -2407,7 +2412,17 @@ begin end. { $Log$ - Revision 1.93 2002-10-10 19:24:58 florian + Revision 1.94 2002-11-15 01:58:52 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.93 2002/10/10 19:24:58 florian + write(ln) support for variants added Revision 1.92 2002/10/10 16:07:57 florian diff --git a/compiler/nld.pas b/compiler/nld.pas index 42a5a95bd7..f6a3497219 100644 --- a/compiler/nld.pas +++ b/compiler/nld.pas @@ -524,18 +524,13 @@ implementation resulttype:=voidtype; { must be made unique } - if assigned(left) then - begin - set_unique(left); - - { set we the function result? } - set_funcret_is_valid(left); - end; + set_unique(left); resulttypepass(left); resulttypepass(right); set_varstate(left,false); set_varstate(right,true); + set_funcret_is_valid(left); if codegenerror then exit; @@ -958,7 +953,11 @@ implementation end; floatdef : begin - hp.left:=ctypeconvnode.create(hp.left,pbestrealtype^); + { C uses 64bit floats } + if nf_cargs in flags then + hp.left:=ctypeconvnode.create(hp.left,s64floattype) + else + hp.left:=ctypeconvnode.create(hp.left,pbestrealtype^); firstpass(hp.left); end; stringdef : @@ -1182,7 +1181,17 @@ begin end. { $Log$ - Revision 1.63 2002-10-17 12:44:09 florian + Revision 1.64 2002-11-15 01:58:52 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.63 2002/10/17 12:44:09 florian + s:=s+ where s is an ansistring is done via calls to append_ansistring_* Revision 1.62 2002/10/05 12:43:25 carl diff --git a/compiler/nobj.pas b/compiler/nobj.pas index a39180d89f..7b0bc9b6a7 100644 --- a/compiler/nobj.pas +++ b/compiler/nobj.pas @@ -273,15 +273,20 @@ implementation end; procedure tclassheader.writenames(p : pprocdeftree); - + var + ca : pchar; + len : longint; begin objectlibrary.getdatalabel(p^.nl); if assigned(p^.l) then writenames(p^.l); datasegment.concat(tai_align.create(const_align(POINTER_SIZE))); dataSegment.concat(Tai_label.Create(p^.nl)); - dataSegment.concat(Tai_const.Create_8bit(strlen(p^.data.messageinf.str))); - dataSegment.concat(Tai_string.Create_pchar(p^.data.messageinf.str)); + len:=strlen(p^.data.messageinf.str); + datasegment.concat(tai_const.create_8bit(len)); + getmem(ca,len+1); + move(p^.data.messageinf.str^,ca^,len+1); + dataSegment.concat(Tai_string.Create_pchar(ca)); if assigned(p^.r) then writenames(p^.r); end; @@ -872,7 +877,7 @@ implementation dataSegment.concat(Tai_const.Create_32bit(implintf.ioffsets(contintfindex)^)); { IIDStr } objectlibrary.getdatalabel(tmplabel); - rawdata.concat(tai_align.create(const_align(pointer_size))); + rawdata.concat(tai_align.create(const_align(pointer_size))); rawdata.concat(Tai_label.Create(tmplabel)); rawdata.concat(Tai_const.Create_8bit(length(curintf.iidstr^))); if curintf.objecttype=odt_interfacecom then @@ -1328,7 +1333,17 @@ initialization end. { $Log$ - Revision 1.35 2002-11-09 16:19:43 carl + Revision 1.36 2002-11-15 01:58:52 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.35 2002/11/09 16:19:43 carl - remove superfluous data in classname Revision 1.34 2002/11/09 15:35:35 carl diff --git a/compiler/options.pas b/compiler/options.pas index dbc257d814..4b7cf882ef 100644 --- a/compiler/options.pas +++ b/compiler/options.pas @@ -105,6 +105,7 @@ begin if s='' then exit; initdefines.insert(upper(s)); + Message1(option_defining_symbol,s); end; @@ -113,6 +114,7 @@ begin if s='' then exit; InitDefines.Remove(s); + Message1(option_undefining_symbol,s); end; @@ -366,554 +368,752 @@ begin { only parse define,undef,target,verbosity and link options the firsttime } if firstpass and - not((opt[1]='-') and (opt[2] in ['i','d','v','T','u','n','X'])) then + not((opt[1]='-') and (opt[2] in ['i','d','v','V','T','u','n','X'])) then exit; Message1(option_handling_option,opt); case opt[1] of - '-' : begin + '-' : + begin more:=Copy(opt,3,255); - case opt[2] of - '!' : initlocalswitches:=initlocalswitches+[cs_ansistrings]; - '?' : WriteHelpPages; - 'a' : begin - initglobalswitches:=initglobalswitches+[cs_asm_leave]; - for j:=1 to length(more) do - case more[j] of - 'l' : include(initglobalswitches,cs_asm_source); - 'r' : include(initglobalswitches,cs_asm_regalloc); - 't' : include(initglobalswitches,cs_asm_tempalloc); - 'n' : include(initglobalswitches,cs_asm_nodes); - '-' : initglobalswitches:=initglobalswitches - - [cs_asm_leave, cs_asm_source,cs_asm_regalloc, cs_asm_tempalloc]; - else - IllegalPara(opt); - end; - end; - 'A' : begin - if set_target_asm_by_string(More) then - asm_is_set:=true - else - IllegalPara(opt); - end; - 'b' : begin - if UnsetBool(More,0) then - begin - exclude(initmoduleswitches,cs_browser); - exclude(initmoduleswitches,cs_local_browser); -{$ifdef BrowserLog} - exclude(initglobalswitches,cs_browser_log); -{$endif} - end - else - begin - include(initmoduleswitches,cs_browser); -{$ifdef BrowserLog} - include(initglobalswitches,cs_browser_log); -{$endif} - end; - if More<>'' then - if (More='l') or (More='l+') then - include(initmoduleswitches,cs_local_browser) - else - if More='l-' then - exclude(initmoduleswitches,cs_local_browser) - else -{$ifdef BrowserLog} - browserlog.elements_to_list.insert(more); -{$else} - IllegalPara(opt); -{$endif} - end; - 'B' : do_build:=not UnSetBool(more,0); - 'C' : begin - j := 1; - while j <= length(more) Do - Begin - case more[j] of - 'a' : Message2(option_obsolete_switch_use_new,'-Ca','-Or'); - 'c' : - begin - if not SetAktProcCall(upper(copy(more,j+1,length(more)-j)),true) then - IllegalPara(opt); - break; - end; - 'h' : - begin - val(copy(more,j+1,length(more)-j),heapsize,code); - if (code<>0) or (heapsize>=67107840) or (heapsize<1024) then - IllegalPara(opt); - break; - end; - 'i' : - If UnsetBool(More, j) then - exclude(initlocalswitches,cs_check_io) - else - include(initlocalswitches,cs_check_io); - 'n' : - If UnsetBool(More, j) then - exclude(initglobalswitches,cs_link_extern) - Else - include(initglobalswitches,cs_link_extern); - 'o' : - If UnsetBool(More, j) then - exclude(initlocalswitches,cs_check_overflow) - Else - include(initlocalswitches,cs_check_overflow); - 'r' : - If UnsetBool(More, j) then - exclude(initlocalswitches,cs_check_range) - Else - include(initlocalswitches,cs_check_range); - 'R' : - If UnsetBool(More, j) then - begin - exclude(initlocalswitches,cs_check_range); - exclude(initlocalswitches,cs_check_object); - end - Else - begin - include(initlocalswitches,cs_check_range); - include(initlocalswitches,cs_check_object); - end; - 's' : - begin - val(copy(more,j+1,length(more)-j),stacksize,code); - if (code<>0) or (stacksize>=67107840) or (stacksize<1024) then - IllegalPara(opt); - break; - end; - 't' : - If UnsetBool(More, j) then - exclude(initlocalswitches,cs_check_stack) - Else - include(initlocalswitches,cs_check_stack); - 'D' : - If UnsetBool(More, j) then - exclude(initmoduleswitches,cs_create_dynamic) - Else - include(initmoduleswitches,cs_create_dynamic); - 'X' : - If UnsetBool(More, j) then - exclude(initmoduleswitches,cs_create_smart) - Else - include(initmoduleswitches,cs_create_smart); - else - IllegalPara(opt); - end; - inc(j); - end; - end; - 'd' : def_symbol(more); - 'D' : begin - include(initglobalswitches,cs_link_deffile); - for j:=1 to length(more) do - case more[j] of - 'd' : begin - description:=Copy(more,j+1,255); - break; - end; - 'v' : begin - dllversion:=Copy(more,j+1,255); - l:=pos('.',dllversion); - dllminor:=0; - error:=0; - if l>0 then - begin - valint(copy(dllversion,l+1,255),minor,error); - if (error=0) and - (minor>=0) and (minor<=$ffff) then - dllminor:=minor - else if error=0 then - error:=1; - end; - if l=0 then l:=256; - dllmajor:=1; - if error=0 then - valint(copy(dllversion,1,l-1),major,error); - if (error=0) and (major>=0) and (major<=$ffff) then - dllmajor:=major - else if error=0 then - error:=1; - if error<>0 then - Message1(scan_w_wrong_version_ignored,dllversion); - break; - end; - 'w' : usewindowapi:=true; - '-' : begin - exclude(initglobalswitches,cs_link_deffile); - usewindowapi:=false; - end; - else - IllegalPara(opt); - end; - end; - 'e' : exepath:=FixPath(More,true); - { Just used by RHIDE } - 'E' : if UnsetBool(More, 0) then - exclude(initglobalswitches,cs_link_extern) - else - include(initglobalswitches,cs_link_extern); - 'F' : begin - c:=more[1]; - Delete(more,1,1); - DefaultReplacements(More); - case c of - 'c' : begin - if not(cpavailable(more)) then - Message1(option_code_page_not_available,more) - else - initsourcecodepage:=more; - end; - 'D' : utilsdirectory:=FixPath(More,true); - 'e' : SetRedirectFile(More); - 'E' : OutputExeDir:=FixPath(More,true); - 'i' : if ispara then - ParaIncludePath.AddPath(More,false) - else - includesearchpath.AddPath(More,true); - 'g' : Message2(option_obsolete_switch_use_new,'-Fg','-Fl'); - 'l' : if ispara then - ParaLibraryPath.AddPath(More,false) - else - LibrarySearchPath.AddPath(More,true); - 'L' : if More<>'' then - ParaDynamicLinker:=More - else - IllegalPara(opt); - 'o' : if ispara then - ParaObjectPath.AddPath(More,false) - else - ObjectSearchPath.AddPath(More,true); - 'r' : Msgfilename:=More; - 'u' : if ispara then - ParaUnitPath.AddPath(More,false) - else - unitsearchpath.AddPath(More,true); - 'U' : OutputUnitDir:=FixPath(More,true); - else - IllegalPara(opt); - end; - end; - 'g' : begin - if UnsetBool(More, 0) then - begin - exclude(initmoduleswitches,cs_debuginfo); - exclude(initglobalswitches,cs_gdb_dbx); - exclude(initglobalswitches,cs_gdb_gsym); - exclude(initglobalswitches,cs_gdb_heaptrc); - exclude(initglobalswitches,cs_gdb_lineinfo); - exclude(initglobalswitches,cs_checkpointer); - end - else - begin -{$ifdef GDB} - include(initmoduleswitches,cs_debuginfo); - if not RelocSectionSetExplicitly then - RelocSection:=false; - for j:=1 to length(more) do - case more[j] of - 'd' : if UnsetBool(More, j) then - exclude(initglobalswitches,cs_gdb_dbx) - else - include(initglobalswitches,cs_gdb_dbx); - 'g' : if UnsetBool(More, j) then - exclude(initglobalswitches,cs_gdb_gsym) - else - include(initglobalswitches,cs_gdb_gsym); - 'h' : if UnsetBool(More, j) then - exclude(initglobalswitches,cs_gdb_heaptrc) - else - include(initglobalswitches,cs_gdb_heaptrc); - 'l' : if UnsetBool(More, j) then - exclude(initglobalswitches,cs_gdb_lineinfo) - else - include(initglobalswitches,cs_gdb_lineinfo); - 'c' : if UnsetBool(More, j) then - exclude(initglobalswitches,cs_checkpointer) - else - include(initglobalswitches,cs_checkpointer); - else - IllegalPara(opt); - end; -{$else GDB} - Message(option_no_debug_support); - Message(option_no_debug_support_recompile_fpc); -{$endif GDB} - end; - end; - 'h' : begin - NoPressEnter:=true; - WriteHelpPages; - end; - 'i' : if More='' then - WriteInfo - else - QuickInfo:=QuickInfo+More; - 'I' : if ispara then - ParaIncludePath.AddPath(More,false) - else - includesearchpath.AddPath(More,false); - 'k' : if more<>'' then - ParaLinkOptions:=ParaLinkOptions+' '+More - else - IllegalPara(opt); - 'l' : DoWriteLogo:=not UnSetBool(more,0); - 'm' : parapreprocess:=not UnSetBool(more,0); - 'n' : if More='' then - disable_configfile:=true - else - IllegalPara(opt); - 'o' : if More<>'' then - Fsplit(More,d,OutputFile,e) - else - IllegalPara(opt); - 'p' : begin - if UnsetBool(More, 0) then - begin - initmoduleswitches:=initmoduleswitches-[cs_profile]; - undef_symbol('FPC_PROFILE'); - end - else - if Length(More)=0 then - IllegalPara(opt) - else - case more[1] of - 'g' : if UnsetBool(more, 1) then - begin - exclude(initmoduleswitches,cs_profile); - undef_symbol('FPC_PROFILE'); - end - else - begin - include(initmoduleswitches,cs_profile); - def_symbol('FPC_PROFILE'); - end; - else - IllegalPara(opt); - end; - end; -{$ifdef Unix} - 'P' : if UnsetBool(More, 0) then - exclude(initglobalswitches,cs_asm_pipe) - else - include(initglobalswitches,cs_asm_pipe); -{$endif Unix} - 's' : - begin - if UnsetBool(More, 0) then - begin - initglobalswitches:=initglobalswitches-[cs_asm_extern,cs_link_extern]; - if more<>'' then - IllegalPara(opt); - end - else - begin - initglobalswitches:=initglobalswitches+[cs_asm_extern,cs_link_extern]; - if more='h' then - initglobalswitches:=initglobalswitches-[cs_link_on_target] - else if more='t' then - initglobalswitches:=initglobalswitches+[cs_link_on_target] - else if more<>'' then - IllegalPara(opt); - end; - end; - 'S' : begin - if more[1]='I' then - begin - if upper(more)='ICOM' then - initinterfacetype:=it_interfacecom - else if upper(more)='ICORBA' then - initinterfacetype:=it_interfacecorba - else - IllegalPara(opt); - end - else - for j:=1 to length(more) do - case more[j] of - '2' : SetCompileMode('OBJFPC',true); - 'a' : include(initlocalswitches,cs_do_assertion); - 'c' : include(initmoduleswitches,cs_support_c_operators); - 'd' : SetCompileMode('DELPHI',true); - 'e' : begin - SetErrorFlags(copy(more,j+1,length(more))); - break; - end; - 'g' : include(initmoduleswitches,cs_support_goto); - 'h' : include(initlocalswitches,cs_ansistrings); - 'i' : include(initmoduleswitches,cs_support_inline); - 'm' : include(initmoduleswitches,cs_support_macro); - 'o' : SetCompileMode('TP',true); - 'p' : SetCompileMode('GPC',true); - 's' : include(initglobalswitches,cs_constructor_name); - 't' : include(initmoduleswitches,cs_static_keyword); - '-' : begin - exclude(initglobalswitches,cs_constructor_name); - initlocalswitches:=InitLocalswitches - [cs_do_assertion, cs_ansistrings]; - initmoduleswitches:=initmoduleswitches - [cs_support_c_operators, cs_support_goto, - cs_support_inline, cs_support_macro, - cs_static_keyword]; - end; - else - IllegalPara(opt); - end; - end; - 'T' : begin - more:=Upper(More); - if not target_is_set then - begin - { remove old target define } - TargetDefines(false); - { Save assembler if set } - if asm_is_set then - forceasm:=target_asm.id; - { load new target } - if not(set_target_by_string(More)) then - IllegalPara(opt); - { also initialize assembler if not explicitly set } - if asm_is_set then - set_target_asm(forceasm); - { set new define } - TargetDefines(true); - target_is_set:=true; - end - else - if More<>upper(target_info.shortname) then - Message1(option_target_is_already_set,target_info.shortname); - end; - 'u' : undef_symbol(upper(More)); - 'U' : begin - for j:=1 to length(more) do - case more[j] of -{$ifdef UNITALIASES} - 'a' : begin - AddUnitAlias(Copy(More,j+1,255)); - break; - end; -{$endif UNITALIASES} - 'n' : exclude(initglobalswitches,cs_check_unit_name); - 'p' : begin - Message2(option_obsolete_switch_use_new,'-Up','-Fu'); - break; - end; - 'r' : do_release:=true; - 's' : include(initmoduleswitches,cs_compilesystem); - '-' : begin - exclude(initmoduleswitches,cs_compilesystem); - exclude(initglobalswitches,cs_check_unit_name); - end; - else - IllegalPara(opt); - end; - end; - 'v' : if not setverbosity(More) then - IllegalPara(opt); - 'W' : begin - j:=0; - while jj) then - begin - if DLLImageBase=nil then - DLLImageBase:=StringDup(Copy(More,j+1,255)); - end - else - begin - RelocSection:=true; - RelocSectionSetExplicitly:=true; - end; - break; - end; - 'C': if UnsetBool(More, j) then - apptype:=app_gui - else - apptype:=app_cui; - 'D': ForceDeffileForExport:=not UnsetBool(More, j); - 'F': apptype:=app_fs; - 'G': if UnsetBool(More, j) then - apptype:=app_cui - else - apptype:=app_gui; - 'N': begin - RelocSection:=UnsetBool(More,j); - RelocSectionSetExplicitly:=true; - end; - 'R': begin - { support -WR+ / -WR- as synonims to -WR / -WN } - RelocSection:=not UnsetBool(More,j); - RelocSectionSetExplicitly:=true; - end; - else - IllegalPara(opt); - end; - end; {of while} - end; - 'X' : begin - for j:=1 to length(More) do - case More[j] of - 'i' : include(initglobalswitches,cs_link_internal); - 'm' : include(initglobalswitches,cs_link_map); - 's' : include(initglobalswitches,cs_link_strip); - 't' : include(initglobalswitches,cs_link_staticflag); - 'D' : begin - def_symbol('FPC_LINK_DYNAMIC'); - undef_symbol('FPC_LINK_SMART'); - undef_symbol('FPC_LINK_STATIC'); - exclude(initglobalswitches,cs_link_static); - exclude(initglobalswitches,cs_link_smart); - include(initglobalswitches,cs_link_shared); - LinkTypeSetExplicitly:=true; - end; - 'S' : begin - def_symbol('FPC_LINK_STATIC'); - undef_symbol('FPC_LINK_SMART'); - undef_symbol('FPC_LINK_DYNAMIC'); - include(initglobalswitches,cs_link_static); - exclude(initglobalswitches,cs_link_smart); - exclude(initglobalswitches,cs_link_shared); - LinkTypeSetExplicitly:=true; - end; - 'X' : begin - def_symbol('FPC_LINK_SMART'); - undef_symbol('FPC_LINK_STATIC'); - undef_symbol('FPC_LINK_DYNAMIC'); - exclude(initglobalswitches,cs_link_static); - include(initglobalswitches,cs_link_smart); - exclude(initglobalswitches,cs_link_shared); - LinkTypeSetExplicitly:=true; - end; - '-' : begin - exclude(initglobalswitches,cs_link_staticflag); - exclude(initglobalswitches,cs_link_strip); - exclude(initglobalswitches,cs_link_map); - set_default_link_type; - end; - else - IllegalPara(opt); - end; - end; - { give processor specific options a chance } + if firstpass then + Message1(option_interpreting_firstpass_option,opt) else - interpret_proc_specific_options(opt); + Message1(option_interpreting_option,opt); + case opt[2] of + '?' : + WriteHelpPages; + + 'a' : + begin + include(initglobalswitches,cs_asm_leave); + j:=1; + while j<=length(more) do + begin + case more[j] of + 'l' : + include(initglobalswitches,cs_asm_source); + 'r' : + include(initglobalswitches,cs_asm_regalloc); + 't' : + include(initglobalswitches,cs_asm_tempalloc); + 'n' : + include(initglobalswitches,cs_asm_nodes); + '-' : + initglobalswitches:=initglobalswitches - + [cs_asm_leave, cs_asm_source,cs_asm_regalloc, cs_asm_tempalloc, cs_asm_nodes]; + else + IllegalPara(opt); + end; + inc(j); + end; + end; + + 'A' : + begin + if set_target_asm_by_string(More) then + asm_is_set:=true + else + IllegalPara(opt); + end; + + 'b' : + begin + if UnsetBool(More,0) then + begin + exclude(initmoduleswitches,cs_browser); + exclude(initmoduleswitches,cs_local_browser); +{$ifdef BrowserLog} + exclude(initglobalswitches,cs_browser_log); +{$endif} + end + else + begin + include(initmoduleswitches,cs_browser); +{$ifdef BrowserLog} + include(initglobalswitches,cs_browser_log); +{$endif} + end; + if More<>'' then + if (More='l') or (More='l+') then + include(initmoduleswitches,cs_local_browser) + else + if More='l-' then + exclude(initmoduleswitches,cs_local_browser) + else +{$ifdef BrowserLog} + browserlog.elements_to_list.insert(more); +{$else} + IllegalPara(opt); +{$endif} + end; + + 'B' : + do_build:=not UnSetBool(more,0); + + 'C' : + begin + j:=1; + while j<=length(more) do + begin + case more[j] of + 'a' : + Message2(option_obsolete_switch_use_new,'-Ca','-Or'); + 'c' : + begin + if not SetAktProcCall(upper(copy(more,j+1,length(more)-j)),true) then + IllegalPara(opt); + break; + end; + 'h' : + begin + val(copy(more,j+1,length(more)-j),heapsize,code); + if (code<>0) or (heapsize>=67107840) or (heapsize<1024) then + IllegalPara(opt); + break; + end; + 'i' : + If UnsetBool(More, j) then + exclude(initlocalswitches,cs_check_io) + else + include(initlocalswitches,cs_check_io); + 'n' : + If UnsetBool(More, j) then + exclude(initglobalswitches,cs_link_extern) + Else + include(initglobalswitches,cs_link_extern); + 'o' : + If UnsetBool(More, j) then + exclude(initlocalswitches,cs_check_overflow) + Else + include(initlocalswitches,cs_check_overflow); + 'r' : + If UnsetBool(More, j) then + exclude(initlocalswitches,cs_check_range) + Else + include(initlocalswitches,cs_check_range); + 'R' : + If UnsetBool(More, j) then + begin + exclude(initlocalswitches,cs_check_range); + exclude(initlocalswitches,cs_check_object); + end + Else + begin + include(initlocalswitches,cs_check_range); + include(initlocalswitches,cs_check_object); + end; + 's' : + begin + val(copy(more,j+1,length(more)-j),stacksize,code); + if (code<>0) or (stacksize>=67107840) or (stacksize<1024) then + IllegalPara(opt); + break; + end; + 't' : + If UnsetBool(More, j) then + exclude(initlocalswitches,cs_check_stack) + Else + include(initlocalswitches,cs_check_stack); + 'D' : + If UnsetBool(More, j) then + exclude(initmoduleswitches,cs_create_dynamic) + Else + include(initmoduleswitches,cs_create_dynamic); + 'X' : + If UnsetBool(More, j) then + exclude(initmoduleswitches,cs_create_smart) + Else + include(initmoduleswitches,cs_create_smart); + else + IllegalPara(opt); + end; + inc(j); + end; + end; + + 'd' : + def_symbol(more); + + 'D' : + begin + include(initglobalswitches,cs_link_deffile); + j:=1; + while j<=length(more) do + begin + case more[j] of + 'd' : + begin + description:=Copy(more,j+1,255); + break; + end; + 'v' : + begin + dllversion:=Copy(more,j+1,255); + l:=pos('.',dllversion); + dllminor:=0; + error:=0; + if l>0 then + begin + valint(copy(dllversion,l+1,255),minor,error); + if (error=0) and + (minor>=0) and (minor<=$ffff) then + dllminor:=minor + else + if error=0 then + error:=1; + end; + if l=0 then + l:=256; + dllmajor:=1; + if error=0 then + valint(copy(dllversion,1,l-1),major,error); + if (error=0) and (major>=0) and (major<=$ffff) then + dllmajor:=major + else + if error=0 then + error:=1; + if error<>0 then + Message1(scan_w_wrong_version_ignored,dllversion); + break; + end; + 'w' : + usewindowapi:=true; + '-' : + begin + exclude(initglobalswitches,cs_link_deffile); + usewindowapi:=false; + end; + else + IllegalPara(opt); + end; + inc(j); + end; + end; + + 'e' : + exepath:=FixPath(More,true); + + 'E' : + begin + if UnsetBool(More, 0) then + exclude(initglobalswitches,cs_link_extern) + else + include(initglobalswitches,cs_link_extern); + end; + + 'F' : + begin + c:=more[1]; + Delete(more,1,1); + DefaultReplacements(More); + case c of + 'c' : + begin + if not(cpavailable(more)) then + Message1(option_code_page_not_available,more) + else + initsourcecodepage:=more; + end; + 'D' : + utilsdirectory:=FixPath(More,true); + 'e' : + SetRedirectFile(More); + 'E' : + OutputExeDir:=FixPath(More,true); + 'i' : + begin + if ispara then + ParaIncludePath.AddPath(More,false) + else + includesearchpath.AddPath(More,true); + end; + 'g' : + Message2(option_obsolete_switch_use_new,'-Fg','-Fl'); + 'l' : + begin + if ispara then + ParaLibraryPath.AddPath(More,false) + else + LibrarySearchPath.AddPath(More,true); + end; + 'L' : + begin + if More<>'' then + ParaDynamicLinker:=More + else + IllegalPara(opt); + end; + 'o' : + begin + if ispara then + ParaObjectPath.AddPath(More,false) + else + ObjectSearchPath.AddPath(More,true); + end; + 'r' : + Msgfilename:=More; + 'u' : + begin + if ispara then + ParaUnitPath.AddPath(More,false) + else + unitsearchpath.AddPath(More,true); + end; + 'U' : + OutputUnitDir:=FixPath(More,true); + else + IllegalPara(opt); + end; + end; + 'g' : begin + if UnsetBool(More, 0) then + begin + exclude(initmoduleswitches,cs_debuginfo); + exclude(initglobalswitches,cs_gdb_dbx); + exclude(initglobalswitches,cs_gdb_gsym); + exclude(initglobalswitches,cs_gdb_heaptrc); + exclude(initglobalswitches,cs_gdb_lineinfo); + exclude(initglobalswitches,cs_checkpointer); + end + else + begin +{$ifdef GDB} + include(initmoduleswitches,cs_debuginfo); + if not RelocSectionSetExplicitly then + RelocSection:=false; + j:=1; + while j<=length(more) do + begin + case more[j] of + 'd' : + begin + if UnsetBool(More, j) then + exclude(initglobalswitches,cs_gdb_dbx) + else + include(initglobalswitches,cs_gdb_dbx); + end; + 'g' : + begin + if UnsetBool(More, j) then + exclude(initglobalswitches,cs_gdb_gsym) + else + include(initglobalswitches,cs_gdb_gsym); + end; + 'h' : + begin + if UnsetBool(More, j) then + exclude(initglobalswitches,cs_gdb_heaptrc) + else + include(initglobalswitches,cs_gdb_heaptrc); + end; + 'l' : + begin + if UnsetBool(More, j) then + exclude(initglobalswitches,cs_gdb_lineinfo) + else + include(initglobalswitches,cs_gdb_lineinfo); + end; + 'c' : + begin + if UnsetBool(More, j) then + exclude(initglobalswitches,cs_checkpointer) + else + include(initglobalswitches,cs_checkpointer); + end; + else + IllegalPara(opt); + end; + inc(j); + end; +{$else GDB} + Message(option_no_debug_support); + Message(option_no_debug_support_recompile_fpc); +{$endif GDB} + end; + end; + + 'h' : + begin + NoPressEnter:=true; + WriteHelpPages; + end; + + 'i' : + begin + if More='' then + WriteInfo + else + QuickInfo:=QuickInfo+More; + end; + + 'I' : + begin + if ispara then + ParaIncludePath.AddPath(More,false) + else + includesearchpath.AddPath(More,false); + end; + + 'k' : + begin + if more<>'' then + ParaLinkOptions:=ParaLinkOptions+' '+More + else + IllegalPara(opt); + end; + + 'l' : + DoWriteLogo:=not UnSetBool(more,0); + + 'm' : + parapreprocess:=not UnSetBool(more,0); + + 'n' : + begin + if More='' then + disable_configfile:=true + else + IllegalPara(opt); + end; + + 'o' : + begin + if More<>'' then + Fsplit(More,d,OutputFile,e) + else + IllegalPara(opt); + end; + + 'p' : + begin + if UnsetBool(More, 0) then + begin + initmoduleswitches:=initmoduleswitches-[cs_profile]; + undef_symbol('FPC_PROFILE'); + end + else + if Length(More)=0 then + IllegalPara(opt) + else + case more[1] of + 'g' : if UnsetBool(more, 1) then + begin + exclude(initmoduleswitches,cs_profile); + undef_symbol('FPC_PROFILE'); + end + else + begin + include(initmoduleswitches,cs_profile); + def_symbol('FPC_PROFILE'); + end; + else + IllegalPara(opt); + end; + end; + +{$ifdef Unix} + 'P' : + begin + if UnsetBool(More, 0) then + exclude(initglobalswitches,cs_asm_pipe) + else + include(initglobalswitches,cs_asm_pipe); + end; +{$endif Unix} + + 's' : + begin + if UnsetBool(More, 0) then + begin + initglobalswitches:=initglobalswitches-[cs_asm_extern,cs_link_extern]; + if more<>'' then + IllegalPara(opt); + end + else + begin + initglobalswitches:=initglobalswitches+[cs_asm_extern,cs_link_extern]; + if more='h' then + initglobalswitches:=initglobalswitches-[cs_link_on_target] + else if more='t' then + initglobalswitches:=initglobalswitches+[cs_link_on_target] + else if more<>'' then + IllegalPara(opt); + end; + end; + + 'S' : + begin + if more[1]='I' then + begin + if upper(more)='ICOM' then + initinterfacetype:=it_interfacecom + else if upper(more)='ICORBA' then + initinterfacetype:=it_interfacecorba + else + IllegalPara(opt); + end + else + begin + j:=1; + while j<=length(more) do + begin + case more[j] of + '2' : + SetCompileMode('OBJFPC',true); + 'a' : + include(initlocalswitches,cs_do_assertion); + 'c' : + include(initmoduleswitches,cs_support_c_operators); + 'd' : + SetCompileMode('DELPHI',true); + 'e' : + begin + SetErrorFlags(copy(more,j+1,length(more))); + break; + end; + 'g' : + include(initmoduleswitches,cs_support_goto); + 'h' : + include(initlocalswitches,cs_ansistrings); + 'i' : + include(initmoduleswitches,cs_support_inline); + 'm' : + include(initmoduleswitches,cs_support_macro); + 'o' : + SetCompileMode('TP',true); + 'p' : + SetCompileMode('GPC',true); + 's' : + include(initglobalswitches,cs_constructor_name); + 't' : + include(initmoduleswitches,cs_static_keyword); + '-' : + begin + exclude(initglobalswitches,cs_constructor_name); + initlocalswitches:=InitLocalswitches - [cs_do_assertion, cs_ansistrings]; + initmoduleswitches:=initmoduleswitches - [cs_support_c_operators, cs_support_goto, + cs_support_inline, cs_support_macro, + cs_static_keyword]; + end; + else + IllegalPara(opt); + end; + inc(j); + end; + end; + end; + + 'T' : + begin + more:=Upper(More); + if not target_is_set then + begin + { remove old target define } + TargetDefines(false); + { Save assembler if set } + if asm_is_set then + forceasm:=target_asm.id; + { load new target } + if not(set_target_by_string(More)) then + IllegalPara(opt); + { also initialize assembler if not explicitly set } + if asm_is_set then + set_target_asm(forceasm); + { set new define } + TargetDefines(true); + target_is_set:=true; + end + else + if More<>upper(target_info.shortname) then + Message1(option_target_is_already_set,target_info.shortname); + end; + + 'u' : + undef_symbol(upper(More)); + + 'U' : + begin + j:=1; + while j<=length(more) do + begin + case more[j] of +{$ifdef UNITALIASES} + 'a' : + begin + AddUnitAlias(Copy(More,j+1,255)); + break; + end; +{$endif UNITALIASES} + 'n' : + exclude(initglobalswitches,cs_check_unit_name); + 'p' : + begin + Message2(option_obsolete_switch_use_new,'-Up','-Fu'); + break; + end; + 'r' : + do_release:=true; + 's' : + include(initmoduleswitches,cs_compilesystem); + '-' : + begin + exclude(initmoduleswitches,cs_compilesystem); + exclude(initglobalswitches,cs_check_unit_name); + end; + else + IllegalPara(opt); + end; + inc(j); + end; + end; + + 'v' : + begin + if not setverbosity(More) then + IllegalPara(opt); + end; + + 'V' : + PrepareReport; + + 'W' : + begin + j:=1; + while j<=length(More) do + begin + case More[j] of + 'B': + begin + { -WB200000 means set trefered base address + to $200000, but does not change relocsection boolean + this way we can create both relocatble and + non relocatable DLL at a specific base address PM } + if (length(More)>j) then + begin + if DLLImageBase=nil then + DLLImageBase:=StringDup(Copy(More,j+1,255)); + end + else + begin + RelocSection:=true; + RelocSectionSetExplicitly:=true; + end; + break; + end; + 'C': + begin + if UnsetBool(More, j) then + apptype:=app_gui + else + apptype:=app_cui; + end; + 'D': + ForceDeffileForExport:=not UnsetBool(More, j); + 'F': + apptype:=app_fs; + 'G': + begin + if UnsetBool(More, j) then + apptype:=app_cui + else + apptype:=app_gui; + end; + 'N': + begin + RelocSection:=UnsetBool(More,j); + RelocSectionSetExplicitly:=true; + end; + 'R': + begin + { support -WR+ / -WR- as synonims to -WR / -WN } + RelocSection:=not UnsetBool(More,j); + RelocSectionSetExplicitly:=true; + end; + else + IllegalPara(opt); + end; + inc(j); + end; + end; + + 'X' : + begin + j:=1; + while j<=length(more) do + begin + case More[j] of + 'i' : + include(initglobalswitches,cs_link_internal); + 'm' : + include(initglobalswitches,cs_link_map); + 's' : + include(initglobalswitches,cs_link_strip); + 't' : + include(initglobalswitches,cs_link_staticflag); + 'D' : + begin + def_symbol('FPC_LINK_DYNAMIC'); + undef_symbol('FPC_LINK_SMART'); + undef_symbol('FPC_LINK_STATIC'); + exclude(initglobalswitches,cs_link_static); + exclude(initglobalswitches,cs_link_smart); + include(initglobalswitches,cs_link_shared); + LinkTypeSetExplicitly:=true; + end; + 'S' : + begin + def_symbol('FPC_LINK_STATIC'); + undef_symbol('FPC_LINK_SMART'); + undef_symbol('FPC_LINK_DYNAMIC'); + include(initglobalswitches,cs_link_static); + exclude(initglobalswitches,cs_link_smart); + exclude(initglobalswitches,cs_link_shared); + LinkTypeSetExplicitly:=true; + end; + 'X' : + begin + def_symbol('FPC_LINK_SMART'); + undef_symbol('FPC_LINK_STATIC'); + undef_symbol('FPC_LINK_DYNAMIC'); + exclude(initglobalswitches,cs_link_static); + include(initglobalswitches,cs_link_smart); + exclude(initglobalswitches,cs_link_shared); + LinkTypeSetExplicitly:=true; + end; + '-' : + begin + exclude(initglobalswitches,cs_link_staticflag); + exclude(initglobalswitches,cs_link_strip); + exclude(initglobalswitches,cs_link_map); + set_default_link_type; + end; + else + IllegalPara(opt); + end; + inc(j); + end; + end; + + { give processor specific options a chance } + else + interpret_proc_specific_options(opt); end; end; - '@' : begin - Message(option_no_nested_response_file); - StopOptions; - end; - else - begin - if (length(param_file)<>0) then - Message(option_only_one_source_support); - param_file:=opt; - end; + + '@' : + begin + Message(option_no_nested_response_file); + StopOptions; + end; + + else + begin + if (length(param_file)<>0) then + Message(option_only_one_source_support); + param_file:=opt; + Message1(option_found_file,opt); + end; end; end; @@ -971,6 +1171,7 @@ begin Message1(option_unable_open_file,filename); exit; end; + Message1(option_start_reading_configfile,filename); fillchar(skip,sizeof(skip),0); level:=0; while not eof(f) do @@ -981,6 +1182,7 @@ begin begin if opts[1]='#' then begin + Message1(option_interpreting_file_option,opts); Delete(opts,1,1); s:=upper(GetName(opts)); if (s='SECTION') then @@ -1072,7 +1274,9 @@ begin if Level>0 then Message(option_too_less_endif); if Not Option_read then - Message1(option_no_option_found,filename); + Message1(option_no_option_found,filename) + else + Message1(option_end_reading_configfile,filename); Close(f); Dec(FileLevel); end; @@ -1541,7 +1745,7 @@ begin if (target_info.system in [system_m68k_netbsd,system_m68k_linux]) then exclude(initmoduleswitches,cs_fp_emulation) else - def_symbol('M68K_FPU_EMULATED'); + def_symbol('FPC_FPU_INTERNAL'); if initoptprocessor=MC68020 then def_symbol('CPUM68020'); @@ -1675,7 +1879,17 @@ finalization end. { $Log$ - Revision 1.87 2002-10-23 17:07:40 peter + Revision 1.88 2002-11-15 01:58:52 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.87 2002/10/23 17:07:40 peter * fix -n that was broken in the previous commit Revision 1.86 2002/10/23 16:57:16 peter diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index 4ed37c9464..58e4fe5b41 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -95,6 +95,43 @@ implementation end; + procedure checkparatype(p:tnamedindexitem;arg:pointer); + var + highname : string; + begin + if tsym(p).typ<>varsym then + exit; + with tvarsym(p) do + begin + if assigned(vartype.def) and + (vartype.def.deftype=arraydef) and + not is_special_array(vartype.def) then + begin + if (varspez<>vs_var) then + Message(parser_h_c_arrays_are_references); + varspez:=vs_var; + end; + if assigned(vartype.def) and + is_array_of_const(vartype.def) then + begin + if assigned(indexnext) and + (tsym(indexnext).typ=varsym) and + (copy(tvarsym(indexnext).name,1,4)='high') then + begin + { removing it is to complicated, + we just hide it PM } + highname:='hidden'+copy(tvarsym(indexnext).name,5,high(name)); + owner.rename(tvarsym(indexnext).name,highname); + if assigned(indexnext.indexnext) then + Message(parser_e_C_array_of_const_must_be_last); + end + else + if assigned(indexnext) then + Message(parser_e_C_array_of_const_must_be_last); + end; + end; + end; + procedure parameter_dec(aktprocdef:tabstractprocdef); { @@ -649,6 +686,9 @@ implementation inc(testcurobject); single_type(aktprocdef.rettype,hs,false); aktprocdef.test_if_fpu_result; + if (aktprocdef.rettype.def.deftype=stringdef) and + (tstringdef(aktprocdef.rettype.def).string_typ<>st_shortstring) then + procinfo.no_fast_exit:=true; dec(testcurobject); end; end; @@ -796,6 +836,29 @@ begin aktprocdef.forwarddef:=false; end; +procedure pd_inline; +var + hp : tparaitem; +begin + { check if there is an array of const } + hp:=tparaitem(aktprocdef.para.first); + while assigned(hp) do + begin + if assigned(hp.paratype.def) and + (hp.paratype.def.deftype=arraydef) then + begin + with tarraydef(hp.paratype.def) do + if IsVariant or IsConstructor {or IsArrayOfConst} then + begin + Message1(parser_w_not_supported_for_inline,'array of const'); + Message(parser_w_inlining_disabled); + aktprocdef.proccalloption:=pocall_fpccall; + end; + hp:=tparaitem(hp.next); + end; + end; +end; + procedure pd_intern; begin consume(_COLON); @@ -916,6 +979,7 @@ procedure pd_external; the procedure is either imported by number or by name. (DM) } var + pd : tprocdef; import_dll, import_name : string; import_nr : word; @@ -953,22 +1017,17 @@ begin current_module.uses_imports:=true; importlib.preparelib(current_module.modulename^); end; -{$ifdef notused} - if not(m_repeat_forward in aktmodeswitches) and - { if the procedure is declared with the overload option } - { it requires a full declaration in the implementation part } - not(sp_has_overloaded in aktprocsym.symoptions) then - begin - { we can only have one overloaded here ! } - if assigned(aktprocdef.defs.next) then - importlib.importprocedure(aktprocdef.defs.next.mangledname, - import_dll,import_nr,import_name) - else - importlib.importprocedure(aktprocdef.mangledname,import_dll,import_nr,import_name); - end + if not(m_repeat_forward in aktmodeswitches) then + begin + { we can only have one overloaded here ! } + if aktprocsym.procdef_count>1 then + pd:=aktprocsym.procdef[2] + else + pd:=aktprocdef; + end else -{$endif notused} - importlib.importprocedure(aktprocdef.mangledname,import_dll,import_nr,import_name); + pd:=aktprocdef; + importlib.importproceduredef(pd,import_dll,import_nr,import_name); end else begin @@ -1043,7 +1102,7 @@ const pooption : []; mutexclpocall : []; mutexclpotype : []; - mutexclpo : [po_assembler,po_external] + mutexclpo : [po_assembler,po_external,po_virtualmethod] ),( idtok:_DYNAMIC; pd_flags : pd_interface+pd_object+pd_notobjintf; @@ -1110,7 +1169,7 @@ const ),( idtok:_INLINE; pd_flags : pd_interface+pd_implemen+pd_body+pd_notobjintf; - handler : nil; + handler : {$ifdef FPCPROCVAR}@{$endif}pd_inline; pocall : pocall_inline; pooption : []; mutexclpocall : []; @@ -1305,7 +1364,7 @@ const pooption : [po_savestdregs]; mutexclpocall : []; mutexclpotype : []; - mutexclpo : [po_assembler,po_external] + mutexclpo : [po_assembler,po_external,po_virtualmethod] ),( idtok:_VARARGS; pd_flags : pd_interface+pd_implemen+pd_procvar; @@ -1493,6 +1552,8 @@ const internalerror(200110234); { do not copy on local !! } tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}resetvaluepara,nil); + { check C cdecl para types } + tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}checkparatype,nil); { Adjust alignment to match cdecl or stdcall } tprocdef(def).parast.dataalignment:=std_param_align; end; @@ -1513,6 +1574,8 @@ const internalerror(200110235); { do not copy on local !! } tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}resetvaluepara,nil); + { check C cdecl para types } + tprocdef(def).parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}checkparatype,nil); { Adjust alignment to match cdecl or stdcall } tprocdef(def).parast.dataalignment:=std_param_align; end; @@ -1996,7 +2059,17 @@ const end. { $Log$ - Revision 1.77 2002-10-06 15:09:12 peter + Revision 1.78 2002-11-15 01:58:53 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.77 2002/10/06 15:09:12 peter * variant:=nil supported Revision 1.76 2002/09/27 21:13:29 carl diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas index 9c02725823..15534ffa54 100644 --- a/compiler/pdecvar.pas +++ b/compiler/pdecvar.pas @@ -238,7 +238,7 @@ implementation } if tloadnode(pt).symtableentry.typ = varsym then begin - if abssym.vartype.def <> + if abssym.vartype.def <> tvarsym(tloadnode(pt).symtableentry).vartype.def then tvarsym(tloadnode(pt).symtableentry).varoptions:= tvarsym(tloadnode(pt).symtableentry).varoptions-[vo_regable,vo_fpuregable] @@ -265,10 +265,9 @@ implementation abssym.abstyp:=toaddr; abssym.absseg:=false; abssym.address:=tordconstnode(pt).value; - if (token=_COLON) and - (target_info.system=system_i386_go32v2) then + if (target_info.system=system_i386_go32v2) and + try_to_consume(_COLON) then begin - consume(token); pt.free; pt:=expr; if is_constintnode(pt) then @@ -277,7 +276,7 @@ implementation abssym.absseg:=true; end else - Message(parser_e_absolute_only_to_var_or_const); + Message(type_e_ordinal_expr_expected); end; symtablestack.replace(vs,abssym); vs.free; @@ -313,7 +312,7 @@ implementation { hint directive } {$ifdef fpc} {$warning hintdirective not stored in syms} -{$endif} +{$endif} dummysymoptions:=[]; try_consume_hintdirective(dummysymoptions); { for a record there doesn't need to be a ; before the END or ) } @@ -576,7 +575,17 @@ implementation end. { $Log$ - Revision 1.37 2002-10-05 15:18:43 carl + Revision 1.38 2002-11-15 01:58:53 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.37 2002/10/05 15:18:43 carl * fix heap leaks Revision 1.36 2002/10/05 12:43:26 carl diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index 1cecb4e5ea..06776e940a 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -631,19 +631,6 @@ implementation begin if not (cs_debuginfo in aktmoduleswitches) then exit; - if (cs_gdb_dbx in aktglobalswitches) then - begin - debugList.concat(tai_comment.Create(strpnew('EINCL of global '+ - tglobalsymtable(current_module.globalsymtable).name^+' has index '+ - tostr(tglobalsymtable(current_module.globalsymtable).unitid)))); - debugList.concat(Tai_stabs.Create(strpnew('"'+ - tglobalsymtable(current_module.globalsymtable).name^+'",'+ - tostr(N_EINCL)+',0,0,0'))); - tglobalsymtable(current_module.globalsymtable).dbx_count_ok:={true}false; - dbx_counter:=tglobalsymtable(current_module.globalsymtable).prev_dbx_counter; - do_count_dbx:=false; - end; - { now insert the units in the symtablestack } hp:=tused_unit(current_module.used_units.first); while assigned(hp) do @@ -672,6 +659,19 @@ implementation { and all local symbols} tglobalsymtable(current_module.globalsymtable).concatstabto(debuglist); end; + if (cs_gdb_dbx in aktglobalswitches) then + begin + debugList.concat(tai_comment.Create(strpnew('EINCL of global '+ + tglobalsymtable(current_module.globalsymtable).name^+' has index '+ + tostr(tglobalsymtable(current_module.globalsymtable).unitid)))); + debugList.concat(Tai_stabs.Create(strpnew('"'+ + tglobalsymtable(current_module.globalsymtable).name^+'",'+ + tostr(N_EINCL)+',0,0,0'))); + tglobalsymtable(current_module.globalsymtable).dbx_count_ok:={true}false; + dbx_counter:=tglobalsymtable(current_module.globalsymtable).prev_dbx_counter; + do_count_dbx:=false; + end; + end; {$Else GDB} begin @@ -1141,7 +1141,7 @@ implementation {$ifdef EXTDEBUG} if not(cs_compilesystem in aktmoduleswitches) then if (store_crc<>current_module.crc) and simplify_ppu then - Comment(V_Warning,current_module.ppufilename^+' implementation CRC changed '+ + Comment(V_Note,current_module.ppufilename^+' implementation CRC changed '+ hexstr(store_crc,8)+'<>'+hexstr(current_module.crc,8)); {$endif EXTDEBUG} @@ -1441,7 +1441,17 @@ implementation end. { $Log$ - Revision 1.83 2002-11-09 15:33:26 carl + Revision 1.84 2002-11-15 01:58:53 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.83 2002/11/09 15:33:26 carl * major alignment updates Revision 1.82 2002/10/16 06:32:52 michael diff --git a/compiler/pp.pas b/compiler/pp.pas index 6f1347fa14..7db03525ec 100644 --- a/compiler/pp.pas +++ b/compiler/pp.pas @@ -119,6 +119,9 @@ uses {$ifdef heaptrc} ppheap, {$endif heaptrc} + {$ifdef EXTDEBUG} + checkmem, + {$endif EXTDEBUG} {$ifndef NOCATCH} {$ifdef Unix} catch, @@ -176,7 +179,17 @@ begin end. { $Log$ - Revision 1.18 2002-10-30 21:45:02 peter + Revision 1.19 2002-11-15 01:58:53 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.18 2002/10/30 21:45:02 peter * do not include catch unit when compiling with NOCATCH Revision 1.17 2002/10/15 18:16:44 peter diff --git a/compiler/ppheap.pas b/compiler/ppheap.pas index 7c440014c6..f52cc96bc8 100644 --- a/compiler/ppheap.pas +++ b/compiler/ppheap.pas @@ -33,11 +33,68 @@ interface procedure pp_heap_init; + procedure ppheap_register_file(name : string;index : longint); + + implementation uses globtype,globals,fmodule; +{***************************************************************************** + Filename registration +*****************************************************************************} + + const + MaxFiles = 1024; + MaxNameLength = 39; + + type + theapfileinfo = record + name : string[MaxNameLength]; + index : longint; + end; + + tfileinfoarray = array [1..MaxFiles] of theapfileinfo; + + var + fileinfoarray : tfileinfoarray; + last_index : longint; + + + procedure ppheap_register_file(name : string;index : longint); + begin + inc(last_index); + if last_index <= MaxFiles then + begin + fileinfoarray[last_index].name:=copy(name,1,MaxNameLength); + fileinfoarray[last_index].index:=index; + end + else + writeln(stderr,'file',name,' has index ',index); + end; + + + function getfilename(index : longint) : string; + var + i : longint; + begin + for i:=1 to last_index do + begin + if fileinfoarray[i].index=index then + begin + getfilename:=fileinfoarray[i].name; + exit; + end; + end; + getfilename:=tostr(index); + end; + + +{***************************************************************************** + Heaptrc callbacks +*****************************************************************************} + type pextra_info = ^textra_info; textra_info = record @@ -60,13 +117,25 @@ implementation end; +{$ifdef VER1_0} + function get_extra_info(p : pointer) : string; + begin + with pextra_info(p)^ do + begin + get_extra_info:=getfilename(fileindex)+'('+tostr(line)+','+tostr(col)+ + ') '; + end; + end; +{$else} procedure show_extra_info(var t : text;p : pointer); begin with pextra_info(p)^ do begin - writeln(t,'fileinfo: (',line,',',col,') ',fileindex); + writeln(t,getfilename(fileindex)+'('+tostr(line)+','+tostr(col)+') '); end; end; +{$endif} + const pp_heap_inited : boolean = false; @@ -77,9 +146,13 @@ implementation begin keepreleased:=true; SetHeapTraceOutput('heap.log'); +{$ifdef VER1_0} + SetExtraInfoString({$ifdef FPC}@{$endif}get_extra_info); +{$else} SetHeapExtraInfo(sizeof(textra_info), {$ifdef FPCPROCVAR}@{$endif}set_extra_info, {$ifdef FPCPROCVAR}@{$endif}show_extra_info); +{$endif} end; pp_heap_inited:=true; end; @@ -90,7 +163,17 @@ begin end. { $Log$ - Revision 1.10 2002-05-18 13:34:13 peter + Revision 1.11 2002-11-15 01:58:53 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.10 2002/05/18 13:34:13 peter * readded missing revisions Revision 1.9 2002/05/16 19:46:43 carl diff --git a/compiler/ppu.pas b/compiler/ppu.pas index 45249d78ea..0b0d8cfa45 100644 --- a/compiler/ppu.pas +++ b/compiler/ppu.pas @@ -848,7 +848,7 @@ begin begin if (crcindex2crc) then - Do_comment(V_Warning,'impl CRC changed'); + Do_comment(V_Note,'impl CRC changed'); {$ifdef Test_Double_checksum_write} Writeln(CRCFile,crc); {$endif Test_Double_checksum_write} @@ -985,7 +985,17 @@ end; end. { $Log$ - Revision 1.27 2002-10-14 19:42:33 peter + Revision 1.28 2002-11-15 01:58:53 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.27 2002/10/14 19:42:33 peter * only use init tables for threadvars Revision 1.26 2002/08/18 20:06:25 peter diff --git a/compiler/psub.pas b/compiler/psub.pas index 07645befc9..1496cf975c 100644 --- a/compiler/psub.pas +++ b/compiler/psub.pas @@ -266,6 +266,13 @@ implementation localmaxfpuregisters:=aktmaxfpuregisters; { parse the code ... } code:=block(current_module.islibrary); + { store a copy of the original tree for inline, for + normal procedures only store a reference to the + current tree } + if (aktprocdef.proccalloption=pocall_inline) then + aktprocdef.code:=code.getcopy + else + aktprocdef.code:=code; { get a better entry point } if assigned(code) then entrypos:=code.fileinfo; @@ -305,7 +312,6 @@ implementation if (status.errorcount=0) then begin generatecode(code); - aktprocdef.code:=code; { first generate entry code with the correct position and switches } aktfilepos:=entrypos; aktlocalswitches:=entryswitches; @@ -404,8 +410,14 @@ implementation tg.resettempgen; { remove code tree, if not inline procedure } - if assigned(code) and (aktprocdef.proccalloption<>pocall_inline) then - code.free; + if assigned(code) then + begin + { the inline procedure has already got a copy of the tree + stored in aktprocdef.code } + code.free; + if (aktprocdef.proccalloption<>pocall_inline) then + aktprocdef.code:=nil; + end; { remove class member symbol tables } while symtablestack.symtabletype=objectsymtable do @@ -609,7 +621,11 @@ implementation {$endif i386} { pointer to the return value ? } - if paramanager.ret_in_param(aktprocdef.rettype.def) then + if paramanager.ret_in_param(aktprocdef.rettype.def) +{$ifdef m68k} + and not(pocall_cdecl in aktprocsym^.definition^.proccalloptions) +{$endif m68k} + then begin procinfo.return_offset:=procinfo.para_offset; inc(procinfo.para_offset,pointer_size); @@ -786,7 +802,17 @@ implementation end. { $Log$ - Revision 1.73 2002-11-09 15:32:30 carl + Revision 1.74 2002-11-15 01:58:53 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.73 2002/11/09 15:32:30 carl * noopt for non-i386 targets Revision 1.72 2002/09/10 20:31:48 florian diff --git a/compiler/script.pas b/compiler/script.pas index 5a6622fa27..c79fc6954b 100644 --- a/compiler/script.pas +++ b/compiler/script.pas @@ -100,6 +100,7 @@ uses Unix, {$endif} {$endif} + cutils, globtype,globals,systems; @@ -130,7 +131,7 @@ end; constructor TScript.CreateExec(const s:string); begin if cs_link_on_target in aktglobalswitches then - fn:=FixFileName(s)+target_info.scriptext + fn:=TargetFixFileName(s)+target_info.scriptext else fn:=FixFileName(s)+source_info.scriptext; executable:=true; @@ -202,10 +203,10 @@ Procedure TAsmScriptDos.AddAsmCommand (Const Command, Options,FileName : String) begin if FileName<>'' then begin - Add('SET THEFILE='+FileName); + Add('SET THEFILE='+ScriptFixFileName(FileName)); Add('echo Assembling %THEFILE%'); end; - Add(command+' '+Options); + Add(maybequoted(command)+' '+Options); Add('if errorlevel 1 goto asmend'); end; @@ -214,17 +215,17 @@ Procedure TAsmScriptDos.AddLinkCommand (Const Command, Options, FileName : Strin begin if FileName<>'' then begin - Add('SET THEFILE='+FileName); + Add('SET THEFILE='+ScriptFixFileName(FileName)); Add('echo Linking %THEFILE%'); end; - Add (Command+' '+Options); + Add(maybequoted(command)+' '+Options); Add('if errorlevel 1 goto linkend'); end; Procedure TAsmScriptDos.AddDeleteCommand (Const FileName : String); begin - Add('Del '+FileName); + Add('Del '+ScriptFixFileName(FileName)); end; @@ -261,10 +262,10 @@ Procedure TAsmScriptAmiga.AddAsmCommand (Const Command, Options,FileName : Strin begin if FileName<>'' then begin - Add('SET THEFILE '+FileName); + Add('SET THEFILE '+ScriptFixFileName(FileName)); Add('echo Assembling $THEFILE'); end; - Add(command+' '+Options); + Add(maybequoted(command)+' '+Options); { There is a problem here, as allways return with a non zero error value PM } Add('if error'); @@ -278,10 +279,10 @@ Procedure TAsmScriptAmiga.AddLinkCommand (Const Command, Options, FileName : Str begin if FileName<>'' then begin - Add('SET THEFILE '+FileName); + Add('SET THEFILE '+ScriptFixFileName(FileName)); Add('echo Linking $THEFILE'); end; - Add (Command+' '+Options); + Add(maybequoted(command)+' '+Options); Add('if error'); Add('skip linkend'); Add('endif'); @@ -290,13 +291,13 @@ end; Procedure TAsmScriptAmiga.AddDeleteCommand (Const FileName : String); begin - Add('Delete '+FileName); + Add('Delete '+ScriptFixFileName(FileName)); end; Procedure TAsmScriptAmiga.AddDeleteDirCommand (Const FileName : String); begin - Add('Delete '+FileName); + Add('Delete '+ScriptFixFileName(FileName)); end; @@ -328,30 +329,30 @@ end; Procedure TAsmScriptUnix.AddAsmCommand (Const Command, Options,FileName : String); begin if FileName<>'' then - Add('echo Assembling '+FileName); - Add (Command+' '+Options); - Add('if [ $? != 0 ]; then DoExitAsm '+FileName+'; fi'); + Add('echo Assembling '+ScriptFixFileName(FileName)); + Add(maybequoted(command)+' '+Options); + Add('if [ $? != 0 ]; then DoExitAsm '+ScriptFixFileName(FileName)+'; fi'); end; Procedure TAsmScriptUnix.AddLinkCommand (Const Command, Options, FileName : String); begin if FileName<>'' then - Add('echo Linking '+FileName); - Add (Command+' '+Options); - Add('if [ $? != 0 ]; then DoExitLink '+FileName+'; fi'); + Add('echo Linking '+ScriptFixFileName(FileName)); + Add(maybequoted(command)+' '+Options); + Add('if [ $? != 0 ]; then DoExitLink '+ScriptFixFileName(FileName)+'; fi'); end; Procedure TAsmScriptUnix.AddDeleteCommand (Const FileName : String); begin - Add('rm '+FileName); + Add('rm '+ScriptFixFileName(FileName)); end; Procedure TAsmScriptUnix.AddDeleteDirCommand (Const FileName : String); begin - Add('rmdir '+FileName); + Add('rmdir '+ScriptFixFileName(FileName)); end; @@ -414,7 +415,17 @@ end; end. { $Log$ - Revision 1.16 2002-05-18 13:34:18 peter + Revision 1.17 2002-11-15 01:58:54 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.16 2002/05/18 13:34:18 peter * readded missing revisions Revision 1.15 2002/05/16 19:46:44 carl diff --git a/compiler/symdef.pas b/compiler/symdef.pas index fa71dc7db8..27c5a6e509 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -1075,6 +1075,8 @@ implementation procedure tstoreddef.write_rtti_data(rt:trttitype); begin + rttilist.concat(tai_const.create_8bit(tkUnknown)); + write_rtti_name; end; @@ -1724,6 +1726,8 @@ implementation bool16bit, bool32bit : stabstring := strpnew('r'+numberstring+';0;255;'); {$else : not Use_integer_types_for_boolean} + uchar : stabstring := strpnew('-20;'); + uwidechar : stabstring := strpnew('-30;'); bool8bit : stabstring := strpnew('-21;'); bool16bit : stabstring := strpnew('-22;'); bool32bit : stabstring := strpnew('-23;'); @@ -2585,6 +2589,7 @@ implementation function tarraydef.size : longint; var + _resultsize, newsize, cachedsize: TConstExprInt; begin @@ -2598,25 +2603,36 @@ implementation if highrange0) and + if (cachedsize>0) and ( (TConstExprInt(highrange)-TConstExprInt(lowrange) > $7fffffff) or { () are needed around elesize-1 to avoid a possible integer overflow for elesize=1 !! PM } (($7fffffff div cachedsize + (cachedsize -1)) < (int64(highrange) - int64(lowrange))) ) Then - Begin + begin Message(sym_e_segment_too_large); - size:=4; + _resultsize := 4 end else - { prevent an overflow } - if newsize>high(longint) then - size:=high(longint) - else - size:=newsize; + begin + { prevent an overflow } + if newsize>high(longint) then + _resultsize:=high(longint) + else + _resultsize:=newsize; + end; + +{$ifdef m68k} + { 68000 (only) CPU's only accept 32K arrays } + if (_resultsize > 32767) and + (aktoptprocessor = MC68000) then + Message(sym_w_segment_too_large); +{$endif} + size := _resultsize; end; + procedure tarraydef.setelementtype(t: ttype); var cachedsize: TConstExprInt; @@ -2883,8 +2899,17 @@ implementation function trecorddef.size:longint; + var + _resultsize : longint; begin - size:=symtable.datasize; + _resultsize:=symtable.datasize; +{$ifdef m68k} + { 68000 (only) CPU's only accept 32K arrays } + if (_resultsize > 32767) and + (aktoptprocessor = MC68000) then + Message(sym_w_segment_too_large); +{$endif} + size:=_resultsize; end; @@ -3126,14 +3151,24 @@ implementation begin case pdc.paratyp of vs_out, - vs_var : inc(l,POINTER_SIZE); + vs_var : + inc(l,POINTER_SIZE); vs_value, - vs_const : if paramanager.push_addr_param(pdc.paratype.def,is_cdecl) then - inc(l,POINTER_SIZE) - else - inc(l,pdc.paratype.def.size); + vs_const : + begin + if paramanager.push_addr_param(pdc.paratype.def,is_cdecl) then + inc(l,POINTER_SIZE) + else + inc(l,pdc.paratype.def.size); + end; end; l:=align(l,alignsize); + if assigned(pdc.paratype.def) and + is_special_array(pdc.paratype.def) then + begin + inc(l,POINTER_SIZE); + l:=align(l,alignsize); + end; pdc:=TParaItem(pdc.next); end; para_size:=l; @@ -4348,12 +4383,21 @@ implementation end; end; + function tobjectdef.size : longint; + var + _resultsize : longint; begin if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba] then - size:=POINTER_SIZE + _resultsize:=POINTER_SIZE else - size:=symtable.datasize; + _resultsize:=symtable.datasize; +{$ifdef m68k} + { 68000 (only) CPU's only accept 32K arrays } + if (_resultsize > 32767) and (aktoptprocessor = MC68000) then + Message(sym_w_segment_too_large); +{$endif} + size := _resultsize; end; @@ -5463,7 +5507,17 @@ implementation end. { $Log$ - Revision 1.101 2002-11-09 15:31:02 carl + Revision 1.102 2002-11-15 01:58:54 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.101 2002/11/09 15:31:02 carl + align RTTI tables Revision 1.100 2002/10/19 15:09:25 peter diff --git a/compiler/symtable.pas b/compiler/symtable.pas index 8f9f6be3da..34cb05d8fd 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -186,6 +186,7 @@ interface { already usable before firstwith needed for firstpass of function parameters PM } withrefnode : pointer; + use_count : longint; constructor create(aowner:tdef;asymsearch:TDictionary); destructor destroy;override; procedure clear;override; @@ -1702,6 +1703,8 @@ implementation debugList.concat(tai_comment.Create(strpnew('Global '+name^+' has index '+tostr(unitid)))); debugList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0'))); {inc(current_module.unitcount);} + { we can't use dbx_vcount, because we don't know + if the object file will be loaded before or afeter PM } dbx_count_ok:=false; dbx_counter:=@dbx_count; do_count_dbx:=true; @@ -1727,6 +1730,10 @@ implementation procedure tglobalsymtable.ppuload(ppufile:tcompilerppufile); +{$ifdef GDB} + var + b : byte; +{$endif GDB} begin {$ifdef GDB} if cs_gdb_dbx in aktglobalswitches then @@ -1758,6 +1765,29 @@ implementation { necessary for dependencies } current_module.globalsymtable:=nil; {$endif NEWMAP} + + { read dbx count } +{$ifdef GDB} + if (current_module.flags and uf_has_dbx)<>0 then + begin + b:=ppufile.readentry; + if b<>ibdbxcount then + Message(unit_f_ppu_dbx_count_problem) + else + dbx_count:=ppufile.getlongint; +{$IfDef EXTDEBUG} + writeln('Read dbx_count ',dbx_count,' in unit ',name^,'.ppu'); +{$ENDIF EXTDEBUG} + { we can't use dbx_vcount, because we don't know + if the object file will be loaded before or afeter PM } + dbx_count_ok := {true}false; + end + else + begin + dbx_count:=-1; + dbx_count_ok:=false; + end; +{$endif GDB} end; @@ -1855,6 +1885,7 @@ implementation direct_with:=false; withnode:=nil; withrefnode:=nil; + use_count:=1; { we don't need the symsearch } symsearch.free; { set the defaults } @@ -2312,7 +2343,17 @@ implementation end. { $Log$ - Revision 1.76 2002-11-09 15:29:28 carl + Revision 1.77 2002-11-15 01:58:54 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.76 2002/11/09 15:29:28 carl + bss / constant alignment fixes * avoid incrementing address/datasize in local symtable for const's diff --git a/compiler/systems/t_linux.pas b/compiler/systems/t_linux.pas index acb4fb88f3..fc3992e226 100644 --- a/compiler/systems/t_linux.pas +++ b/compiler/systems/t_linux.pas @@ -209,6 +209,10 @@ procedure TLinkerLinux.SetDefaultInfo; { This will also detect which libc version will be used } +{$ifdef m68k} +var + St : SearchRec; +{$endif m68k} begin Glibc2:=false; Glibc21:=false; @@ -217,6 +221,21 @@ begin ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $STRIP -L. -o $EXE $RES'; DllCmd[1]:='ld $OPT $INIT $FINI $SONAME -shared -L. -o $EXE $RES'; DllCmd[2]:='strip --strip-unneeded $EXE'; +{$ifdef m68k} + Glibc2:=true; + FindFirst('/lib/ld*',AnyFile,st); + while DosError=0 do + begin + if copy(st.name,1,5)='ld-2.' then + begin + DynamicLinker:='/lib/'+St.name; + Glibc21:=st.name[6]<>'0'; + break; + end; + FindNext(St); + end; + FindClose(St); +{$else m68k} { first try glibc2 } DynamicLinker:='/lib/ld-linux.so.2'; if FileExists(DynamicLinker) then @@ -230,6 +249,7 @@ begin end else DynamicLinker:='/lib/ld-linux.so.1'; +{$endif m68k} end; end; @@ -525,7 +545,17 @@ end. { $Log$ - Revision 1.2 2002-09-09 17:34:17 peter + Revision 1.3 2002-11-15 01:59:02 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.2 2002/09/09 17:34:17 peter * tdicationary.replace added to replace and item in a dictionary. This is only allowed for the same name * varsyms are inserted in symtable before the types are parsed. This diff --git a/compiler/systems/t_win32.pas b/compiler/systems/t_win32.pas index 8592e5f01c..a013e2f480 100644 --- a/compiler/systems/t_win32.pas +++ b/compiler/systems/t_win32.pas @@ -34,7 +34,7 @@ interface {$endif Delphi} cutils,cclasses, aasmbase,aasmtai,aasmcpu,fmodule,globtype,globals,systems,verbose, - symconst,symsym, + symconst,symdef,symsym, script,gendef, cpubase, {$ifdef GDB} @@ -50,12 +50,18 @@ interface tStr4=array[1..MAX_DEFAULT_EXTENSIONS]of string[4]; pStr4=^tStr4; + twin32imported_item = class(timported_item) + procdef : tprocdef; + end; + timportlibwin32=class(timportlib) private + procedure win32importproc(aprocdef:tprocdef;const func,module : string;index : longint;const name : string); procedure importvariable_str(const s:string;const name,module:string); public procedure GetDefExt(var N:longint;var P:pStr4);virtual; procedure preparelib(const s:string);override; + procedure importproceduredef(aprocdef:tprocdef;const module:string;index:longint;const name:string);override; procedure importprocedure(const func,module:string;index:longint;const name:string);override; procedure importvariable(vs:tvarsym;const name,module:string);override; procedure generatelib;override; @@ -133,12 +139,13 @@ const end; - procedure timportlibwin32.importprocedure(const func,module : string;index : longint;const name : string); + procedure timportlibwin32.win32importproc(aprocdef:tprocdef;const func,module : string;index : longint;const name : string); var hp1 : timportlist; - hp2 : timported_item; + hp2 : twin32imported_item; hs : string; - PP:pStr4;NN:longint; + PP : pStr4; + NN : longint; begin { force the current mangledname } aktprocdef.has_mangledname:=true; @@ -160,21 +167,34 @@ const current_module.imports.concat(hp1); end; { search for reuse of old import item } - hp2:=timported_item(hp1.imported_items.first); + hp2:=twin32imported_item(hp1.imported_items.first); while assigned(hp2) do begin if hp2.func^=func then break; - hp2:=timported_item(hp2.next); + hp2:=twin32imported_item(hp2.next); end; if not assigned(hp2) then begin - hp2:=timported_item.create(func,name,index); + hp2:=twin32imported_item.create(func,name,index); + hp2.procdef:=aprocdef; hp1.imported_items.concat(hp2); end; end; + procedure timportlibwin32.importproceduredef(aprocdef:tprocdef;const module : string;index : longint;const name : string); + begin + win32importproc(aprocdef,aprocdef.mangledname,module,index,name); + end; + + + procedure timportlibwin32.importprocedure(const func,module : string;index : longint;const name : string); + begin + win32importproc(nil,func,module,index,name); + end; + + procedure timportlibwin32.importvariable(vs:tvarsym;const name,module:string); begin importvariable_str(vs.mangledname,name,module); @@ -184,9 +204,10 @@ const procedure timportlibwin32.importvariable_str(const s:string;const name,module:string); var hp1 : timportlist; - hp2 : timported_item; + hp2 : twin32imported_item; hs : string; - NN:longint;PP:pStr4; + NN : longint; + PP : pStr4; begin GetDefExt(NN,PP); hs:=DllName(module,NN,PP); @@ -204,21 +225,22 @@ const hp1:=timportlist.create(hs); current_module.imports.concat(hp1); end; - hp2:=timported_item.create_var(s,name); + hp2:=twin32imported_item.create_var(s,name); + hp2.procdef:=nil; hp1.imported_items.concat(hp2); end; procedure timportlibwin32.generatenasmlib; var hp1 : timportlist; - hp2 : timported_item; + hp2 : twin32imported_item; p : pchar; begin importssection.concat(tai_section.create(sec_code)); hp1:=timportlist(current_module.imports.first); while assigned(hp1) do begin - hp2:=timported_item(hp1.imported_items.first); + hp2:=twin32imported_item(hp1.imported_items.first); while assigned(hp2) do begin if (aktoutputformat=as_i386_tasm) or @@ -229,7 +251,7 @@ const importssection.concat(tai_direct.create(p)); p:=strpnew(#9+'import '+hp2.func^+' '+hp1.dllname^+' '+hp2.name^); importssection.concat(tai_direct.create(p)); - hp2:=timported_item(hp2.next); + hp2:=twin32imported_item(hp2.next); end; hp1:=timportlist(hp1.next); end; @@ -243,9 +265,10 @@ const hp1 : timportlist; {$ifdef GDB} importname : string; + mangledstring : string; suffix : integer; {$endif GDB} - hp2 : timported_item; + hp2 : twin32imported_item; lhead,lname,lcode, lidata4,lidata5 : tasmlabel; href : treference; @@ -286,7 +309,7 @@ const importsSection.concat(Tai_label.Create(lidata5)); { create procedures } - hp2:=timported_item(hp1.imported_items.first); + hp2:=twin32imported_item(hp1.imported_items.first); while assigned(hp2) do begin { insert cuts } @@ -306,6 +329,15 @@ const importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0)); importsSection.concat(Taicpu.Op_ref(A_JMP,S_NO,href)); importsSection.concat(Tai_align.Create_op(4,$90)); +{$IfDef GDB} + if assigned(hp2.procdef) then + begin + mangledstring:=hp2.procdef.mangledname; + hp2.procdef.setmangledname(hp2.func^); + hp2.procdef.concatstabto(importssection); + hp2.procdef.setmangledname(mangledstring); + end; +{$EndIf GDB} end; { create head link } importsSection.concat(Tai_section.Create(sec_idata7)); @@ -357,7 +389,7 @@ const importsSection.concat(Tai_const.Create_16bit(hp2.ordnr)); importsSection.concat(Tai_string.Create(hp2.name^+#0)); importsSection.concat(Tai_align.Create_op(2,0)); - hp2:=timported_item(hp2.next); + hp2:=twin32imported_item(hp2.next); end; { write final section } @@ -381,10 +413,11 @@ const procedure timportlibwin32.generatelib; var hp1 : timportlist; - hp2 : timported_item; + hp2 : twin32imported_item; l1,l2,l3,l4 : tasmlabel; {$ifdef GDB} importname : string; + mangledstring : string; suffix : integer; {$endif GDB} href : treference; @@ -422,7 +455,7 @@ const importsSection.concat(Tai_section.Create(sec_idata4)); importsSection.concat(Tai_label.Create(l2)); - hp2:=timported_item(hp1.imported_items.first); + hp2:=twin32imported_item(hp1.imported_items.first); while assigned(hp2) do begin objectlibrary.getlabel(tasmlabel(hp2.lab)); @@ -430,7 +463,7 @@ const importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab)) else importsSection.concat(Tai_const.Create_32bit($80000000 or hp2.ordnr)); - hp2:=timported_item(hp2.next); + hp2:=twin32imported_item(hp2.next); end; { finalize the names ... } importsSection.concat(Tai_const.Create_32bit(0)); @@ -438,7 +471,7 @@ const { then the addresses and create also the indirect jump } importsSection.concat(Tai_section.Create(sec_idata5)); importsSection.concat(Tai_label.Create(l3)); - hp2:=timported_item(hp1.imported_items.first); + hp2:=twin32imported_item(hp1.imported_items.first); while assigned(hp2) do begin if not hp2.is_var then @@ -448,9 +481,22 @@ const reference_reset_symbol(href,l4,0); { place jump in codesegment } importsSection.concat(Tai_section.Create(sec_code)); +{$IfDef GDB} + if (cs_debuginfo in aktmoduleswitches) then + importssection.concat(tai_stab_function_name.create(nil)); +{$EndIf GDB} importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0)); importsSection.concat(Taicpu.Op_ref(A_JMP,S_NO,href)); importsSection.concat(Tai_align.Create_op(4,$90)); +{$IfDef GDB} + if assigned(hp2.procdef) then + begin + mangledstring:=hp2.procdef.mangledname; + hp2.procdef.setmangledname(hp2.func^); + hp2.procdef.concatstabto(importssection); + hp2.procdef.setmangledname(mangledstring); + end; +{$EndIf GDB} { add jump field to imporTSection } importsSection.concat(Tai_section.Create(sec_idata5)); {$ifdef GDB} @@ -487,14 +533,14 @@ const importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0)); end; importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab)); - hp2:=timported_item(hp2.next); + hp2:=twin32imported_item(hp2.next); end; { finalize the addresses } importsSection.concat(Tai_const.Create_32bit(0)); { finally the import information } importsSection.concat(Tai_section.Create(sec_idata6)); - hp2:=timported_item(hp1.imported_items.first); + hp2:=twin32imported_item(hp1.imported_items.first); while assigned(hp2) do begin importsSection.concat(Tai_label.Create(hp2.lab)); @@ -502,7 +548,7 @@ const importsSection.concat(Tai_const.Create_16bit(hp2.ordnr)); importsSection.concat(Tai_string.Create(hp2.name^+#0)); importsSection.concat(Tai_align.Create_op(2,0)); - hp2:=timported_item(hp2.next); + hp2:=twin32imported_item(hp2.next); end; { create import dll name } importsSection.concat(Tai_section.Create(sec_idata7)); @@ -864,6 +910,8 @@ begin LinkRes.AddFileName(GetShortName(FindObjectFile('wdllprt0',''))) else LinkRes.AddFileName(GetShortName(FindObjectFile('wprt0',''))); + if cs_profile in aktmoduleswitches then + LinkRes.AddFileName(GetShortName(FindObjectFile('mcount',''))); while not ObjectFiles.Empty do begin s:=ObjectFiles.GetFirst; @@ -874,7 +922,8 @@ begin if cs_profile in aktmoduleswitches then begin LinkRes.Add('-lgmon'); - LinkRes.Add('-lc'); + LinkRes.Add('-lkernel32'); + LinkRes.Add('-lmsvcrt'); end; LinkRes.Add(')'); @@ -1563,7 +1612,17 @@ initialization end. { $Log$ - Revision 1.3 2002-10-05 12:43:29 carl + Revision 1.4 2002-11-15 01:59:02 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.3 2002/10/05 12:43:29 carl * fixes for Delphi 6 compilation (warning : Some features do not work under Delphi) diff --git a/compiler/tgobj.pas b/compiler/tgobj.pas index 0766a45b3d..9bdc3b13fa 100644 --- a/compiler/tgobj.pas +++ b/compiler/tgobj.pas @@ -91,8 +91,8 @@ unit tgobj; procedure GetTemp(list: taasmoutput; size : longint;temptype:ttemptype;var ref : treference); procedure UnGetTemp(list: taasmoutput; const ref : treference); - function SizeOfTemp(const ref: treference): longint; - procedure ChangeTempType(const ref:treference;temptype:ttemptype); + function SizeOfTemp(list: taasmoutput; const ref: treference): longint; + function ChangeTempType(list: taasmoutput; const ref:treference;temptype:ttemptype):boolean; {# Returns TRUE if the reference ref is allocated in temporary volatile memory space, otherwise returns FALSE. @@ -238,7 +238,7 @@ unit tgobj; {$ifdef EXTDEBUG} if size=0 then begin - Comment(V_Warning,'Temp of size 0 requested'); + Comment(V_Warning,'Temp of size 0 requested, allocating 4 bytes'); size:=4; end; {$endif} @@ -346,8 +346,10 @@ unit tgobj; end; {$ifdef EXTDEBUG} tl^.posinfo:=aktfilepos; -{$endif} + list.concat(tai_tempalloc.allocinfo(tl^.pos,tl^.size,'type '+TempTypeStr[templist^.temptype])); +{$else} list.concat(tai_tempalloc.alloc(tl^.pos,tl^.size)); +{$endif} AllocTemp:=tl^.pos; end; @@ -368,6 +370,7 @@ unit tgobj; begin {$ifdef EXTDEBUG} Comment(V_Warning,'temp managment : (FreeTemp) temp at pos '+tostr(pos)+ ' is already free !'); + list.concat(tai_tempalloc.allocinfo(hp^.pos,hp^.size,'temp is already freed')); {$endif} exit; end; @@ -375,7 +378,8 @@ unit tgobj; if not(hp^.temptype in temptypes) then begin {$ifdef EXTDEBUG} - Comment(V_Debug,'temp managment : (Freetemp) temp at pos '+tostr(pos)+ ' has different type, not releasing'); + Comment(V_Debug,'temp managment : (Freetemp) temp at pos '+tostr(pos)+ ' has different type ('+TempTypeStr[hp^.temptype]+'), not releasing'); + list.concat(tai_tempalloc.allocinfo(hp^.pos,hp^.size,'temp has wrong type ('+TempTypeStr[hp^.temptype]+') not releasing')); {$endif} exit; end; @@ -445,7 +449,7 @@ unit tgobj; end; - function ttgobj.SizeOfTemp(const ref: treference): longint; + function ttgobj.SizeOfTemp(list: taasmoutput; const ref: treference): longint; var hp : ptemprecord; begin @@ -461,15 +465,17 @@ unit tgobj; hp := hp^.next; end; {$ifdef EXTDEBUG} - Comment(V_Debug,'temp managment : SizeOfTemp temp at pos '+tostr(ref.offset)+ ' not found !'); + Comment(V_Debug,'temp managment : SizeOfTemp temp at pos '+tostr(ref.offset)+' not found !'); + list.concat(tai_tempalloc.allocinfo(ref.offset,0,'temp not found')); {$endif} end; - procedure ttgobj.ChangeTempType(const ref:treference;temptype:ttemptype); + function ttgobj.ChangeTempType(list: taasmoutput; const ref:treference;temptype:ttemptype):boolean; var hp : ptemprecord; begin + ChangeTempType:=false; hp:=templist; while assigned(hp) do begin @@ -481,7 +487,9 @@ unit tgobj; if hp^.temptype=temptype then Comment(V_Warning,'temp managment : ChangeTempType temp'+ ' at pos '+tostr(ref.offset)+ ' is already of the correct type !'); + list.concat(tai_tempalloc.allocinfo(hp^.pos,hp^.size,'type changed to '+TempTypeStr[templist^.temptype])); {$endif} + ChangeTempType:=true; hp^.temptype:=temptype; end else @@ -489,6 +497,7 @@ unit tgobj; {$ifdef EXTDEBUG} Comment(V_Warning,'temp managment : ChangeTempType temp'+ ' at pos '+tostr(ref.offset)+ ' is already freed !'); + list.concat(tai_tempalloc.allocinfo(hp^.pos,hp^.size,'temp is already freed')); {$endif} end; exit; @@ -498,6 +507,7 @@ unit tgobj; {$ifdef EXTDEBUG} Comment(V_Warning,'temp managment : ChangeTempType temp'+ ' at pos '+tostr(ref.offset)+ ' not found !'); + list.concat(tai_tempalloc.allocinfo(ref.offset,0,'temp not found')); {$endif} end; @@ -522,7 +532,17 @@ finalization end. { $Log$ - Revision 1.18 2002-10-11 11:57:43 florian + Revision 1.19 2002-11-15 01:58:54 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.18 2002/10/11 11:57:43 florian *** empty log message *** Revision 1.16 2002/09/07 18:25:00 florian diff --git a/compiler/verbose.pas b/compiler/verbose.pas index 26b1caf35f..8fef47eb4e 100644 --- a/compiler/verbose.pas +++ b/compiler/verbose.pas @@ -74,6 +74,7 @@ const procedure SetRedirectFile(const fn:string); function SetVerbosity(const s:string):boolean; +procedure PrepareReport; procedure SetCompileModule(p:tmodulebase); procedure Stop; @@ -118,6 +119,11 @@ var close(status.redirfile); status.use_redir:=false; end; + if status.use_bugreport then + begin + close(status.reportbugfile); + status.use_bugreport:=false; + end; end; @@ -133,6 +139,25 @@ var end; + procedure PrepareReport; + var + fn : string; + begin + if status.use_bugreport then + exit; + fn:='fpcdebug.txt'; + assign(status.reportbugfile,fn); + {$I-} + append(status.reportbugfile); + if ioresult <> 0 then + rewrite(status.reportbugfile); + {$I+} + status.use_bugreport:=(ioresult=0); + if status.use_bugreport then + writeln(status.reportbugfile,'FPC bug report file'); + end; + + function SetVerbosity(const s:string):boolean; var m : Longint; @@ -424,8 +449,9 @@ var (status.errorhint and ((l and V_Hint)<>0)) then inc(status.errorcount); { check verbosity level } - if (status.verbosity and l)<>l then - exit; + if ((status.verbosity and l)<>l) and + (not status.use_bugreport) then + exit; { Create status info } UpdateStatus; { Fix replacements } @@ -521,7 +547,8 @@ var end; Delete(s,1,idx); { check verbosity level } - if (status.verbosity and v)<>v then + if ((status.verbosity and v)<>v) and + (not status.use_bugreport) then exit; { fix status } UpdateStatus; @@ -675,14 +702,26 @@ var dispose(msg,Done); msg:=nil; end; - if status.use_redir then - DoneRedirectFile; + DoneRedirectFile; end; +finalization + { Be sure to close the redirect files to flush all data } + DoneRedirectFile; end. { $Log$ - Revision 1.21 2002-10-05 12:43:29 carl + Revision 1.22 2002-11-15 01:58:54 peter + * merged changes from 1.0.7 up to 04-11 + - -V option for generating bug report tracing + - more tracing for option parsing + - errors for cdecl and high() + - win32 import stabs + - win32 records<=8 are returned in eax:edx (turned off by default) + - heaptrc update + - more info for temp management in .s file with EXTDEBUG + + Revision 1.21 2002/10/05 12:43:29 carl * fixes for Delphi 6 compilation (warning : Some features do not work under Delphi)