Browse Source

* more fixes

florian 25 years ago
parent
commit
68ceefdb2a
2 changed files with 24 additions and 19 deletions
  1. 19 16
      compiler/n386add.pas
  2. 5 3
      compiler/nadd.pas

+ 19 - 16
compiler/n386add.pas

@@ -29,10 +29,11 @@ unit n386add;
        nadd;
        nadd;
 
 
     ti386addnode = class(taddnode)
     ti386addnode = class(taddnode)
-      procedure pass_2;override;
-      function getresflags(unsigned : boolean) : tresflags;
-      procedure SetResultLocation(cmpop,unsigned : boolean);
-      procedure addstring;
+       procedure pass_2;override;
+       function getresflags(unsigned : boolean) : tresflags;
+       procedure SetResultLocation(cmpop,unsigned : boolean);
+       procedure addstring;
+       procedure addset;
     end;
     end;
 
 
   implementation
   implementation
@@ -94,10 +95,10 @@ unit n386add;
             ((left.resulttype^.deftype<>setdef) or (psetdef(left.resulttype)^.settype=smallset)) and
             ((left.resulttype^.deftype<>setdef) or (psetdef(left.resulttype)^.settype=smallset)) and
             (left.location.loc in [LOC_MEM,LOC_REFERENCE]) then
             (left.location.loc in [LOC_MEM,LOC_REFERENCE]) then
            ungetiftemp(left.location.reference);
            ungetiftemp(left.location.reference);
-         if (right^.resulttype^.deftype<>stringdef) and
-            ((right^.resulttype^.deftype<>setdef) or (psetdef(right^.resulttype)^.settype=smallset)) and
-            (right^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
-           ungetiftemp(right^.location.reference);
+         if (right.resulttype^.deftype<>stringdef) and
+            ((right.resulttype^.deftype<>setdef) or (psetdef(right.resulttype)^.settype=smallset)) and
+            (right.location.loc in [LOC_MEM,LOC_REFERENCE]) then
+           ungetiftemp(right.location.reference);
          { in case of comparison operation the put result in the flags }
          { in case of comparison operation the put result in the flags }
          if cmpop then
          if cmpop then
            begin
            begin
@@ -450,7 +451,7 @@ unit n386add;
                                 Addset
                                 Addset
 *****************************************************************************}
 *****************************************************************************}
 
 
-    procedure addset(var p : ptree);
+    procedure ti386addnode.addset;
       var
       var
         createset,
         createset,
         cmpop,
         cmpop,
@@ -644,15 +645,15 @@ unit n386add;
         else
         else
           CGMessage(type_e_mismatch);
           CGMessage(type_e_mismatch);
         end;
         end;
-        SetResultLocation(cmpop,true,p);
+        SetResultLocation(cmpop,true);
       end;
       end;
 
 
 
 
 {*****************************************************************************
 {*****************************************************************************
-                                SecondAdd
+                                pass_2
 *****************************************************************************}
 *****************************************************************************}
 
 
-    procedure secondadd(var p : ptree);
+    procedure ti386addnode.pass_2;
     { is also being used for xor, and "mul", "sub, or and comparative }
     { is also being used for xor, and "mul", "sub, or and comparative }
     { operators                                                }
     { operators                                                }
 
 
@@ -962,7 +963,7 @@ unit n386add;
                                 begin
                                 begin
                                 { adding elements is not commutative }
                                 { adding elements is not commutative }
                                   if swaped and (left.treetype=setelementn) then
                                   if swaped and (left.treetype=setelementn) then
-                                   swaptree(p);
+                                   swaptree;
                                 { are we adding set elements ? }
                                 { are we adding set elements ? }
                                   if right.treetype=setelementn then
                                   if right.treetype=setelementn then
                                    begin
                                    begin
@@ -2311,7 +2312,7 @@ unit n386add;
 {$endif SUPPORT_MMX}
 {$endif SUPPORT_MMX}
               else CGMessage(type_e_mismatch);
               else CGMessage(type_e_mismatch);
            end;
            end;
-       SetResultLocation(cmpop,unsigned,p);
+       SetResultLocation(cmpop,unsigned);
     end;
     end;
 
 
     procedure ti386addnode.pass_2;
     procedure ti386addnode.pass_2;
@@ -2324,7 +2325,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.2  2000-09-21 12:24:22  jonas
+  Revision 1.3  2000-09-22 22:42:52  florian
+    * more fixes
+
+  Revision 1.2  2000/09/21 12:24:22  jonas
     * small fix to my changes for full boolean evaluation support (moved
     * small fix to my changes for full boolean evaluation support (moved
       opsize determination for boolean operations back in boolean
       opsize determination for boolean operations back in boolean
       processing block)
       processing block)
@@ -2332,5 +2336,4 @@ end.
 
 
   Revision 1.1  2000/09/20 21:23:32  florian
   Revision 1.1  2000/09/20 21:23:32  florian
     * initial revision
     * initial revision
-
 }
 }

+ 5 - 3
compiler/nadd.pas

@@ -32,14 +32,13 @@ interface
           function firstpass : tnode;override;
           function firstpass : tnode;override;
           procedure make_bool_equal_size;
           procedure make_bool_equal_size;
        end;
        end;
-       tcaddnode : class of taddnode;
 
 
     var
     var
        { caddnode is used to create nodes of the add type }
        { caddnode is used to create nodes of the add type }
        { the virtual constructor allows to assign         }
        { the virtual constructor allows to assign         }
        { another class type to caddnode => processor      }
        { another class type to caddnode => processor      }
        { specific node types can be created               }
        { specific node types can be created               }
-       caddnode : tcaddnode;
+       caddnode : class of taddnode;
 
 
     function isbinaryoverloaded(var p : pnode) : boolean;
     function isbinaryoverloaded(var p : pnode) : boolean;
 
 
@@ -1228,7 +1227,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.4  2000-09-21 12:22:42  jonas
+  Revision 1.5  2000-09-22 22:42:52  florian
+    * more fixes
+
+  Revision 1.4  2000/09/21 12:22:42  jonas
     * put piece of code between -dnewoptimizations2 since it wasn't
     * put piece of code between -dnewoptimizations2 since it wasn't
       necessary otherwise
       necessary otherwise
     + support for full boolean evaluation (from tcadd)
     + support for full boolean evaluation (from tcadd)