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

* merged from 0_99_12 branch

Browse Source
This commit is contained in:
pierre 1999-06-17 13:19:50 +00:00
parent 53dfbeb145
commit e8da115c3f
8 changed files with 117 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
compiler/cgai386.pas
View File

@ -2801,8 +2801,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin begin
if procinfo.retdef<>pdef(voiddef) then if procinfo.retdef<>pdef(voiddef) then
begin begin
if (procinfo.flags and pi_operator)<>0 then if ((procinfo.flags and pi_operator)<>0) and
procinfo.funcret_is_valid:=opsym^.refs>0; assigned(opsym) then
procinfo.funcret_is_valid:=
procinfo.funcret_is_valid or (opsym^.refs>0);
if not(procinfo.funcret_is_valid) and not inlined { and if not(procinfo.funcret_is_valid) and not inlined { and
((procinfo.flags and pi_uses_asm)=0)} then ((procinfo.flags and pi_uses_asm)=0)} then
CGMessage(sym_w_function_result_not_set); CGMessage(sym_w_function_result_not_set);
@ -3086,7 +3088,13 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
end. end.
{ {
$Log$ $Log$
Revision 1.6 1999-06-14 17:47:48 peter Revision 1.7 1999-06-17 13:19:50 pierre
* merged from 0_99_12 branch
Revision 1.5.2.2 1999/06/17 12:38:39 pierre
* wrong warning for operators removed
Revision 1.6 1999/06/14 17:47:48 peter
* merged * merged
Revision 1.5.2.1 1999/06/14 17:27:08 peter Revision 1.5.2.1 1999/06/14 17:27:08 peter

23
compiler/htypechk.pas
View File

@ -50,7 +50,7 @@ interface
function valid_for_formal_const(p : ptree) : boolean; function valid_for_formal_const(p : ptree) : boolean;
function is_procsym_load(p:Ptree):boolean; function is_procsym_load(p:Ptree):boolean;
function is_procsym_call(p:Ptree):boolean; function is_procsym_call(p:Ptree):boolean;
function is_assignment_overloaded(from_def,to_def : pdef) : boolean; function assignment_overloaded(from_def,to_def : pdef) : pprocdef;
implementation implementation
@ -460,7 +460,7 @@ implementation
else else
begin begin
{ assignment overwritten ?? } { assignment overwritten ?? }
if is_assignment_overloaded(def_from,def_to) then if assigned(assignment_overloaded(def_from,def_to)) then
b:=2; b:=2;
end; end;
end; end;
@ -636,12 +636,12 @@ implementation
end; end;
function is_assignment_overloaded(from_def,to_def : pdef) : boolean; function assignment_overloaded(from_def,to_def : pdef) : pprocdef;
var var
passproc : pprocdef; passproc : pprocdef;
convtyp : tconverttype; convtyp : tconverttype;
begin begin
is_assignment_overloaded:=false; assignment_overloaded:=nil;
if assigned(overloaded_operators[assignment]) then if assigned(overloaded_operators[assignment]) then
passproc:=overloaded_operators[assignment]^.definition passproc:=overloaded_operators[assignment]^.definition
else else
@ -649,9 +649,10 @@ implementation
while passproc<>nil do while passproc<>nil do
begin begin
if is_equal(passproc^.retdef,to_def) and if is_equal(passproc^.retdef,to_def) and
(isconvertable(from_def,passproc^.para1^.data,convtyp,ordconstn,false)=1) then (is_equal(passproc^.para1^.data,from_def) or
(isconvertable(from_def,passproc^.para1^.data,convtyp,ordconstn,false)=1)) then
begin begin
is_assignment_overloaded:=true; assignment_overloaded:=passproc;
break; break;
end; end;
passproc:=passproc^.nextoverloaded; passproc:=passproc^.nextoverloaded;
@ -661,7 +662,15 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.27 1999-06-01 19:27:47 peter Revision 1.28 1999-06-17 13:19:51 pierre
* merged from 0_99_12 branch
Revision 1.27.2.1 1999/06/17 12:51:42 pierre
* changed is_assignment_overloaded into
function assignment_overloaded : pprocdef
to allow overloading of assignment with only different result type
Revision 1.27 1999/06/01 19:27:47 peter
* better checks for procvar and methodpointer * better checks for procvar and methodpointer
Revision 1.26 1999/05/20 14:58:26 peter Revision 1.26 1999/05/20 14:58:26 peter

13
compiler/pexpr.pas
View File

@ -838,6 +838,9 @@ unit pexpr;
(not ((m_tp in aktmodeswitches) and (not ((m_tp in aktmodeswitches) and
(afterassignment or in_args))) then (afterassignment or in_args))) then
begin begin
if ((pvarsym(sym)=opsym) and
((p^.flags and pi_operator)<>0)) then
inc(opsym^.refs);
p1:=genzeronode(funcretn); p1:=genzeronode(funcretn);
pd:=p^.retdef; pd:=p^.retdef;
p1^.funcretprocinfo:=p; p1^.funcretprocinfo:=p;
@ -2024,7 +2027,15 @@ unit pexpr;
end. end.
{ {
$Log$ $Log$
Revision 1.114 1999-06-15 18:58:33 peter Revision 1.115 1999-06-17 13:19:52 pierre
* merged from 0_99_12 branch
Revision 1.112.2.3 1999/06/17 12:51:44 pierre
* changed is_assignment_overloaded into
function assignment_overloaded : pprocdef
to allow overloading of assignment with only different result type
Revision 1.114 1999/06/15 18:58:33 peter
* merged * merged
Revision 1.113 1999/06/13 22:41:05 peter Revision 1.113 1999/06/13 22:41:05 peter

13
compiler/pstatmnt.pas
View File

@ -1158,7 +1158,8 @@ unit pstatmnt;
begin begin
{ the space has been set in the local symtable } { the space has been set in the local symtable }
procinfo.retoffset:=-funcretsym^.address; procinfo.retoffset:=-funcretsym^.address;
if (procinfo.flags and pi_operator)<>0 then if ((procinfo.flags and pi_operator)<>0) and
assigned(opsym) then
{opsym^.address:=procinfo.call_offset; is wrong PM } {opsym^.address:=procinfo.call_offset; is wrong PM }
opsym^.address:=-procinfo.retoffset; opsym^.address:=-procinfo.retoffset;
{ eax is modified by a function } { eax is modified by a function }
@ -1271,7 +1272,15 @@ unit pstatmnt;
end. end.
{ {
$Log$ $Log$
Revision 1.88 1999-06-15 13:19:46 pierre Revision 1.89 1999-06-17 13:19:54 pierre
* merged from 0_99_12 branch
Revision 1.88.2.1 1999/06/17 12:51:46 pierre
* changed is_assignment_overloaded into
function assignment_overloaded : pprocdef
to allow overloading of assignment with only different result type
Revision 1.88 1999/06/15 13:19:46 pierre
* better uninitialized var tests for TP mode * better uninitialized var tests for TP mode
Revision 1.87 1999/05/27 19:44:50 peter Revision 1.87 1999/05/27 19:44:50 peter

33
compiler/psub.pas
View File

@ -355,7 +355,7 @@ begin
{$ifndef UseNiceNames} {$ifndef UseNiceNames}
if assigned(procinfo._class) then if assigned(procinfo._class) then
if (pos('_$$_',procprefix)=0) then if (pos('_$$_',procprefix)=0) then
hs:=procprefix+'_$$_'+procinfo._class^.objname^+'_'+sp hs:=procprefix+'_$$_'+procinfo._class^.objname^+'_$$_'+sp
else else
hs:=procprefix+'_$'+sp; hs:=procprefix+'_$'+sp;
{$else UseNiceNames} {$else UseNiceNames}
@ -582,7 +582,11 @@ begin
procinfo.flags:=procinfo.flags or pi_operator; procinfo.flags:=procinfo.flags or pi_operator;
parse_proc_head(pooperator); parse_proc_head(pooperator);
if token<>ID then if token<>ID then
consume(ID) begin
opsym:=nil;
if not(m_result in aktmodeswitches) then
consume(ID);
end
else else
begin begin
opsym:=new(pvarsym,init(pattern,voiddef)); opsym:=new(pvarsym,init(pattern,voiddef));
@ -604,7 +608,12 @@ begin
orddef) or (porddef(aktprocsym^.definition^. orddef) or (porddef(aktprocsym^.definition^.
retdef)^.typ<>bool8bit)) then retdef)^.typ<>bool8bit)) then
Message(parser_e_comparative_operator_return_boolean); Message(parser_e_comparative_operator_return_boolean);
opsym^.definition:=aktprocsym^.definition^.retdef; if assigned(opsym) then
opsym^.definition:=aktprocsym^.definition^.retdef;
{ We need to add the retrun type in the mangledname
to allow overloading with just different results !! (PM) }
aktprocsym^.definition^.setmangledname(
aktprocsym^.definition^.mangledname+'$$'+hs);
end; end;
end; end;
end; end;
@ -1131,7 +1140,10 @@ begin
while (assigned(pd)) and (assigned(pd^.nextoverloaded)) do while (assigned(pd)) and (assigned(pd^.nextoverloaded)) do
begin begin
if not(m_repeat_forward in aktmodeswitches) or if not(m_repeat_forward in aktmodeswitches) or
equal_paras(aktprocsym^.definition^.para1,pd^.nextoverloaded^.para1,false) then (equal_paras(aktprocsym^.definition^.para1,pd^.nextoverloaded^.para1,false) and
{ for operators equal_paras is not enough !! }
(((aktprocsym^.definition^.options and pooperator)=0) or (optoken<>ASSIGNMENT) or
is_equal(pd^.nextoverloaded^.retdef,aktprocsym^.definition^.retdef))) then
begin begin
if pd^.nextoverloaded^.forwarddef then if pd^.nextoverloaded^.forwarddef then
{ remove the forward definition but don't delete it, } { remove the forward definition but don't delete it, }
@ -1265,7 +1277,8 @@ begin
end; end;
end; end;
{ insert opsym only in the right symtable } { insert opsym only in the right symtable }
if ((procinfo.flags and pi_operator)<>0) and not parse_only then if ((procinfo.flags and pi_operator)<>0) and assigned(opsym)
and not parse_only then
begin begin
if ret_in_param(aktprocsym^.definition^.retdef) then if ret_in_param(aktprocsym^.definition^.retdef) then
begin begin
@ -1779,7 +1792,15 @@ end.
{ {
$Log$ $Log$
Revision 1.1 1999-06-11 13:21:37 peter Revision 1.2 1999-06-17 13:19:56 pierre
* merged from 0_99_12 branch
Revision 1.1.2.1 1999/06/17 12:44:47 pierre
* solve problems related to assignment overloading
* support Delphi syntax for operator
* avoid problems if local procedure in operator
Revision 1.1 1999/06/11 13:21:37 peter
* reinserted * reinserted
Revision 1.153 1999/06/02 22:44:14 pierre Revision 1.153 1999/06/02 22:44:14 pierre

10
compiler/tcadd.pas
View File

@ -109,6 +109,7 @@ implementation
{ overloaded operator ? } { overloaded operator ? }
if (p^.treetype=starstarn) or if (p^.treetype=starstarn) or
(ld^.deftype=recorddef) or (ld^.deftype=recorddef) or
(ld^.deftype=arraydef) or
{ <> and = are defined for classes } { <> and = are defined for classes }
((ld^.deftype=objectdef) and ((ld^.deftype=objectdef) and
(not(pobjectdef(ld)^.isclass) or (not(pobjectdef(ld)^.isclass) or
@ -116,6 +117,7 @@ implementation
) )
) or ) or
(rd^.deftype=recorddef) or (rd^.deftype=recorddef) or
(rd^.deftype=arraydef) or
{ <> and = are defined for classes } { <> and = are defined for classes }
((rd^.deftype=objectdef) and ((rd^.deftype=objectdef) and
(not(pobjectdef(rd)^.isclass) or (not(pobjectdef(rd)^.isclass) or
@ -1094,7 +1096,13 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.34 1999-06-02 10:11:52 florian Revision 1.35 1999-06-17 13:19:57 pierre
* merged from 0_99_12 branch
Revision 1.34.2.1 1999/06/17 12:35:23 pierre
* allow array binary operator overloading if not with orddef
Revision 1.34 1999/06/02 10:11:52 florian
* make cycle fixed i.e. compilation with 0.99.10 * make cycle fixed i.e. compilation with 0.99.10
* some fixes for qword * some fixes for qword
* start of register calling conventions * start of register calling conventions

23
compiler/tccnv.pas
View File

@ -625,11 +625,13 @@ implementation
exit; exit;
end; end;
end; end;
aprocdef:=assignment_overloaded(p^.left^.resulttype,p^.resulttype);
if is_assignment_overloaded(p^.left^.resulttype,p^.resulttype) then if assigned(aprocdef) then
begin begin
procinfo.flags:=procinfo.flags or pi_do_call; procinfo.flags:=procinfo.flags or pi_do_call;
hp:=gencallnode(overloaded_operators[assignment],nil); hp:=gencallnode(overloaded_operators[assignment],nil);
{ tell explicitly which def we must use !! (PM) }
hp^.procdefinition:=aprocdef;
hp^.left:=gencallparanode(p^.left,nil); hp^.left:=gencallparanode(p^.left,nil);
putnode(p); putnode(p);
p:=hp; p:=hp;
@ -809,9 +811,10 @@ implementation
{ possible, if the source is no register } { possible, if the source is no register }
if ((p^.resulttype^.deftype in [recorddef,stringdef,arraydef]) or if ((p^.resulttype^.deftype in [recorddef,stringdef,arraydef]) or
((p^.resulttype^.deftype=objectdef) and not(pobjectdef(p^.resulttype)^.isclass)) ((p^.resulttype^.deftype=objectdef) and not(pobjectdef(p^.resulttype)^.isclass))
) and (p^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) and ) and (p^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) { and
{it also works if the assignment is overloaded } it also works if the assignment is overloaded
not is_assignment_overloaded(p^.left^.resulttype,p^.resulttype) then YES but this code is not executed if assignment is overloaded (PM)
not assigned(assignment_overloaded(p^.left^.resulttype,p^.resulttype))} then
CGMessage(cg_e_illegal_type_conversion); CGMessage(cg_e_illegal_type_conversion);
end end
else else
@ -912,7 +915,15 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.37 1999-06-15 18:58:35 peter Revision 1.38 1999-06-17 13:19:58 pierre
* merged from 0_99_12 branch
Revision 1.35.2.3 1999/06/17 12:51:48 pierre
* changed is_assignment_overloaded into
function assignment_overloaded : pprocdef
to allow overloading of assignment with only different result type
Revision 1.37 1999/06/15 18:58:35 peter
* merged * merged
Revision 1.36 1999/06/13 22:41:06 peter Revision 1.36 1999/06/13 22:41:06 peter

16
compiler/tcld.pas
View File

@ -432,7 +432,13 @@ implementation
{ looks a little bit dangerous to me } { looks a little bit dangerous to me }
{ len-1 gives problems with is_open_array if len=0, } { len-1 gives problems with is_open_array if len=0, }
{ is_open_array checks now for isconstructor (FK) } { is_open_array checks now for isconstructor (FK) }
p^.resulttype:=new(parraydef,init(0,len-1,s32bitdef)); { skip if already done ! (PM) }
if not assigned(p^.resulttype) or
(p^.resulttype^.deftype<>arraydef) or
not parraydef(p^.resulttype)^.IsConstructor or
(parraydef(p^.resulttype)^.lowrange<>0) or
(parraydef(p^.resulttype)^.highrange<>len-1) then
p^.resulttype:=new(parraydef,init(0,len-1,s32bitdef));
parraydef(p^.resulttype)^.definition:=pd; parraydef(p^.resulttype)^.definition:=pd;
parraydef(p^.resulttype)^.IsConstructor:=true; parraydef(p^.resulttype)^.IsConstructor:=true;
parraydef(p^.resulttype)^.IsVariant:=varia; parraydef(p^.resulttype)^.IsVariant:=varia;
@ -454,7 +460,13 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.34 1999-06-01 19:26:39 peter Revision 1.35 1999-06-17 13:19:59 pierre
* merged from 0_99_12 branch
Revision 1.34.2.1 1999/06/17 12:33:39 pierre
* avoid warning with extdebug for arrayconstruct
Revision 1.34 1999/06/01 19:26:39 peter
* fixed bug 249 * fixed bug 249
Revision 1.33 1999/05/27 19:45:21 peter Revision 1.33 1999/05/27 19:45:21 peter