mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 09:59:29 +02:00
+ generic set handling
This commit is contained in:
parent
2091014e89
commit
63e0f03f63
@ -29,7 +29,7 @@ unit cpunode;
|
||||
implementation
|
||||
|
||||
uses
|
||||
ncgbas,ncgflw,ncgcnv,ncgld,ncgmem,ncgcon,
|
||||
ncgbas,ncgflw,ncgcnv,ncgld,ncgmem,ncgcon,ncgset,
|
||||
n386add,n386cal,n386con,n386cnv,n386flw,n386mat,n386mem,
|
||||
n386set,n386inl,n386opt,
|
||||
{ this not really a node }
|
||||
@ -38,7 +38,10 @@ unit cpunode;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 2002-05-18 13:34:22 peter
|
||||
Revision 1.14 2002-07-06 20:27:26 carl
|
||||
+ generic set handling
|
||||
|
||||
Revision 1.13 2002/05/18 13:34:22 peter
|
||||
* readded missing revisions
|
||||
|
||||
Revision 1.12 2002/05/16 19:46:50 carl
|
||||
|
@ -1110,6 +1110,11 @@ implementation
|
||||
(aktprocdef.proctypeoption=potype_constructor) then
|
||||
begin
|
||||
emitjmp(C_Z,faillabel);
|
||||
{$ifdef TEST_GENERIC}
|
||||
{ should be moved to generic version! }
|
||||
reference_reset_base(href, procinfo^.framepointer,procinfo^.selfpointer_offset);
|
||||
cg.a_load_ref_reg(exprasmlist, OS_ADDR, href, SELF_POINTER_REG);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
{ call to AfterConstruction? }
|
||||
@ -1475,7 +1480,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.56 2002-07-01 18:46:31 peter
|
||||
Revision 1.57 2002-07-06 20:27:26 carl
|
||||
+ generic set handling
|
||||
|
||||
Revision 1.56 2002/07/01 18:46:31 peter
|
||||
* internal linker
|
||||
* reorganized aasm layer
|
||||
|
||||
|
@ -27,15 +27,13 @@ unit n386set;
|
||||
interface
|
||||
|
||||
uses
|
||||
node,nset;
|
||||
node,nset,pass_1;
|
||||
|
||||
type
|
||||
ti386setelementnode = class(tsetelementnode)
|
||||
procedure pass_2;override;
|
||||
end;
|
||||
|
||||
ti386innode = class(tinnode)
|
||||
procedure pass_2;override;
|
||||
function pass_1 : tnode;override;
|
||||
end;
|
||||
ti386casenode = class(tcasenode)
|
||||
procedure pass_2;override;
|
||||
@ -56,40 +54,40 @@ implementation
|
||||
const
|
||||
bytes2Sxx:array[1..8] of Topsize=(S_B,S_W,S_NO,S_L,S_NO,S_NO,S_NO,S_Q);
|
||||
|
||||
{*****************************************************************************
|
||||
TI386SETELEMENTNODE
|
||||
*****************************************************************************}
|
||||
|
||||
procedure ti386setelementnode.pass_2;
|
||||
var
|
||||
pushedregs : tmaybesave;
|
||||
begin
|
||||
{ load first value in 32bit register }
|
||||
secondpass(left);
|
||||
if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
|
||||
location_force_reg(exprasmlist,left.location,OS_32,false);
|
||||
|
||||
{ also a second value ? }
|
||||
if assigned(right) then
|
||||
begin
|
||||
maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
|
||||
secondpass(right);
|
||||
if codegenerror then
|
||||
exit;
|
||||
maybe_restore(exprasmlist,left.location,pushedregs);
|
||||
if right.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
|
||||
location_force_reg(exprasmlist,right.location,OS_32,false);
|
||||
end;
|
||||
|
||||
{ we doesn't modify the left side, we check only the type }
|
||||
location_copy(location,left.location);
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
TI386INNODE
|
||||
*****************************************************************************}
|
||||
|
||||
function ti386innode.pass_1 : tnode;
|
||||
begin
|
||||
result:=nil;
|
||||
{ this is the only difference from the generic version }
|
||||
location.loc:=LOC_FLAGS;
|
||||
|
||||
firstpass(right);
|
||||
firstpass(left);
|
||||
if codegenerror then
|
||||
exit;
|
||||
|
||||
left_right_max;
|
||||
{ this is not allways true due to optimization }
|
||||
{ but if we don't set this we get problems with optimizing self code }
|
||||
if tsetdef(right.resulttype.def).settype<>smallset then
|
||||
procinfo^.flags:=procinfo^.flags or pi_do_call
|
||||
else
|
||||
begin
|
||||
{ a smallset needs maybe an misc. register }
|
||||
if (left.nodetype<>ordconstn) and
|
||||
not(right.location.loc in [LOC_CREGISTER,LOC_REGISTER]) and
|
||||
(right.registers32<1) then
|
||||
inc(registers32);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure ti386innode.pass_2;
|
||||
type
|
||||
Tsetpart=record
|
||||
@ -1011,13 +1009,17 @@ implementation
|
||||
|
||||
|
||||
begin
|
||||
csetelementnode:=ti386setelementnode;
|
||||
{$ifndef TEST_GENERIC}
|
||||
cinnode:=ti386innode;
|
||||
{$endif}
|
||||
ccasenode:=ti386casenode;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.32 2002-07-01 18:46:33 peter
|
||||
Revision 1.33 2002-07-06 20:27:26 carl
|
||||
+ generic set handling
|
||||
|
||||
Revision 1.32 2002/07/01 18:46:33 peter
|
||||
* internal linker
|
||||
* reorganized aasm layer
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user