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

* fixed overloading of array of char

Browse Source
This commit is contained in:
peter 1999-03-02 18:24:19 +00:00
parent 554f02687b
commit f4f4f17da7
7 changed files with 275 additions and 732 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

464
compiler/cg386cnv.pas
View File

@ -161,8 +161,6 @@ implementation
type
tsecondconvproc = procedure(pto,pfrom : ptree;convtyp : tconverttype);
{$ifndef OLDCNV}
procedure second_int_to_int(pto,pfrom : ptree;convtyp : tconverttype);
var
op : tasmop;
@ -238,355 +236,6 @@ implementation
end;
end;
{$else}
procedure maybe_rangechecking(p : ptree;p2,p1 : pdef);
{
produces if necessary rangecheckcode
}
var
hp : preference;
hregister : tregister;
neglabel,poslabel : plabel;
is_register : boolean;
begin
{ convert from p2 to p1 }
{ range check from enums is not made yet !!}
{ and its probably not easy }
if (p1^.deftype<>orddef) or (p2^.deftype<>orddef) then
exit;
{ range checking is different for u32bit }
{ lets try to generate it allways }
if (cs_check_range in aktlocalswitches) and
{ with $R+ explicit type conversations in TP aren't range checked! }
(not(p^.explizit) {or not(cs_tp_compatible in aktmoduleswitches)}) and
((porddef(p1)^.low>porddef(p2)^.low) or
(porddef(p1)^.high<porddef(p2)^.high) or
(porddef(p1)^.typ=u32bit) or
(porddef(p2)^.typ=u32bit)) then
begin
porddef(p1)^.genrangecheck;
is_register:=(p^.location.loc=LOC_REGISTER) or
(p^.location.loc=LOC_CREGISTER);
if porddef(p2)^.typ=u8bit then
begin
if is_register then
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,p^.location.register,R_EDI)))
else
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,newreference(p^.location.reference),R_EDI)));
hregister:=R_EDI;
end
else if porddef(p2)^.typ=s8bit then
begin
if is_register then
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_BL,p^.location.register,R_EDI)))
else
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_BL,newreference(p^.location.reference),R_EDI)));
hregister:=R_EDI;
end
{ rangechecking for u32bit ?? !!!!!!}
{ lets try }
else if (porddef(p2)^.typ=s32bit) or (porddef(p2)^.typ=u32bit) then
begin
if is_register then
hregister:=p^.location.register
else
begin
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.location.reference),R_EDI)));
hregister:=R_EDI;
end;
end
else if porddef(p2)^.typ=u16bit then
begin
if is_register then
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_WL,p^.location.register,R_EDI)))
else
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_WL,newreference(p^.location.reference),R_EDI)));
hregister:=R_EDI;
end
else if porddef(p2)^.typ=s16bit then
begin
if is_register then
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_WL,p^.location.register,R_EDI)))
else
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_WL,newreference(p^.location.reference),R_EDI)));
hregister:=R_EDI;
end
else internalerror(6);
hp:=new_reference(R_NO,0);
hp^.symbol:=newasmsymbol(porddef(p1)^.getrangecheckstring);
if porddef(p1)^.low>porddef(p1)^.high then
begin
getlabel(neglabel);
getlabel(poslabel);
exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_L,hregister,hregister)));
emitl(A_JL,neglabel);
end;
exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hp)));
if porddef(p1)^.low>porddef(p1)^.high then
begin
hp:=new_reference(R_NO,0);
hp^.symbol:=newasmsymbol(porddef(p1)^.getrangecheckstring);
{ second part here !! }
hp^.offset:=8;
emitjmp(C_None,poslabel);
emitlab(neglabel);
exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hp)));
emitlab(poslabel);
end;
end;
end;
procedure second_only_rangecheck(pto,pfrom : ptree;convtyp : tconverttype);
begin
maybe_rangechecking(pto,pfrom^.resulttype,pto^.resulttype);
end;
procedure second_smaller(pto,pfrom : ptree;convtyp : tconverttype);
var
hregister,destregister : tregister;
ref : boolean;
hpp : preference;
begin
ref:=false;
{ problems with enums !! }
if (cs_check_range in aktlocalswitches) and
{ with $R+ explicit type conversations in TP aren't range checked! }
(not(pto^.explizit) {or not(cs_tp_compatible in aktmoduleswitches)}) and
(pto^.resulttype^.deftype=orddef) and
(pfrom^.resulttype^.deftype=orddef) then
begin
if porddef(pfrom^.resulttype)^.typ=u32bit then
begin
{ when doing range checking for u32bit, we have some trouble }
{ because BOUND assumes signed values }
{ first, we check if the values is greater than 2^31: }
{ the u32bit rangenr contains the appropriate rangenr }
porddef(pfrom^.resulttype)^.genrangecheck;
hregister:=R_EDI;
if (pto^.location.loc=LOC_REGISTER) or
(pto^.location.loc=LOC_CREGISTER) then
hregister:=pto^.location.register
else
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
newreference(pto^.location.reference),R_EDI)));
hpp:=new_reference(R_NO,0);
hpp^.symbol:=newasmsymbol(porddef(pfrom^.resulttype)^.getrangecheckstring);
exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hpp)));
{ then we do a normal range check }
porddef(pto^.resulttype)^.genrangecheck;
hpp:=new_reference(R_NO,0);
hpp^.symbol:=newasmsymbol(porddef(pto^.resulttype)^.getrangecheckstring);
exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hpp)));
end
else
if ((porddef(pto^.resulttype)^.low>porddef(pfrom^.resulttype)^.low) or
(porddef(pto^.resulttype)^.high<porddef(pfrom^.resulttype)^.high)) then
begin
porddef(pto^.resulttype)^.genrangecheck;
{ per default the var is copied to EDI }
hregister:=R_EDI;
if porddef(pfrom^.resulttype)^.typ=s32bit then
begin
if (pto^.location.loc=LOC_REGISTER) or
(pto^.location.loc=LOC_CREGISTER) then
hregister:=pto^.location.register
else
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(pto^.location.reference),R_EDI)));
end
else if porddef(pfrom^.resulttype)^.typ=u16bit then
begin
if (pto^.location.loc=LOC_REGISTER) or
(pto^.location.loc=LOC_CREGISTER) then
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_WL,pto^.location.register,R_EDI)))
else
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_WL,
newreference(pto^.location.reference),R_EDI)));
end
else if porddef(pfrom^.resulttype)^.typ=s16bit then
begin
if (pto^.location.loc=LOC_REGISTER) or
(pto^.location.loc=LOC_CREGISTER) then
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_WL,pto^.location.register,R_EDI)))
else
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_WL,
newreference(pto^.location.reference),R_EDI)));
end
else internalerror(6);
hpp:=new_reference(R_NO,0);
hpp^.symbol:=newasmsymbol(porddef(pto^.resulttype)^.getrangecheckstring);
exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hpp)));
(*
if (p^.location.loc=LOC_REGISTER) or
(p^.location.loc=LOC_CREGISTER) then
begin
destregister:=pfrom^.location.register;
case convtyp of
tc_s32bit_2_s8bit,
tc_s32bit_2_u8bit:
destregister:=reg32toreg8(destregister);
tc_s32bit_2_s16bit,
tc_s32bit_2_u16bit:
destregister:=reg32toreg16(destregister);
{ this was false because destregister is allways a 32bitreg }
tc_s16bit_2_s8bit,
tc_s16bit_2_u8bit,
tc_u16bit_2_s8bit,
tc_u16bit_2_u8bit:
destregister:=reg32toreg8(destregister);
end;
p^.location.register:=destregister;
exit;
*)
end;
end;
{ p^.location.loc is already set! }
if (pto^.location.loc=LOC_REGISTER) or
(pto^.location.loc=LOC_CREGISTER) then
begin
destregister:=pfrom^.location.register;
case convtyp of
tc_s32bit_2_s8bit,
tc_s32bit_2_u8bit:
destregister:=reg32toreg8(destregister);
tc_s32bit_2_s16bit,
tc_s32bit_2_u16bit:
destregister:=reg32toreg16(destregister);
tc_s16bit_2_s8bit,
tc_s16bit_2_u8bit,
tc_u16bit_2_s8bit,
tc_u16bit_2_u8bit:
destregister:=reg16toreg8(destregister);
end;
pto^.location.register:=destregister;
end;
end;
procedure second_bigger(pto,pfrom : ptree;convtyp : tconverttype);
var
hregister : tregister;
opsize : topsize;
op : tasmop;
is_register : boolean;
begin
is_register:=pfrom^.location.loc=LOC_REGISTER;
if not(is_register) and (pfrom^.location.loc<>LOC_CREGISTER) then
begin
del_reference(pfrom^.location.reference);
{ we can do this here as we need no temp inside second_bigger }
ungetiftemp(pfrom^.location.reference);
end;
{ this is wrong !!!
gives me movl (%eax),%eax
for the length(string !!!
use only for constant values }
{Constant cannot be loaded into registers using MOVZX!}
if (pfrom^.location.loc<>LOC_MEM) or (not pfrom^.location.reference.is_immediate) then
case convtyp of
tc_u8bit_2_s32bit,tc_u8bit_2_u32bit :
begin
if is_register then
hregister:=reg8toreg32(pfrom^.location.register)
else hregister:=getregister32;
op:=A_MOVZX;
opsize:=S_BL;
end;
{ here what do we do for negative values ? }
tc_s8bit_2_s32bit,tc_s8bit_2_u32bit :
begin
if is_register then
hregister:=reg8toreg32(pfrom^.location.register)
else hregister:=getregister32;
op:=A_MOVSX;
opsize:=S_BL;
end;
tc_u16bit_2_s32bit,tc_u16bit_2_u32bit :
begin
if is_register then
hregister:=reg16toreg32(pfrom^.location.register)
else hregister:=getregister32;
op:=A_MOVZX;
opsize:=S_WL;
end;
tc_s16bit_2_s32bit,tc_s16bit_2_u32bit :
begin
if is_register then
hregister:=reg16toreg32(pfrom^.location.register)
else hregister:=getregister32;
op:=A_MOVSX;
opsize:=S_WL;
end;
tc_s8bit_2_u16bit,
tc_u8bit_2_s16bit,
tc_u8bit_2_u16bit :
begin
if is_register then
hregister:=reg8toreg16(pfrom^.location.register)
else hregister:=reg32toreg16(getregister32);
op:=A_MOVZX;
opsize:=S_BW;
end;
tc_s8bit_2_s16bit :
begin
if is_register then
hregister:=reg8toreg16(pfrom^.location.register)
else hregister:=reg32toreg16(getregister32);
op:=A_MOVSX;
opsize:=S_BW;
end;
end
else
case convtyp of
tc_u8bit_2_s32bit,
tc_s8bit_2_s32bit,
tc_u16bit_2_s32bit,
tc_s16bit_2_s32bit,
tc_u8bit_2_u32bit,
tc_s8bit_2_u32bit,
tc_u16bit_2_u32bit,
tc_s16bit_2_u32bit:
begin
hregister:=getregister32;
op:=A_MOV;
opsize:=S_L;
end;
tc_s8bit_2_u16bit,
tc_s8bit_2_s16bit,
tc_u8bit_2_s16bit,
tc_u8bit_2_u16bit:
begin
hregister:=reg32toreg16(getregister32);
op:=A_MOV;
opsize:=S_W;
end;
end;
if is_register then
begin
emit_reg_reg(op,opsize,pfrom^.location.register,hregister);
end
else
begin
if pfrom^.location.loc=LOC_CREGISTER then
emit_reg_reg(op,opsize,pfrom^.location.register,hregister)
else exprasmlist^.concat(new(pai386,op_ref_reg(op,opsize,
newreference(pfrom^.location.reference),hregister)));
end;
clear_location(pto^.location);
pto^.location.loc:=LOC_REGISTER;
pto^.location.register:=hregister;
maybe_rangechecking(pfrom,pfrom^.resulttype,pto^.resulttype);
end;
{$endif}
var
ltemptoremove : plinkedlist;
@ -803,35 +452,61 @@ implementation
{ to a string }
procedure second_chararray_to_string(pto,pfrom : ptree;convtyp : tconverttype);
var
pushed : tpushed;
l : longint;
begin
{ calc the length of the array }
l:=parraydef(pfrom^.resulttype)^.highrange-parraydef(pfrom^.resulttype)^.lowrange+1;
{ this is a type conversion which copies the data, so we can't }
{ return a reference }
clear_location(pto^.location);
pto^.location.loc:=LOC_MEM;
{ first get the memory for the string }
gettempofsizereference(256,pto^.location.reference);
{ calc the length of the array }
l:=parraydef(pfrom^.resulttype)^.highrange-
parraydef(pfrom^.resulttype)^.lowrange+1;
if l>255 then
CGMessage(type_e_mismatch);
{ write the length }
exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_B,l,
newreference(pto^.location.reference))));
{ copy to first char of string }
inc(pto^.location.reference.offset);
{ generates the copy code }
{ and we need the source never }
concatcopy(pfrom^.location.reference,pto^.location.reference,l,true,false);
{ correct the string location }
dec(pto^.location.reference.offset);
case pstringdef(pto^.resulttype)^.string_typ of
st_shortstring :
begin
if l>255 then
begin
CGMessage(type_e_mismatch);
l:=255;
end;
{ first get the memory for the string }
gettempofsizereference(256,pto^.location.reference);
{ write the length }
exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_B,l,
newreference(pto^.location.reference))));
{ copy to first char of string }
inc(pto^.location.reference.offset);
{ generates the copy code }
{ and we need the source never }
concatcopy(pfrom^.location.reference,pto^.location.reference,l,true,false);
{ correct the string location }
dec(pto^.location.reference.offset);
end;
st_ansistring :
begin
gettempofsizereference(4,pto^.location.reference);
ltemptoremove^.concat(new(ptemptodestroy,init(pto^.location.reference,pto^.resulttype)));
exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_L,0,newreference(pto^.location.reference))));
release_loc(pfrom^.location);
pushusedregisters(pushed,$ff);
push_int(l);
emitpushreferenceaddr(exprasmlist,pfrom^.location.reference);
emitpushreferenceaddr(exprasmlist,pto^.location.reference);
emitcall('FPC_CHARARRAY_TO_ANSISTR',true);
popusedregisters(pushed);
maybe_loadesi;
end;
st_longstring:
begin
{!!!!!!!}
internalerror(8888);
end;
st_widestring:
begin
{!!!!!!!}
internalerror(8888);
end;
end;
end;
@ -1127,7 +802,6 @@ implementation
getlabel(truelabel);
getlabel(falselabel);
secondpass(pfrom);
{$ifndef OLDBOOL}
{ byte(boolean) or word(wordbool) or longint(longbool) must
be accepted for var parameters }
if (pto^.explizit) and
@ -1141,7 +815,6 @@ implementation
falselabel:=oldfalselabel;
exit;
end;
{$endif ndef OLDBOOL}
clear_location(pto^.location);
pto^.location.loc:=LOC_REGISTER;
del_reference(pfrom^.location.reference);
@ -1248,7 +921,6 @@ implementation
hregister : tregister;
begin
clear_location(pto^.location);
{$ifndef OLDBOOL}
{ byte(boolean) or word(wordbool) or longint(longbool) must
be accepted for var parameters }
if (pto^.explizit) and
@ -1258,7 +930,6 @@ implementation
set_location(pto^.location,pfrom^.location);
exit;
end;
{$endif ndef OLDBOOL}
pto^.location.loc:=LOC_REGISTER;
del_reference(pfrom^.location.reference);
case pfrom^.location.loc of
@ -1426,7 +1097,6 @@ implementation
procedure secondtypeconv(var p : ptree);
const
secondconvert : array[tconverttype] of tsecondconvproc = (
{$ifndef OLDCNV}
second_nothing, {equal}
second_nothing, {not_possible}
second_string_to_string,
@ -1451,39 +1121,8 @@ implementation
second_nothing, {arrayconstructor_to_set}
second_load_smallset
);
{$else}
second_nothing,second_nothing,
second_bigger,second_only_rangecheck,
second_bigger,second_bigger,second_bigger,
second_smaller,second_smaller,
second_smaller,second_string_to_string,
second_cstring_to_pchar,second_string_to_chararray,
second_array_to_pointer,second_pointer_to_array,
second_char_to_string,second_bigger,
second_bigger,second_bigger,
second_smaller,second_smaller,
second_smaller,second_smaller,
second_bigger,second_smaller,
second_only_rangecheck,second_bigger,
second_bigger,second_bigger,
second_bigger,second_only_rangecheck,
second_smaller,second_smaller,
second_smaller,second_smaller,
second_bool_to_int,second_int_to_bool,
second_int_to_real,second_real_to_fix,
second_fix_to_real,second_int_to_fix,second_real_to_real,
second_chararray_to_string,
second_proc_to_procvar,
{ is constant char to pchar, is done by firstpass }
second_nothing,
second_load_smallset,
second_ansistring_to_pchar,
second_pchar_to_string,
second_nothing);
{$endif}
var
oldrl,oldlrl : plinkedlist;
begin
{ the ansi string disposing is a little bit hairy: }
oldrl:=temptoremove;
@ -1624,7 +1263,10 @@ implementation
end.
{
$Log$
Revision 1.59 1999-03-01 15:46:18 peter
Revision 1.60 1999-03-02 18:24:19 peter
* fixed overloading of array of char
Revision 1.59 1999/03/01 15:46:18 peter
* ag386bin finally make cycles correct
* prefixes are now also normal opcodes

176
compiler/htypechk.pas
View File

@ -35,7 +35,7 @@ interface
{ Conversion }
function isconvertable(def_from,def_to : pdef;
var doconv : tconverttype;fromtreetype : ttreetyp;
explicit : boolean) : boolean;
explicit : boolean) : byte;
{ Register Allocation }
procedure make_not_regable(p : ptree);
@ -62,10 +62,14 @@ implementation
Convert
****************************************************************************}
{ Returns:
0 - Not convertable
1 - Convertable
2 - Convertable, but not first choice }
function isconvertable(def_from,def_to : pdef;
var doconv : tconverttype;fromtreetype : ttreetyp;
explicit : boolean) : boolean;
{$ifndef OLDCNV}
explicit : boolean) : byte;
{ Tbasetype: uauto,uvoid,uchar,
u8bit,u16bit,u32bit,
s8bit,s16bit,s32,
@ -85,83 +89,19 @@ implementation
(tc_not_possible,tc_equal,tc_not_possible,tc_not_possible),
(tc_not_possible,tc_not_possible,tc_int_2_int,tc_int_2_bool),
(tc_not_possible,tc_not_possible,tc_bool_2_int,tc_int_2_bool));
{$else}
const
basedefconverts : array[tbasetype,tbasetype] of tconverttype =
{uauto}
((tc_not_possible,tc_not_possible,tc_not_possible,
tc_not_possible,tc_not_possible,tc_not_possible,
tc_not_possible,tc_not_possible,tc_not_possible,
tc_not_possible,tc_not_possible,tc_not_possible),
{uvoid}
(tc_not_possible,tc_not_possible,tc_not_possible,
tc_not_possible,tc_not_possible,tc_not_possible,
tc_not_possible,tc_not_possible,tc_not_possible,
tc_not_possible,tc_not_possible,tc_not_possible),
{uchar}
(tc_not_possible,tc_not_possible,tc_only_rangechecks32bit,
tc_not_possible,tc_not_possible,tc_not_possible,
tc_not_possible,tc_not_possible,tc_not_possible,
tc_not_possible,tc_not_possible,tc_not_possible),
{u8bit}
(tc_not_possible,tc_not_possible,tc_not_possible,
tc_only_rangechecks32bit,tc_u8bit_2_u16bit,tc_u8bit_2_u32bit,
tc_only_rangechecks32bit,tc_u8bit_2_s16bit,tc_u8bit_2_s32bit,
tc_int_2_bool,tc_int_2_bool,tc_int_2_bool),
{u16bit}
(tc_not_possible,tc_not_possible,tc_not_possible,
tc_u16bit_2_u8bit,tc_only_rangechecks32bit,tc_u16bit_2_u32bit,
tc_u16bit_2_s8bit,tc_only_rangechecks32bit,tc_u16bit_2_s32bit,
tc_int_2_bool,tc_int_2_bool,tc_int_2_bool),
{u32bit}
(tc_not_possible,tc_not_possible,tc_not_possible,
tc_u32bit_2_u8bit,tc_u32bit_2_u16bit,tc_only_rangechecks32bit,
tc_u32bit_2_s8bit,tc_u32bit_2_s16bit,tc_only_rangechecks32bit,
tc_int_2_bool,tc_int_2_bool,tc_int_2_bool),
{s8bit}
(tc_not_possible,tc_not_possible,tc_not_possible,
tc_only_rangechecks32bit,tc_s8bit_2_u16bit,tc_s8bit_2_u32bit,
tc_only_rangechecks32bit,tc_s8bit_2_s16bit,tc_s8bit_2_s32bit,
tc_int_2_bool,tc_int_2_bool,tc_int_2_bool),
{s16bit}
(tc_not_possible,tc_not_possible,tc_not_possible,
tc_s16bit_2_u8bit,tc_only_rangechecks32bit,tc_s16bit_2_u32bit,
tc_s16bit_2_s8bit,tc_only_rangechecks32bit,tc_s16bit_2_s32bit,
tc_int_2_bool,tc_int_2_bool,tc_int_2_bool),
{s32bit}
(tc_not_possible,tc_not_possible,tc_not_possible,
tc_s32bit_2_u8bit,tc_s32bit_2_u16bit,tc_only_rangechecks32bit,
tc_s32bit_2_s8bit,tc_s32bit_2_s16bit,tc_only_rangechecks32bit,
tc_int_2_bool,tc_int_2_bool,tc_int_2_bool),
{bool8bit}
(tc_not_possible,tc_not_possible,tc_not_possible,
tc_bool_2_int,tc_bool_2_int,tc_bool_2_int,
tc_bool_2_int,tc_bool_2_int,tc_bool_2_int,
tc_only_rangechecks32bit,tc_int_2_bool,tc_int_2_bool),
{bool16bit}
(tc_not_possible,tc_not_possible,tc_not_possible,
tc_bool_2_int,tc_bool_2_int,tc_bool_2_int,
tc_bool_2_int,tc_bool_2_int,tc_bool_2_int,
tc_int_2_bool,tc_only_rangechecks32bit,tc_int_2_bool),
{bool32bit}
(tc_not_possible,tc_not_possible,tc_not_possible,
tc_bool_2_int,tc_bool_2_int,tc_bool_2_int,
tc_bool_2_int,tc_bool_2_int,tc_bool_2_int,
tc_int_2_bool,tc_int_2_bool,tc_only_rangechecks32bit));
{$endif}
var
b : boolean;
b : byte;
hd1,hd2 : pdef;
begin
{ safety check }
if not(assigned(def_from) and assigned(def_to)) then
begin
isconvertable:=false;
isconvertable:=0;
exit;
end;
b:=false;
b:=0;
{ we walk the wanted (def_to) types and check then the def_from
types if there is a conversion possible }
case def_to^.deftype of
@ -170,9 +110,8 @@ implementation
case def_from^.deftype of
orddef :
begin
{$ifndef OLDCNV}
doconv:=basedefconverts[basedeftbl[porddef(def_from)^.typ],basedeftbl[porddef(def_to)^.typ]];
b:=true;
b:=1;
if (doconv=tc_not_possible) or
((doconv=tc_int_2_bool) and
(not explicit) and
@ -180,24 +119,13 @@ implementation
((doconv=tc_bool_2_int) and
(not explicit) and
(not is_boolean(def_to))) then
b:=false;
{$else}
doconv:=basedefconverts[porddef(def_from)^.typ,porddef(def_to)^.typ];
b:=true;
if (doconv=tc_not_possible) or
((doconv=tc_int_2_bool) and
(not explicit) and
(not is_boolean(def_from))) then
b:=false;
{$endif}
b:=0;
end;
{$ifndef OLDCNV}
enumdef :
begin
doconv:=tc_int_2_int;
b:=true;
b:=1;
end;
{$endif}
end;
end;
@ -206,14 +134,14 @@ implementation
case def_from^.deftype of
stringdef : begin
doconv:=tc_string_2_string;
b:=true;
b:=1;
end;
orddef : begin
{ char to string}
if is_char(def_from) then
begin
doconv:=tc_char_2_string;
b:=true;
b:=1;
end;
end;
arraydef : begin
@ -221,7 +149,13 @@ implementation
if is_equal(parraydef(def_from)^.definition,cchardef) then
begin
doconv:=tc_chararray_2_string;
b:=true;
if (not(cs_ansistrings in aktlocalswitches) and
is_shortstring(def_to)) or
((cs_ansistrings in aktlocalswitches) and
is_ansistring(def_to)) then
b:=1
else
b:=2;
end;
end;
pointerdef : begin
@ -229,7 +163,7 @@ implementation
if is_pchar(def_from) and not(m_tp in aktmodeswitches) then
begin
doconv:=tc_pchar_2_string;
b:=true;
b:=1;
end;
end;
end;
@ -245,7 +179,7 @@ implementation
doconv:=tc_int_2_fix
else
doconv:=tc_int_2_real;
b:=true;
b:=1;
end;
end;
floatdef : begin { 2 float types ? }
@ -268,7 +202,7 @@ implementation
CGMessage(type_w_convert_real_2_comp);
{$endif}
end;
b:=true;
b:=1;
end;
end;
end;
@ -285,7 +219,8 @@ implementation
hd2:=penumdef(def_to)^.basedef
else
hd2:=def_to;
b:=(hd1=hd2);
if (hd1=hd2) then
b:=1;
end;
end;
@ -296,7 +231,7 @@ implementation
is_equal(parraydef(def_to)^.definition,def_from) then
begin
doconv:=tc_equal;
b:=true;
b:=1;
end
else
begin
@ -306,7 +241,7 @@ implementation
is_equal(ppointerdef(def_from)^.definition,parraydef(def_to)^.definition) then
begin
doconv:=tc_pointer_2_array;
b:=true;
b:=1;
end;
end;
stringdef : begin
@ -314,7 +249,7 @@ implementation
if is_equal(parraydef(def_to)^.definition,cchardef) then
begin
doconv:=tc_string_2_chararray;
b:=true;
b:=1;
end;
end;
end;
@ -330,7 +265,7 @@ implementation
is_pchar(def_to) then
begin
doconv:=tc_cstring_2_pchar;
b:=true;
b:=1;
end;
end;
orddef : begin
@ -339,7 +274,7 @@ implementation
is_pchar(def_to) then
begin
doconv:=tc_cchar_2_pchar;
b:=true;
b:=1;
end;
end;
arraydef : begin
@ -348,7 +283,7 @@ implementation
is_equal(parraydef(def_from)^.definition,ppointerdef(def_to)^.definition) then
begin
doconv:=tc_array_2_pointer;
b:=true;
b:=1;
end;
end;
pointerdef : begin
@ -366,7 +301,7 @@ implementation
is_equal(ppointerdef(def_from)^.definition,voiddef) then
begin
doconv:=tc_equal;
b:=true;
b:=1;
end;
end;
procvardef : begin
@ -377,7 +312,7 @@ implementation
(porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
begin
doconv:=tc_equal;
b:=true;
b:=1;
end;
end;
classrefdef,
@ -392,7 +327,7 @@ implementation
(porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
begin
doconv:=tc_equal;
b:=true;
b:=1;
end;
end;
end;
@ -404,7 +339,7 @@ implementation
if (def_from^.deftype=arraydef) and (parraydef(def_from)^.IsConstructor) then
begin
doconv:=tc_arrayconstructor_2_set;
b:=true;
b:=1;
end;
end;
@ -415,7 +350,8 @@ implementation
begin
def_from^.deftype:=procvardef;
doconv:=tc_proc_2_procvar;
b:=is_equal(def_from,def_to);
if is_equal(def_from,def_to) then
b:=1;
def_from^.deftype:=procdef;
end
else
@ -427,14 +363,14 @@ implementation
(porddef(ppointerdef(def_from)^.definition)^.typ=uvoid) then
begin
doconv:=tc_equal;
b:=true;
b:=1;
end
else
{ nil is compatible with procvars }
if (fromtreetype=niln) then
begin
doconv:=tc_equal;
b:=true;
b:=1;
end;
end;
@ -445,14 +381,15 @@ implementation
pobjectdef(def_from)^.isclass and pobjectdef(def_to)^.isclass }then
begin
doconv:=tc_equal;
b:=pobjectdef(def_from)^.isrelated(pobjectdef(def_to));
if pobjectdef(def_from)^.isrelated(pobjectdef(def_to)) then
b:=1;
end
else
{ nil is compatible with class instances }
if (fromtreetype=niln) and (pobjectdef(def_to)^.isclass) then
begin
doconv:=tc_equal;
b:=true;
b:=1;
end;
end;
@ -462,15 +399,16 @@ implementation
if (def_from^.deftype=classrefdef) then
begin
doconv:=tc_equal;
b:=pobjectdef(pclassrefdef(def_from)^.definition)^.isrelated(
pobjectdef(pclassrefdef(def_to)^.definition));
if pobjectdef(pclassrefdef(def_from)^.definition)^.isrelated(
pobjectdef(pclassrefdef(def_to)^.definition)) then
b:=1;
end
else
{ nil is compatible with class references }
if (fromtreetype=niln) then
begin
doconv:=tc_equal;
b:=true;
b:=1;
end;
end;
@ -506,7 +444,7 @@ implementation
) then
begin
doconv:=tc_equal;
b:=true;
b:=1;
end
end;
@ -514,7 +452,7 @@ implementation
begin
{ assignment overwritten ?? }
if is_assignment_overloaded(def_from,def_to) then
b:=true;
b:=1;
end;
end;
@ -524,7 +462,7 @@ implementation
and (pstringdef(def_to)^.string_typ in [st_ansistring,st_widestring]) then
begin
doconv:=tc_equal;
b:=true;
b:=1;
end
else
}
@ -537,7 +475,7 @@ implementation
(porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
begin
doconv:=tc_equal;
b:=true;
b:=1;
end
else
}
@ -549,7 +487,7 @@ implementation
(porddef(ppointerdef(def_to)^.definition)^.typ=uchar) then
begin
doconv:=tc_ansistring_2_pchar;
b:=true;
b:=1;
end
else
}
@ -706,8 +644,7 @@ implementation
while passproc<>nil do
begin
if is_equal(passproc^.retdef,to_def) and
isconvertable(from_def,passproc^.para1^.data,convtyp,
ordconstn { nur Dummy},false ) then
(isconvertable(from_def,passproc^.para1^.data,convtyp,ordconstn,false)=1) then
begin
is_assignment_overloaded:=true;
break;
@ -719,7 +656,10 @@ implementation
end.
{
$Log$
Revision 1.16 1999-01-27 13:53:27 pierre
Revision 1.17 1999-03-02 18:24:20 peter
* fixed overloading of array of char
Revision 1.16 1999/01/27 13:53:27 pierre
htypechk.pas
Revision 1.15 1999/01/27 13:12:10 pierre

6
compiler/symdefh.inc
View File

@ -103,6 +103,7 @@
next : pdefcoll;
paratyp : tvarspez;
argconvtyp : targconvtyp;
convertlevel : byte;
end;
tfiletype = (ft_text,ft_typed,ft_untyped);
@ -504,7 +505,10 @@
{
$Log$
Revision 1.17 1999-03-01 13:45:06 pierre
Revision 1.18 1999-03-02 18:24:21 peter
* fixed overloading of array of char
Revision 1.17 1999/03/01 13:45:06 pierre
+ added staticppusymtable symtable type for local browsing
Revision 1.16 1999/02/22 20:13:39 florian

230
compiler/tccal.pas
View File

@ -517,37 +517,22 @@ implementation
pd:=aktcallprocsym^.definition;
while assigned(pd) do
begin
{ we should also check that the overloaded function
has been declared in a unit that is in the uses !! }
{ pd^.owner should be in the symtablestack !! }
{ Laenge der deklarierten Parameterliste feststellen: }
{ not necessary why nextprocsym field }
{st:=symtablestack;
if (pd^.owner^.symtabletype<>objectsymtable) then
while assigned(st) do
begin
if (st=pd^.owner) then break;
st:=st^.next;
end;
if assigned(st) then }
pdc:=pd^.para1;
l:=0;
while assigned(pdc) do
begin
pdc:=pd^.para1;
l:=0;
while assigned(pdc) do
begin
inc(l);
pdc:=pdc^.next;
end;
{ only when the # of parameter are equal }
if (l=paralength) then
begin
new(hp);
hp^.data:=pd;
hp^.next:=procs;
hp^.nextpara:=pd^.para1;
hp^.firstpara:=pd^.para1;
procs:=hp;
end;
inc(l);
pdc:=pdc^.next;
end;
{ only when the # of parameter are equal }
if (l=paralength) then
begin
new(hp);
hp^.data:=pd;
hp^.next:=procs;
hp^.nextpara:=pd^.para1;
hp^.firstpara:=pd^.para1;
procs:=hp;
end;
pd:=pd^.nextoverloaded;
end;
@ -570,7 +555,15 @@ implementation
while assigned(pt) do
begin
dec(l);
{ matches a parameter of one procedure exact ? }
{ walk all procedures and determine how this parameter matches and set:
1. pt^.exact_match_found if one parameter has an exact match
2. exactmatch if an equal or exact match is found
3. para^.argconvtyp to exact,equal or convertable
(when convertable then also convertlevel is set)
4. pt^.convlevel1found if there is a convertlevel=1
5. pt^.convlevel2found if there is a convertlevel=2
}
exactmatch:=false;
hp:=procs;
while assigned(hp) do
@ -587,61 +580,57 @@ implementation
exactmatch:=true;
end
else
hp^.nextpara^.argconvtyp:=act_convertable;
begin
hp^.nextpara^.argconvtyp:=act_convertable;
hp^.nextpara^.convertlevel:=isconvertable(pt^.resulttype,hp^.nextpara^.data,
hcvt,pt^.left^.treetype,false);
case hp^.nextpara^.convertlevel of
1 : pt^.convlevel1found:=true;
2 : pt^.convlevel2found:=true;
end;
end;
hp:=hp^.next;
end;
{ .... if yes, del all the other procedures }
{ If there was an exactmatch then delete all convertables }
if exactmatch then
begin
{ the first .... }
while (assigned(procs)) and not(is_equal(pt,procs^.nextpara^.data)) do
begin
hp:=procs^.next;
dispose(procs);
procs:=hp;
end;
{ and the others }
hp:=procs;
while (assigned(hp)) and assigned(hp^.next) do
begin
if not(is_equal(pt,hp^.next^.nextpara^.data)) then
begin
hp2:=hp^.next^.next;
dispose(hp^.next);
hp^.next:=hp2;
end
else
hp:=hp^.next;
end;
hp:=procs;
procs:=nil;
while assigned(hp) do
begin
hp2:=hp^.next;
{ keep if not convertable }
if (hp^.nextpara^.argconvtyp<>act_convertable) then
begin
hp^.next:=procs;
procs:=hp;
end
else
dispose(hp);
hp:=hp2;
end;
end
{ when a parameter matches exact, remove all procs
which need typeconvs }
else
{ No exact match was found, remove all procedures that are
not convertable (convertlevel=0) }
begin
{ the first... }
while (assigned(procs)) and
not(isconvertable(pt^.resulttype,procs^.nextpara^.data,
hcvt,pt^.left^.treetype,false)) do
begin
hp:=procs^.next;
dispose(procs);
procs:=hp;
end;
{ and the others }
hp:=procs;
while (assigned(hp)) and assigned(hp^.next) do
begin
if not(isconvertable(pt^.resulttype,hp^.next^.nextpara^.data,
hcvt,pt^.left^.treetype,false)) then
begin
hp2:=hp^.next^.next;
dispose(hp^.next);
hp^.next:=hp2;
end
else
hp:=hp^.next;
end;
hp:=procs;
procs:=nil;
while assigned(hp) do
begin
hp2:=hp^.next;
{ keep if not convertable }
if (hp^.nextpara^.convertlevel<>0) then
begin
hp^.next:=procs;
procs:=hp;
end
else
dispose(hp);
hp:=hp2;
end;
end;
{ update nextpara for all procedures }
hp:=procs;
@ -657,6 +646,8 @@ implementation
pt:=nil;
end;
{ All parameters are checked, check if there are any
procedures left }
if not assigned(procs) then
begin
{ there is an error, must be wrong type, because
@ -769,17 +760,18 @@ implementation
end;
end;
{ reset nextpara for all procs left }
hp:=procs;
while assigned(hp) do
begin
hp^.nextpara:=hp^.firstpara;
hp:=hp^.next;
end;
{ let's try to eliminate equal is exact is there }
if assigned(procs^.next) then
{ let's try to eliminate equal if there is an exact match
is there }
if assigned(procs) and assigned(procs^.next) then
begin
{ reset nextpara for all procs left }
hp:=procs;
while assigned(hp) do
begin
hp^.nextpara:=hp^.firstpara;
hp:=hp^.next;
end;
pt:=p^.left;
while assigned(pt) do
begin
@ -791,15 +783,13 @@ implementation
begin
hp2:=hp^.next;
{ keep the exact matches, dispose the others }
if (hp^.nextpara^.data=pt^.resulttype) then
if (hp^.nextpara^.argconvtyp=act_exact) then
begin
hp^.next:=procs;
procs:=hp;
end
else
begin
dispose(hp);
end;
dispose(hp);
hp:=hp2;
end;
end;
@ -814,10 +804,59 @@ implementation
end;
end;
if assigned(procs^.next) then
{ Check if there are convertlevel 1 and 2 differences
left for the parameters, then discard all convertlevel
2 procedures. The value of convlevelXfound can still
be used, because all convertables are still here or
not }
if assigned(procs) and assigned(procs^.next) then
begin
{ reset nextpara for all procs left }
hp:=procs;
while assigned(hp) do
begin
hp^.nextpara:=hp^.firstpara;
hp:=hp^.next;
end;
pt:=p^.left;
while assigned(pt) do
begin
if pt^.convlevel1found and pt^.convlevel2found then
begin
hp:=procs;
procs:=nil;
while assigned(hp) do
begin
hp2:=hp^.next;
{ keep all not act_convertable and all convertlevels=1 }
if (hp^.nextpara^.argconvtyp<>act_convertable) or
(hp^.nextpara^.convertlevel=1) then
begin
hp^.next:=procs;
procs:=hp;
end
else
dispose(hp);
hp:=hp2;
end;
end;
{ update nextpara for all procedures }
hp:=procs;
while assigned(hp) do
begin
hp^.nextpara:=hp^.nextpara^.next;
hp:=hp^.next;
end;
pt:=pt^.right;
end;
end;
if not(assigned(procs)) or assigned(procs^.next) then
begin
CGMessage(cg_e_cant_choose_overload_function);
aktcallprocsym^.write_parameter_lists;
exit;
end;
{$ifdef TEST_PROCSYMS}
if (procs=nil) and assigned(nextprocsym) then
@ -1078,7 +1117,10 @@ implementation
end.
{
$Log$
Revision 1.25 1999-02-22 15:09:44 florian
Revision 1.26 1999-03-02 18:24:22 peter
* fixed overloading of array of char
Revision 1.25 1999/02/22 15:09:44 florian
* behaviaor of PROTECTED and PRIVATE fixed, works now like TP/Delphi
Revision 1.24 1999/02/22 02:15:45 peter

81
compiler/tccnv.pas
View File

@ -239,8 +239,6 @@ implementation
type
tfirstconvproc = procedure(var p : ptree);
{$ifndef OLDCNV}
procedure first_int_to_int(var p : ptree);
begin
if (p^.registers32=0) and
@ -252,14 +250,6 @@ implementation
end;
end;
{$else}
procedure first_bigger_smaller(var p : ptree);
begin
if (p^.left^.location.loc<>LOC_REGISTER) and (p^.registers32=0) then
p^.registers32:=1;
p^.location.loc:=LOC_REGISTER;
end;
{$endif}
procedure first_cstring_to_pchar(var p : ptree);
begin
@ -454,51 +444,29 @@ implementation
end;
{$ifdef OLDCNV}
procedure first_locmem(var p : ptree);
begin
p^.location.loc:=LOC_MEM;
end;
{$endif}
procedure first_bool_to_int(var p : ptree);
begin
{$ifndef OLDBOOL}
{ byte(boolean) or word(wordbool) or longint(longbool) must
be accepted for var parameters }
if (p^.explizit) and
(p^.left^.resulttype^.size=p^.resulttype^.size) and
(p^.left^.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
exit;
{$endif ndef OLDBOOL}
p^.location.loc:=LOC_REGISTER;
{ Florian I think this is overestimated
but I still do not really understand how to get this right (PM) }
{ Hmmm, I think we need only one reg to return the result of }
{ this node => so }
if p^.registers32<1 then
p^.registers32:=1;
{ should work (FK)
p^.registers32:=p^.left^.registers32+1;}
end;
procedure first_int_to_bool(var p : ptree);
begin
{$ifndef OLDBOOL}
{ byte(boolean) or word(wordbool) or longint(longbool) must
be accepted for var parameters }
if (p^.explizit) and
(p^.left^.resulttype^.size=p^.resulttype^.size) and
(p^.left^.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
exit;
{$endif ndef OLDBOOL}
p^.location.loc:=LOC_REGISTER;
{ Florian I think this is overestimated
but I still do not really understand how to get this right (PM) }
{ Hmmm, I think we need only one reg to return the result of }
{ this node => so }
p^.left:=gentypeconvnode(p^.left,s32bitdef);
{ need if bool to bool !!
not very nice !! }
@ -506,9 +474,6 @@ implementation
firstpass(p^.left);
if p^.registers32<1 then
p^.registers32:=1;
{ p^.resulttype:=booldef; }
{ should work (FK)
p^.registers32:=p^.left^.registers32+1;}
end;
@ -570,7 +535,6 @@ implementation
proctype : tdeftype;
const
firstconvert : array[tconverttype] of tfirstconvproc = (
{$ifndef OLDCNV}
first_nothing, {equal}
first_nothing, {not_possible}
first_string_to_string,
@ -595,34 +559,6 @@ implementation
first_arrayconstructor_to_set,
first_load_smallset
);
{$else}
first_nothing,first_nothing,
first_bigger_smaller,first_nothing,first_bigger_smaller,
first_bigger_smaller,first_bigger_smaller,
first_bigger_smaller,first_bigger_smaller,
first_bigger_smaller,first_string_to_string,
first_cstring_to_pchar,first_string_to_chararray,
first_array_to_pointer,first_pointer_to_array,
first_char_to_string,first_bigger_smaller,
first_bigger_smaller,first_bigger_smaller,
first_bigger_smaller,first_bigger_smaller,
first_bigger_smaller,first_bigger_smaller,
first_bigger_smaller,first_bigger_smaller,
first_bigger_smaller,first_bigger_smaller,
first_bigger_smaller,first_bigger_smaller,
first_bigger_smaller,first_bigger_smaller,
first_bigger_smaller,first_bigger_smaller,
first_bigger_smaller,first_bigger_smaller,
first_bool_to_int,first_int_to_bool,
first_int_to_real,first_real_to_fix,
first_fix_to_real,first_int_to_fix,first_real_to_real,
first_locmem,first_proc_to_procvar,
first_cchar_to_pchar,
first_load_smallset,
first_ansistring_to_pchar,
first_pchar_to_string,
first_arrayconstructor_to_set);
{$endif}
begin
aprocdef:=nil;
{ if explicite type cast, then run firstpass }
@ -695,8 +631,7 @@ implementation
exit;
end;
if (not(isconvertable(p^.left^.resulttype,p^.resulttype,
p^.convtyp,p^.left^.treetype,p^.explizit))) then
if isconvertable(p^.left^.resulttype,p^.resulttype,p^.convtyp,p^.left^.treetype,p^.explizit)=0 then
begin
{Procedures have a resulttype of voiddef and functions of their
own resulttype. They will therefore always be incompatible with
@ -823,8 +758,7 @@ implementation
end
else
begin
if not isconvertable(s32bitdef,p^.resulttype,p^.convtyp,
ordconstn { only Dummy},false ) then
if isconvertable(s32bitdef,p^.resulttype,p^.convtyp,ordconstn,false)=0 then
CGMessage(cg_e_illegal_type_conversion);
end;
@ -844,8 +778,7 @@ implementation
end
else
begin
if not isconvertable(p^.left^.resulttype,s32bitdef,p^.convtyp,
ordconstn { nur Dummy},false ) then
if IsConvertable(p^.left^.resulttype,s32bitdef,p^.convtyp,ordconstn,false)=0 then
CGMessage(cg_e_illegal_type_conversion);
end;
end
@ -866,8 +799,7 @@ implementation
begin
{ this is wrong because it converts to a 4 byte long var !!
if not isconvertable(p^.left^.resulttype,s32bitdef,p^.convtyp,ordconstn nur Dummy ) then }
if not isconvertable(p^.left^.resulttype,u8bitdef,
p^.convtyp,ordconstn { nur Dummy},false ) then
if IsConvertable(p^.left^.resulttype,u8bitdef,p^.convtyp,ordconstn,false)=0 then
CGMessage(cg_e_illegal_type_conversion);
end;
end
@ -979,7 +911,10 @@ implementation
end.
{
$Log$
Revision 1.19 1999-02-22 02:15:46 peter
Revision 1.20 1999-03-02 18:24:23 peter
* fixed overloading of array of char
Revision 1.19 1999/02/22 02:15:46 peter
* updates for ag386bin
Revision 1.18 1999/01/27 14:56:57 pierre

13
compiler/tcmem.pas
View File

@ -381,11 +381,9 @@ implementation
{ range check only for arrays }
if (p^.left^.resulttype^.deftype=arraydef) then
begin
if not(isconvertable(p^.right^.resulttype,
parraydef(p^.left^.resulttype)^.rangedef,
ct,ordconstn,false)) and
not(is_equal(p^.right^.resulttype,
parraydef(p^.left^.resulttype)^.rangedef)) then
if (isconvertable(p^.right^.resulttype,parraydef(p^.left^.resulttype)^.rangedef,
ct,ordconstn,false)=0) and
not(is_equal(p^.right^.resulttype,parraydef(p^.left^.resulttype)^.rangedef)) then
CGMessage(type_e_mismatch);
end;
{ Never convert a boolean or a char !}
@ -557,7 +555,10 @@ implementation
end.
{
$Log$
Revision 1.11 1999-02-22 02:15:54 peter
Revision 1.12 1999-03-02 18:24:24 peter
* fixed overloading of array of char
Revision 1.11 1999/02/22 02:15:54 peter
* updates for ag386bin
Revision 1.10 1999/02/04 11:44:47 florian

37
compiler/tree.pas
View File

@ -131,7 +131,6 @@ unit tree;
loadvmtn
);
{$ifndef OLDCNV}
tconverttype = (
tc_equal,
tc_not_possible,
@ -157,32 +156,6 @@ unit tree;
tc_arrayconstructor_2_set,
tc_load_smallset
);
{$else}
tconverttype = (tc_equal,tc_not_possible,tc_u8bit_2_s32bit,
tc_only_rangechecks32bit,tc_s8bit_2_s32bit,
tc_u16bit_2_s32bit,tc_s16bit_2_s32bit,
tc_s32bit_2_s16bit,tc_s32bit_2_u8bit,
tc_s32bit_2_u16bit,tc_string_2_string,
tc_cstring_2_pchar,tc_string_2_chararray,
tc_array_2_pointer,tc_pointer_2_array,
tc_char_2_string,tc_u8bit_2_s16bit,
tc_u8bit_2_u16bit,tc_s8bit_2_s16bit,
tc_s16bit_2_s8bit,tc_s16bit_2_u8bit,
tc_u16bit_2_s8bit,tc_u16bit_2_u8bit,
tc_s8bit_2_u16bit,tc_s32bit_2_s8bit,
tc_s32bit_2_u32bit,tc_s16bit_2_u32bit,
tc_s8bit_2_u32bit,tc_u16bit_2_u32bit,
tc_u8bit_2_u32bit,tc_u32bit_2_s32bit,
tc_u32bit_2_s8bit,tc_u32bit_2_u8bit,
tc_u32bit_2_s16bit,tc_u32bit_2_u16bit,
tc_bool_2_int,tc_int_2_bool,
tc_int_2_real,tc_real_2_fix,
tc_fix_2_real,tc_int_2_fix,tc_real_2_real,
tc_chararray_2_string,
tc_proc_2_procvar,tc_cchar_2_pchar,tc_load_smallset,
tc_ansistring_2_pchar,tc_pchar_2_string,
tc_arrayconstructor_2_set);
{$endif}
{ allows to determine which elementes are to be replaced }
tdisposetyp = (dt_nothing,dt_leftright,dt_left,dt_leftrighthigh,
@ -237,7 +210,8 @@ unit tree;
{$endif extdebug}
case treetype : ttreetyp of
addn : (use_strconcat : boolean;string_typ : tstringtype);
callparan : (is_colon_para : boolean;exact_match_found : boolean;hightree:ptree);
callparan : (is_colon_para : boolean;exact_match_found,
convlevel1found,convlevel2found:boolean;hightree:ptree);
assignn : (assigntyp : tassigntyp;concat_string : boolean);
loadn : (symtableentry : psym;symtable : psymtable;
is_absolute,is_first : boolean);
@ -657,6 +631,8 @@ unit tree;
p^.registersfpu:=0;
p^.resulttype:=nil;
p^.exact_match_found:=false;
p^.convlevel1found:=false;
p^.convlevel2found:=false;
p^.is_colon_para:=false;
p^.hightree:=nil;
set_file_line(expr,p);
@ -1669,7 +1645,10 @@ unit tree;
end.
{
$Log$
Revision 1.67 1999-02-25 21:02:56 peter
Revision 1.68 1999-03-02 18:24:25 peter
* fixed overloading of array of char
Revision 1.67 1999/02/25 21:02:56 peter
* ag386bin updates
+ coff writer