paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-12 17:49:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ support for NOT overloading

Browse Source 
+ unsupported overloaded operators generate errors
This commit is contained in:
pierre 2000-06-05 20:41:17 +00:00
parent d0399b4e55
commit 7b1219536c
5 changed files with 103 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
compiler/htypechk.pas
View File

@ -30,34 +30,37 @@ interface
Ttok2nodeRec=record
tok : ttoken;
nod : ttreetyp;
op_overloading_supported : boolean;
end;
const
tok2nodes=23;
tok2nodes=25;
tok2node:array[1..tok2nodes] of ttok2noderec=(
(tok:_PLUS ;nod:addn),
(tok:_MINUS ;nod:subn),
(tok:_STAR ;nod:muln),
(tok:_SLASH ;nod:slashn),
(tok:_EQUAL ;nod:equaln),
(tok:_GT ;nod:gtn),
(tok:_LT ;nod:ltn),
(tok:_GTE ;nod:gten),
(tok:_LTE ;nod:lten),
(tok:_SYMDIF ;nod:symdifn),
(tok:_STARSTAR;nod:starstarn),
(tok:_OP_AS ;nod:asn),
(tok:_OP_IN ;nod:inn),
(tok:_OP_IS ;nod:isn),
(tok:_OP_OR ;nod:orn),
(tok:_OP_AND ;nod:andn),
(tok:_OP_DIV ;nod:divn),
(tok:_OP_MOD ;nod:modn),
(tok:_OP_SHL ;nod:shln),
(tok:_OP_SHR ;nod:shrn),
(tok:_OP_XOR ;nod:xorn),
(tok:_CARET ;nod:caretn),
(tok:_UNEQUAL ;nod:unequaln)
(tok:_PLUS ;nod:addn;op_overloading_supported:true), { binary overloading supported }
(tok:_MINUS ;nod:subn;op_overloading_supported:true), { binary and unary overloading supported }
(tok:_STAR ;nod:muln;op_overloading_supported:true), { binary overloading supported }
(tok:_SLASH ;nod:slashn;op_overloading_supported:true), { binary overloading supported }
(tok:_EQUAL ;nod:equaln;op_overloading_supported:true), { binary overloading supported }
(tok:_GT ;nod:gtn;op_overloading_supported:true), { binary overloading supported }
(tok:_LT ;nod:ltn;op_overloading_supported:true), { binary overloading supported }
(tok:_GTE ;nod:gten;op_overloading_supported:true), { binary overloading supported }
(tok:_LTE ;nod:lten;op_overloading_supported:true), { binary overloading supported }
(tok:_SYMDIF ;nod:symdifn;op_overloading_supported:true), { binary overloading supported }
(tok:_STARSTAR;nod:starstarn;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_AS ;nod:asn;op_overloading_supported:false), { binary overloading NOT supported }
(tok:_OP_IN ;nod:inn;op_overloading_supported:false), { binary overloading NOT supported }
(tok:_OP_IS ;nod:isn;op_overloading_supported:false), { binary overloading NOT supported }
(tok:_OP_OR ;nod:orn;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_AND ;nod:andn;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_DIV ;nod:divn;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_NOT ;nod:notn;op_overloading_supported:true), { unary overloading supported }
(tok:_OP_MOD ;nod:modn;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_SHL ;nod:shln;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_SHR ;nod:shrn;op_overloading_supported:true), { binary overloading supported }
(tok:_OP_XOR ;nod:xorn;op_overloading_supported:true), { binary overloading supported }
(tok:_ASSIGNMENT;nod:assignn;op_overloading_supported:true), { unary overloading supported }
(tok:_CARET ;nod:caretn;op_overloading_supported:false), { binary overloading NOT supported }
(tok:_UNEQUAL ;nod:unequaln;op_overloading_supported:false) { binary overloading NOT supported overload = instead }
);
const
{ firstcallparan without varspez we don't count the ref }
@ -649,7 +652,8 @@ implementation
if (treetyp=assignn) then
begin
isunaryoperatoroverloadable:=true;
{ this already get tbs0261 to fail not is_equal(rd,dd); PM }
{ this already get tbs0261 to fail
isunaryoperatoroverloadable:=not is_equal(rd,dd); PM }
end
{ should we force that rd and dd are equal ?? }
else if (treetyp=unaryminusn) then
@ -659,6 +663,15 @@ implementation
{$ifdef SUPPORT_MMX}
and not ((cs_mmx in aktlocalswitches) and
is_mmx_able_array(rd))
{$endif SUPPORT_MMX}
;
end
else if (treetyp=notn) then
begin
isunaryoperatoroverloadable:=not is_integer(rd) and not is_boolean(rd)
{$ifdef SUPPORT_MMX}
and not ((cs_mmx in aktlocalswitches) and
is_mmx_able_array(rd))
{$endif SUPPORT_MMX}
;
end;
@ -678,8 +691,9 @@ implementation
ld:=pvarsym(pf^.parast^.symindex^.first)^.vartype.def;
rd:=pvarsym(pf^.parast^.symindex^.first^.next)^.vartype.def;
dd:=pf^.rettype.def;
isoperatoracceptable:=isbinaryoperatoroverloadable
(ld,rd,dd,tok2node[i].nod);
isoperatoracceptable:=
tok2node[i].op_overloading_supported and
isbinaryoperatoroverloadable(ld,rd,dd,tok2node[i].nod);
break;
end;
end;
@ -689,8 +703,9 @@ implementation
for i:=1 to tok2nodes do
if tok2node[i].tok=optoken then
begin
isoperatoracceptable:=isunaryoperatoroverloadable
(rd,dd,tok2node[i].nod);
isoperatoracceptable:=
tok2node[i].op_overloading_supported and
isunaryoperatoroverloadable(rd,dd,tok2node[i].nod);
break;
end;
end;
@ -1089,7 +1104,11 @@ implementation
end.
{
$Log$
Revision 1.66 2000-06-04 09:04:30 peter
Revision 1.67 2000-06-05 20:41:17 pierre
+ support for NOT overloading
+ unsupported overloaded operators generate errors
Revision 1.66 2000/06/04 09:04:30 peter
* check for procvar in valid_for_formal
Revision 1.65 2000/06/02 21:22:04 pierre
@ -1193,4 +1212,4 @@ end.
* arrayconstructor -> arrayofconst fixed when arraycosntructor was not
variant.
}
}

