paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 11:29:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* splitted defbase in defutil,symutil,defcmp

Browse Source 
* merged isconvertable and is_equal into compare_defs(_ext)
  * made operator search faster by walking the list only once
This commit is contained in:
peter 2002-11-25 17:43:16 +00:00
parent 3113922e0b
commit f3fc72095f
72 changed files with 3123 additions and 2946 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
compiler/cg64f32.pas
View File

@ -96,7 +96,7 @@ unit cg64f32;
globtype,globals,systems,
cgbase,
verbose,
symbase,symconst,symdef,defbase;
symbase,symconst,symdef,defutil;
function joinreg64(reglo,reghi : tregister) : tregister64;
@ -748,7 +748,12 @@ begin
end.
{
$Log$
Revision 1.31 2002-10-05 12:43:23 carl
Revision 1.32 2002-11-25 17:43:16 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.31 2002/10/05 12:43:23 carl
* fixes for Delphi 6 compilation
(warning : Some features do not work under Delphi)

9
compiler/cgbase.pas
View File

@ -250,7 +250,7 @@ implementation
systems,
cresstr,
tgobj,rgobj,
defbase,
defutil,
fmodule
{$ifdef fixLeaksOnError}
,comphook
@ -658,7 +658,12 @@ begin
end.
{
$Log$
Revision 1.33 2002-11-18 17:31:54 peter
Revision 1.34 2002-11-25 17:43:16 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.33 2002/11/18 17:31:54 peter
* pass proccalloption to ret_in_xxx and push_xxx functions
Revision 1.32 2002/10/05 12:43:23 carl

15
compiler/cgobj.pas
View File

@ -247,9 +247,9 @@ unit cgobj;
procedure a_jmp_always(list : taasmoutput;l: tasmlabel); virtual; abstract;
procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); virtual; abstract;
{# Depending on the value to check in the flags, either sets the register reg to one (if the flag is set)
or zero (if the flag is cleared). The size parameter indicates the destination size register.
{# Depending on the value to check in the flags, either sets the register reg to one (if the flag is set)
or zero (if the flag is cleared). The size parameter indicates the destination size register.
}
procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: tresflags; reg: TRegister); virtual; abstract;
procedure g_flags2ref(list: taasmoutput; size: TCgSize; const f: tresflags; const ref:TReference); virtual;
@ -491,7 +491,7 @@ unit cgobj;
uses
globals,globtype,options,systems,cgbase,
verbose,defbase,tgobj,symdef,paramgr,
verbose,defutil,tgobj,symdef,paramgr,
rgobj,cutils;
const
@ -1625,7 +1625,12 @@ finalization
end.
{
$Log$
Revision 1.65 2002-11-17 16:27:31 carl
Revision 1.66 2002-11-25 17:43:16 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.65 2002/11/17 16:27:31 carl
* document flags2reg
Revision 1.64 2002/11/16 17:06:28 peter

2225
compiler/defbase.pas
View File

File diff suppressed because it is too large Load Diff

1150
compiler/defcmp.pas Normal file
View File

File diff suppressed because it is too large Load Diff

928
compiler/defutil.pas Normal file
View File

@ -0,0 +1,928 @@
{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl
This unit provides some help routines for type handling
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 defutil;
{$i fpcdefs.inc}
interface
uses
cclasses,
cpuinfo,
globals,
node,
symconst,symbase,symtype,symdef;
type
tmmxtype = (mmxno,mmxu8bit,mmxs8bit,mmxu16bit,mmxs16bit,
mmxu32bit,mmxs32bit,mmxfixed16,mmxsingle);
const
{# true if we must never copy this parameter }
never_copy_const_param : boolean = false;
{*****************************************************************************
Basic type functions
*****************************************************************************}
{# Returns true, if definition defines an ordinal type }
function is_ordinal(def : tdef) : boolean;
{# Returns the minimal integer value of the type }
function get_min_value(def : tdef) : TConstExprInt;
{# Returns basetype of the specified integer range }
function range_to_basetype(low,high:TConstExprInt):tbasetype;
{# Returns true, if definition defines an integer type }
function is_integer(def : tdef) : boolean;
{# Returns true if definition is a boolean }
function is_boolean(def : tdef) : boolean;
{# Returns true if definition is a char
This excludes the unicode char.
}
function is_char(def : tdef) : boolean;
{# Returns true if definition is a widechar }
function is_widechar(def : tdef) : boolean;
{# Returns true if definition is a void}
function is_void(def : tdef) : boolean;
{# Returns true if definition is a smallset}
function is_smallset(p : tdef) : boolean;
{# Returns true, if def defines a signed data type
(only for ordinal types)
}
function is_signed(def : tdef) : boolean;
{# Returns true whether def_from's range is comprised in def_to's if both are
orddefs, false otherwise }
function is_in_limit(def_from,def_to : tdef) : boolean;
function is_in_limit_value(val_from:TConstExprInt;def_from,def_to : tdef) : boolean;
{*****************************************************************************
Array helper functions
*****************************************************************************}
{# Returns true, if p points to a zero based (non special like open or
dynamic array def).
This is mainly used to see if the array
is convertable to a pointer
}
function is_zero_based_array(p : tdef) : boolean;
{# Returns true if p points to an open array definition }
function is_open_array(p : tdef) : boolean;
{# Returns true if p points to a dynamic array definition }
function is_dynamic_array(p : tdef) : boolean;
{# Returns true, if p points to an array of const definition }
function is_array_constructor(p : tdef) : boolean;
{# Returns true, if p points to a variant array }
function is_variant_array(p : tdef) : boolean;
{# Returns true, if p points to an array of const }
function is_array_of_const(p : tdef) : boolean;
{# Returns true, if p points any kind of special array
That is if the array is an open array, a variant
array, an array constants constructor, or an
array of const.
}
function is_special_array(p : tdef) : boolean;
{# Returns true if p is a char array def }
function is_chararray(p : tdef) : boolean;
{# Returns true if p is a wide char array def }
function is_widechararray(p : tdef) : boolean;
{*****************************************************************************
String helper functions
*****************************************************************************}
{# Returns true if p points to an open string type }
function is_open_string(p : tdef) : boolean;
{# Returns true if p is an ansi string type }
function is_ansistring(p : tdef) : boolean;
{# Returns true if p is a long string type }
function is_longstring(p : tdef) : boolean;
{# returns true if p is a wide string type }
function is_widestring(p : tdef) : boolean;
{# Returns true if p is a short string type }
function is_shortstring(p : tdef) : boolean;
{# Returns true if p is a pchar def }
function is_pchar(p : tdef) : boolean;
{# Returns true if p is a pwidechar def }
function is_pwidechar(p : tdef) : boolean;
{# Returns true if p is a voidpointer def }
function is_voidpointer(p : tdef) : boolean;
{# Returns true, if definition is a float }
function is_fpu(def : tdef) : boolean;
{# Returns true, if def is a currency type }
function is_currency(def : tdef) : boolean;
{# Returns true, if def is a 64 bit integer type }
function is_64bitint(def : tdef) : boolean;
{# If @var(l) isn't in the range of def a range check error (if not explicit) is generated and
the value is placed within the range
}
procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
{# Returns the range of def, where @var(l) is the low-range and @var(h) is
the high-range.
}
procedure getrange(def : tdef;var l : TConstExprInt;var h : TConstExprInt);
{ some type helper routines for MMX support }
function is_mmx_able_array(p : tdef) : boolean;
{# returns the mmx type }
function mmx_type(p : tdef) : tmmxtype;
implementation
uses
globtype,tokens,systems,verbose,
symtable;
{ returns true, if def uses FPU }
function is_fpu(def : tdef) : boolean;
begin
is_fpu:=(def.deftype=floatdef);
end;
{ returns true, if def is a currency type }
function is_currency(def : tdef) : boolean;
begin
is_currency:=(def.deftype=floatdef) and (tfloatdef(def).typ=s64currency);
end;
function range_to_basetype(low,high:TConstExprInt):tbasetype;
begin
{ generate a unsigned range if high<0 and low>=0 }
if (low>=0) and (high<0) then
range_to_basetype:=u32bit
else if (low>=0) and (high<=255) then
range_to_basetype:=u8bit
else if (low>=-128) and (high<=127) then
range_to_basetype:=s8bit
else if (low>=0) and (high<=65536) then
range_to_basetype:=u16bit
else if (low>=-32768) and (high<=32767) then
range_to_basetype:=s16bit
else
range_to_basetype:=s32bit;
end;
{ true if p is an ordinal }
function is_ordinal(def : tdef) : boolean;
var
dt : tbasetype;
begin
case def.deftype of
orddef :
begin
dt:=torddef(def).typ;
is_ordinal:=dt in [uchar,uwidechar,
u8bit,u16bit,u32bit,u64bit,
s8bit,s16bit,s32bit,s64bit,
bool8bit,bool16bit,bool32bit];
end;
enumdef :
is_ordinal:=true;
else
is_ordinal:=false;
end;
end;
{ returns the min. value of the type }
function get_min_value(def : tdef) : TConstExprInt;
begin
case def.deftype of
orddef:
get_min_value:=torddef(def).low;
enumdef:
get_min_value:=tenumdef(def).min;
else
get_min_value:=0;
end;
end;
{ true if p is an integer }
function is_integer(def : tdef) : boolean;
begin
is_integer:=(def.deftype=orddef) and
(torddef(def).typ in [u8bit,u16bit,u32bit,u64bit,
s8bit,s16bit,s32bit,s64bit]);
end;
{ true if p is a boolean }
function is_boolean(def : tdef) : boolean;
begin
is_boolean:=(def.deftype=orddef) and
(torddef(def).typ in [bool8bit,bool16bit,bool32bit]);
end;
{ true if p is a void }
function is_void(def : tdef) : boolean;
begin
is_void:=(def.deftype=orddef) and
(torddef(def).typ=uvoid);
end;
{ true if p is a char }
function is_char(def : tdef) : boolean;
begin
is_char:=(def.deftype=orddef) and
(torddef(def).typ=uchar);
end;
{ true if p is a wchar }
function is_widechar(def : tdef) : boolean;
begin
is_widechar:=(def.deftype=orddef) and
(torddef(def).typ=uwidechar);
end;
{ true if p is signed (integer) }
function is_signed(def : tdef) : boolean;
var
dt : tbasetype;
begin
case def.deftype of
orddef :
begin
dt:=torddef(def).typ;
is_signed:=(dt in [s8bit,s16bit,s32bit,s64bit]);
end;
enumdef :
is_signed:=tenumdef(def).min < 0;
arraydef :
is_signed:=is_signed(tarraydef(def).rangetype.def);
else
is_signed:=false;
end;
end;
function is_in_limit(def_from,def_to : tdef) : boolean;
var
fromqword, toqword: boolean;
begin
if (def_from.deftype <> orddef) or
(def_to.deftype <> orddef) then
begin
is_in_limit := false;
exit;
end;
fromqword := torddef(def_from).typ = u64bit;
toqword := torddef(def_to).typ = u64bit;
is_in_limit:=(toqword and is_signed(def_from)) or
((not fromqword) and
(torddef(def_from).low>=torddef(def_to).low) and
(torddef(def_from).high<=torddef(def_to).high));
end;
function is_in_limit_value(val_from:TConstExprInt;def_from,def_to : tdef) : boolean;
begin
if (def_from.deftype <> orddef) and
(def_to.deftype <> orddef) then
internalerror(200210062);
if (torddef(def_to).typ = u64bit) then
begin
is_in_limit_value:=((TConstExprUInt(val_from)>=TConstExprUInt(torddef(def_to).low)) and
(TConstExprUInt(val_from)<=TConstExprUInt(torddef(def_to).high)));
end
else
begin;
is_in_limit_value:=((val_from>=torddef(def_to).low) and
(val_from<=torddef(def_to).high));
end;
end;
{ true, if p points to an open array def }
function is_open_string(p : tdef) : boolean;
begin
is_open_string:=(p.deftype=stringdef) and
(tstringdef(p).string_typ=st_shortstring) and
(tstringdef(p).len=0);
end;
{ true, if p points to a zero based array def }
function is_zero_based_array(p : tdef) : boolean;
begin
is_zero_based_array:=(p.deftype=arraydef) and
(tarraydef(p).lowrange=0) and
not(is_special_array(p));
end;
{ true if p points to a dynamic array def }
function is_dynamic_array(p : tdef) : boolean;
begin
is_dynamic_array:=(p.deftype=arraydef) and
tarraydef(p).IsDynamicArray;
end;
{ true, if p points to an open array def }
function is_open_array(p : tdef) : boolean;
begin
{ check for s32bittype is needed, because for u32bit the high
range is also -1 ! (PFV) }
is_open_array:=(p.deftype=arraydef) and
(tarraydef(p).rangetype.def=s32bittype.def) and
(tarraydef(p).lowrange=0) and
(tarraydef(p).highrange=-1) and
not(tarraydef(p).IsConstructor) and
not(tarraydef(p).IsVariant) and
not(tarraydef(p).IsArrayOfConst) and
not(tarraydef(p).IsDynamicArray);
end;
{ true, if p points to an array of const def }
function is_array_constructor(p : tdef) : boolean;
begin
is_array_constructor:=(p.deftype=arraydef) and
(tarraydef(p).IsConstructor);
end;
{ true, if p points to a variant array }
function is_variant_array(p : tdef) : boolean;
begin
is_variant_array:=(p.deftype=arraydef) and
(tarraydef(p).IsVariant);
end;
{ true, if p points to an array of const }
function is_array_of_const(p : tdef) : boolean;
begin
is_array_of_const:=(p.deftype=arraydef) and
(tarraydef(p).IsArrayOfConst);
end;
{ true, if p points to a special array }
function is_special_array(p : tdef) : boolean;
begin
is_special_array:=(p.deftype=arraydef) and
((tarraydef(p).IsVariant) or
(tarraydef(p).IsArrayOfConst) or
(tarraydef(p).IsConstructor) or
is_open_array(p)
);
end;
{ true if p is an ansi string def }
function is_ansistring(p : tdef) : boolean;
begin
is_ansistring:=(p.deftype=stringdef) and
(tstringdef(p).string_typ=st_ansistring);
end;
{ true if p is an long string def }
function is_longstring(p : tdef) : boolean;
begin
is_longstring:=(p.deftype=stringdef) and
(tstringdef(p).string_typ=st_longstring);
end;
{ true if p is an wide string def }
function is_widestring(p : tdef) : boolean;
begin
is_widestring:=(p.deftype=stringdef) and
(tstringdef(p).string_typ=st_widestring);
end;
{ true if p is an short string def }
function is_shortstring(p : tdef) : boolean;
begin
is_shortstring:=(p.deftype=stringdef) and
(tstringdef(p).string_typ=st_shortstring);
end;
{ true if p is a char array def }
function is_chararray(p : tdef) : boolean;
begin
is_chararray:=(p.deftype=arraydef) and
is_char(tarraydef(p).elementtype.def) and
not(is_special_array(p));
end;
{ true if p is a widechar array def }
function is_widechararray(p : tdef) : boolean;
begin
is_widechararray:=(p.deftype=arraydef) and
is_widechar(tarraydef(p).elementtype.def) and
not(is_special_array(p));
end;
{ true if p is a pchar def }
function is_pchar(p : tdef) : boolean;
begin
is_pchar:=(p.deftype=pointerdef) and
(is_char(tpointerdef(p).pointertype.def) or
(is_zero_based_array(tpointerdef(p).pointertype.def) and
is_chararray(tpointerdef(p).pointertype.def)));
end;
{ true if p is a pchar def }
function is_pwidechar(p : tdef) : boolean;
begin
is_pwidechar:=(p.deftype=pointerdef) and
(is_widechar(tpointerdef(p).pointertype.def) or
(is_zero_based_array(tpointerdef(p).pointertype.def) and
is_widechararray(tpointerdef(p).pointertype.def)));
end;
{ true if p is a voidpointer def }
function is_voidpointer(p : tdef) : boolean;
begin
is_voidpointer:=(p.deftype=pointerdef) and
(tpointerdef(p).pointertype.def.deftype=orddef) and
(torddef(tpointerdef(p).pointertype.def).typ=uvoid);
end;
{ true if p is a smallset def }
function is_smallset(p : tdef) : boolean;
begin
is_smallset:=(p.deftype=setdef) and
(tsetdef(p).settype=smallset);
end;
{ true, if def is a 64 bit int type }
function is_64bitint(def : tdef) : boolean;
begin
is_64bitint:=(def.deftype=orddef) and (torddef(def).typ in [u64bit,s64bit])
end;
{ if l isn't in the range of def a range check error (if not explicit) is generated and
the value is placed within the range }
procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
var
lv,hv: TConstExprInt;
error: boolean;
begin
error := false;
{ for 64 bit types we need only to check if it is less than }
{ zero, if def is a qword node }
if is_64bitint(def) then
begin
if (l<0) and (torddef(def).typ=u64bit) then
begin
{ don't zero the result, because it may come from hex notation
like $ffffffffffffffff! (JM)
l:=0; }
if not explicit then
begin
if (cs_check_range in aktlocalswitches) then
Message(parser_e_range_check_error)
else
Message(parser_w_range_check_error);
end;
error := true;
end;
end
else
begin
getrange(def,lv,hv);
if (def.deftype=orddef) and
(torddef(def).typ=u32bit) then
begin
if (l < cardinal(lv)) or
(l > cardinal(hv)) then
begin
if not explicit then
begin
if (cs_check_range in aktlocalswitches) then
Message(parser_e_range_check_error)
else
Message(parser_w_range_check_error);
end;
error := true;
end;
end
else if (l<lv) or (l>hv) then
begin
if not explicit then
begin
if ((def.deftype=enumdef) and
{ delphi allows range check errors in
enumeration type casts FK }
not(m_delphi in aktmodeswitches)) or
(cs_check_range in aktlocalswitches) then
Message(parser_e_range_check_error)
else
Message(parser_w_range_check_error);
end;
error := true;
end;
end;
if error then
begin
{ Fix the value to fit in the allocated space for this type of variable }
case def.size of
1: l := l and $ff;
2: l := l and $ffff;
{ work around sign extension bug (to be fixed) (JM) }
4: l := l and (int64($fffffff) shl 4 + $f);
end;
{ do sign extension if necessary (JM) }
if is_signed(def) then
begin
case def.size of
1: l := shortint(l);
2: l := smallint(l);
4: l := longint(l);
end;
end;
end;
end;
{ return the range from def in l and h }
procedure getrange(def : tdef;var l : TConstExprInt;var h : TConstExprInt);
begin
case def.deftype of
orddef :
begin
l:=torddef(def).low;
h:=torddef(def).high;
end;
enumdef :
begin
l:=tenumdef(def).min;
h:=tenumdef(def).max;
end;
arraydef :
begin
l:=tarraydef(def).lowrange;
h:=tarraydef(def).highrange;
end;
else
internalerror(987);
end;
end;
function mmx_type(p : tdef) : tmmxtype;
begin
mmx_type:=mmxno;
if is_mmx_able_array(p) then
begin
if tarraydef(p).elementtype.def.deftype=floatdef then
case tfloatdef(tarraydef(p).elementtype.def).typ of
s32real:
mmx_type:=mmxsingle;
end
else
case torddef(tarraydef(p).elementtype.def).typ of
u8bit:
mmx_type:=mmxu8bit;
s8bit:
mmx_type:=mmxs8bit;
u16bit:
mmx_type:=mmxu16bit;
s16bit:
mmx_type:=mmxs16bit;
u32bit:
mmx_type:=mmxu32bit;
s32bit:
mmx_type:=mmxs32bit;
end;
end;
end;
function is_mmx_able_array(p : tdef) : boolean;
begin
{$ifdef SUPPORT_MMX}
if (cs_mmx_saturation in aktlocalswitches) then
begin
is_mmx_able_array:=(p.deftype=arraydef) and
not(is_special_array(p)) and
(
(
(tarraydef(p).elementtype.def.deftype=orddef) and
(
(
(tarraydef(p).lowrange=0) and
(tarraydef(p).highrange=1) and
(torddef(tarraydef(p).elementtype.def).typ in [u32bit,s32bit])
)
or
(
(tarraydef(p).lowrange=0) and
(tarraydef(p).highrange=3) and
(torddef(tarraydef(p).elementtype.def).typ in [u16bit,s16bit])
)
)
)
or
(
(
(tarraydef(p).elementtype.def.deftype=floatdef) and
(
(tarraydef(p).lowrange=0) and
(tarraydef(p).highrange=1) and
(tfloatdef(tarraydef(p).elementtype.def).typ=s32real)
)
)
)
);
end
else
begin
is_mmx_able_array:=(p.deftype=arraydef) and
(
(
(tarraydef(p).elementtype.def.deftype=orddef) and
(
(
(tarraydef(p).lowrange=0) and
(tarraydef(p).highrange=1) and
(torddef(tarraydef(p).elementtype.def).typ in [u32bit,s32bit])
)
or
(
(tarraydef(p).lowrange=0) and
(tarraydef(p).highrange=3) and
(torddef(tarraydef(p).elementtype.def).typ in [u16bit,s16bit])
)
or
(
(tarraydef(p).lowrange=0) and
(tarraydef(p).highrange=7) and
(torddef(tarraydef(p).elementtype.def).typ in [u8bit,s8bit])
)
)
)
or
(
(tarraydef(p).elementtype.def.deftype=floatdef) and
(
(tarraydef(p).lowrange=0) and
(tarraydef(p).highrange=1) and
(tfloatdef(tarraydef(p).elementtype.def).typ=s32real)
)
)
);
end;
{$else SUPPORT_MMX}
is_mmx_able_array:=false;
{$endif SUPPORT_MMX}
end;
end.
{
$Log$
Revision 1.1 2002-11-25 17:43:17 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.26 2002/11/17 16:31:55 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.25 2002/11/16 18:00:53 peter
* fix merged proc-procvar check
Revision 1.24 2002/11/15 01:58:46 peter
* merged changes from 1.0.7 up to 04-11
- -V option for generating bug report tracing
- more tracing for option parsing
- errors for cdecl and high()
- win32 import stabs
- win32 records<=8 are returned in eax:edx (turned off by default)
- heaptrc update
- more info for temp management in .s file with EXTDEBUG
Revision 1.23 2002/10/20 15:34:16 peter
* removed df_unique flag. It breaks code. For a good type=type <id>
a def copy is required
Revision 1.22 2002/10/10 16:07:57 florian
+ several widestring/pwidechar related stuff added
Revision 1.21 2002/10/09 21:01:41 florian
* variants aren't compatible with nil
Revision 1.20 2002/10/07 09:49:42 florian
* overloaded :=-operator is now searched when looking for possible
variant type conversions
Revision 1.19 2002/10/06 21:02:17 peter
* fixed limit checking for qword
Revision 1.18 2002/10/06 15:08:59 peter
* only check for forwarddefs the definitions that really belong to
the current procsym
Revision 1.17 2002/10/06 12:25:04 florian
+ proper support of type <id> = type <another id>;
Revision 1.16 2002/10/05 12:43:24 carl
* fixes for Delphi 6 compilation
(warning : Some features do not work under Delphi)
Revision 1.15 2002/10/05 00:50:01 peter
* check parameters from left to right in equal_paras, so default
parameters are checked at the end
Revision 1.14 2002/09/30 07:00:44 florian
* fixes to common code to get the alpha compiler compiled applied
Revision 1.13 2002/09/22 14:02:34 carl
* stack checking cannot be called before system unit is initialized
* MC68020 define
Revision 1.12 2002/09/16 14:11:12 peter
* add argument to equal_paras() to support default values or not
Revision 1.11 2002/09/15 17:54:46 peter
* allow default parameters in equal_paras
Revision 1.10 2002/09/08 11:10:17 carl
* bugfix 2109 (bad imho, but only way)
Revision 1.9 2002/09/07 15:25:02 peter
* old logs removed and tabs fixed
Revision 1.8 2002/09/07 09:16:55 carl
* fix my stupid copy and paste bug
Revision 1.7 2002/09/06 19:58:31 carl
* start bugfix 1996
* 64-bit typed constant now work correctly and fully (bugfix 2001)
Revision 1.6 2002/08/20 10:31:26 daniel
* Tcallnode.det_resulttype rewritten
Revision 1.5 2002/08/12 20:39:17 florian
* casting of classes to interface fixed when the interface was
implemented by a parent class
Revision 1.4 2002/08/12 14:17:56 florian
* nil is now recognized as being compatible with a dynamic array
Revision 1.3 2002/08/05 18:27:48 carl
+ more more more documentation
+ first version include/exclude (can't test though, not enough scratch for i386 :()...
Revision 1.2 2002/07/23 09:51:22 daniel
* Tried to make Tprocsym.defs protected. I didn't succeed but the cleanups
are worth comitting.
Revision 1.1 2002/07/20 11:57:53 florian
* types.pas renamed to defbase.pas because D6 contains a types
unit so this would conflicts if D6 programms are compiled
+ Willamette/SSE2 instructions to assembler added
Revision 1.75 2002/07/11 14:41:32 florian
* start of the new generic parameter handling
Revision 1.74 2002/07/01 16:23:54 peter
* cg64 patch
* basics for currency
* asnode updates for class and interface (not finished)
Revision 1.73 2002/05/18 13:34:21 peter
* readded missing revisions
Revision 1.72 2002/05/16 19:46:47 carl
+ defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
+ try to fix temp allocation (still in ifdef)
+ generic constructor calls
+ start of tassembler / tmodulebase class cleanup
Revision 1.70 2002/05/12 16:53:16 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.69 2002/04/25 20:16:39 peter
* moved more routines from cga/n386util
Revision 1.68 2002/04/15 19:08:22 carl
+ target_info.size_of_pointer -> pointer_size
+ some cleanup of unused types/variables
Revision 1.67 2002/04/07 13:40:29 carl
+ update documentation
Revision 1.66 2002/04/02 17:11:32 peter
* tlocation,treference update
* LOC_CONSTANT added for better constant handling
* secondadd splitted in multiple routines
* location_force_reg added for loading a location to a register
of a specified size
* secondassignment parses now first the right and then the left node
(this is compatible with Kylix). This saves a lot of push/pop especially
with string operations
* adapted some routines to use the new cg methods
Revision 1.65 2002/04/01 20:57:14 jonas
* fixed web bug 1907
* fixed some other procvar related bugs (all related to accepting procvar
constructs with either too many or too little parameters)
(both merged, includes second typo fix of pexpr.pas)
Revision 1.64 2002/01/24 18:25:53 peter
* implicit result variable generation for assembler routines
* removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
Revision 1.63 2002/01/24 12:33:53 jonas
* adapted ranges of native types to int64 (e.g. high cardinal is no
longer longint($ffffffff), but just $fffffff in psystem)
* small additional fix in 64bit rangecheck code generation for 32 bit
processors
* adaption of ranges required the matching talgorithm used for selecting
which overloaded procedure to call to be adapted. It should now always
select the closest match for ordinal parameters.
+ inttostr(qword) in sysstr.inc/sysstrh.inc
+ abs(int64), sqr(int64), sqr(qword) in systemh.inc/generic.inc (previous
fixes were required to be able to add them)
* is_in_limit() moved from ncal to types unit, should always be used
instead of direct comparisons of low/high values of orddefs because
qword is a special case
}

9
compiler/htypechk.pas
View File

@ -126,7 +126,7 @@ implementation
globtype,systems,
cutils,verbose,globals,
symconst,symsym,symtable,
defbase,cpubase,
defutil,defcmp,cpubase,
ncnv,nld,
nmem,ncal,nmat,
cgbase
@ -975,7 +975,12 @@ implementation
end.
{
$Log$
Revision 1.50 2002-10-07 20:12:08 peter
Revision 1.51 2002-11-25 17:43:17 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.50 2002/10/07 20:12:08 peter
* ugly hack to fix tb0411
Revision 1.49 2002/10/05 00:47:03 peter

9
compiler/i386/cgcpu.pas
View File

@ -55,7 +55,7 @@ unit cgcpu;
uses
globtype,globals,verbose,systems,cutils,
symdef,symsym,defbase,paramgr,
symdef,symsym,defutil,paramgr,
rgobj,tgobj,rgcpu;
@ -174,7 +174,12 @@ begin
end.
{
$Log$
Revision 1.31 2002-10-05 12:43:29 carl
Revision 1.32 2002-11-25 17:43:26 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.31 2002/10/05 12:43:29 carl
* fixes for Delphi 6 compilation
(warning : Some features do not work under Delphi)

9
compiler/i386/n386add.pas
View File

@ -57,7 +57,7 @@ interface
globtype,systems,
cutils,verbose,globals,
symconst,symdef,paramgr,
aasmbase,aasmtai,aasmcpu,defbase,htypechk,
aasmbase,aasmtai,aasmcpu,defutil,htypechk,
cgbase,pass_2,regvars,
cpupara,
ncon,nset,
@ -1553,7 +1553,12 @@ begin
end.
{
$Log$
Revision 1.51 2002-11-15 01:58:56 peter
Revision 1.52 2002-11-25 17:43:26 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.51 2002/11/15 01:58:56 peter
* merged changes from 1.0.7 up to 04-11
- -V option for generating bug report tracing
- more tracing for option parsing

9
compiler/i386/n386cal.pas
View File

@ -50,7 +50,7 @@ implementation
uses
systems,
cutils,verbose,globals,
symconst,symbase,symsym,symtable,defbase,
symconst,symbase,symsym,symtable,defutil,
{$ifdef GDB}
{$ifdef delphi}
sysutils,
@ -1242,7 +1242,12 @@ begin
end.
{
$Log$
Revision 1.75 2002-11-18 17:32:00 peter
Revision 1.76 2002-11-25 17:43:26 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.75 2002/11/18 17:32:00 peter
* pass proccalloption to ret_in_xxx and push_xxx functions
Revision 1.74 2002/11/15 01:58:57 peter

9
compiler/i386/n386cnv.pas
View File

@ -27,7 +27,7 @@ unit n386cnv;
interface
uses
node,ncgcnv,defbase;
node,ncgcnv,defutil,defcmp;
type
ti386typeconvnode = class(tcgtypeconvnode)
@ -413,7 +413,12 @@ begin
end.
{
$Log$
Revision 1.51 2002-10-10 16:14:54 florian
Revision 1.52 2002-11-25 17:43:26 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.51 2002/10/10 16:14:54 florian
* fixed to reflect last tconvtype change
Revision 1.50 2002/10/05 12:43:29 carl

9
compiler/i386/n386inl.pas
View File

@ -62,7 +62,7 @@ implementation
uses
globtype,systems,
cutils,verbose,globals,fmodule,
symconst,symdef,defbase,
symconst,symdef,defutil,
aasmbase,aasmtai,aasmcpu,
cginfo,cgbase,pass_1,pass_2,
cpubase,paramgr,
@ -328,7 +328,12 @@ begin
end.
{
$Log$
Revision 1.53 2002-09-07 15:25:10 peter
Revision 1.54 2002-11-25 17:43:26 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.53 2002/09/07 15:25:10 peter
* old logs removed and tabs fixed
Revision 1.52 2002/08/02 07:44:31 jonas

9
compiler/i386/n386mat.pas
View File

@ -54,7 +54,7 @@ implementation
uses
globtype,systems,
cutils,verbose,globals,
symconst,symdef,aasmbase,aasmtai,aasmcpu,defbase,
symconst,symdef,aasmbase,aasmtai,aasmcpu,defutil,
cginfo,cgbase,pass_1,pass_2,
ncon,
cpubase,cpuinfo,
@ -838,7 +838,12 @@ begin
end.
{
$Log$
Revision 1.40 2002-09-07 15:25:10 peter
Revision 1.41 2002-11-25 17:43:26 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.40 2002/09/07 15:25:10 peter
* old logs removed and tabs fixed
Revision 1.39 2002/08/15 15:15:55 carl

9
compiler/i386/n386mem.pas
View File

@ -52,7 +52,7 @@ implementation
{$endif}
globtype,systems,
cutils,verbose,globals,
symconst,symtype,symdef,symsym,symtable,defbase,paramgr,
symconst,symtype,symdef,symsym,symtable,defutil,paramgr,
aasmbase,aasmtai,aasmcpu,
cginfo,cgbase,pass_2,
pass_1,nld,ncon,nadd,
@ -149,7 +149,12 @@ begin
end.
{
$Log$
Revision 1.45 2002-11-23 22:50:09 carl
Revision 1.46 2002-11-25 17:43:27 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.45 2002/11/23 22:50:09 carl
* some small speed optimizations
+ added several new warnings/hints

9
compiler/i386/n386opt.pas
View File

@ -42,7 +42,7 @@ type
implementation
uses
pass_1, defbase, htypechk,
pass_1,defutil,htypechk,
symdef,paramgr,
aasmbase,aasmtai,aasmcpu,
ncnv, ncon, pass_2,
@ -248,7 +248,12 @@ end.
{
$Log$
Revision 1.25 2002-11-15 01:58:57 peter
Revision 1.26 2002-11-25 17:43:27 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.25 2002/11/15 01:58:57 peter
* merged changes from 1.0.7 up to 04-11
- -V option for generating bug report tracing
- more tracing for option parsing

9
compiler/i386/n386set.pas
View File

@ -49,7 +49,7 @@ implementation
uses
globtype,systems,
verbose,globals,
symconst,symdef,defbase,
symconst,symdef,defutil,
aasmbase,aasmtai,aasmcpu,
cginfo,cgbase,pass_2,
ncon,
@ -706,7 +706,12 @@ begin
end.
{
$Log$
Revision 1.44 2002-10-03 21:34:45 carl
Revision 1.45 2002-11-25 17:43:27 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.44 2002/10/03 21:34:45 carl
* range check error fixes
Revision 1.43 2002/09/17 18:54:05 jonas

9
compiler/i386/radirect.pas
View File

@ -42,7 +42,7 @@ interface
{ aasm }
aasmbase,aasmtai,aasmcpu,
{ symtable }
symconst,symbase,symtype,symsym,symtable,defbase,paramgr,
symconst,symbase,symtype,symsym,symtable,defutil,paramgr,
{ pass 1 }
nbas,
{ parser }
@ -304,7 +304,12 @@ initialization
end.
{
$Log$
Revision 1.4 2002-11-18 17:32:00 peter
Revision 1.5 2002-11-25 17:43:27 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.4 2002/11/18 17:32:00 peter
* pass proccalloption to ret_in_xxx and push_xxx functions
Revision 1.3 2002/09/03 16:26:28 daniel

9
compiler/m68k/cgcpu.pas
View File

@ -108,7 +108,7 @@ Implementation
uses
globtype,globals,verbose,systems,cutils,
symdef,symsym,defbase,paramgr,
symdef,symsym,defutil,paramgr,
rgobj,tgobj,rgcpu;
@ -1250,7 +1250,12 @@ end.
{
$Log$
Revision 1.11 2002-11-18 17:32:00 peter
Revision 1.12 2002-11-25 17:43:27 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.11 2002/11/18 17:32:00 peter
* pass proccalloption to ret_in_xxx and push_xxx functions
Revision 1.10 2002/09/22 14:15:31 carl

10
compiler/m68k/n68kcnv.pas
View File

@ -27,7 +27,7 @@ unit n68kcnv;
interface
uses
node,ncnv,ncgcnv,defbase;
node,ncnv,ncgcnv,defcmp;
type
tm68ktypeconvnode = class(tcgtypeconvnode)
@ -44,6 +44,7 @@ implementation
uses
verbose,globals,systems,
symconst,symdef,aasmbase,aasmtai,
defutil,
cgbase,pass_1,pass_2,
ncon,ncal,
ncgutil,
@ -293,7 +294,12 @@ begin
end.
{
$Log$
Revision 1.5 2002-11-09 16:10:35 carl
Revision 1.6 2002-11-25 17:43:27 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.5 2002/11/09 16:10:35 carl
+ update for compilation
Revision 1.4 2002/09/07 20:53:28 carl

51
compiler/nadd.pas
View File

@ -67,7 +67,7 @@ implementation
uses
globtype,systems,
cutils,verbose,globals,widestr,
symconst,symtype,symdef,symsym,symtable,defbase,
symconst,symtype,symdef,symsym,symtable,defutil,defcmp,
cgbase,
htypechk,pass_1,
nbas,nmat,ncnv,ncon,nset,nopt,ncal,ninl,
@ -238,8 +238,8 @@ implementation
else if (nodetype <> subn) and
is_voidpointer(ld) then
inserttypeconv(left,right.resulttype)
else if not(is_equal(ld,rd)) then
CGMessage(type_e_mismatch);
else if not(equal_defs(ld,rd)) then
CGMessage2(type_e_incompatible_types,ld.typename,rd.typename);
end
else if (lt=ordconstn) and (rt=ordconstn) then
begin
@ -866,14 +866,14 @@ implementation
CGMessage(type_w_signed_unsigned_always_false);
end
else
{ give out a warning if types are not of the same sign, and are
{ give out a warning if types are not of the same sign, and are
not constants.
}
if (((byte(is_signed(rd)) xor byte(is_signed(ld))) and 1)<>0) and
if (((byte(is_signed(rd)) xor byte(is_signed(ld))) and 1)<>0) and
(nodetype in [ltn,gtn,gten,lten,equaln,unequaln]) and (not is_constintnode(left)) and
(not is_constintnode(right)) then
begin
CGMessage(type_w_mixed_signed_unsigned3);
CGMessage(type_w_mixed_signed_unsigned3);
end;
inserttypeconv(right,s32bittype);
@ -896,7 +896,7 @@ implementation
begin
if (rt=setelementn) then
begin
if not(is_equal(tsetdef(ld).elementtype.def,rd)) then
if not(equal_defs(tsetdef(ld).elementtype.def,rd)) then
CGMessage(type_e_set_element_are_not_comp);
end
else
@ -907,7 +907,7 @@ implementation
if not(nodetype in [addn,subn,symdifn,muln,equaln,unequaln,lten,gten]) then
CGMessage(type_e_set_operation_unknown);
{ right def must be a also be set }
if (rd.deftype<>setdef) or not(is_equal(rd,ld)) then
if (rd.deftype<>setdef) or not(equal_defs(rd,ld)) then
CGMessage(type_e_set_element_are_not_comp);
end;
@ -996,8 +996,8 @@ implementation
inserttypeconv(right,left.resulttype)
else if is_voidpointer(left.resulttype.def) then
inserttypeconv(left,right.resulttype)
else if not(is_equal(ld,rd)) then
CGMessage(type_e_mismatch);
else if not(equal_defs(ld,rd)) then
CGMessage2(type_e_incompatible_types,ld.typename,rd.typename);
end;
ltn,lten,gtn,gten:
begin
@ -1007,8 +1007,8 @@ implementation
inserttypeconv(right,left.resulttype)
else if is_voidpointer(left.resulttype.def) then
inserttypeconv(left,right.resulttype)
else if not(is_equal(ld,rd)) then
CGMessage(type_e_mismatch);
else if not(equal_defs(ld,rd)) then
CGMessage2(type_e_incompatible_types,ld.typename,rd.typename);
end
else
CGMessage(type_e_mismatch);
@ -1021,8 +1021,8 @@ implementation
inserttypeconv(right,left.resulttype)
else if is_voidpointer(left.resulttype.def) then
inserttypeconv(left,right.resulttype)
else if not(is_equal(ld,rd)) then
CGMessage(type_e_mismatch);
else if not(equal_defs(ld,rd)) then
CGMessage2(type_e_incompatible_types,ld.typename,rd.typename);
end
else
CGMessage(type_e_mismatch);
@ -1037,8 +1037,8 @@ implementation
inserttypeconv(right,left.resulttype)
else if is_voidpointer(left.resulttype.def) then
inserttypeconv(left,right.resulttype)
else if not(is_equal(ld,rd)) then
CGMessage(type_e_mismatch);
else if not(equal_defs(ld,rd)) then
CGMessage2(type_e_incompatible_types,ld.typename,rd.typename);
end
else
CGMessage(type_e_mismatch);
@ -1118,7 +1118,7 @@ implementation
else if (cs_mmx in aktlocalswitches) and
is_mmx_able_array(ld) and
is_mmx_able_array(rd) and
is_equal(ld,rd) then
equal_defs(ld,rd) then
begin
case nodetype of
addn,subn,xorn,orn,andn:
@ -1179,7 +1179,9 @@ implementation
CGMessage(type_e_mismatch);
end
else if (rd.deftype=procvardef) and (ld.deftype=procvardef) and is_equal(rd,ld) then
else if (rd.deftype=procvardef) and
(ld.deftype=procvardef) and
equal_defs(rd,ld) then
begin
if not (nodetype in [equaln,unequaln]) then
CGMessage(type_e_mismatch);
@ -1188,7 +1190,7 @@ implementation
{ enums }
else if (ld.deftype=enumdef) and (rd.deftype=enumdef) then
begin
if not(is_equal(ld,rd)) then
if not(equal_defs(ld,rd)) then
inserttypeconv(right,left.resulttype);
if not(nodetype in [equaln,unequaln,ltn,lten,gtn,gten]) then
CGMessage(type_e_mismatch);
@ -1816,7 +1818,9 @@ implementation
calcregisters(self,1,0,0);
end
else if (rd.deftype=procvardef) and (ld.deftype=procvardef) and is_equal(rd,ld) then
else if (rd.deftype=procvardef) and
(ld.deftype=procvardef) and
equal_defs(rd,ld) then
begin
location.loc:=LOC_REGISTER;
calcregisters(self,1,0,0);
@ -1887,7 +1891,12 @@ begin
end.
{
$Log$
Revision 1.71 2002-11-23 22:50:06 carl
Revision 1.72 2002-11-25 17:43:17 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.71 2002/11/23 22:50:06 carl
* some small speed optimizations
+ added several new warnings/hints

11
compiler/nbas.pas
View File

@ -173,7 +173,7 @@ implementation
uses
cutils,
verbose,globals,globtype,systems,
symconst,symdef,symsym,defbase,
symconst,symdef,symsym,defutil,defcmp,
pass_1,
nld,ncal,nflw,rgobj,cgbase
;
@ -617,7 +617,7 @@ implementation
result :=
inherited docompare(p) and
(ttempcreatenode(p).size = size) and
is_equal(ttempcreatenode(p).tempinfo^.restype.def,tempinfo^.restype.def);
equal_defs(ttempcreatenode(p).tempinfo^.restype.def,tempinfo^.restype.def);
end;
{*****************************************************************************
@ -767,7 +767,12 @@ begin
end.
{
$Log$
Revision 1.36 2002-10-05 15:15:19 peter
Revision 1.37 2002-11-25 17:43:17 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.36 2002/10/05 15:15:19 peter
* don't complain in X- mode for internal generated function calls
with funcretrefnode set
* give statement error at the correct line position instead of the

46
compiler/ncal.pas
View File

@ -147,7 +147,7 @@ implementation
uses
cutils,systems,
verbose,globals,
symconst,paramgr,defbase,
symconst,paramgr,defutil,defcmp,
htypechk,pass_1,cpuinfo,cpubase,
nbas,ncnv,nld,ninl,nadd,ncon,
rgobj,cgbase
@ -352,7 +352,7 @@ implementation
{ passing a single element to a openarray of the same type }
not(
(is_open_array(to_def) and
is_equal(tarraydef(to_def).elementtype.def,from_def))
equal_defs(tarraydef(to_def).elementtype.def,from_def))
) and
{ an implicit file conversion is also allowed }
{ from a typed file to an untyped one }
@ -362,7 +362,7 @@ implementation
(tfiledef(to_def).filetyp = ft_untyped) and
(tfiledef(from_def).filetyp = ft_typed)
) and
not(is_equal(from_def,to_def)));
not(equal_defs(from_def,to_def)));
end;
@ -491,11 +491,11 @@ implementation
is_shortstring(defcoll.paratype.def) and
(defcoll.paratyp in [vs_out,vs_var]) and
not(is_open_string(defcoll.paratype.def)) and
not(is_equal(left.resulttype.def,defcoll.paratype.def)) then
begin
aktfilepos:=left.fileinfo;
CGMessage(type_e_strict_var_string_violation);
end;
not(equal_defs(left.resulttype.def,defcoll.paratype.def)) then
begin
aktfilepos:=left.fileinfo;
CGMessage(type_e_strict_var_string_violation);
end;
{ Handle formal parameters separate }
if (defcoll.paratype.def.deftype=formaldef) then
@ -1442,7 +1442,7 @@ implementation
end;
{ all types can be passed to a formaldef }
is_equal:=(def.deftype=formaldef) or
(defbase.is_equal(p.resulttype.def,def))
(defcmp.equal_defs(p.resulttype.def,def))
{ integer constants are compatible with all integer parameters if
the specified value matches the range }
or
@ -1481,7 +1481,7 @@ implementation
(
(m_tp_procvar in aktmodeswitches) and
(def.deftype=procvardef) and (p.left.nodetype=calln) and
(proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def),false))
(proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def))>=te_equal)
)
;
end;
@ -1629,7 +1629,7 @@ implementation
hp:=procs;
while assigned(hp) do
begin
if equal_paras(hp^.data.para,pd.para,cp_value_equal_const,false) then
if compare_paras(hp^.data.para,pd.para,cp_value_equal_const,false)>=te_equal then
begin
found:=true;
break;
@ -1757,8 +1757,17 @@ implementation
(m_tp7 in aktmodeswitches)) then
hp^.nextPara.convertlevel:=0
else
hp^.nextPara.convertlevel:=isconvertable(pt.resulttype.def,hp^.nextPara.paratype.def,
hcvt,pt.left.nodetype,false);
begin
case compare_defs(pt.resulttype.def,hp^.nextPara.paratype.def,pt.left.nodetype) of
te_convert_l1 :
hp^.nextPara.convertlevel:=1;
te_convert_operator,
te_convert_l2 :
hp^.nextPara.convertlevel:=2;
else
hp^.nextPara.convertlevel:=0;
end;
end;
case hp^.nextPara.convertlevel of
1 : include(pt.callparaflags,cpf_convlevel1found);
2 : include(pt.callparaflags,cpf_convlevel2found);
@ -1920,7 +1929,7 @@ implementation
is_in_limit(def_to,conv_to) then
begin
{ is it the same as the previous best? }
if not defbase.is_equal(def_to,conv_to) then
if not defcmp.equal_defs(def_to,conv_to) then
begin
{ no -> remove all previous best matches }
hp := hp^.next;
@ -2531,7 +2540,7 @@ implementation
(procdefinition = tcallnode(p).procdefinition) and
(methodpointer.isequal(tcallnode(p).methodpointer)) and
((restypeset and tcallnode(p).restypeset and
(is_equal(restype.def,tcallnode(p).restype.def))) or
(equal_defs(restype.def,tcallnode(p).restype.def))) or
(not restypeset and not tcallnode(p).restypeset));
end;
@ -2655,7 +2664,12 @@ begin
end.
{
$Log$
Revision 1.108 2002-11-18 17:31:54 peter
Revision 1.109 2002-11-25 17:43:17 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.108 2002/11/18 17:31:54 peter
* pass proccalloption to ret_in_xxx and push_xxx functions
Revision 1.107 2002/11/15 01:58:50 peter

9
compiler/ncgcal.pas
View File

@ -61,7 +61,7 @@ implementation
uses
systems,
cutils,verbose,globals,
symconst,symbase,symsym,symtable,defbase,paramgr,
symconst,symbase,symsym,symtable,defutil,paramgr,
{$ifdef GDB}
{$ifdef delphi}
sysutils,
@ -1541,7 +1541,12 @@ begin
end.
{
$Log$
Revision 1.28 2002-11-18 17:31:54 peter
Revision 1.29 2002-11-25 17:43:17 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.28 2002/11/18 17:31:54 peter
* pass proccalloption to ret_in_xxx and push_xxx functions
Revision 1.27 2002/11/16 15:34:30 florian

11
compiler/ncgcnv.pas
View File

@ -28,7 +28,7 @@ unit ncgcnv;
interface
uses
node,ncnv,defbase;
node,ncnv,defutil,defcmp;
type
tcgtypeconvnode = class(ttypeconvnode)
@ -437,7 +437,7 @@ interface
begin
{$ifdef fpc}
{$warning todo: add RTL routine for widechar-char conversion }
{$endif}
{$endif}
{ Quick hack to atleast generate 'working' code (PFV) }
second_int_to_int;
end;
@ -507,7 +507,12 @@ end.
{
$Log$
Revision 1.33 2002-10-05 12:43:25 carl
Revision 1.34 2002-11-25 17:43:17 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.33 2002/10/05 12:43:25 carl
* fixes for Delphi 6 compilation
(warning : Some features do not work under Delphi)

9
compiler/ncgcon.pas
View File

@ -65,7 +65,7 @@ implementation
uses
globtype,widestr,systems,
verbose,globals,
symconst,symdef,aasmbase,aasmtai,aasmcpu,defbase,
symconst,symdef,aasmbase,aasmtai,aasmcpu,defutil,
cpuinfo,cpubase,
cginfo,cgbase,tgobj,rgobj
{$ifdef delphi}
@ -531,7 +531,12 @@ begin
end.
{
$Log$
Revision 1.22 2002-11-09 15:36:50 carl
Revision 1.23 2002-11-25 17:43:17 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.22 2002/11/09 15:36:50 carl
* align all constants correctly (default of 4 size for real type constants)
Revision 1.21 2002/10/06 21:01:50 peter

9
compiler/ncgflw.pas
View File

@ -89,7 +89,7 @@ implementation
uses
verbose,globals,systems,globtype,
symconst,symsym,aasmbase,aasmtai,aasmcpu,defbase,
symconst,symsym,aasmbase,aasmtai,aasmcpu,defutil,
cginfo,cgbase,pass_2,
cpubase,cpuinfo,
nld,ncon,
@ -1247,7 +1247,12 @@ begin
end.
{
$Log$
Revision 1.43 2002-09-30 07:00:45 florian
Revision 1.44 2002-11-25 17:43:17 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.43 2002/09/30 07:00:45 florian
* fixes to common code to get the alpha compiler compiled applied
Revision 1.42 2002/09/07 15:25:02 peter

9
compiler/ncginl.pas
View File

@ -54,7 +54,7 @@ implementation
uses
globtype,systems,
cutils,verbose,globals,fmodule,
symconst,symdef,defbase,
symconst,symdef,defutil,
aasmbase,aasmtai,aasmcpu,
cginfo,cgbase,pass_1,pass_2,
cpubase,paramgr,
@ -610,7 +610,12 @@ end.
{
$Log$
Revision 1.16 2002-10-05 12:43:25 carl
Revision 1.17 2002-11-25 17:43:18 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.16 2002/10/05 12:43:25 carl
* fixes for Delphi 6 compilation
(warning : Some features do not work under Delphi)

9
compiler/ncgld.pas
View File

@ -53,7 +53,7 @@ implementation
uses
systems,
verbose,globtype,globals,
symconst,symtype,symdef,symsym,symtable,defbase,paramgr,
symconst,symtype,symdef,symsym,symtable,defutil,paramgr,
ncnv,ncon,nmem,
aasmbase,aasmtai,aasmcpu,regvars,
cginfo,cgbase,pass_2,
@ -989,7 +989,12 @@ begin
end.
{
$Log$
Revision 1.39 2002-11-22 16:22:45 jonas
Revision 1.40 2002-11-25 17:43:18 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.39 2002/11/22 16:22:45 jonas
* fixed error in my previous commit (the size of the location of the
funcretnode must be based on the current resulttype of the node and not
the resulttype defined by the function; these can be different in case

9
compiler/ncgmat.pas
View File

@ -99,7 +99,7 @@ implementation
uses
globtype,systems,
cutils,verbose,globals,
symconst,symdef,aasmbase,aasmtai,aasmcpu,defbase,
symconst,symdef,aasmbase,aasmtai,aasmcpu,defutil,
pass_1,pass_2,
ncon,
cpuinfo,
@ -454,7 +454,12 @@ begin
end.
{
$Log$
Revision 1.4 2002-09-17 18:54:02 jonas
Revision 1.5 2002-11-25 17:43:18 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.4 2002/09/17 18:54:02 jonas
* a_load_reg_reg() now has two size parameters: source and dest. This
allows some optimizations on architectures that don't encode the
register size in the register name.

9
compiler/ncgmem.pas
View File

@ -95,7 +95,7 @@ implementation
{$endif GDB}
globtype,systems,
cutils,verbose,globals,
symconst,symtype,symdef,symsym,symtable,defbase,paramgr,
symconst,symtype,symdef,symsym,symtable,defutil,paramgr,
aasmbase,aasmtai,aasmcpu,
cginfo,cgbase,pass_2,
pass_1,nld,ncon,nadd,
@ -915,7 +915,12 @@ begin
end.
{
$Log$
Revision 1.34 2002-11-24 18:19:20 carl
Revision 1.35 2002-11-25 17:43:18 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.34 2002/11/24 18:19:20 carl
+ checkpointer for interfaces also
Revision 1.33 2002/11/23 22:50:06 carl

13
compiler/ncgset.pas
View File

@ -87,7 +87,7 @@ implementation
uses
globtype,systems,
verbose,
symconst,symdef,defbase,
symconst,symdef,defutil,
paramgr,
pass_2,
ncon,
@ -747,7 +747,7 @@ implementation
hregister2, l1);
{ the comparisation of the low dword must be always unsigned! }
cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_B, aword(lo(int64(t^._low))), hregister, elselabel);
{$endif}
{$endif}
cg.a_label(exprasmlist,l1);
end
else
@ -772,7 +772,7 @@ implementation
cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_gt, aword(hi(int64(t^._high))), hregister2,
l1);
cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_BE, aword(lo(int64(t^._high))), hregister, t^.statement);
{$endif}
{$endif}
cg.a_label(exprasmlist,l1);
end
else
@ -1015,7 +1015,12 @@ begin
end.
{
$Log$
Revision 1.22 2002-10-05 12:43:25 carl
Revision 1.23 2002-11-25 17:43:18 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.22 2002/10/05 12:43:25 carl
* fixes for Delphi 6 compilation
(warning : Some features do not work under Delphi)

11
compiler/ncgutil.pas
View File

@ -99,8 +99,8 @@ implementation
{$endif}
cutils,cclasses,
globals,systems,verbose,
symconst,symsym,symtable,defbase,paramgr,
fmodule,
symconst,symsym,symtable,defutil,
paramgr,fmodule,
cgbase,regvars,
{$ifdef GDB}
gdb,
@ -1876,7 +1876,12 @@ function returns in a register and the caller receives it in an other one}
end.
{
$Log$
Revision 1.62 2002-11-18 17:31:55 peter
Revision 1.63 2002-11-25 17:43:18 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.62 2002/11/18 17:31:55 peter
* pass proccalloption to ret_in_xxx and push_xxx functions
Revision 1.61 2002/11/17 17:49:08 mazen

634
compiler/ncnv.pas
View File

@ -28,7 +28,8 @@ interface
uses
node,
symtype,symppu,defbase,
symtype,symppu,
defutil,defcmp,
nld
{$ifdef Delphi}
,dmisc
@ -194,7 +195,7 @@ implementation
end;
{ don't insert obsolete type conversions }
if is_equal(p.resulttype.def,t.def) and
if equal_defs(p.resulttype.def,t.def) and
not ((p.resulttype.def.deftype=setdef) and
(tsetdef(p.resulttype.def).settype <>
tsetdef(t.def).settype)) then
@ -220,7 +221,7 @@ implementation
end;
{ don't insert obsolete type conversions }
if is_equal(p.resulttype.def,t.def) and
if equal_defs(p.resulttype.def,t.def) and
not ((p.resulttype.def.deftype=setdef) and
(tsetdef(p.resulttype.def).settype <>
tsetdef(t.def).settype)) then
@ -363,7 +364,7 @@ implementation
inserttypeconv(p3,u8bitdef);
end;
}
if assigned(htype.def) and not(is_equal(htype.def,p3.resulttype.def)) then
if assigned(htype.def) and not(equal_defs(htype.def,p3.resulttype.def)) then
begin
aktfilepos:=p3.fileinfo;
CGMessage(type_e_typeconflict_in_set);
@ -967,7 +968,7 @@ implementation
hp : tnode;
currprocdef,
aprocdef : tprocdef;
eq : tequaltype;
begin
result:=nil;
resulttype:=totype;
@ -976,394 +977,266 @@ implementation
if codegenerror then
exit;
{ remove obsolete type conversions }
if is_equal(left.resulttype.def,resulttype.def) then
begin
{ because is_equal only checks the basetype for sets we need to
check here if we are loading a smallset into a normalset }
if (resulttype.def.deftype=setdef) and
(left.resulttype.def.deftype=setdef) and
((tsetdef(resulttype.def).settype = smallset) xor
(tsetdef(left.resulttype.def).settype = smallset)) then
begin
{ constant sets can be converted by changing the type only }
if (left.nodetype=setconstn) then
eq:=compare_defs_ext(left.resulttype.def,resulttype.def,left.nodetype,
nf_explizit in flags,true,convtype,aprocdef);
case eq of
te_exact,
te_equal :
begin
{ because is_equal only checks the basetype for sets we need to
check here if we are loading a smallset into a normalset }
if (resulttype.def.deftype=setdef) and
(left.resulttype.def.deftype=setdef) and
((tsetdef(resulttype.def).settype = smallset) xor
(tsetdef(left.resulttype.def).settype = smallset)) then
begin
{ constant sets can be converted by changing the type only }
if (left.nodetype=setconstn) then
begin
tsetdef(left.resulttype.def).changesettype(tsetdef(resulttype.def).settype);
result:=left;
left:=nil;
exit;
end;
if (tsetdef(resulttype.def).settype <> smallset) then
convtype:=tc_load_smallset
else
convtype := tc_normal_2_smallset;
exit;
end
else
begin
left.resulttype:=resulttype;
result:=left;
left:=nil;
exit;
end;
end;
te_convert_l1,
te_convert_l2 :
begin
{ nothing to do }
end;
te_convert_operator :
begin
procinfo.flags:=procinfo.flags or pi_do_call;
hp:=ccallnode.create(ccallparanode.create(left,nil),
overloaded_operators[_assignment],nil,nil);
{ tell explicitly which def we must use !! (PM) }
tcallnode(hp).procdefinition:=aprocdef;
left:=nil;
result:=hp;
exit;
end;
te_incompatible :
begin
{ Procedures have a resulttype.def of voiddef and functions of their
own resulttype.def. They will therefore always be incompatible with
a procvar. Because isconvertable cannot check for procedures we
use an extra check for them.}
if (m_tp_procvar in aktmodeswitches) then
begin
if (resulttype.def.deftype=procvardef) and
(is_procsym_load(left) or is_procsym_call(left)) then
begin
if is_procsym_call(left) then
begin
currprocdef:=Tprocsym(Tcallnode(left).symtableprocentry).search_procdef_byprocvardef(Tprocvardef(resulttype.def));
hp:=cloadnode.create_procvar(tprocsym(tcallnode(left).symtableprocentry),
currprocdef,tcallnode(left).symtableproc);
if (tcallnode(left).symtableprocentry.owner.symtabletype=objectsymtable) and
assigned(tcallnode(left).methodpointer) then
tloadnode(hp).set_mp(tcallnode(left).methodpointer.getcopy);
resulttypepass(hp);
left.free;
left:=hp;
aprocdef:=tprocdef(left.resulttype.def);
end
else
begin
if (left.nodetype<>addrn) then
aprocdef:=tprocsym(tloadnode(left).symtableentry).first_procdef;
end;
convtype:=tc_proc_2_procvar;
{ Now check if the procedure we are going to assign to
the procvar, is compatible with the procvar's type }
if assigned(aprocdef) then
begin
if proc_to_procvar_equal(aprocdef,tprocvardef(resulttype.def))=te_incompatible then
CGMessage2(type_e_incompatible_types,aprocdef.typename,resulttype.def.typename);
end
else
CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
exit;
end;
end;
{ Handle explicit type conversions }
if nf_explizit in flags then
begin
{ do common tc_equal cast }
convtype:=tc_equal;
{ check if the result could be in a register }
if not(tstoreddef(resulttype.def).is_intregable) and
not(tstoreddef(resulttype.def).is_fpuregable) then
make_not_regable(left);
{ class to class or object to object, with checkobject support }
if (resulttype.def.deftype=objectdef) and
(left.resulttype.def.deftype=objectdef) then
begin
if (cs_check_object in aktlocalswitches) then
begin
if is_class_or_interface(resulttype.def) then
begin
{ we can translate the typeconvnode to 'as' when
typecasting to a class or interface }
hp:=casnode.create(left,cloadvmtnode.create(ctypenode.create(resulttype)));
left:=nil;
result:=hp;
exit;
end;
end
else
begin
{ check if the types are related }
if (not(tobjectdef(left.resulttype.def).is_related(tobjectdef(resulttype.def)))) and
(not(tobjectdef(resulttype.def).is_related(tobjectdef(left.resulttype.def)))) then
CGMessage2(type_w_classes_not_related,left.resulttype.def.typename,resulttype.def.typename);
end;
end
{ only if the same size or formal def }
{ why do we allow typecasting of voiddef ?? (PM) }
else
begin
if not(
(left.resulttype.def.deftype=formaldef) or
(not(is_open_array(left.resulttype.def)) and
(left.resulttype.def.size=resulttype.def.size)) or
(is_void(left.resulttype.def) and
(left.nodetype=derefn))
) then
CGMessage(cg_e_illegal_type_conversion);
if ((left.resulttype.def.deftype=orddef) and
(resulttype.def.deftype=pointerdef)) or
((resulttype.def.deftype=orddef) and
(left.resulttype.def.deftype=pointerdef)) then
CGMessage(cg_d_pointer_to_longint_conv_not_portable);
end;
{ the conversion into a strutured type is only }
{ possible, if the source is not a register }
if (
(resulttype.def.deftype in [recorddef,stringdef,arraydef]) or
((resulttype.def.deftype=objectdef) and
not(is_class(resulttype.def)))
) and
(left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
CGMessage(cg_e_illegal_type_conversion);
end
else
CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
end;
else
internalerror(200211231);
end;
{ Constant folding and other node transitions to
remove the typeconv node }
case left.nodetype of
loadn :
begin
{ tp7 procvar support, when right is not a procvardef and we got a
loadn of a procvar then convert to a calln, the check for the
result is already done in is_convertible, also no conflict with
@procvar is here because that has an extra addrn }
if (m_tp_procvar in aktmodeswitches) and
(resulttype.def.deftype<>procvardef) and
(left.resulttype.def.deftype=procvardef) then
begin
hp:=ccallnode.create(nil,nil,nil,nil);
tcallnode(hp).set_procvar(left);
resulttypepass(hp);
left:=hp;
end;
end;
niln :
begin
{ nil to ordinal node }
if (resulttype.def.deftype=orddef) then
begin
hp:=cordconstnode.create(0,resulttype,true);
result:=hp;
exit;
end
else
{ fold nil to any pointer type }
if (resulttype.def.deftype=pointerdef) then
begin
hp:=cnilnode.create;
hp.resulttype:=resulttype;
result:=hp;
exit;
end
else
{ remove typeconv after niln, but not when the result is a
methodpointer. The typeconv of the methodpointer will then
take care of updateing size of niln to OS_64 }
if not((resulttype.def.deftype=procvardef) and
(po_methodpointer in tprocvardef(resulttype.def).procoptions)) then
begin
tsetdef(left.resulttype.def).changesettype(tsetdef(resulttype.def).settype);
left.resulttype:=resulttype;
result:=left;
left:=nil;
exit;
end;
if (tsetdef(resulttype.def).settype <> smallset) then
convtype:=tc_load_smallset
else
convtype := tc_normal_2_smallset;
exit;
end
else
begin
left.resulttype:=resulttype;
result:=left;
left:=nil;
exit;
end;
end;
aprocdef:=assignment_overloaded(left.resulttype.def,resulttype.def);
if assigned(aprocdef) then
begin
procinfo.flags:=procinfo.flags or pi_do_call;
hp:=ccallnode.create(ccallparanode.create(left,nil),
overloaded_operators[_assignment],nil,nil);
{ tell explicitly which def we must use !! (PM) }
tcallnode(hp).procdefinition:=aprocdef;
left:=nil;
result:=hp;
exit;
end;
if isconvertable(left.resulttype.def,resulttype.def,convtype,left.nodetype,nf_explizit in flags)=0 then
begin
{Procedures have a resulttype.def of voiddef and functions of their
own resulttype.def. They will therefore always be incompatible with
a procvar. Because isconvertable cannot check for procedures we
use an extra check for them.}
if (m_tp_procvar in aktmodeswitches) then
begin
if (resulttype.def.deftype=procvardef) and
(is_procsym_load(left) or is_procsym_call(left)) then
begin
if is_procsym_call(left) then
begin
currprocdef:=Tprocsym(Tcallnode(left).symtableprocentry).search_procdef_byprocvardef(Tprocvardef(resulttype.def));
hp:=cloadnode.create_procvar(tprocsym(tcallnode(left).symtableprocentry),
currprocdef,tcallnode(left).symtableproc);
if (tcallnode(left).symtableprocentry.owner.symtabletype=objectsymtable) and
assigned(tcallnode(left).methodpointer) then
tloadnode(hp).set_mp(tcallnode(left).methodpointer.getcopy);
resulttypepass(hp);
left.free;
left:=hp;
aprocdef:=tprocdef(left.resulttype.def);
end
else
begin
if (left.nodetype<>addrn) then
aprocdef:=tprocsym(tloadnode(left).symtableentry).first_procdef;
end;
convtype:=tc_proc_2_procvar;
{ Now check if the procedure we are going to assign to
the procvar, is compatible with the procvar's type }
if assigned(aprocdef) then
begin
if not proc_to_procvar_equal(aprocdef,tprocvardef(resulttype.def),false) then
CGMessage2(type_e_incompatible_types,aprocdef.typename,resulttype.def.typename);
end
else
CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
exit;
end;
end;
if nf_explizit in flags then
ordconstn :
begin
{ check if the result could be in a register }
if not(tstoreddef(resulttype.def).is_intregable) and
not(tstoreddef(resulttype.def).is_fpuregable) then
make_not_regable(left);
{ boolean to byte are special because the
location can be different }
if is_integer(resulttype.def) and
is_boolean(left.resulttype.def) then
begin
convtype:=tc_bool_2_int;
exit;
end;
if is_char(resulttype.def) and
is_boolean(left.resulttype.def) then
begin
convtype:=tc_bool_2_int;
exit;
end;
{ ansistring to pchar }
if is_pchar(resulttype.def) and
is_ansistring(left.resulttype.def) then
begin
convtype:=tc_ansistring_2_pchar;
exit;
end;
{ do common tc_equal cast }
convtype:=tc_equal;
{ enum to ordinal will always be s32bit }
if (left.resulttype.def.deftype=enumdef) and
is_ordinal(resulttype.def) then
begin
if left.nodetype=ordconstn then
begin
hp:=cordconstnode.create(tordconstnode(left).value,
resulttype,true);
result:=hp;
exit;
end
else
begin
if isconvertable(s32bittype.def,resulttype.def,convtype,ordconstn,false)=0 then
CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
end;
end
{ ordinal to enumeration }
else
if (resulttype.def.deftype=enumdef) and
is_ordinal(left.resulttype.def) then
{ ordinal contants can be directly converted }
{ but not char to char because it is a widechar to char or via versa }
{ which needs extra code to do the code page transistion }
if is_ordinal(resulttype.def) and
not(convtype=tc_char_2_char) then
begin
if left.nodetype=ordconstn then
begin
hp:=cordconstnode.create(tordconstnode(left).value,
resulttype,true);
result:=hp;
exit;
end
else
begin
if IsConvertable(left.resulttype.def,s32bittype.def,convtype,ordconstn,false)=0 then
CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
end;
{ replace the resulttype and recheck the range }
left.resulttype:=resulttype;
testrange(left.resulttype.def,tordconstnode(left).value,(nf_explizit in flags));
result:=left;
left:=nil;
exit;
end;
end;
pointerconstn :
begin
{ pointerconstn to any pointer is folded too }
if (resulttype.def.deftype=pointerdef) then
begin
left.resulttype:=resulttype;
result:=left;
left:=nil;
exit;
end
{ nil to ordinal node }
else if (left.nodetype=niln) and is_ordinal(resulttype.def) then
begin
hp:=cordconstnode.create(0,resulttype,true);
result:=hp;
exit;
end
{ constant pointer to ordinal }
else if is_ordinal(resulttype.def) and
(left.nodetype=pointerconstn) then
else if is_ordinal(resulttype.def) then
begin
hp:=cordconstnode.create(tpointerconstnode(left).value,
resulttype,true);
result:=hp;
exit;
end
{ class to class or object to object, with checkobject support }
else if (resulttype.def.deftype=objectdef) and
(left.resulttype.def.deftype=objectdef) then
begin
if (cs_check_object in aktlocalswitches) then
begin
if is_class_or_interface(resulttype.def) then
begin
{ we can translate the typeconvnode to 'as' when
typecasting to a class or interface }
hp:=casnode.create(left,cloadvmtnode.create(ctypenode.create(resulttype)));
left:=nil;
result:=hp;
exit;
end;
end
else
begin
{ check if the types are related }
if (not(tobjectdef(left.resulttype.def).is_related(tobjectdef(resulttype.def)))) and
(not(tobjectdef(resulttype.def).is_related(tobjectdef(left.resulttype.def)))) then
CGMessage2(type_w_classes_not_related,left.resulttype.def.typename,resulttype.def.typename);
end;
end
{Are we typecasting an ordconst to a char?}
else
if is_char(resulttype.def) and
is_ordinal(left.resulttype.def) then
begin
if left.nodetype=ordconstn then
begin
hp:=cordconstnode.create(tordconstnode(left).value,
resulttype,true);
result:=hp;
exit;
end
else
begin
if IsConvertable(left.resulttype.def,u8bittype.def,convtype,ordconstn,false)=0 then
CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
end;
end
{Are we typecasting an ordconst to a wchar?}
else
if is_widechar(resulttype.def) and
is_ordinal(left.resulttype.def) then
begin
if left.nodetype=ordconstn then
begin
hp:=cordconstnode.create(tordconstnode(left).value,
resulttype,true);
result:=hp;
exit;
end
else
begin
if IsConvertable(left.resulttype.def,u16bittype.def,convtype,ordconstn,false)=0 then
CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
end;
end
{ char to ordinal }
else
if is_char(left.resulttype.def) and
is_ordinal(resulttype.def) then
begin
if left.nodetype=ordconstn then
begin
hp:=cordconstnode.create(tordconstnode(left).value,
resulttype,true);
result:=hp;
exit;
end
else
begin
if IsConvertable(u8bittype.def,resulttype.def,convtype,ordconstn,false)=0 then
CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
end;
end
{ widechar to ordinal }
else
if is_widechar(left.resulttype.def) and
is_ordinal(resulttype.def) then
begin
if left.nodetype=ordconstn then
begin
hp:=cordconstnode.create(tordconstnode(left).value,
resulttype,true);
result:=hp;
exit;
end
else
begin
if IsConvertable(u16bittype.def,resulttype.def,convtype,ordconstn,false)=0 then
CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
end;
end
{ ordinal to pointer }
else
if (m_delphi in aktmodeswitches) and
is_ordinal(left.resulttype.def) and
(resulttype.def.deftype=pointerdef) then
begin
if left.nodetype=pointerconstn then
begin
hp:=cordconstnode.create(tpointerconstnode(left).value,
resulttype,true);
result:=hp;
exit;
end
else
begin
if IsConvertable(left.resulttype.def,ordpointertype.def,convtype,ordconstn,false)=0 then
CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
end;
end
{ only if the same size or formal def }
{ why do we allow typecasting of voiddef ?? (PM) }
else
begin
if not(
(left.resulttype.def.deftype=formaldef) or
(not(is_open_array(left.resulttype.def)) and
(left.resulttype.def.size=resulttype.def.size)) or
(is_void(left.resulttype.def) and
(left.nodetype=derefn))
) then
CGMessage(cg_e_illegal_type_conversion);
if ((left.resulttype.def.deftype=orddef) and
(resulttype.def.deftype=pointerdef)) or
((resulttype.def.deftype=orddef) and
(left.resulttype.def.deftype=pointerdef)) then
CGMessage(cg_d_pointer_to_longint_conv_not_portable);
end;
{ the conversion into a strutured type is only }
{ possible, if the source is not a register }
if ((resulttype.def.deftype in [recorddef,stringdef,arraydef]) or
((resulttype.def.deftype=objectdef) and not(is_class(resulttype.def)))
) and (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) { and
it also works if the assignment is overloaded
YES but this code is not executed if assignment is overloaded (PM)
not assigned(assignment_overloaded(left.resulttype.def,resulttype.def))} then
CGMessage(cg_e_illegal_type_conversion);
end
else
CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
end;
{ tp7 procvar support, when right is not a procvardef and we got a
loadn of a procvar then convert to a calln, the check for the
result is already done in is_convertible, also no conflict with
@procvar is here because that has an extra addrn }
if (m_tp_procvar in aktmodeswitches) and
(resulttype.def.deftype<>procvardef) and
(left.resulttype.def.deftype=procvardef) and
(left.nodetype=loadn) then
begin
hp:=ccallnode.create(nil,nil,nil,nil);
tcallnode(hp).set_procvar(left);
resulttypepass(hp);
left:=hp;
end;
{ remove typeconv after niln, but not when the result is a
methodpointer. The typeconv of the methodpointer will then
take care of updateing size of niln to OS_64 }
if (left.nodetype=niln) and
not((resulttype.def.deftype=procvardef) and
(po_methodpointer in tprocvardef(resulttype.def).procoptions)) then
begin
left.resulttype:=resulttype;
result:=left;
left:=nil;
exit;
end;
{ ordinal contants can be directly converted }
if (left.nodetype=ordconstn) and is_ordinal(resulttype.def) and
{ but not char to char because it is a widechar to char or via versa }
{ which needs extra code to do the code page transistion }
not(convtype=tc_char_2_char) then
begin
{ replace the resulttype and recheck the range }
left.resulttype:=resulttype;
testrange(left.resulttype.def,tordconstnode(left).value,(nf_explizit in flags));
result:=left;
left:=nil;
exit;
end;
{ fold nil to any pointer type }
if (left.nodetype=niln) and (resulttype.def.deftype=pointerdef) then
begin
hp:=cnilnode.create;
hp.resulttype:=resulttype;
result:=hp;
exit;
end;
{ further, pointerconstn to any pointer is folded too }
if (left.nodetype=pointerconstn) and (resulttype.def.deftype=pointerdef) then
begin
left.resulttype:=resulttype;
result:=left;
left:=nil;
exit;
end;
end;
end;
{ now call the resulttype helper to do constant folding }
result:=resulttype_call_helper(convtype);
@ -2098,7 +1971,12 @@ begin
end.
{
$Log$
Revision 1.88 2002-11-17 16:31:56 carl
Revision 1.89 2002-11-25 17:43:18 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.88 2002/11/17 16:31:56 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k

9
compiler/ncon.pas
View File

@ -172,7 +172,7 @@ implementation
uses
cutils,verbose,systems,
defbase,cpubase,nld;
defutil,cpubase,nld;
function genintconstnode(v : TConstExprInt) : tordconstnode;
@ -924,7 +924,12 @@ begin
end.
{
$Log$
Revision 1.44 2002-11-22 22:48:10 carl
Revision 1.45 2002-11-25 17:43:18 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.44 2002/11/22 22:48:10 carl
* memory optimization with tconstsym (1.5%)
Revision 1.43 2002/10/05 12:43:25 carl

9
compiler/nflw.pas
View File

@ -207,7 +207,7 @@ implementation
uses
globtype,systems,
cutils,verbose,globals,
symconst,symtable,paramgr,defbase,htypechk,pass_1,
symconst,symtable,paramgr,defutil,htypechk,pass_1,
ncon,nmem,nld,ncnv,nbas,rgobj,
{$ifdef state_tracking}
nstate,
@ -1412,7 +1412,12 @@ begin
end.
{
$Log$
Revision 1.55 2002-11-18 17:31:56 peter
Revision 1.56 2002-11-25 17:43:18 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.55 2002/11/18 17:31:56 peter
* pass proccalloption to ret_in_xxx and push_xxx functions
Revision 1.54 2002/10/20 15:31:49 peter

13
compiler/ninl.pas
View File

@ -72,7 +72,7 @@ implementation
uses
verbose,globals,systems,
globtype, cutils,
symbase,symconst,symtype,symdef,symsym,symtable,paramgr,defbase,
symbase,symconst,symtype,symdef,symsym,symtable,paramgr,defutil,defcmp,
pass_1,
ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,
cpubase,tgobj,cgbase
@ -488,7 +488,7 @@ implementation
para.left:=p1;
end;
if not is_equal(para.left.resulttype.def,tfiledef(filepara.resulttype.def).typedfiletype.def) then
if not equal_defs(para.left.resulttype.def,tfiledef(filepara.resulttype.def).typedfiletype.def) then
begin
CGMessagePos(para.left.fileinfo,type_e_mismatch);
found_error := true;
@ -728,7 +728,7 @@ implementation
(torddef(para.left.resulttype.def).typ in [s8bit,s16bit,u8bit,u16bit])
) or
(is_real and
not is_equal(para.left.resulttype.def,pbestrealtype^.def)
not equal_defs(para.left.resulttype.def,pbestrealtype^.def)
)
) then
{ special handling of reading small numbers, because the helpers }
@ -2408,7 +2408,12 @@ begin
end.
{
$Log$
Revision 1.97 2002-11-18 18:35:01 peter
Revision 1.98 2002-11-25 17:43:19 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.97 2002/11/18 18:35:01 peter
* Swap(QWord) constant support
Revision 1.96 2002/11/18 17:31:57 peter

11
compiler/nld.pas
View File

@ -151,7 +151,7 @@ implementation
uses
cutils,verbose,globtype,globals,systems,
symtable,paramgr,defbase,
symtable,paramgr,defutil,defcmp,
htypechk,pass_1,
ncon,ninl,ncnv,nmem,ncal,cpubase,rgobj,cginfo,cgbase
;
@ -878,7 +878,7 @@ implementation
else
begin
if ((nf_novariaallowed in flags) or (not varia)) and
(not is_equal(htype.def,hp.left.resulttype.def)) then
(not equal_defs(htype.def,hp.left.resulttype.def)) then
begin
varia:=true;
end;
@ -1181,7 +1181,12 @@ begin
end.
{
$Log$
Revision 1.65 2002-11-18 17:31:57 peter
Revision 1.66 2002-11-25 17:43:20 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.65 2002/11/18 17:31:57 peter
* pass proccalloption to ret_in_xxx and push_xxx functions
Revision 1.64 2002/11/15 01:58:52 peter

11
compiler/nmat.pas
View File

@ -83,7 +83,7 @@ implementation
systems,tokens,
verbose,globals,cutils,
globtype,
symconst,symtype,symtable,symdef,defbase,
symconst,symtype,symtable,symdef,defutil,
htypechk,pass_1,cpubase,
cgbase,
ncon,ncnv,ncal,nadd;
@ -118,7 +118,7 @@ implementation
end;
if is_constintnode(left) then
begin
lv:=tordconstnode(left).value;
lv:=tordconstnode(left).value;
case nodetype of
modn:
@ -748,7 +748,12 @@ begin
end.
{
$Log$
Revision 1.43 2002-10-04 21:19:28 jonas
Revision 1.44 2002-11-25 17:43:20 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.43 2002/10/04 21:19:28 jonas
* fixed web bug 2139: checking for division by zero fixed
Revision 1.42 2002/09/07 12:16:04 carl

13
compiler/nmem.pas
View File

@ -155,7 +155,7 @@ implementation
uses
globtype,systems,
cutils,verbose,globals,
symconst,symbase,defbase,
symconst,symbase,defutil,defcmp,
nbas,
htypechk,pass_1,ncal,nld,ncon,ncnv,cgbase
;
@ -734,9 +734,7 @@ implementation
arraydef :
begin
{ check type of the index value }
if (isconvertable(right.resulttype.def,tarraydef(left.resulttype.def).rangetype.def,
ct,ordconstn,false)=0) and
not(is_equal(right.resulttype.def,tarraydef(left.resulttype.def).rangetype.def)) then
if (compare_defs(right.resulttype.def,tarraydef(left.resulttype.def).rangetype.def,right.nodetype)=te_incompatible) then
CGMessage(type_e_mismatch);
resulttype:=tarraydef(left.resulttype.def).elementtype;
end;
@ -1057,7 +1055,12 @@ begin
end.
{
$Log$
Revision 1.40 2002-09-27 21:13:28 carl
Revision 1.41 2002-11-25 17:43:20 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.40 2002/09/27 21:13:28 carl
* low-highval always checked if limit ober 2GB is reached (to avoid overflow)
Revision 1.39 2002/09/01 18:44:17 peter

23
compiler/nobj.pas
View File

@ -145,7 +145,7 @@ implementation
strings,
{$endif}
globals,verbose,
symtable,symconst,symtype,symsym,defbase,paramgr,
symtable,symconst,symtype,symsym,defutil,defcmp,paramgr,
{$ifdef GDB}
gdb,
{$endif GDB}
@ -630,7 +630,7 @@ implementation
begin
if tstoredsym(procdefcoll^.data.procsym).is_visible_for_object(pd._class) and
(not(pdoverload or hasoverloads) or
equal_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)) then
(compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)>=te_equal)) then
begin
if is_visible then
procdefcoll^.hidden:=true;
@ -648,7 +648,7 @@ implementation
begin
{ we start a new virtual tree, hide the old }
if (not(pdoverload or hasoverloads) or
equal_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)) and
(compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)>=te_equal)) and
(tstoredsym(procdefcoll^.data.procsym).is_visible_for_object(pd._class)) then
begin
if is_visible then
@ -664,7 +664,7 @@ implementation
{ do nothing, the error will follow when adding the entry }
end
{ same parameters }
else if (equal_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)) then
else if (compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)>=te_equal) then
begin
{ overload is inherited }
if (po_overload in procdefcoll^.data.procoptions) then
@ -680,7 +680,7 @@ implementation
MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,pd.fullprocname);
{ error, if the return types aren't equal }
if not(is_equal(procdefcoll^.data.rettype.def,pd.rettype.def)) and
if not(equal_defs(procdefcoll^.data.rettype.def,pd.rettype.def)) and
not((procdefcoll^.data.rettype.def.deftype=objectdef) and
(pd.rettype.def.deftype=objectdef) and
is_class(procdefcoll^.data.rettype.def) and
@ -718,7 +718,7 @@ implementation
if the new defintion has not the overload directive }
if is_visible and
((not(pdoverload or hasoverloads)) or
equal_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)) then
(compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)>=te_equal)) then
procdefcoll^.hidden:=true;
end;
end
@ -728,7 +728,7 @@ implementation
has not the overload directive }
if is_visible and
((not pdoverload) or
equal_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)) then
(compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)>=te_equal)) then
procdefcoll^.hidden:=true;
end;
end; { not hidden }
@ -1030,7 +1030,7 @@ implementation
for i:=1 to sym.procdef_count do
begin
implprocdef:=sym.procdef[i];
if equal_paras(proc.para,implprocdef.para,cp_none,false) and
if (compare_paras(proc.para,implprocdef.para,cp_none,false)>=te_equal) and
(proc.proccalloption=implprocdef.proccalloption) then
begin
gintfgetcprocdef:=implprocdef;
@ -1333,7 +1333,12 @@ initialization
end.
{
$Log$
Revision 1.37 2002-11-17 16:31:56 carl
Revision 1.38 2002-11-25 17:43:20 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.37 2002/11/17 16:31:56 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k

9
compiler/nopt.pas
View File

@ -84,7 +84,7 @@ var
implementation
uses cutils, htypechk, defbase, globtype, globals, cpubase, ncnv, ncon,
uses cutils, htypechk, defutil, defcmp, globtype, globals, cpubase, ncnv, ncon,
verbose, symdef, cgbase;
@ -278,7 +278,12 @@ end.
{
$Log$
Revision 1.11 2002-08-17 09:23:37 florian
Revision 1.12 2002-11-25 17:43:20 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.11 2002/08/17 09:23:37 florian
* first part of procinfo rewrite
Revision 1.10 2002/07/20 11:57:55 florian

12
compiler/nset.pas
View File

@ -116,7 +116,7 @@ implementation
uses
globtype,systems,
verbose,
symconst,symdef,symsym,defbase,
symconst,symdef,symsym,defutil,defcmp,
htypechk,pass_1,
ncnv,ncon,cpubase,nld,rgobj,cgbase;
@ -348,8 +348,7 @@ implementation
if codegenerror then
exit;
{ both types must be compatible }
if not(is_equal(left.resulttype.def,right.resulttype.def)) and
(isconvertable(left.resulttype.def,right.resulttype.def,ct,ordconstn,false)=0) then
if compare_defs(left.resulttype.def,right.resulttype.def,left.nodetype)=te_incompatible then
CGMessage(type_e_mismatch);
{ Check if only when its a constant set }
if (left.nodetype=ordconstn) and (right.nodetype=ordconstn) then
@ -691,7 +690,12 @@ begin
end.
{
$Log$
Revision 1.34 2002-10-05 12:43:25 carl
Revision 1.35 2002-11-25 17:43:21 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.34 2002/10/05 12:43:25 carl
* fixes for Delphi 6 compilation
(warning : Some features do not work under Delphi)

9
compiler/paramgr.pas
View File

@ -108,7 +108,7 @@ unit paramgr;
cpuinfo,globals,systems,
symconst,symbase,symsym,
rgobj,
defbase,cgbase,cginfo,verbose;
defutil,cgbase,cginfo,verbose;
{ true if the return value is in accumulator (EAX for i386), D0 for 68k }
function tparamanager.ret_in_acc(def : tdef;calloption : tproccalloption) : boolean;
@ -339,7 +339,12 @@ end.
{
$Log$
Revision 1.23 2002-11-18 17:31:58 peter
Revision 1.24 2002-11-25 17:43:21 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.23 2002/11/18 17:31:58 peter
* pass proccalloption to ret_in_xxx and push_xxx functions
Revision 1.22 2002/11/16 18:00:04 peter

27
compiler/pdecobj.pas
View File

@ -37,7 +37,7 @@ implementation
uses
cutils,cclasses,
globals,verbose,systems,tokens,
symconst,symbase,symsym,symtable,defbase,
symconst,symbase,symsym,symtable,defutil,defcmp,
cgbase,
node,nld,nmem,ncon,ncnv,ncal,pass_1,
scanner,
@ -397,13 +397,13 @@ implementation
begin
pd:=Tprocsym(sym).search_procdef_bypara(propertyparas,true,false);
if not(assigned(pd)) or
not(is_equal(pd.rettype.def,p.proptype.def)) then
not(equal_defs(pd.rettype.def,p.proptype.def)) then
Message(parser_e_ill_property_access_sym);
p.readaccess.setdef(pd);
end;
varsym :
begin
if CheckTypes(p.readaccess.def,p.proptype.def) then
if compare_defs(p.readaccess.def,p.proptype.def,nothingn)>=te_equal then
begin
{ property parameters are allowed if this is
an indexed property, because the index is then
@ -412,7 +412,9 @@ implementation
that it isn't allowed, but the compiler accepts it (PFV) }
if (ppo_hasparameters in p.propoptions) then
Message(parser_e_ill_property_access_sym);
end;
end
else
CGMessage2(type_e_incompatible_types,p.readaccess.def.typename,p.proptype.def.typename);
end;
else
Message(parser_e_ill_property_access_sym);
@ -439,7 +441,7 @@ implementation
end;
varsym :
begin
if CheckTypes(p.writeaccess.def,p.proptype.def) then
if compare_defs(p.writeaccess.def,p.proptype.def,nothingn)>=te_equal then
begin
{ property parameters are allowed if this is
an indexed property, because the index is then
@ -448,7 +450,9 @@ implementation
that it isn't allowed, but the compiler accepts it (PFV) }
if (ppo_hasparameters in p.propoptions) then
Message(parser_e_ill_property_access_sym);
end;
end
else
CGMessage2(type_e_incompatible_types,p.readaccess.def.typename,p.proptype.def.typename);
end;
else
Message(parser_e_ill_property_access_sym);
@ -780,8 +784,8 @@ implementation
Message1(sym_e_duplicate_id,implintf.name)
else
begin
{ allocate and prepare the GUID only if the class
implements some interfaces.
{ allocate and prepare the GUID only if the class
implements some interfaces.
}
if aktclass.implementedinterfaces.count = 0 then
aktclass.prepareguid;
@ -1169,7 +1173,12 @@ implementation
end.
{
$Log$
Revision 1.56 2002-11-17 16:31:56 carl
Revision 1.57 2002-11-25 17:43:21 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.56 2002/11/17 16:31:56 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k

24
compiler/pdecsub.pas
View File

@ -72,7 +72,7 @@ implementation
{ aasm }
aasmbase,aasmtai,aasmcpu,
{ symtable }
symbase,symtable,defbase,paramgr,
symbase,symtable,defutil,defcmp,paramgr,
{ pass 1 }
node,htypechk,
nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
@ -226,7 +226,10 @@ implementation
aktprocdef.concatpara(tt,vs,varspez,nil);
{ check the types for procedures only }
if not is_procvar then
CheckTypes(tt.def,procinfo._class);
begin
if compare_defs(tt.def,procinfo._class,nothingn)>=te_equal then
CGMessage2(type_e_incompatible_types,tt.def.typename,procinfo._class.typename);
end;
end
else
begin
@ -764,7 +767,7 @@ implementation
if assigned(otsym) then
otsym.vartype.def:=aktprocdef.rettype.def;
if (optoken=_ASSIGNMENT) and
is_equal(aktprocdef.rettype.def,
equal_defs(aktprocdef.rettype.def,
tvarsym(aktprocdef.parast.symindex.first).vartype.def) then
message(parser_e_no_such_assignment)
else if not isoperatoracceptable(aktprocdef,optoken) then
@ -1837,10 +1840,10 @@ const
) or
{ check arguments }
(
equal_paras(aprocdef.para,hd.para,cp_none,false) and
(compare_paras(aprocdef.para,hd.para,cp_none,false)>=te_equal) and
{ for operators equal_paras is not enough !! }
((aprocdef.proctypeoption<>potype_operator) or (optoken<>_ASSIGNMENT) or
is_equal(hd.rettype.def,aprocdef.rettype.def))
equal_defs(hd.rettype.def,aprocdef.rettype.def))
) then
begin
{ Check if we've found the forwarddef, if found then
@ -1856,12 +1859,12 @@ const
(
(m_repeat_forward in aktmodeswitches) and
(not((aprocdef.maxparacount=0) or
equal_paras(aprocdef.para,hd.para,cp_all,false)))
(compare_paras(aprocdef.para,hd.para,cp_all,false)>=te_equal)))
) or
(
((m_repeat_forward in aktmodeswitches) or
not(is_void(aprocdef.rettype.def))) and
(not is_equal(hd.rettype.def,aprocdef.rettype.def))) then
(not equal_defs(hd.rettype.def,aprocdef.rettype.def))) then
begin
MessagePos1(aprocdef.fileinfo,parser_e_header_dont_match_forward,
aprocdef.fullprocname);
@ -2054,7 +2057,12 @@ const
end.
{
$Log$
Revision 1.81 2002-11-18 17:31:58 peter
Revision 1.82 2002-11-25 17:43:21 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.81 2002/11/18 17:31:58 peter
* pass proccalloption to ret_in_xxx and push_xxx functions
Revision 1.80 2002/11/17 16:31:56 carl

10
compiler/pdecvar.pas
View File

@ -39,7 +39,8 @@ implementation
globtype,globals,tokens,verbose,
systems,
{ symtable }
symconst,symbase,symtype,symdef,symsym,symtable,defbase,fmodule,paramgr,
symconst,symbase,symtype,symdef,symsym,symtable,defutil,
fmodule,paramgr,
{ pass 1 }
node,
nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
@ -578,7 +579,12 @@ implementation
end.
{
$Log$
Revision 1.39 2002-11-15 16:29:31 peter
Revision 1.40 2002-11-25 17:43:21 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.39 2002/11/15 16:29:31 peter
* made tasmsymbol.refs private (merged)
Revision 1.38 2002/11/15 01:58:53 peter

22
compiler/pexpr.pas
View File

@ -68,7 +68,7 @@ implementation
globtype,tokens,verbose,
systems,widestr,
{ symtable }
symconst,symbase,symdef,symsym,symtable,defbase,
symconst,symbase,symdef,symsym,symtable,defutil,defcmp,
{ pass 1 }
pass_1,htypechk,
nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,
@ -609,11 +609,6 @@ implementation
begin
prevafterassn:=afterassignment;
afterassignment:=false;
{$ifdef EXTDEBUG}
{ if assigned(p1) and
(p1.nodetype<>calln) then
internalerror(20021118);}
{$endif EXTDEBUG}
{ want we only determine the address of }
{ a subroutine ? }
if not(getaddr) then
@ -907,7 +902,7 @@ implementation
(assigned(getprocvardef) and
((block_type=bt_const) or
((m_tp_procvar in aktmodeswitches) and
proc_to_procvar_equal(tprocsym(sym).first_procdef,getprocvardef,false)
(proc_to_procvar_equal(tprocsym(sym).first_procdef,getprocvardef)>te_incompatible)
)
)
),again,p1);
@ -1244,7 +1239,7 @@ implementation
(assigned(getprocvardef) and
((block_type=bt_const) or
((m_tp_procvar in aktmodeswitches) and
proc_to_procvar_equal(tprocsym(srsym).first_procdef,getprocvardef,false)
(proc_to_procvar_equal(tprocsym(srsym).first_procdef,getprocvardef)>te_incompatible)
)
)
),again,p1);
@ -1608,7 +1603,7 @@ implementation
if (p1.resulttype.def.deftype=procvardef) then
begin
if assigned(getprocvardef) and
is_equal(p1.resulttype.def,getprocvardef) then
equal_defs(p1.resulttype.def,getprocvardef) then
again:=false
else
if (token=_LKLAMMER) or
@ -2266,8 +2261,13 @@ implementation
end.
{
$Log$
Revision 1.91 2002-11-22 22:48:10 carl
* memory optimization with tconstsym (1.5%)
Revision 1.92 2002-11-25 17:43:22 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.91 2002/11/22 22:48:10 carl
* memory optimization with tconstsym (1.5%)
Revision 1.90 2002/11/20 22:49:55 pierre
* commented check code tht was invalid in 1.1

9
compiler/pinline.pas
View File

@ -52,7 +52,7 @@ implementation
globtype,tokens,verbose,
systems,
{ symtable }
symconst,symdef,symsym,symtable,defbase,
symconst,symdef,symsym,symtable,defutil,
{ pass 1 }
pass_1,htypechk,
nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,
@ -657,7 +657,12 @@ implementation
end.
{
$Log$
Revision 1.9 2002-10-29 10:01:22 pierre
Revision 1.10 2002-11-25 17:43:22 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.9 2002/10/29 10:01:22 pierre
* fix crash report as webbug 2174
Revision 1.8 2002/10/02 18:20:52 peter

11
compiler/powerpc/cpubase.pas
View File

@ -605,11 +605,11 @@ uses
{the return_result_reg, is used inside the called function to store its return
value when that is a scalar value otherwise a pointer to the address of the
result is placed inside it}
return_result_reg = accumulator;
return_result_reg = accumulator;
{the function_result_reg contains the function result after a call to a scalar
function othewise it contains a pointer to the returned result}
function_result_reg = accumulator;
function_result_reg = accumulator;
{# Hi-Results are returned in this register (64-bit value high register) }
accumulatorhigh = R_4;
{ WARNING: don't change to R_ST0!! See comments above implementation of }
@ -740,7 +740,12 @@ implementation
end.
{
$Log$
Revision 1.37 2002-11-24 14:28:56 jonas
Revision 1.38 2002-11-25 17:43:27 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.37 2002/11/24 14:28:56 jonas
+ some comments describing the fields of treference
Revision 1.36 2002/11/17 18:26:16 mazen

9
compiler/powerpc/cpupara.pas
View File

@ -44,7 +44,7 @@ unit cpupara;
verbose,
globtype,
cpuinfo,cginfo,cgbase,
defbase;
defutil;
function tppcparamanager.getintparaloc(nr : longint) : tparalocation;
@ -295,7 +295,12 @@ begin
end.
{
$Log$
Revision 1.16 2002-11-18 17:32:01 peter
Revision 1.17 2002-11-25 17:43:27 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.16 2002/11/18 17:32:01 peter
* pass proccalloption to ret_in_xxx and push_xxx functions
Revision 1.15 2002/10/02 13:33:36 jonas

9
compiler/powerpc/nppcadd.pas
View File

@ -54,7 +54,7 @@ interface
globtype,systems,
cutils,verbose,globals,
symconst,symdef,paramgr,
aasmbase,aasmtai,aasmcpu,defbase,htypechk,
aasmbase,aasmtai,aasmcpu,defutil,htypechk,
cgbase,cpuinfo,pass_1,pass_2,regvars,
cpupara,
ncon,nset,
@ -1464,7 +1464,12 @@ begin
end.
{
$Log$
Revision 1.19 2002-10-21 18:08:05 jonas
Revision 1.20 2002-11-25 17:43:27 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.19 2002/10/21 18:08:05 jonas
* some range errors fixed
Revision 1.18 2002/09/08 14:14:49 jonas

9
compiler/powerpc/nppccal.pas
View File

@ -40,7 +40,7 @@ implementation
uses
globtype,systems,
cutils,verbose,globals,
symconst,symbase,symsym,symtable,defbase,paramgr,
symconst,symbase,symsym,symtable,defutil,paramgr,
{$ifdef GDB}
{$ifdef delphi}
sysutils,
@ -121,7 +121,12 @@ begin
end.
{
$Log$
Revision 1.2 2002-08-17 09:23:49 florian
Revision 1.3 2002-11-25 17:43:28 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.2 2002/08/17 09:23:49 florian
* first part of procinfo rewrite
Revision 1.1 2002/08/13 21:40:59 florian

10
compiler/powerpc/nppccnv.pas
View File

@ -27,7 +27,7 @@ unit nppccnv;
interface
uses
node,ncnv,ncgcnv,defbase;
node,ncnv,ncgcnv,defcmp;
type
tppctypeconvnode = class(tcgtypeconvnode)
@ -61,6 +61,7 @@ implementation
uses
verbose,globals,systems,
symconst,symdef,aasmbase,aasmtai,
defutil,
cgbase,pass_1,pass_2,
ncon,ncal,
ncgutil,
@ -391,7 +392,12 @@ begin
end.
{
$Log$
Revision 1.26 2002-10-18 16:38:42 jonas
Revision 1.27 2002-11-25 17:43:28 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.26 2002/10/18 16:38:42 jonas
+ added entry for pwchar_to_string conversion addition
Revision 1.25 2002/09/17 18:54:06 jonas

9
compiler/powerpc/nppcinl.pas
View File

@ -50,7 +50,7 @@ implementation
uses
globtype,systems,
cutils,verbose,globals,fmodule,
symconst,symdef,defbase,
symconst,symdef,defutil,
aasmbase,aasmtai,aasmcpu,
cginfo,cgbase,pass_1,pass_2,
cpubase,paramgr,
@ -150,7 +150,12 @@ begin
end.
{
$Log$
Revision 1.3 2002-09-18 09:19:37 jonas
Revision 1.4 2002-11-25 17:43:28 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.3 2002/09/18 09:19:37 jonas
* fixed LOC_REFERENCE/LOC_CREFERENCE problems
Revision 1.2 2002/08/19 17:35:42 jonas

9
compiler/powerpc/nppcmat.pas
View File

@ -55,7 +55,7 @@ implementation
cutils,verbose,globals,
symconst,symdef,
aasmbase,aasmcpu,aasmtai,
defbase,
defutil,
cgbase,cgobj,pass_1,pass_2,
ncon,
cpubase,cpuinfo,cginfo,
@ -503,7 +503,12 @@ begin
end.
{
$Log$
Revision 1.19 2002-09-10 21:21:29 jonas
Revision 1.20 2002-11-25 17:43:28 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.19 2002/09/10 21:21:29 jonas
* fixed unary minus of 64bit values
Revision 1.18 2002/09/07 15:25:14 peter

9
compiler/powerpc/nppcset.pas
View File

@ -42,7 +42,7 @@ implementation
uses
globtype,systems,
verbose,globals,
symconst,symdef,defbase,
symconst,symdef,defutil,
paramgr,
cpuinfo,
pass_2,cgcpu,
@ -156,7 +156,12 @@ begin
end.
{
$Log$
Revision 1.4 2002-10-21 18:08:05 jonas
Revision 1.5 2002-11-25 17:43:28 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.4 2002/10/21 18:08:05 jonas
* some range errors fixed
Revision 1.3 2002/09/09 13:57:45 jonas

9
compiler/powerpc/radirect.pas
View File

@ -45,7 +45,7 @@ interface
{ aasm }
aasmbase,aasmtai,aasmcpu,
{ symtable }
symconst,symbase,symtype,symsym,symtable,defbase,
symconst,symbase,symtype,symsym,symtable,defutil,
{ pass 1 }
nbas,
{ parser }
@ -314,7 +314,12 @@ initialization
end.
{
$Log$
Revision 1.5 2002-09-03 19:04:18 daniel
Revision 1.6 2002-11-25 17:43:28 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.5 2002/09/03 19:04:18 daniel
* Fixed PowerPC & M68000 compilation
Revision 1.4 2002/09/03 16:26:28 daniel

10
compiler/pstatmnt.pas
View File

@ -46,7 +46,8 @@ implementation
{ aasm }
cpubase,aasmbase,aasmtai,aasmcpu,
{ symtable }
symconst,symbase,symtype,symdef,symsym,symtable,defbase,paramgr,
symconst,symbase,symtype,symdef,symsym,symtable,defutil,defcmp,
paramgr,
{ pass 1 }
pass_1,htypechk,
nbas,nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,
@ -1146,7 +1147,12 @@ implementation
end.
{
$Log$
Revision 1.79 2002-11-18 17:31:58 peter
Revision 1.80 2002-11-25 17:43:22 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.79 2002/11/18 17:31:58 peter
* pass proccalloption to ret_in_xxx and push_xxx functions
Revision 1.78 2002/09/07 19:34:08 florian

10
compiler/psub.pas
View File

@ -46,7 +46,8 @@ implementation
{ aasm }
cpubase,cpuinfo,aasmbase,aasmtai,
{ symtable }
symconst,symbase,symdef,symsym,symtype,symtable,defbase,paramgr,
symconst,symbase,symdef,symsym,symtype,symtable,defutil,
paramgr,
ppu,fmodule,
{ pass 1 }
node,
@ -804,7 +805,12 @@ implementation
end.
{
$Log$
Revision 1.77 2002-11-23 22:50:06 carl
Revision 1.78 2002-11-25 17:43:23 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.77 2002/11/23 22:50:06 carl
* some small speed optimizations
+ added several new warnings/hints

15
compiler/ptconst.pas
View File

@ -41,9 +41,9 @@ implementation
{$else}
strings,
{$endif Delphi}
globtype,systems,tokens,
globtype,systems,tokens,verbose,
cutils,globals,widestr,scanner,
symconst,symbase,symdef,aasmbase,aasmtai,aasmcpu,defbase,verbose,
symconst,symbase,symdef,aasmbase,aasmtai,aasmcpu,defutil,defcmp,
{ pass 1 }
node,
nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,
@ -248,7 +248,7 @@ implementation
p:=comp_expr(true);
if (p.nodetype=typeconvn) and
(ttypeconvnode(p).left.nodetype in [addrn,niln]) and
is_equal(t.def,p.resulttype.def) then
equal_defs(t.def,p.resulttype.def) then
begin
hp:=ttypeconvnode(p).left;
ttypeconvnode(p).left:=nil;
@ -477,7 +477,7 @@ implementation
p:=comp_expr(true);
if p.nodetype=ordconstn then
begin
if is_equal(p.resulttype.def,t.def) or
if equal_defs(p.resulttype.def,t.def) or
is_subequal(p.resulttype.def,t.def) then
begin
case p.resulttype.def.size of
@ -985,7 +985,12 @@ implementation
end.
{
$Log$
Revision 1.59 2002-11-22 22:48:10 carl
Revision 1.60 2002-11-25 17:43:23 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.59 2002/11/22 22:48:10 carl
* memory optimization with tconstsym (1.5%)
Revision 1.58 2002/11/09 15:31:57 carl

14
compiler/ptype.pas
View File

@ -60,7 +60,8 @@ implementation
globals,tokens,verbose,
systems,
{ symtable }
symconst,symbase,symdef,symsym,symtable,defbase,
symconst,symbase,symdef,symsym,symtable,
defutil,defcmp,
{ pass 1 }
node,
nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
@ -481,7 +482,7 @@ implementation
same type }
if is_integer(p.resulttype.def) or
is_char(p.resulttype.def) or
is_equal(p.resulttype.def,aktenumdef) then
equal_defs(p.resulttype.def,aktenumdef) then
v:=tordconstnode(p).value
else
Message2(type_e_incompatible_types,p.resulttype.def.typename,s32bittype.def.typename);
@ -508,7 +509,7 @@ implementation
{ we expect an integer or an enum of the
same type }
if is_integer(p.resulttype.def) or
is_equal(p.resulttype.def,aktenumdef) then
equal_defs(p.resulttype.def,aktenumdef) then
l:=tordconstnode(p).value
else
Message2(type_e_incompatible_types,p.resulttype.def.typename,s32bittype.def.typename);
@ -640,7 +641,12 @@ implementation
end.
{
$Log$
Revision 1.45 2002-09-27 21:13:29 carl
Revision 1.46 2002-11-25 17:43:23 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.45 2002/09/27 21:13:29 carl
* low-highval always checked if limit ober 2GB is reached (to avoid overflow)
Revision 1.44 2002/09/10 16:26:39 peter

9
compiler/rautils.pas
View File

@ -216,7 +216,7 @@ uses
{$else}
strings,
{$endif}
defbase,systems,verbose,globals,
defutil,systems,verbose,globals,
symsym,symtable,paramgr,
aasmcpu,
cgbase;
@ -1592,7 +1592,12 @@ end;
end.
{
$Log$
Revision 1.49 2002-11-22 22:48:10 carl
Revision 1.50 2002-11-25 17:43:23 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.49 2002/11/22 22:48:10 carl
* memory optimization with tconstsym (1.5%)
Revision 1.48 2002/11/18 17:31:59 peter

9
compiler/regvars.pas
View File

@ -48,7 +48,7 @@ implementation
uses
globtype,systems,comphook,
cutils,cclasses,verbose,globals,
symconst,symbase,symtype,symdef,paramgr,defbase,
symconst,symbase,symtype,symdef,paramgr,defutil,
cgbase,cgobj,cgcpu,rgcpu;
@ -469,7 +469,12 @@ end.
{
$Log$
Revision 1.42 2002-11-18 17:31:59 peter
Revision 1.43 2002-11-25 17:43:24 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.42 2002/11/18 17:31:59 peter
* pass proccalloption to ret_in_xxx and push_xxx functions
Revision 1.41 2002/08/25 19:25:20 peter

87
compiler/sparc/cgcpu.pas
View File

@ -98,7 +98,7 @@ CONST
IMPLEMENTATION
USES
globtype,globals,verbose,systems,cutils,
symdef,symsym,defbase,paramgr,
symdef,symsym,defutil,paramgr,
rgobj,tgobj,rgcpu,cpupi;
{ we implement the following routines because otherwise we can't }
{ instantiate the class since it's abstract }
@ -107,15 +107,15 @@ procedure tcgSPARC.a_param_reg(list:TAasmOutput;size:tcgsize;r:tregister;CONST L
IF(Size<>OS_32)AND(Size<>OS_S32)
THEN
InternalError(2002032212);
with list,LocPara do
case Loc of
LOC_REGISTER:
if r<>Register
then
Concat(taicpu.op_Reg_Reg_Reg(A_OR,r,R_G0,Register));
else
InternalError(2002101002);
end;
with list,LocPara do
case Loc of
LOC_REGISTER:
if r<>Register
then
Concat(taicpu.op_Reg_Reg_Reg(A_OR,r,R_G0,Register));
else
InternalError(2002101002);
end;
end;
procedure tcgSPARC.a_param_const(list:TAasmOutput;size:tcgsize;a:aword;CONST LocPara:TParaLocation);
BEGIN
@ -134,37 +134,37 @@ procedure tcgSPARC.a_param_ref(list:TAasmOutput;size:tcgsize;const r:TReference;
ref: treference;
tmpreg:TRegister;
begin
with LocPara do
case locpara.loc of
LOC_REGISTER,LOC_CREGISTER:
a_load_ref_reg(list,size,r,Register);
LOC_REFERENCE:
begin
with LocPara do
case locpara.loc of
LOC_REGISTER,LOC_CREGISTER:
a_load_ref_reg(list,size,r,Register);
LOC_REFERENCE:
begin
{Code conventions need the parameters being allocated in %o6+92. See
comment on g_stack_frame}
if locpara.sp_fixup<92
then
InternalError(2002081104);
reference_reset(ref);
ref.base:=locpara.reference.index;
ref.offset:=locpara.reference.offset;
tmpreg := get_scratch_reg_int(list);
a_load_ref_reg(list,size,r,tmpreg);
a_load_reg_ref(list,size,tmpreg,ref);
free_scratch_reg(list,tmpreg);
end;
LOC_FPUREGISTER,LOC_CFPUREGISTER:
case size of
OS_32:
a_loadfpu_ref_reg(list,OS_F32,r,locpara.register);
OS_64:
a_loadfpu_ref_reg(list,OS_F64,r,locpara.register);
else
internalerror(2002072801);
end;
else
internalerror(2002081103);
end;
if locpara.sp_fixup<92
then
InternalError(2002081104);
reference_reset(ref);
ref.base:=locpara.reference.index;
ref.offset:=locpara.reference.offset;
tmpreg := get_scratch_reg_int(list);
a_load_ref_reg(list,size,r,tmpreg);
a_load_reg_ref(list,size,tmpreg,ref);
free_scratch_reg(list,tmpreg);
end;
LOC_FPUREGISTER,LOC_CFPUREGISTER:
case size of
OS_32:
a_loadfpu_ref_reg(list,OS_F32,r,locpara.register);
OS_64:
a_loadfpu_ref_reg(list,OS_F64,r,locpara.register);
else
internalerror(2002072801);
end;
else
internalerror(2002081103);
end;
end;
procedure tcgSPARC.a_paramaddr_ref(list:TAasmOutput;CONST r:TReference;CONST LocPara:TParaLocation);
VAR
@ -833,7 +833,7 @@ procedure tcgSPARC.g_return_from_proc(list:TAasmOutput;parasize:aword);
{According to the SPARC ABI, the stack is cleared using the RESTORE instruction
which is genereted in the g_restore_frame_pointer. Notice that SPARC has no
RETURN instruction and that JMPL is used instead. The JMPL instrucion have one
delay slot, so an inversion is possible such as
delay slot, so an inversion is possible such as
JMPL %i7+8,%g0
RESTORE %g0,0,%g0
If no inversion we can use just
@ -1253,7 +1253,12 @@ BEGIN
END.
{
$Log$
Revision 1.24 2002-11-17 17:49:09 mazen
Revision 1.25 2002-11-25 17:43:28 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.24 2002/11/17 17:49:09 mazen
+ return_result_reg and function_result_reg are now used, in all plateforms, to pass functions result between called function and its caller. See the explanation of each one
Revision 1.23 2002/11/10 19:07:46 mazen

9
compiler/sparc/cpupara.pas
View File

@ -42,7 +42,7 @@ uses
verbose,
globtype,
cpuinfo,cginfo,cgbase,
defbase;
defutil;
function TSparcParaManager.GetIntParaLoc(nr:longint):TParaLocation;
begin
if nr<1
@ -283,7 +283,12 @@ begin
end.
{
$Log$
Revision 1.10 2002-11-18 17:32:01 peter
Revision 1.11 2002-11-25 17:43:28 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.10 2002/11/18 17:32:01 peter
* pass proccalloption to ret_in_xxx and push_xxx functions
Revision 1.9 2002/11/03 20:22:40 mazen

11
compiler/sparc/naddcpu.pas
View File

@ -40,7 +40,7 @@ uses
globtype,systems,
cutils,verbose,globals,
symconst,symdef,paramgr,
aasmbase,aasmtai,aasmcpu,defbase,htypechk,
aasmbase,aasmtai,aasmcpu,defutil,htypechk,
cgbase,pass_2,regvars,
cpupara,
ncon,nset,
@ -302,7 +302,7 @@ procedures }
extra_not:=false;
mboverflow:=false;
cmpop:=false;
unsigned:=not(is_signed(left.resulttype.def))or
unsigned:=not(is_signed(left.resulttype.def))or
not(is_signed(right.resulttype.def));
opsize:=def_opsize(left.resulttype.def);
pass_left_and_right;
@ -408,7 +408,12 @@ begin
end.
{
$Log$
Revision 1.9 2002-11-10 19:07:46 mazen
Revision 1.10 2002-11-25 17:43:28 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.9 2002/11/10 19:07:46 mazen
* SPARC calling mechanism almost OK (as in GCC./mppcsparc )
Revision 1.8 2002/11/06 15:34:00 mazen

12
compiler/sparc/ncpucnv.pas
View File

@ -25,7 +25,7 @@ unit ncpucnv;
interface
uses
node,ncnv,ncgcnv,defbase;
node,ncnv,ncgcnv,defcmp;
type
TSparcTypeConvNode = class(TCgTypeConvNode)
@ -59,6 +59,7 @@ implementation
uses
verbose,globals,systems,
symconst,symdef,aasmbase,aasmtai,
defutil,
cgbase,pass_1,pass_2,
ncon,ncal,
ncgutil,
@ -374,7 +375,7 @@ implementation
@second_char_to_char,
@second_nothing, { normal_2_smallset }
@second_nothing, { dynarray_2_openarray }
@second_nothing
@second_nothing
);
type
tprocedureofobject = procedure of object;
@ -420,7 +421,12 @@ begin
end.
{
$Log$
Revision 1.7 2002-11-10 19:07:46 mazen
Revision 1.8 2002-11-25 17:43:28 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.7 2002/11/10 19:07:46 mazen
* SPARC calling mechanism almost OK (as in GCC./mppcsparc )
Revision 1.6 2002/11/06 11:31:24 mazen

9
compiler/sparc/radirect.pas
View File

@ -48,7 +48,7 @@ interface
{ aasm }
aasmbase,aasmtai,aasmcpu,
{ symtable }
symconst,symbase,symtype,symsym,symtable,defbase,paramgr,
symconst,symbase,symtype,symsym,symtable,defutil,paramgr,
{ pass 1 }
nbas,
{ parser }
@ -314,7 +314,12 @@ initialization
end.
{
$Log$
Revision 1.3 2002-11-18 17:32:01 peter
Revision 1.4 2002-11-25 17:43:29 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.3 2002/11/18 17:32:01 peter
* pass proccalloption to ret_in_xxx and push_xxx functions
Revision 1.2 2002/09/19 20:24:47 mazen

11
compiler/symdef.pas
View File

@ -729,7 +729,7 @@ implementation
systems,
{ symtable }
symsym,symtable,paramgr,
defbase,
symutil,defutil,
{ module }
{$ifdef GDB}
gdb,
@ -3526,7 +3526,7 @@ implementation
begin
s:=fullprocname;
if assigned(rettype.def) and
not(is_equal(rettype.def,voidtype.def)) then
not(is_void(rettype.def)) then
s:=s+' : '+rettype.def.gettypename;
fullprocnamewithret:=s;
end;
@ -5537,7 +5537,12 @@ implementation
end.
{
$Log$
Revision 1.109 2002-11-23 22:50:06 carl
Revision 1.110 2002-11-25 17:43:24 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.109 2002/11/23 22:50:06 carl
* some small speed optimizations
+ added several new warnings/hints

157
compiler/symsym.pas
View File

@ -143,8 +143,7 @@ interface
allowdefault:boolean):Tprocdef;
function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
function search_procdef_by1paradef(firstpara:Tdef):Tprocdef;
function search_procdef_byretdef_by1paradef(retdef,firstpara:Tdef;
matchtype:Tdefmatch; var pd : pprocdeflist):Tprocdef;
function search_procdef_assignment_operator(fromdef,todef:tdef):Tprocdef;
function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
{$ifdef GDB}
function stabstring : pchar;override;
@ -390,7 +389,7 @@ implementation
{ target }
systems,
{ symtable }
symtable,defbase,
symtable,defutil,defcmp,
{$ifdef GDB}
gdb,
{$endif GDB}
@ -1021,72 +1020,58 @@ implementation
function Tprocsym.search_procdef_bypara(params:Tparalinkedlist;
allowconvert,
allowdefault:boolean):Tprocdef;
var
pd:Pprocdeflist;
eq : tequaltype;
begin
search_procdef_bypara:=nil;
pd:=defs;
while assigned(pd) do
begin
if equal_paras(pd^.def.para,params,cp_value_equal_const,allowdefault) or
(allowconvert and convertable_paras(pd^.def.para,params,
cp_value_equal_const)) then
begin
search_procdef_bypara:=pd^.def;
break;
end;
pd:=pd^.next;
end;
end;
begin
eq:=compare_paras(pd^.def.para,params,cp_value_equal_const,allowdefault);
if (eq>=te_equal) or
(allowconvert and (eq>te_incompatible)) then
begin
search_procdef_bypara:=pd^.def;
break;
end;
pd:=pd^.next;
end;
end;
function Tprocsym.search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
var pd:Pprocdeflist;
_result : tprocdef;
begin
{This function will return the pprocdef of pprocsym that
is the best match for procvardef. When there are multiple
matches it returns nil.}
{Try to find an exact match first.}
var
pd : Pprocdeflist;
eq,besteq : tequaltype;
bestpd : tprocdef;
begin
{ This function will return the pprocdef of pprocsym that
is the best match for procvardef. When there are multiple
matches it returns nil.}
search_procdef_byprocvardef:=nil;
_result := nil;
bestpd:=nil;
besteq:=te_incompatible;
pd:=defs;
while assigned(pd) do
begin
if proc_to_procvar_equal(pd^.def,d,true) then
begin
{ already found a match ? Then stop and return nil }
if assigned(search_procdef_byprocvardef) then
begin
search_procdef_byprocvardef:=nil;
break;
end;
search_procdef_byprocvardef:=pd^.def;
end;
pd:=pd^.next;
end;
{Try a convertable match, if no exact match was found.}
if not assigned(_result) and not assigned(pd) then
begin
eq:=proc_to_procvar_equal(pd^.def,d);
if eq>te_incompatible then
begin
pd:=defs;
while assigned(pd) do
begin
if proc_to_procvar_equal(pd^.def,d,false) then
begin
{ already found a match ? Then stop and return nil }
if assigned(_result) then
begin
search_procdef_byprocvardef:=nil;
_result := nil;
break;
end;
search_procdef_byprocvardef:=pd^.def;
_result:=pd^.def;
end;
pd:=pd^.next;
end;
{ multiple procvars with the same equal level }
if assigned(bestpd) and
(besteq=eq) then
exit;
if eq>besteq then
begin
besteq:=eq;
bestpd:=pd^.def;
end;
end;
end;
pd:=pd^.next;
end;
search_procdef_byprocvardef:=bestpd;
end;
function Tprocsym.search_procdef_by1paradef(firstpara:Tdef):Tprocdef;
var
@ -1096,7 +1081,7 @@ implementation
pd:=defs;
while assigned(pd) do
begin
if is_equal(Tparaitem(pd^.def.para.first).paratype.def,firstpara) and
if equal_defs(Tparaitem(pd^.def.para.first).paratype.def,firstpara) and
(Tparaitem(pd^.def.para.first).next=nil) then
begin
search_procdef_by1paradef:=pd^.def;
@ -1107,40 +1092,39 @@ implementation
end;
function Tprocsym.search_procdef_byretdef_by1paradef(retdef,firstpara:Tdef;
matchtype:Tdefmatch; var pd : pprocdeflist):Tprocdef;
function Tprocsym.search_procdef_assignment_operator(fromdef,todef:tdef):Tprocdef;
var
convtyp:tconverttype;
a,b:boolean;
oldpd : pprocdeflist;
convtyp : tconverttype;
pd : pprocdeflist;
bestpd : tprocdef;
eq,
besteq : tequaltype;
hpd : tprocdef;
begin
search_procdef_byretdef_by1paradef:=nil;
if not assigned(pd) then
pd:=defs;
search_procdef_assignment_operator:=nil;
bestpd:=nil;
besteq:=te_incompatible;
pd:=defs;
while assigned(pd) do
begin
oldpd := pd;
a:=is_equal(retdef,pd^.def.rettype.def);
if a then
begin
case matchtype of
dm_exact:
b:=TParaItem(pd^.def.para.first).paratype.def=firstpara;
dm_equal:
b:=is_equal(Tparaitem(pd^.def.para.first).paratype.def,firstpara);
dm_convertl1:
b:=overloaded_assignment_isconvertable(firstpara,Tparaitem(pd^.def.para.first).paratype.def,
convtyp,ordconstn,false,oldpd)=1;
if equal_defs(todef,pd^.def.rettype.def) then
begin
eq:=compare_defs_ext(fromdef,Tparaitem(pd^.def.para.first).paratype.def,
nothingn,false,false,convtyp,hpd);
if eq=te_exact then
begin
search_procdef_assignment_operator:=pd^.def;
exit;
end;
if eq>besteq then
begin
bestpd:=pd^.def;
besteq:=eq;
end;
end;
if a and b then
begin
search_procdef_byretdef_by1paradef:=pd^.def;
break;
end;
pd:=pd^.next;
end;
search_procdef_assignment_operator:=bestpd;
end;
@ -2499,7 +2483,12 @@ implementation
end.
{
$Log$
Revision 1.75 2002-11-23 22:50:09 carl
Revision 1.76 2002-11-25 17:43:26 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.75 2002/11/23 22:50:09 carl
* some small speed optimizations
+ added several new warnings/hints

108
compiler/symutil.pas Normal file
View File

@ -0,0 +1,108 @@
{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl
This unit provides some help routines for symbol handling
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 symutil;
{$i fpcdefs.inc}
interface
uses
cclasses,
cpuinfo,
globals,
node,
symconst,symbase,symtype,symdef,symsym;
function equal_constsym(sym1,sym2:tconstsym):boolean;
{ returns true, if sym needs an entry in the proplist of a class rtti }
function needs_prop_entry(sym : tsym) : boolean;
implementation
uses
globtype,tokens,systems,verbose,
symtable;
function needs_prop_entry(sym : tsym) : boolean;
begin
needs_prop_entry:=(sp_published in tsym(sym).symoptions) and
(sym.typ in [propertysym,varsym]);
end;
function equal_constsym(sym1,sym2:tconstsym):boolean;
var
p1,p2,pend : pchar;
begin
equal_constsym:=false;
if sym1.consttyp<>sym2.consttyp then
exit;
case sym1.consttyp of
constint,
constbool,
constchar,
constord :
equal_constsym:=(sym1.value.valueord=sym2.value.valueord);
constpointer :
equal_constsym:=(sym1.value.valueordptr=sym2.value.valueordptr);
conststring,constresourcestring :
begin
if sym1.value.len=sym2.value.len then
begin
p1:=pchar(sym1.value.valueptr);
p2:=pchar(sym2.value.valueptr);
pend:=p1+sym1.value.len;
while (p1<pend) do
begin
if p1^<>p2^ then
break;
inc(p1);
inc(p2);
end;
if (p1=pend) then
equal_constsym:=true;
end;
end;
constreal :
equal_constsym:=(pbestreal(sym1.value.valueptr)^=pbestreal(sym2.value.valueptr)^);
constset :
equal_constsym:=(pnormalset(sym1.value.valueptr)^=pnormalset(sym2.value.valueptr)^);
constnil :
equal_constsym:=true;
end;
end;
end.
{
$Log$
Revision 1.1 2002-11-25 17:43:26 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
}

9
compiler/x86/cgx86.pas
View File

@ -147,7 +147,7 @@ unit cgx86;
uses
globtype,globals,verbose,systems,cutils,
symdef,symsym,defbase,paramgr,
symdef,symsym,defutil,paramgr,
rgobj,tgobj,rgcpu;
{$ifndef NOTARGETWIN32}
@ -1682,7 +1682,12 @@ unit cgx86;
end.
{
$Log$
Revision 1.21 2002-11-18 17:32:01 peter
Revision 1.22 2002-11-25 17:43:29 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.21 2002/11/18 17:32:01 peter
* pass proccalloption to ret_in_xxx and push_xxx functions
Revision 1.20 2002/11/09 21:18:31 carl