mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-01 04:13:45 +02:00
4dcd96747e
* foreach gets extra argument for passing local data to the
iterator function
* -CR checks also class typecasts at runtime by changing them
into as
* fixed compiler to cycle with the -CR option
* fixed stabs with elf writer, finally the global variables can
be watched
* removed a lot of routines from cga unit and replaced them by
calls to cgobj
* u32bit-s32bit updates for and,or,xor nodes. When one element is
u32bit then the other is typecasted also to u32bit without giving
a rangecheck warning/error.
* fixed pascal calling method with reversing also the high tree in
the parast, detected by tcalcst3 test
290 lines
10 KiB
ObjectPascal
290 lines
10 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 1998-2000 by Florian Klaempfl
|
|
|
|
Generate assembler for nodes that handle loads and assignments which
|
|
are the same for all (most) processors
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
|
****************************************************************************
|
|
}
|
|
unit ncgld;
|
|
|
|
{$i defines.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
node,nld;
|
|
|
|
type
|
|
tcgarrayconstructornode = class(tarrayconstructornode)
|
|
procedure pass_2;override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
systems,
|
|
verbose,globals,
|
|
symconst,symtype,symdef,aasm,types,
|
|
cginfo,cgbase,pass_2,
|
|
cpubase,
|
|
tgobj,ncgutil,cgobj,cg64f32,rgobj,rgcpu;
|
|
|
|
{*****************************************************************************
|
|
SecondArrayConstruct
|
|
*****************************************************************************}
|
|
|
|
const
|
|
vtInteger = 0;
|
|
vtBoolean = 1;
|
|
vtChar = 2;
|
|
vtExtended = 3;
|
|
vtString = 4;
|
|
vtPointer = 5;
|
|
vtPChar = 6;
|
|
vtObject = 7;
|
|
vtClass = 8;
|
|
vtWideChar = 9;
|
|
vtPWideChar = 10;
|
|
vtAnsiString = 11;
|
|
vtCurrency = 12;
|
|
vtVariant = 13;
|
|
vtInterface = 14;
|
|
vtWideString = 15;
|
|
vtInt64 = 16;
|
|
vtQWord = 17;
|
|
|
|
procedure tcgarrayconstructornode.pass_2;
|
|
var
|
|
hp : tarrayconstructornode;
|
|
href : treference;
|
|
lt : tdef;
|
|
vaddr : boolean;
|
|
vtype : longint;
|
|
freetemp,
|
|
dovariant : boolean;
|
|
elesize : longint;
|
|
tmpreg : tregister;
|
|
begin
|
|
dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
|
|
if dovariant then
|
|
elesize:=8
|
|
else
|
|
elesize:=tarraydef(resulttype.def).elesize;
|
|
if not(nf_cargs in flags) then
|
|
begin
|
|
location_reset(location,LOC_REFERENCE,OS_NO);
|
|
{ Allocate always a temp, also if no elements are required, to
|
|
be sure that location is valid (PFV) }
|
|
if tarraydef(resulttype.def).highrange=-1 then
|
|
tg.gettempofsizereference(exprasmlist,elesize,location.reference)
|
|
else
|
|
tg.gettempofsizereference(exprasmlist,(tarraydef(resulttype.def).highrange+1)*elesize,location.reference);
|
|
href:=location.reference;
|
|
end;
|
|
hp:=self;
|
|
while assigned(hp) do
|
|
begin
|
|
if assigned(hp.left) then
|
|
begin
|
|
freetemp:=true;
|
|
secondpass(hp.left);
|
|
if codegenerror then
|
|
exit;
|
|
if dovariant then
|
|
begin
|
|
{ find the correct vtype value }
|
|
vtype:=$ff;
|
|
vaddr:=false;
|
|
lt:=hp.left.resulttype.def;
|
|
case lt.deftype of
|
|
enumdef,
|
|
orddef :
|
|
begin
|
|
if is_64bitint(lt) then
|
|
begin
|
|
case torddef(lt).typ of
|
|
s64bit:
|
|
vtype:=vtInt64;
|
|
u64bit:
|
|
vtype:=vtQWord;
|
|
end;
|
|
freetemp:=false;
|
|
vaddr:=true;
|
|
end
|
|
else if (lt.deftype=enumdef) or
|
|
is_integer(lt) then
|
|
vtype:=vtInteger
|
|
else
|
|
if is_boolean(lt) then
|
|
vtype:=vtBoolean
|
|
else
|
|
if (lt.deftype=orddef) and (torddef(lt).typ=uchar) then
|
|
vtype:=vtChar;
|
|
end;
|
|
floatdef :
|
|
begin
|
|
vtype:=vtExtended;
|
|
vaddr:=true;
|
|
freetemp:=false;
|
|
end;
|
|
procvardef,
|
|
pointerdef :
|
|
begin
|
|
if is_pchar(lt) then
|
|
vtype:=vtPChar
|
|
else
|
|
vtype:=vtPointer;
|
|
end;
|
|
classrefdef :
|
|
vtype:=vtClass;
|
|
objectdef :
|
|
begin
|
|
vtype:=vtObject;
|
|
end;
|
|
stringdef :
|
|
begin
|
|
if is_shortstring(lt) then
|
|
begin
|
|
vtype:=vtString;
|
|
vaddr:=true;
|
|
freetemp:=false;
|
|
end
|
|
else
|
|
if is_ansistring(lt) then
|
|
begin
|
|
vtype:=vtAnsiString;
|
|
freetemp:=false;
|
|
end
|
|
else
|
|
if is_widestring(lt) then
|
|
begin
|
|
vtype:=vtWideString;
|
|
freetemp:=false;
|
|
end;
|
|
end;
|
|
end;
|
|
if vtype=$ff then
|
|
internalerror(14357);
|
|
{ write C style pushes or an pascal array }
|
|
if nf_cargs in flags then
|
|
begin
|
|
if vaddr then
|
|
begin
|
|
location_force_mem(exprasmlist,hp.left.location);
|
|
cg.a_paramaddr_ref(exprasmlist,hp.left.location.reference,-1);
|
|
location_release(exprasmlist,hp.left.location);
|
|
if freetemp then
|
|
location_freetemp(exprasmlist,hp.left.location);
|
|
end
|
|
else
|
|
cg.a_param_loc(exprasmlist,hp.left.location,-1);
|
|
inc(pushedparasize,4);
|
|
end
|
|
else
|
|
begin
|
|
{ write changing field update href to the next element }
|
|
inc(href.offset,4);
|
|
if vaddr then
|
|
begin
|
|
location_force_mem(exprasmlist,hp.left.location);
|
|
tmpreg:=cg.get_scratch_reg(exprasmlist);
|
|
cg.a_loadaddr_ref_reg(exprasmlist,hp.left.location.reference,tmpreg);
|
|
cg.a_load_reg_ref(exprasmlist,cg.reg_cgsize(tmpreg),tmpreg,href);
|
|
cg.free_scratch_reg(exprasmlist,tmpreg);
|
|
location_release(exprasmlist,hp.left.location);
|
|
if freetemp then
|
|
location_freetemp(exprasmlist,hp.left.location);
|
|
end
|
|
else
|
|
begin
|
|
location_release(exprasmlist,left.location);
|
|
cg.a_load_loc_ref(exprasmlist,hp.left.location,href);
|
|
end;
|
|
{ update href to the vtype field and write it }
|
|
dec(href.offset,4);
|
|
cg.a_load_const_ref(exprasmlist, OS_INT,vtype,href);
|
|
{ goto next array element }
|
|
inc(href.offset,8);
|
|
end;
|
|
end
|
|
else
|
|
{ normal array constructor of the same type }
|
|
begin
|
|
case elesize of
|
|
1,2,4 :
|
|
begin
|
|
location_release(exprasmlist,left.location);
|
|
cg.a_load_loc_ref(exprasmlist,hp.left.location,href);
|
|
end;
|
|
8 :
|
|
begin
|
|
if hp.left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
|
|
tcg64f32(cg).a_load64_loc_ref(exprasmlist,hp.left.location,href)
|
|
else
|
|
cg.g_concatcopy(exprasmlist,hp.left.location.reference,href,elesize,freetemp,false);
|
|
end;
|
|
else
|
|
begin
|
|
{ concatcopy only supports reference }
|
|
if not(hp.left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
|
|
internalerror(200108012);
|
|
cg.g_concatcopy(exprasmlist,hp.left.location.reference,href,elesize,freetemp,false);
|
|
end;
|
|
end;
|
|
inc(href.offset,elesize);
|
|
end;
|
|
end;
|
|
{ load next entry }
|
|
hp:=tarrayconstructornode(hp.right);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
carrayconstructornode:=tcgarrayconstructornode;
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.3 2002-05-12 16:53:07 peter
|
|
* moved entry and exitcode to ncgutil and cgobj
|
|
* foreach gets extra argument for passing local data to the
|
|
iterator function
|
|
* -CR checks also class typecasts at runtime by changing them
|
|
into as
|
|
* fixed compiler to cycle with the -CR option
|
|
* fixed stabs with elf writer, finally the global variables can
|
|
be watched
|
|
* removed a lot of routines from cga unit and replaced them by
|
|
calls to cgobj
|
|
* u32bit-s32bit updates for and,or,xor nodes. When one element is
|
|
u32bit then the other is typecasted also to u32bit without giving
|
|
a rangecheck warning/error.
|
|
* fixed pascal calling method with reversing also the high tree in
|
|
the parast, detected by tcalcst3 test
|
|
|
|
Revision 1.2 2002/04/21 15:24:38 carl
|
|
+ a_jmp_cond -> a_jmp_always (a_jmp_cond is NOT portable)
|
|
+ changeregsize -> rg.makeregsize
|
|
|
|
Revision 1.1 2002/04/19 15:39:34 peter
|
|
* removed some more routines from cga
|
|
* moved location_force_reg/mem to ncgutil
|
|
* moved arrayconstructnode secondpass to ncgld
|
|
|
|
}
|