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

--- Merging r41243 into '.':

Browse Source 
U    rtl/inc/objc.pp
--- Recording mergeinfo for merge of r41243 into '.':
 U   .
--- Merging r41335 into '.':
U    compiler/arm/cgcpu.pas
U    compiler/cgobj.pas
--- Recording mergeinfo for merge of r41335 into '.':
 G   .
--- Merging r41422 into '.':
U    compiler/scanner.pas
--- Recording mergeinfo for merge of r41422 into '.':
 G   .
--- Merging r41474 into '.':
U    compiler/pexpr.pas
A    tests/webtbf/tw35149a.pp
A    tests/webtbs/tw35149.pp
--- Recording mergeinfo for merge of r41474 into '.':
 G   .
--- Merging r41650 into '.':
U    compiler/aarch64/racpugas.pas
--- Recording mergeinfo for merge of r41650 into '.':
 G   .
--- Merging r41651 into '.':
U    tests/test/taarch64abi.pp
--- Recording mergeinfo for merge of r41651 into '.':
 G   .
--- Merging r41905 into '.':
U    compiler/utils/ppuutils/ppudump.pp
--- Recording mergeinfo for merge of r41905 into '.':
 G   .

git-svn-id: branches/fixes_3_2@41943 -
This commit is contained in:
Jonas Maebe 2019-04-27 19:21:30 +00:00
parent d32d0df485
commit 846da37c9f
11 changed files with 99 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -14625,6 +14625,7 @@ tests/webtbf/tw34821.pp svneol=native#text/plain
tests/webtbf/tw3488.pp svneol=native#text/plain
tests/webtbf/tw3495.pp svneol=native#text/plain
tests/webtbf/tw3502.pp svneol=native#text/plain
tests/webtbf/tw35149a.pp svneol=native#text/plain
tests/webtbf/tw3553.pp svneol=native#text/plain
tests/webtbf/tw3562.pp svneol=native#text/plain
tests/webtbf/tw3583.pp svneol=native#text/plain
@ -16338,6 +16339,7 @@ tests/webtbs/tw3504.pp svneol=native#text/plain
tests/webtbs/tw3506.pp svneol=native#text/plain
tests/webtbs/tw35139.pp svneol=native#text/plain
tests/webtbs/tw35139a.pp svneol=native#text/plain
tests/webtbs/tw35149.pp svneol=native#text/plain
tests/webtbs/tw3523.pp svneol=native#text/plain
tests/webtbs/tw3529.pp svneol=native#text/plain
tests/webtbs/tw3531.pp svneol=native#text/plain

9
compiler/aarch64/racpugas.pas
View File

@ -485,8 +485,8 @@ Unit racpugas;
useszr:=false;
for i:=low(instr.operands) to pred(opnr) do
begin
if (instr.operands[1].opr.typ=OPR_REGISTER) then
case getsupreg(instr.operands[1].opr.reg) of
if (instr.operands[i].opr.typ=OPR_REGISTER) then
case getsupreg(instr.operands[i].opr.reg) of
RS_XZR:
useszr:=true;
RS_SP:
@ -494,7 +494,10 @@ Unit racpugas;
end;
end;
result:=valid_shifter_operand(instr.opcode,useszr,usessp,instr.Is64bit,sm,instr.operands[opnr].opr.shifterop.shiftimm);
end
if result then
instr.Ops:=opnr;
end;
break;
end;
end;
end;

56
compiler/arm/cgcpu.pas
View File

