+ generic set handling

This commit is contained in:
carl 2002-07-06 20:27:26 +00:00
parent 2091014e89
commit 63e0f03f63
3 changed files with 50 additions and 37 deletions

View File

@ -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

View File

@ -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

View File

@ -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