10
compiler/pexpr.pas
View File

@ -1890,8 +1890,8 @@ _LECKKLAMMER : begin
p1:=sub_expr(oppower,false);
p1:=gensinglenode(unaryminusn,p1);
end;
_NOT : begin
consume(_NOT);
_OP_NOT : begin
consume(_OP_NOT);
p1:=factor(false);
p1:=gensinglenode(notn,p1);
end;
@ -2121,7 +2121,11 @@ _LECKKLAMMER : begin
end.
{
$Log$
Revision 1.174 2000-06-02 21:22:56 pierre
Revision 1.175 2000-06-05 20:41:17 pierre
+ support for NOT overloading
+ unsupported overloaded operators generate errors
Revision 1.174 2000/06/02 21:22:56 pierre
tok2node moved to htypechk unit
Revision 1.173 2000/03/23 15:56:59 peter

8
compiler/symtable.pas
View File

@ -406,7 +406,7 @@ unit symtable;
'lower_or_equal',
'sym_diff','starstar',
'as','is','in','or',
'and','div','mod','shl','shr','xor',
'and','div','mod','not','shl','shr','xor',
'assign');
{$ifdef UNITALIASES}
@ -2925,7 +2925,11 @@ implementation
end.
{
$Log$
Revision 1.95 2000-06-02 21:17:26 pierre
Revision 1.96 2000-06-05 20:41:17 pierre
+ support for NOT overloading
+ unsupported overloaded operators generate errors
Revision 1.95 2000/06/02 21:17:26 pierre
fix bug in tbs/tbs0317
Revision 1.94 2000/06/02 18:48:48 florian

33
compiler/tcmat.pas
View File

@ -368,6 +368,7 @@ implementation
procedure firstnot(var p : ptree);
var
t : ptree;
notdef : pprocdef;
begin
firstpass(p^.left);
set_varstate(p^.left,true);
@ -427,7 +428,7 @@ implementation
p^.registers32:=2;
end;
end
else
else if is_integer(p^.left^.resulttype) then
begin
p^.left:=gentypeconvnode(p^.left,s32bitdef);
firstpass(p^.left);
@ -444,15 +445,43 @@ implementation
(p^.registers32<1) then
p^.registers32:=1;
p^.location.loc:=LOC_REGISTER;
end
else
begin
if assigned(overloaded_operators[_op_not]) then
notdef:=overloaded_operators[_op_not]^.definition
else
notdef:=nil;
while assigned(notdef) do
begin
if is_equal(pparaitem(notdef^.para^.first)^.paratype.def,p^.left^.resulttype) and
(pparaitem(notdef^.para^.first)^.next=nil) then
begin
t:=gencallnode(overloaded_operators[_op_not],nil);
t^.left:=gencallparanode(p^.left,nil);
putnode(p);
p:=t;
firstpass(p);
exit;
end;
notdef:=notdef^.nextoverloaded;
end;
CGMessage(type_e_mismatch);
end;
p^.registersfpu:=p^.left^.registersfpu;
end;
end.
{
$Log$
Revision 1.30 2000-06-02 21:13:56 pierre
Revision 1.31 2000-06-05 20:41:18 pierre
+ support for NOT overloading
+ unsupported overloaded operators generate errors
Revision 1.30 2000/06/02 21:13:56 pierre
* use is_equal instead of direct def equality in unary minus overload
Revision 1.29 2000/02/17 14:53:43 florian

12
compiler/tokens.pas
View File

@ -50,6 +50,7 @@ type
_OP_AND,
_OP_DIV,
_OP_MOD,
_OP_NOT,
_OP_SHL,
_OP_SHR,
_OP_XOR,
@ -249,7 +250,8 @@ const
(str:'or' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'and' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'div' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'mod' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'mod' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'not' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'shl' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'shr' ;special:true ;keyword:m_none;op:NOTOKEN),
(str:'xor' ;special:true ;keyword:m_none;op:NOTOKEN),
@ -306,7 +308,7 @@ const
(str:'MOD' ;special:false;keyword:m_all;op:_OP_MOD),
(str:'NEW' ;special:false;keyword:m_all;op:NOTOKEN),
(str:'NIL' ;special:false;keyword:m_all;op:NOTOKEN),
(str:'NOT' ;special:false;keyword:m_all;op:NOTOKEN),
(str:'NOT' ;special:false;keyword:m_all;op:_OP_NOT),
(str:'SET' ;special:false;keyword:m_all;op:NOTOKEN),
(str:'SHL' ;special:false;keyword:m_all;op:_OP_SHL),
(str:'SHR' ;special:false;keyword:m_all;op:_OP_SHR),
@ -513,7 +515,11 @@ end;
end.
{
$Log$
Revision 1.22 2000-03-19 14:56:39 florian
Revision 1.23 2000-06-05 20:41:18 pierre
+ support for NOT overloading
+ unsupported overloaded operators generate errors
Revision 1.22 2000/03/19 14:56:39 florian
* bug 873 fixed
* some cleanup in objectdec