@ -42,7 +42,9 @@ unit cgcpu;
cgsetflags : boolean;
procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const paraloc : TCGPara);override;
procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);override;
protected
procedure a_load_ref_cgparalocref(list: TAsmList; sourcesize: tcgsize; sizeleft: tcgint; const ref, paralocref: treference; const cgpara: tcgpara; const location: PCGParaLocation); override;
public
procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : TCGPara);override;
procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override;
@ -569,52 +571,16 @@ unit cgcpu;
end;
procedure tbasecgarm.a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);
var
tmpref, ref: treference;
location: pcgparalocation;
sizeleft: aint;
procedure tbasecgarm.a_load_ref_cgparalocref(list: TAsmList; sourcesize: tcgsize; sizeleft: tcgint; const ref, paralocref: treference; const cgpara: tcgpara; const location: PCGParaLocation);
begin
location := paraloc.location;
tmpref := r;
sizeleft := paraloc.intsize;
while assigned(location) do
{ doubles in softemu mode have a strange order of registers and references }
if (cgpara.size=OS_F64) and
(location^.size=OS_32) then
begin
paramanager.allocparaloc(list,location);
case location^.loc of
LOC_REGISTER,LOC_CREGISTER:
a_load_ref_reg(list,location^.size,location^.size,tmpref,location^.register);
LOC_REFERENCE:
begin
reference_reset_base(ref,location^.reference.index,location^.reference.offset,ctempposinvalid,paraloc.alignment,[]);
{ doubles in softemu mode have a strange order of registers and references }
if location^.size=OS_32 then
g_concatcopy(list,tmpref,ref,4)
else
begin
g_concatcopy(list,tmpref,ref,sizeleft);
if assigned(location^.next) then
internalerror(2005010710);
end;
end;
LOC_FPUREGISTER,LOC_CFPUREGISTER:
case location^.size of
OS_F32, OS_F64:
a_loadfpu_ref_reg(list,location^.size,location^.size,tmpref,location^.register);
else
internalerror(2002072801);
end;
LOC_VOID:
begin
// nothing to do
end;
else
internalerror(2002081103);
end;
inc(tmpref.offset,tcgsize2size[location^.size]);
dec(sizeleft,tcgsize2size[location^.size]);
location := location^.next;
end;
g_concatcopy(list,ref,paralocref,4)
end
else
inherited;
end;

32
compiler/cgobj.pas
View File

@ -170,6 +170,9 @@ unit cgobj;
@param(cgpara where the parameter will be stored)
}
procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : TCGPara);virtual;
protected
procedure a_load_ref_cgparalocref(list: TAsmList; sourcesize: tcgsize; sizeleft: tcgint; const ref, paralocref: treference; const cgpara: tcgpara; const location: PCGParaLocation); virtual;
public
{# Pass the value of a parameter, which can be located either in a register or memory location,
to a routine.
@ -1123,16 +1126,8 @@ implementation
end;
LOC_REFERENCE,LOC_CREFERENCE:
begin
if assigned(location^.next) then
internalerror(2010052906);
reference_reset_base(ref,location^.reference.index,location^.reference.offset,ctempposinvalid,newalignment(cgpara.alignment,cgpara.intsize-sizeleft),[]);
if (size <> OS_NO) and
(tcgsize2size[size] <= sizeof(aint)) then
a_load_ref_ref(list,size,location^.size,tmpref,ref)
else
{ use concatcopy, because the parameter can be larger than }
{ what the OS_* constants can handle }
g_concatcopy(list,tmpref,ref,sizeleft);
reference_reset_base(ref,location^.reference.index,location^.reference.offset,ctempposinvalid,newalignment(cgpara.alignment,cgpara.intsize-sizeleft),[]);
a_load_ref_cgparalocref(list,size,sizeleft,tmpref,ref,cgpara,location);
end;
LOC_MMREGISTER,LOC_CMMREGISTER:
begin
@ -1147,6 +1142,10 @@ implementation
else
internalerror(2010053101);
end;
end;
LOC_FPUREGISTER,LOC_CFPUREGISTER:
begin
a_loadfpu_ref_reg(list,size,location^.size,tmpref,location^.register);
end
else
internalerror(2010053111);
@ -1157,6 +1156,19 @@ implementation
end;
end;
procedure tcg.a_load_ref_cgparalocref(list: TAsmList; sourcesize: tcgsize; sizeleft: tcgint; const ref, paralocref: treference; const cgpara: tcgpara; const location: PCGParaLocation);
begin
if assigned(location^.next) then
internalerror(2010052906);
if (sourcesize<>OS_NO) and
(tcgsize2size[sourcesize]<=sizeof(aint)) then
a_load_ref_ref(list,sourcesize,location^.size,ref,paralocref)
else
{ use concatcopy, because the parameter can be larger than }
{ what the OS_* constants can handle }
g_concatcopy(list,ref,paralocref,sizeleft);
end;
procedure tcg.a_load_loc_cgpara(list : TAsmList;const l:tlocation;const cgpara : TCGPara);
begin

4
compiler/pexpr.pas
View File

@ -1399,9 +1399,7 @@ implementation
(current_procinfo.procdef.struct=structh))) then
Message(parser_e_only_class_members)
else
Message(parser_e_only_class_members_via_class_ref)
else if isobjecttype then
Message(parser_e_only_static_members_via_object_type);
Message(parser_e_only_class_members_via_class_ref);
p1:=csubscriptnode.create(sym,p1);
end;
end;

