+ support for NOT overloading

  + unsupported overloaded operators generate errors

compiler/htypechk.pas

@@ -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.
 
-}
+}

compiler/pexpr.pas

@@ -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

compiler/symtable.pas

@@ -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

compiler/tcmat.pas

@@ -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

compiler/tokens.pas

@@ -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