paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-21 23:31:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revisions 2843-2844,2854-2855,2952,2957-2959,2968,2973-2976,3002-3003 via svnmerge from

Browse Source 
svn+ssh://jonas@svn.freepascal.org/FPC/svn/fpc/trunk

........
r2843 | jonas | 2006-03-10 21:59:45 +0100 (Fri, 10 Mar 2006) | 2 lines

+ added

........
r2844 | jonas | 2006-03-10 22:18:21 +0100 (Fri, 10 Mar 2006) | 2 lines

  * fixed tests/test/cg/tformfnc.pp

........
r2854 | jonas | 2006-03-11 14:54:20 +0100 (Sat, 11 Mar 2006) | 2 lines

  * fixed a_param_ref for large parameters

........
r2855 | jonas | 2006-03-11 15:13:47 +0100 (Sat, 11 Mar 2006) | 3 lines

  * don't explicitly us NR_F0 in concatcopy but ask a register from
    the register allocator (since NR_F0 can also be used by the ra)

........
r2952 | jonas | 2006-03-18 12:05:04 +0100 (Sat, 18 Mar 2006) | 3 lines

  * fixed web bug #4913 (don't allow indexing of strings/variants/pointers
    with enums/chars/booleans)

........
r2957 | jonas | 2006-03-18 23:02:37 +0100 (Sat, 18 Mar 2006) | 3 lines

  * don't give range check hints/warnings for conversions of
    realconstnodes to types with less precision than the default (bug 4898)

........
r2958 | jonas | 2006-03-18 23:25:41 +0100 (Sat, 18 Mar 2006) | 2 lines

  * support goto/label by default in tp/delphi/macpas modes (bug 4893)

........
r2959 | jonas | 2006-03-18 23:53:27 +0100 (Sat, 18 Mar 2006) | 2 lines

  * count references to symbols accessed via properties (fixes bug #4826)

........
r2968 | jonas | 2006-03-19 17:44:18 +0100 (Sun, 19 Mar 2006) | 3 lines

  - removed markheap since it doesn't work anymore (since a long
    time already in fact)

........
r2973 | jonas | 2006-03-19 21:01:11 +0100 (Sun, 19 Mar 2006) | 4 lines

  * support subscripting record function results on ABI's that return
    (some) records in registers (+ internalerror if unsupported
    record location). Fixes "make all" in top dir on darwin/x86.

........
r2974 | jonas | 2006-03-19 21:08:21 +0100 (Sun, 19 Mar 2006) | 2 lines

  + nostackframe directive to fix on darwin/x86

........
r2975 | jonas | 2006-03-19 21:26:29 +0100 (Sun, 19 Mar 2006) | 2 lines

  * fixed test

........
r2976 | jonas | 2006-03-19 21:29:15 +0100 (Sun, 19 Mar 2006) | 2 lines

  * fixed loading of -0.0

........
r3002 | jonas | 2006-03-21 16:25:16 +0100 (Tue, 21 Mar 2006) | 3 lines

  * don't change "mov const,ref; mov ref,reg" into "mov const,reg; mov reg,ref"
    if ref depends on reg

........
r3003 | jonas | 2006-03-21 16:44:55 +0100 (Tue, 21 Mar 2006) | 4 lines

  * if we find a constant already loaded in a register and we use that
    register, mark the register as read by the current instruction
    (fixes compilation of tcalfun8 with optimizations)

........

git-svn-id: branches/fixes_2_0@3004 -
This commit is contained in:
Jonas Maebe 2006-03-21 16:36:20 +00:00
parent 34a31c2c6b
commit 715a88dca2
24 changed files with 194 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
.gitattributes vendored
View File