10
compiler/scanner.pas
View File

@ -572,13 +572,15 @@ implementation
{ Default to intel assembler for delphi/tp7 on i386/i8086 }
if (m_delphi in current_settings.modeswitches) or
(m_tp7 in current_settings.modeswitches) then
begin
{$ifdef i8086}
current_settings.asmmode:=asmmode_i8086_intel;
current_settings.asmmode:=asmmode_i8086_intel;
{$else i8086}
current_settings.asmmode:=asmmode_i386_intel;
current_settings.asmmode:=asmmode_i386_intel;
{$endif i8086}
if changeinit then
init_settings.asmmode:=current_settings.asmmode;
if changeinit then
init_settings.asmmode:=current_settings.asmmode;
end;
{$endif i386 or i8086}
{ Exception support explicitly turned on (mainly for macpas, to }

4
compiler/utils/ppuutils/ppudump.pp
View File

@ -781,7 +781,7 @@ end;
Procedure ReadContainer(const prefix:string);
{
Read a serie of strings and write to the screen starting every line
Read a series of strings and write to the screen starting every line
with prefix
}
begin
@ -3825,7 +3825,7 @@ begin
ibresources :
if not silent then
ReadLinkContainer('Resource file: ');
ReadContainer('Resource file: ');
iberror :
begin

3
rtl/inc/objc.pp
View File

@ -3,6 +3,9 @@ unit objc;
{$ifdef darwin}
{$define targethandled}
{$linklib objc}
{$if defined(iphonesim) or defined(cpuarm) or defined(cpux86_64) or defined(cpupowerpc64) or defined(cpuaarch64)}
{$i objcnf.inc}
{$endif}

42
tests/test/taarch64abi.pp
View File

@ -23,34 +23,28 @@ begin
Halt(3);
end;
function RetByte: byte;
var
q: qword;
begin
q:=$1111111112345678;
asm
ldr x0,q
end;
function RetByte: byte; assembler;
asm
movz x0,#22136
movk x0,#4660,lsl #16
movk x0,#4369,lsl #32
movk x0,#4369,lsl #48
end;
function RetWord: word;
var
q: qword;
begin
q:=$1111111112345678;
asm
ldr x0,q
end;
function RetWord: word; assembler;
asm
movz x0,#22136
movk x0,#4660,lsl #16
movk x0,#4369,lsl #32
movk x0,#4369,lsl #48
end;
function RetDWord: dword;
var
q: qword;
begin
q:=$1111111112345678;
asm
ldr x0,q
end;
function RetDWord: dword; assembler;
asm
movz x0,#22136
movk x0,#4660,lsl #16
movk x0,#4369,lsl #32
movk x0,#4369,lsl #48
end;
procedure TestParams;

14
tests/webtbf/tw35149a.pp Normal file
View File

@ -0,0 +1,14 @@
{ %fail }
program project1;
{$mode objfpc}
type
TestObject = object
var
TestNested: Integer;
end;
begin
writeln(TestObject.TestNested);
end.

14
tests/webtbs/tw35149.pp Normal file
View File

@ -0,0 +1,14 @@
{ %norun }
program project1;
{$mode objfpc}
type
TestObject = object
var
TestNested: Integer;
end;
begin
writeln(SizeOf(TestObject.TestNested));
end.