mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-16 15:22:48 +02:00
557 lines
21 KiB
ObjectPascal
557 lines
21 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 1998-2000 by Florian Klaempfl
|
|
|
|
Generate i386 assembler for constants
|
|
|
|
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 n386con;
|
|
|
|
{$i defines.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
node,ncon;
|
|
|
|
type
|
|
ti386realconstnode = class(trealconstnode)
|
|
function pass_1 : tnode;override;
|
|
procedure pass_2;override;
|
|
end;
|
|
|
|
ti386ordconstnode = class(tordconstnode)
|
|
procedure pass_2;override;
|
|
end;
|
|
|
|
ti386pointerconstnode = class(tpointerconstnode)
|
|
procedure pass_2;override;
|
|
end;
|
|
|
|
ti386stringconstnode = class(tstringconstnode)
|
|
procedure pass_2;override;
|
|
end;
|
|
|
|
ti386setconstnode = class(tsetconstnode)
|
|
procedure pass_2;override;
|
|
end;
|
|
|
|
ti386nilnode = class(tnilnode)
|
|
procedure pass_2;override;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
globtype,widestr,systems,
|
|
verbose,globals,
|
|
symconst,symdef,aasm,types,
|
|
temp_gen,
|
|
cpubase,
|
|
cga,tgcpu;
|
|
|
|
{*****************************************************************************
|
|
TI386REALCONSTNODE
|
|
*****************************************************************************}
|
|
|
|
function ti386realconstnode.pass_1 : tnode;
|
|
begin
|
|
result:=nil;
|
|
if (value_real=1.0) or (value_real=0.0) then
|
|
begin
|
|
location.loc:=LOC_FPU;
|
|
registersfpu:=1;
|
|
end
|
|
else
|
|
location.loc:=LOC_MEM;
|
|
end;
|
|
|
|
procedure ti386realconstnode.pass_2;
|
|
const
|
|
floattype2ait:array[tfloattype] of tait=
|
|
(ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit);
|
|
|
|
var
|
|
hp1 : tai;
|
|
lastlabel : tasmlabel;
|
|
realait : tait;
|
|
|
|
begin
|
|
if (value_real=1.0) then
|
|
begin
|
|
emit_none(A_FLD1,S_NO);
|
|
location.loc:=LOC_FPU;
|
|
inc(fpuvaroffset);
|
|
end
|
|
else if (value_real=0.0) then
|
|
begin
|
|
emit_none(A_FLDZ,S_NO);
|
|
location.loc:=LOC_FPU;
|
|
inc(fpuvaroffset);
|
|
end
|
|
else
|
|
begin
|
|
lastlabel:=nil;
|
|
realait:=floattype2ait[tfloatdef(resulttype.def).typ];
|
|
{ const already used ? }
|
|
if not assigned(lab_real) then
|
|
begin
|
|
{ tries to find an old entry }
|
|
hp1:=tai(Consts.first);
|
|
while assigned(hp1) do
|
|
begin
|
|
if hp1.typ=ait_label then
|
|
lastlabel:=tai_label(hp1).l
|
|
else
|
|
begin
|
|
if (hp1.typ=realait) and (lastlabel<>nil) then
|
|
begin
|
|
if(
|
|
((realait=ait_real_32bit) and (tai_real_32bit(hp1).value=value_real)) or
|
|
((realait=ait_real_64bit) and (tai_real_64bit(hp1).value=value_real)) or
|
|
((realait=ait_real_80bit) and (tai_real_80bit(hp1).value=value_real)) or
|
|
((realait=ait_comp_64bit) and (tai_comp_64bit(hp1).value=value_real))
|
|
) then
|
|
begin
|
|
{ found! }
|
|
lab_real:=lastlabel;
|
|
break;
|
|
end;
|
|
end;
|
|
lastlabel:=nil;
|
|
end;
|
|
hp1:=tai(hp1.next);
|
|
end;
|
|
{ :-(, we must generate a new entry }
|
|
if not assigned(lab_real) then
|
|
begin
|
|
getdatalabel(lastlabel);
|
|
lab_real:=lastlabel;
|
|
if (cs_create_smart in aktmoduleswitches) then
|
|
Consts.concat(Tai_cut.Create);
|
|
Consts.concat(Tai_label.Create(lastlabel));
|
|
case realait of
|
|
ait_real_32bit :
|
|
Consts.concat(Tai_real_32bit.Create(value_real));
|
|
ait_real_64bit :
|
|
Consts.concat(Tai_real_64bit.Create(value_real));
|
|
ait_real_80bit :
|
|
Consts.concat(Tai_real_80bit.Create(value_real));
|
|
ait_comp_64bit :
|
|
Consts.concat(Tai_comp_64bit.Create(value_real));
|
|
else
|
|
internalerror(10120);
|
|
end;
|
|
end;
|
|
end;
|
|
reset_reference(location.reference);
|
|
location.reference.symbol:=lab_real;
|
|
location.loc:=LOC_MEM;
|
|
end;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TI386ORDCONSTNODE
|
|
*****************************************************************************}
|
|
|
|
procedure ti386ordconstnode.pass_2;
|
|
var
|
|
l : tasmlabel;
|
|
|
|
begin
|
|
location.loc:=LOC_MEM;
|
|
if is_64bitint(resulttype.def) then
|
|
begin
|
|
getdatalabel(l);
|
|
if (cs_create_smart in aktmoduleswitches) then
|
|
Consts.concat(Tai_cut.Create);
|
|
Consts.concat(Tai_label.Create(l));
|
|
Consts.concat(Tai_const.Create_32bit(longint(lo(value))));
|
|
Consts.concat(Tai_const.Create_32bit(longint(hi(value))));
|
|
reset_reference(location.reference);
|
|
location.reference.symbol:=l;
|
|
end
|
|
else
|
|
begin
|
|
{ non int64 const. behaves as a memory reference }
|
|
location.reference.is_immediate:=true;
|
|
location.reference.offset:=longint(value);
|
|
end;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TI386POINTERCONSTNODE
|
|
*****************************************************************************}
|
|
|
|
procedure ti386pointerconstnode.pass_2;
|
|
begin
|
|
{ an integer const. behaves as a memory reference }
|
|
location.loc:=LOC_MEM;
|
|
location.reference.is_immediate:=true;
|
|
location.reference.offset:=longint(value);
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
Ti386STRINGCONSTNODE
|
|
*****************************************************************************}
|
|
|
|
procedure ti386stringconstnode.pass_2;
|
|
var
|
|
hp1 : tai;
|
|
l1,l2,
|
|
lastlabel : tasmlabel;
|
|
pc : pchar;
|
|
same_string : boolean;
|
|
l,j,
|
|
i,mylength : longint;
|
|
begin
|
|
{ for empty ansistrings we could return a constant 0 }
|
|
if is_ansistring(resulttype.def) and
|
|
(len=0) then
|
|
begin
|
|
location.loc:=LOC_MEM;
|
|
location.reference.is_immediate:=true;
|
|
location.reference.offset:=0;
|
|
exit;
|
|
end;
|
|
{ const already used ? }
|
|
lastlabel:=nil;
|
|
if not assigned(lab_str) then
|
|
begin
|
|
if is_shortstring(resulttype.def) then
|
|
mylength:=len+2
|
|
else
|
|
mylength:=len+1;
|
|
{ widestrings can't be reused yet }
|
|
if not(is_widestring(resulttype.def)) then
|
|
begin
|
|
{ tries to found an old entry }
|
|
hp1:=tai(Consts.first);
|
|
while assigned(hp1) do
|
|
begin
|
|
if hp1.typ=ait_label then
|
|
lastlabel:=tai_label(hp1).l
|
|
else
|
|
begin
|
|
{ when changing that code, be careful that }
|
|
{ you don't use typed consts, which are }
|
|
{ are also written to consts }
|
|
{ currently, this is no problem, because }
|
|
{ typed consts have no leading length or }
|
|
{ they have no trailing zero }
|
|
if (hp1.typ=ait_string) and (lastlabel<>nil) and
|
|
(tai_string(hp1).len=mylength) then
|
|
begin
|
|
same_string:=true;
|
|
{ if shortstring then check the length byte first and
|
|
set the start index to 1 }
|
|
if is_shortstring(resulttype.def) then
|
|
begin
|
|
if len<>ord(tai_string(hp1).str[0]) then
|
|
same_string:=false;
|
|
j:=1;
|
|
end
|
|
else
|
|
j:=0;
|
|
{ don't check if the length byte was already wrong }
|
|
if same_string then
|
|
begin
|
|
for i:=0 to len do
|
|
begin
|
|
if tai_string(hp1).str[j]<>value_str[i] then
|
|
begin
|
|
same_string:=false;
|
|
break;
|
|
end;
|
|
inc(j);
|
|
end;
|
|
end;
|
|
{ found ? }
|
|
if same_string then
|
|
begin
|
|
lab_str:=lastlabel;
|
|
{ create a new entry for ansistrings, but reuse the data }
|
|
if (st_type in [st_ansistring,st_widestring]) then
|
|
begin
|
|
getdatalabel(l2);
|
|
Consts.concat(Tai_label.Create(l2));
|
|
Consts.concat(Tai_const_symbol.Create(lab_str));
|
|
{ return the offset of the real string }
|
|
lab_str:=l2;
|
|
end;
|
|
break;
|
|
end;
|
|
end;
|
|
lastlabel:=nil;
|
|
end;
|
|
hp1:=tai(hp1.next);
|
|
end;
|
|
end;
|
|
{ :-(, we must generate a new entry }
|
|
if not assigned(lab_str) then
|
|
begin
|
|
getdatalabel(lastlabel);
|
|
lab_str:=lastlabel;
|
|
if (cs_create_smart in aktmoduleswitches) then
|
|
Consts.concat(Tai_cut.Create);
|
|
Consts.concat(Tai_label.Create(lastlabel));
|
|
{ generate an ansi string ? }
|
|
case st_type of
|
|
st_ansistring:
|
|
begin
|
|
{ an empty ansi string is nil! }
|
|
if len=0 then
|
|
Consts.concat(Tai_const.Create_32bit(0))
|
|
else
|
|
begin
|
|
getdatalabel(l1);
|
|
getdatalabel(l2);
|
|
Consts.concat(Tai_label.Create(l2));
|
|
Consts.concat(Tai_const_symbol.Create(l1));
|
|
Consts.concat(Tai_const.Create_32bit(len));
|
|
Consts.concat(Tai_const.Create_32bit(len));
|
|
Consts.concat(Tai_const.Create_32bit(-1));
|
|
Consts.concat(Tai_label.Create(l1));
|
|
getmem(pc,len+2);
|
|
move(value_str^,pc^,len);
|
|
pc[len]:=#0;
|
|
{ to overcome this problem we set the length explicitly }
|
|
{ with the ending null char }
|
|
Consts.concat(Tai_string.Create_length_pchar(pc,len+1));
|
|
{ return the offset of the real string }
|
|
lab_str:=l2;
|
|
end;
|
|
end;
|
|
st_widestring:
|
|
begin
|
|
{ an empty wide string is nil! }
|
|
if len=0 then
|
|
Consts.concat(Tai_const.Create_32bit(0))
|
|
else
|
|
begin
|
|
getdatalabel(l1);
|
|
getdatalabel(l2);
|
|
Consts.concat(Tai_label.Create(l2));
|
|
Consts.concat(Tai_const_symbol.Create(l1));
|
|
|
|
{ we use always UTF-16 coding for constants }
|
|
{ at least for now }
|
|
{ Consts.concat(Tai_const.Create_8bit(2)); }
|
|
Consts.concat(Tai_const.Create_32bit(len));
|
|
Consts.concat(Tai_const.Create_32bit(len));
|
|
Consts.concat(Tai_const.Create_32bit(-1));
|
|
Consts.concat(Tai_label.Create(l1));
|
|
for i:=0 to len-1 do
|
|
Consts.concat(Tai_const.Create_16bit(pcompilerwidestring(value_str)^.data[i]));
|
|
{ return the offset of the real string }
|
|
lab_str:=l2;
|
|
end;
|
|
end;
|
|
st_shortstring:
|
|
begin
|
|
{ truncate strings larger than 255 chars }
|
|
if len>255 then
|
|
l:=255
|
|
else
|
|
l:=len;
|
|
{ also length and terminating zero }
|
|
getmem(pc,l+3);
|
|
move(value_str^,pc[1],l+1);
|
|
pc[0]:=chr(l);
|
|
{ to overcome this problem we set the length explicitly }
|
|
{ with the ending null char }
|
|
pc[l+1]:=#0;
|
|
Consts.concat(Tai_string.Create_length_pchar(pc,l+2));
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
reset_reference(location.reference);
|
|
location.reference.symbol:=lab_str;
|
|
location.loc:=LOC_MEM;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TI386SETCONSTNODE
|
|
*****************************************************************************}
|
|
|
|
procedure ti386setconstnode.pass_2;
|
|
var
|
|
hp1 : tai;
|
|
lastlabel : tasmlabel;
|
|
i : longint;
|
|
neededtyp : tait;
|
|
begin
|
|
{ small sets are loaded as constants }
|
|
if tsetdef(resulttype.def).settype=smallset then
|
|
begin
|
|
location.loc:=LOC_MEM;
|
|
location.reference.is_immediate:=true;
|
|
location.reference.offset:=plongint(value_set)^;
|
|
exit;
|
|
end;
|
|
if tsetdef(resulttype.def).settype=smallset then
|
|
neededtyp:=ait_const_32bit
|
|
else
|
|
neededtyp:=ait_const_8bit;
|
|
lastlabel:=nil;
|
|
{ const already used ? }
|
|
if not assigned(lab_set) then
|
|
begin
|
|
{ tries to found an old entry }
|
|
hp1:=tai(Consts.first);
|
|
while assigned(hp1) do
|
|
begin
|
|
if hp1.typ=ait_label then
|
|
lastlabel:=tai_label(hp1).l
|
|
else
|
|
begin
|
|
if (lastlabel<>nil) and (hp1.typ=neededtyp) then
|
|
begin
|
|
if (hp1.typ=ait_const_8bit) then
|
|
begin
|
|
{ compare normal set }
|
|
i:=0;
|
|
while assigned(hp1) and (i<32) do
|
|
begin
|
|
if tai_const(hp1).value<>value_set^[i] then
|
|
break;
|
|
inc(i);
|
|
hp1:=tai(hp1.next);
|
|
end;
|
|
if i=32 then
|
|
begin
|
|
{ found! }
|
|
lab_set:=lastlabel;
|
|
break;
|
|
end;
|
|
{ leave when the end of consts is reached, so no
|
|
hp1.next is done }
|
|
if not assigned(hp1) then
|
|
break;
|
|
end
|
|
else
|
|
begin
|
|
{ compare small set }
|
|
if plongint(value_set)^=tai_const(hp1).value then
|
|
begin
|
|
{ found! }
|
|
lab_set:=lastlabel;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
lastlabel:=nil;
|
|
end;
|
|
hp1:=tai(hp1.next);
|
|
end;
|
|
{ :-(, we must generate a new entry }
|
|
if not assigned(lab_set) then
|
|
begin
|
|
getdatalabel(lastlabel);
|
|
lab_set:=lastlabel;
|
|
if (cs_create_smart in aktmoduleswitches) then
|
|
Consts.concat(Tai_cut.Create);
|
|
Consts.concat(Tai_label.Create(lastlabel));
|
|
if tsetdef(resulttype.def).settype=smallset then
|
|
begin
|
|
move(value_set^,i,sizeof(longint));
|
|
Consts.concat(Tai_const.Create_32bit(i));
|
|
end
|
|
else
|
|
begin
|
|
for i:=0 to 31 do
|
|
Consts.concat(Tai_const.Create_8bit(value_set^[i]));
|
|
end;
|
|
end;
|
|
end;
|
|
reset_reference(location.reference);
|
|
location.reference.symbol:=lab_set;
|
|
location.loc:=LOC_MEM;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TI386NILNODE
|
|
*****************************************************************************}
|
|
|
|
procedure ti386nilnode.pass_2;
|
|
begin
|
|
location.loc:=LOC_MEM;
|
|
location.reference.is_immediate:=true;
|
|
location.reference.offset:=0;
|
|
end;
|
|
|
|
begin
|
|
crealconstnode:=ti386realconstnode;
|
|
cordconstnode:=ti386ordconstnode;
|
|
cpointerconstnode:=ti386pointerconstnode;
|
|
cstringconstnode:=ti386stringconstnode;
|
|
csetconstnode:=ti386setconstnode;
|
|
cnilnode:=ti386nilnode;
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.10 2001-08-26 13:36:57 florian
|
|
* some cg reorganisation
|
|
* some PPC updates
|
|
|
|
Revision 1.9 2001/07/08 21:00:18 peter
|
|
* various widestring updates, it works now mostly without charset
|
|
mapping supported
|
|
|
|
Revision 1.8 2001/04/13 01:22:18 peter
|
|
* symtable change to classes
|
|
* range check generation and errors fixed, make cycle DEBUG=1 works
|
|
* memory leaks fixed
|
|
|
|
Revision 1.7 2001/04/02 21:20:37 peter
|
|
* resulttype rewrite
|
|
|
|
Revision 1.6 2000/12/25 00:07:32 peter
|
|
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
|
|
tlinkedlist objects)
|
|
|
|
Revision 1.5 2000/11/29 00:30:47 florian
|
|
* unused units removed from uses clause
|
|
* some changes for widestrings
|
|
|
|
Revision 1.4 2000/11/20 15:31:38 jonas
|
|
* longint typecast to assignment of constant to offset field
|
|
|
|
Revision 1.3 2000/11/13 14:44:36 jonas
|
|
* fixes so no more range errors with improved range checking code
|
|
|
|
Revision 1.2 2000/10/31 22:02:56 peter
|
|
* symtable splitted, no real code changes
|
|
|
|
Revision 1.1 2000/10/15 09:33:31 peter
|
|
* moved n386*.pas to i386/ cpu_target dir
|
|
|
|
Revision 1.2 2000/10/14 10:14:48 peter
|
|
* moehrendorf oct 2000 rewrite
|
|
|
|
Revision 1.1 2000/09/28 20:48:52 florian
|
|
*** empty log message ***
|
|
}
|