@ -5241,6 +5241,7 @@ tests/test/cg/tdivz1.pp svneol=native#text/plain
tests/test/cg/tdivz2.pp svneol=native#text/plain
tests/test/cg/texit.pp svneol=native#text/plain
tests/test/cg/tfor.pp svneol=native#text/plain
tests/test/cg/tformfnc.pp -text
tests/test/cg/tfuncret.pp svneol=native#text/plain
tests/test/cg/tin.pp svneol=native#text/plain
tests/test/cg/tincexc.pp svneol=native#text/plain
@ -5709,6 +5710,9 @@ tests/webtbf/tw4777.pp svneol=native#text/plain
tests/webtbf/tw4778a.pp svneol=native#text/plain
tests/webtbf/tw4781a.pp svneol=native#text/plain
tests/webtbf/tw4781b.pp svneol=native#text/plain
tests/webtbf/tw4893d.pp svneol=native#text/plain
tests/webtbf/tw4893e.pp svneol=native#text/plain
tests/webtbf/tw4913.pp -text
tests/webtbf/uw0744.pp svneol=native#text/plain
tests/webtbf/uw0840a.pp svneol=native#text/plain
tests/webtbf/uw0840b.pp svneol=native#text/plain
@ -6445,6 +6449,11 @@ tests/webtbs/tw4781a.pp svneol=native#text/plain
tests/webtbs/tw4781b.pp svneol=native#text/plain
tests/webtbs/tw4789.pp svneol=native#text/plain
tests/webtbs/tw4809.pp svneol=native#text/plain
tests/webtbs/tw4826.pp svneol=native#text/plain
tests/webtbs/tw4893a.pp svneol=native#text/plain
tests/webtbs/tw4893b.pp svneol=native#text/plain
tests/webtbs/tw4893c.pp svneol=native#text/plain
tests/webtbs/tw4898.pp -text
tests/webtbs/ub1873.pp svneol=native#text/plain
tests/webtbs/ub1883.pp svneol=native#text/plain
tests/webtbs/uw0555.pp svneol=native#text/plain

2
compiler/cgobj.pas
View File

@ -778,7 +778,7 @@ implementation
ref.offset:=cgpara.location^.reference.offset;
{ use concatcopy, because it can also be a float which fails when
load_ref_ref is used }
g_concatcopy(list,r,ref,tcgsize2size[size]);
g_concatcopy(list,r,ref,cgpara.intsize);
end
else
internalerror(2002071004);

3
compiler/htypechk.pas
View File

@ -2222,7 +2222,8 @@ implementation
not is_boolean(destdef) and
assigned(source.resulttype.def) and
(source.resulttype.def.deftype in [enumdef,orddef,floatdef]) and
not is_boolean(source.resulttype.def) then
not is_boolean(source.resulttype.def) and
not is_constrealnode(source) then
begin
if (destdef.size < source.resulttype.def.size) then
begin

4
compiler/i386/csopt386.pas
View File

@ -1981,6 +1981,10 @@ begin
findRegWithConst(hp1,taicpu(p).opsize,taicpu(p).oper[0]^.val,memreg) then
begin
taicpu(p).loadreg(0,memreg);
{ mark the used register as read }
incstate(ptaiprop(p.optinfo)^.
regs[getsupreg(memreg)].rstate,20);
updateState(getsupreg(memreg),p);
allocRegBetween(asml,memreg,
ptaiprop(hp1.optinfo)^.regs[getsupreg(memreg)].startMod,p,
ptaiprop(ptaiprop(hp1.optinfo)^.regs[getsupreg(memreg)].startMod.optinfo)^.usedregs);

2
compiler/i386/n386con.pas
View File

@ -73,6 +73,8 @@ implementation
else if (value_real=0.0) then
begin
emit_none(A_FLDZ,S_NO);
if (get_real_sign(value_real) < 0) then
emit_none(A_FCHS,S_NO);
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
location.register:=NR_ST;
tcgx86(cg).inc_fpu_stack;

3
compiler/i386/popt386.pas
View File

@ -1164,7 +1164,8 @@ begin
(taicpu(hp1).oper[0]^.typ = top_ref) and
(taicpu(hp1).oper[1]^.typ = top_reg) and
(taicpu(p).opsize = taicpu(hp1).opsize) and
RefsEqual(taicpu(hp1).oper[0]^.ref^,taicpu(p).oper[1]^.ref^) then
RefsEqual(taicpu(hp1).oper[0]^.ref^,taicpu(p).oper[1]^.ref^) and
not(reginref(getsupreg(taicpu(hp1).oper[1]^.reg),taicpu(hp1).oper[0]^.ref^)) then
begin
allocregbetween(asml,taicpu(hp1).oper[1]^.reg,p,hp1,usedregs);
taicpu(hp1).LoadReg(0,taicpu(hp1).oper[1]^.reg);

2
compiler/ncgcal.pas
View File

@ -399,7 +399,7 @@ implementation
begin
{ allow passing of a constant to a const formaldef }
if (parasym.varspez=vs_const) and
(left.location.loc=LOC_CONSTANT) then
(left.location.loc in [LOC_CONSTANT,LOC_REGISTER]) then
location_force_mem(exprasmlist,left.location);
push_addr_para;
end

17
compiler/ncgmem.pas
View File

@ -302,7 +302,22 @@ implementation
end;
end
else
location_copy(location,left.location);
begin
location_copy(location,left.location);
{ some abi's require that functions return (some) records in }
{ registers }
case location.loc of
LOC_REGISTER:
location_force_mem(exprasmlist,location);
LOC_REFERENCE,
LOC_CREFERENCE:
;
{ record regvars are not supported yet
LOC_CREGISTER: }
else
internalerror(2006031901);
end;
end;
inc(location.reference.offset,vs.fieldoffset);
{ also update the size of the location }

7
compiler/nmem.pas
View File

@ -668,9 +668,10 @@ implementation
{ maybe type conversion for the index value, but
do not convert enums,booleans,char }
if (right.resulttype.def.deftype<>enumdef) and
not(is_char(right.resulttype.def) or is_widechar(right.resulttype.def)) and
not(is_boolean(right.resulttype.def)) then
if ((right.resulttype.def.deftype<>enumdef) and
not(is_char(right.resulttype.def) or is_widechar(right.resulttype.def)) and
not(is_boolean(right.resulttype.def))) or
(left.resulttype.def.deftype <> arraydef) then
begin
inserttypeconv(right,sinttype);
end;

7
compiler/pexpr.pas
View File

@ -164,6 +164,7 @@ implementation
case plist^.sltype of
sl_load :
begin
inc(plist^.sym.refs);
if not assigned(st) then
st:=plist^.sym.owner;
{ p1 can already contain the loadnode of
@ -184,7 +185,10 @@ implementation
p1:=cloadnode.create(plist^.sym,st);
end;
sl_subscript :
p1:=csubscriptnode.create(plist^.sym,p1);
begin
inc(plist^.sym.refs);
p1:=csubscriptnode.create(plist^.sym,p1);
end;
sl_typeconv :
p1:=ctypeconvnode.create_explicit(p1,plist^.tt);
sl_absolutetype :
@ -1044,6 +1048,7 @@ implementation
if membercall then
include(callflags,cnf_member_call);
p1:=ccallnode.create(paras,tprocsym(tpropertysym(sym).writeaccess.firstsym^.sym),st,p1,callflags);
inc(tpropertysym(sym).writeaccess.firstsym^.sym.refs);
paras:=nil;
consume(_ASSIGNMENT);
{ read the expression }

26
compiler/powerpc/cgcpu.pas
View File

@ -1838,6 +1838,7 @@ const
lab: tasmlabel;
count, count2: aint;
size: tcgsize;
copyreg: tregister;
begin
{$ifdef extdebug}
@ -1856,10 +1857,9 @@ const
end
else
begin
a_reg_alloc(list,NR_F0);
a_loadfpu_ref_reg(list,OS_F64,source,NR_F0);
a_loadfpu_reg_ref(list,OS_F64,NR_F0,dest);
a_reg_dealloc(list,NR_F0);
copyreg := getfpuregister(list,OS_F64);
a_loadfpu_ref_reg(list,OS_F64,source,copyreg);
a_loadfpu_reg_ref(list,OS_F64,copyreg,dest);
end;
exit;
end;
@ -1909,16 +1909,15 @@ const
list.concat(taicpu.op_reg_reg_const(A_SUBI,dst.base,dst.base,8));
countreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
a_load_const_reg(list,OS_32,count,countreg);
{ explicitely allocate R_0 since it can be used safely here }
{ (for holding date that's being copied) }
a_reg_alloc(list,NR_F0);
copyreg := getfpuregister(list,OS_F64);
a_reg_sync(list,copyreg);
objectlibrary.getlabel(lab);
a_label(list, lab);
list.concat(taicpu.op_reg_reg_const(A_SUBIC_,countreg,countreg,1));
list.concat(taicpu.op_reg_ref(A_LFDU,NR_F0,src));
list.concat(taicpu.op_reg_ref(A_STFDU,NR_F0,dst));
list.concat(taicpu.op_reg_ref(A_LFDU,copyreg,src));
list.concat(taicpu.op_reg_ref(A_STFDU,copyreg,dst));
a_jmp(list,A_BC,C_NE,0,lab);
a_reg_dealloc(list,NR_F0);
a_reg_sync(list,copyreg);
len := len mod 8;
end;
@ -1926,15 +1925,14 @@ const
if count > 0 then
{ unrolled loop }
begin
a_reg_alloc(list,NR_F0);
copyreg := getfpuregister(list,OS_F64);
for count2 := 1 to count do
begin
a_loadfpu_ref_reg(list,OS_F64,src,NR_F0);
a_loadfpu_reg_ref(list,OS_F64,NR_F0,dst);
a_loadfpu_ref_reg(list,OS_F64,src,copyreg);
a_loadfpu_reg_ref(list,OS_F64,copyreg,dst);
inc(src.offset,8);
inc(dst.offset,8);
end;
a_reg_dealloc(list,NR_F0);
len := len mod 8;
end;

9
compiler/scanner.pas
View File

@ -307,6 +307,15 @@ implementation
if changeinit then
exclude(initlocalswitches,cs_ansistrings);
end;
{ support goto/label by default in delphi/tp7/mac modes }
if ([m_delphi,m_tp7,m_mac] * aktmodeswitches <> []) then
begin
include(aktmoduleswitches,cs_support_goto);
if changeinit then
include(initmoduleswitches,cs_support_goto);
end;
{ Default enum packing for delphi/tp7 }
if (m_tp7 in aktmodeswitches) or
(m_delphi in aktmodeswitches) then

14
rtl/inc/heaptrc.pp
View File

@ -18,7 +18,6 @@ interface
{$goto on}
Procedure DumpHeap;
Procedure MarkHeap;
{ define EXTRA to add more
tests :
@ -952,19 +951,6 @@ begin
end;
procedure markheap;
var
pp : pheap_mem_info;
begin
pp:=heap_mem_root;
while pp<>nil do
begin
pp^.sig:=$AAAAAAAA;
pp:=pp^.previous;
end;
end;
{*****************************************************************************
AllocMem
*****************************************************************************}

13
tests/test/cg/tformfnc.pp Normal file
View File

@ -0,0 +1,13 @@
function f: longint;
begin
f := 1;
end;
procedure t(const c);
begin
end;
begin
t(f);
end.

10
tests/webtbf/tw4893d.pp Normal file
View File

@ -0,0 +1,10 @@
{ %fail }
{$mode fpc}
label a;
begin
goto a;
a:
end.

10
tests/webtbf/tw4893e.pp Normal file
View File

@ -0,0 +1,10 @@
{ %fail }
{$mode objfpc}
label a;
begin
goto a;
a:
end.

22
tests/webtbf/tw4913.pp Normal file
View File

@ -0,0 +1,22 @@
{ %fail }
{ Source provided for Free Pascal Bug Report 4913 }
{ Submitted by "Vinzent Hoefler" on 2006-03-17 }
{ e-mail: ada.rocks@jlfencey.com }
const
Some_String : String = '0123456789';
type
Some_Enum = (Zero, One, Two, Three);
var
i : Some_Enum;
begin
WriteLn (Some_String[2]); // Should fail if "Some_String = '...'";
WriteLn (Some_String[Two]); // Should fail with type error.
i := Three;
WriteLn (Some_String[i]);
end.

2
tests/webtbs/tw1229.pp
View File

@ -5,7 +5,7 @@
{$asmmode intel }
procedure SomePostScript; assembler;
procedure SomePostScript; assembler;nostackframe;
asm
db '/pop2 { pop pop } def',0;
end;

4
tests/webtbs/tw4534.pp
View File

@ -12,8 +12,10 @@ begin
begin
if (p1^ xor p2^) = $80 then
halt(0);
halt(1);
inc(p1);
inc(p2);
end;
halt(1);
end;
var x,y:extended;

31
tests/webtbs/tw4826.pp Normal file
View File

@ -0,0 +1,31 @@
{ %OPT=-vn -Sen }
{ Source provided for Free Pascal Bug Report 4826 }
{ Submitted by "Ivo Steinmann" on 2006-02-20 }
{ e-mail: isteinmann@bluewin.ch }
program bug;
{$mode delphi}
type
TTest = class
private
FFoobar: Integer;
protected
property Foobar: Integer read FFoobar write FFoobar;
public
constructor Create;
end;
constructor TTest.Create;
begin
inherited Create;
Foobar := 0;
end;
var
Test: TTest;
begin
Test := TTest.Create;
Test.Free;
end.

8
tests/webtbs/tw4893a.pp Normal file
View File

@ -0,0 +1,8 @@
{$mode delphi}
label a;
begin
goto a;
a:
end.

8
tests/webtbs/tw4893b.pp Normal file
View File

@ -0,0 +1,8 @@
{$mode tp}
label a;
begin
goto a;
a:
end.

8
tests/webtbs/tw4893c.pp Normal file
View File

@ -0,0 +1,8 @@
{$mode macpas}
label a;
begin
goto a;
a:
end.

12
tests/webtbs/tw4898.pp Normal file
View File

@ -0,0 +1,12 @@
{ %OPT=-Sewh -vwh}
{ Source provided for Free Pascal Bug Report 4898 }
{ Submitted by "Naj Kejah" on 2006-03-13 }
{ e-mail: universario@hotmail.com }
program aFP211p;
var R : real;
begin
R:=0.0;
writeln(r);
end.