+ support for full boolean evaluation (b+/b-), default remains short

    circuit boolean evaluation

compiler/cg386add.pas

@@ -760,6 +760,53 @@ implementation
            end;
         end;
 
+
+    procedure handle_bool_as_int;
+
+      begin
+        if p^.left^.treetype=ordconstn then
+        swaptree(p);
+        if p^.left^.location.loc=LOC_JUMP then
+          begin
+            otl:=truelabel;
+            getlabel(truelabel);
+            ofl:=falselabel;
+            getlabel(falselabel);
+          end;
+
+        secondpass(p^.left);
+        { if in flags then copy first to register, because the
+          flags can be destroyed }
+        case p^.left^.location.loc of
+          LOC_FLAGS:
+            locflags2reg(p^.left^.location,opsize);
+          LOC_JUMP:
+            locjump2reg(p^.left^.location,opsize, otl, ofl);
+        end;
+        set_location(p^.location,p^.left^.location);
+        pushed:=maybe_push(p^.right^.registers32,p,false);
+        if p^.right^.location.loc=LOC_JUMP then
+          begin
+            otl:=truelabel;
+            getlabel(truelabel);
+            ofl:=falselabel;
+            getlabel(falselabel);
+          end;
+        secondpass(p^.right);
+        if pushed then
+          begin
+            restore(p,false);
+            set_location(p^.left^.location,p^.location);
+          end;
+        case p^.right^.location.loc of
+          LOC_FLAGS:
+            locflags2reg(p^.right^.location,opsize);
+          LOC_JUMP:
+            locjump2reg(p^.right^.location,opsize,otl,ofl);
+        end;
+      end;
+
+
       begin
       { to make it more readable, string and set (not smallset!) have their
         own procedures }
@@ -792,19 +839,67 @@ implementation
          { calculate the operator which is more difficult }
          firstcomplex(p);
 
+         { set the opsize for booleans already (JM) }
+         if (porddef(p^.left^.resulttype)^.typ=bool8bit) or
+            (porddef(p^.right^.resulttype)^.typ=bool8bit) then
+           opsize:=S_B
+         else
+           if (porddef(p^.left^.resulttype)^.typ=bool16bit) or
+              (porddef(p^.right^.resulttype)^.typ=bool16bit) then
+             opsize:=S_W
+         else
+           opsize:=S_L;
+         
          { handling boolean expressions extra: }
          if is_boolean(p^.left^.resulttype) and
             is_boolean(p^.right^.resulttype) then
            begin
-             if (porddef(p^.left^.resulttype)^.typ=bool8bit) or
-                (porddef(p^.right^.resulttype)^.typ=bool8bit) then
-               opsize:=S_B
-             else
-               if (porddef(p^.left^.resulttype)^.typ=bool16bit) or
-                  (porddef(p^.right^.resulttype)^.typ=bool16bit) then
-                 opsize:=S_W
-             else
-               opsize:=S_L;
+             if (cs_full_boolean_eval in aktlocalswitches) or
+                (p^.treetype in
+                  [unequaln,ltn,lten,gtn,gten,equaln,xorn]) then
+               begin
+                 if p^.left^.treetype=ordconstn then
+                 swaptree(p);
+                 if p^.left^.location.loc=LOC_JUMP then
+                   begin
+                     otl:=truelabel;
+                     getlabel(truelabel);
+                     ofl:=falselabel;
+                     getlabel(falselabel);
+                   end;
+
+                 secondpass(p^.left);
+                 { if in flags then copy first to register, because the
+                   flags can be destroyed }
+                 case p^.left^.location.loc of
+                   LOC_FLAGS:
+                     locflags2reg(p^.left^.location,opsize);
+                   LOC_JUMP:
+                     locjump2reg(p^.left^.location,opsize, otl, ofl);
+                 end;
+                 set_location(p^.location,p^.left^.location);
+                 pushed:=maybe_push(p^.right^.registers32,p,false);
+                 if p^.right^.location.loc=LOC_JUMP then
+                   begin
+                     otl:=truelabel;
+                     getlabel(truelabel);
+                     ofl:=falselabel;
+                     getlabel(falselabel);
+                   end;
+                 secondpass(p^.right);
+                 if pushed then
+                   begin
+                     restore(p,false);
+                     set_location(p^.left^.location,p^.location);
+                   end;
+                 case p^.right^.location.loc of
+                   LOC_FLAGS:
+                     locflags2reg(p^.right^.location,opsize);
+                   LOC_JUMP:
+                     locjump2reg(p^.right^.location,opsize,otl,ofl);
+                 end;
+                 goto do_normal;
+               end;
              case p^.treetype of
               andn,
                orn : begin
@@ -834,50 +929,6 @@ implementation
                        secondpass(p^.right);
                        maketojumpbool(p^.right);
                      end;
-          unequaln,ltn,lten,gtn,gten,
-       equaln,xorn : begin
-                       if p^.left^.treetype=ordconstn then
-                        swaptree(p);
-                       if p^.left^.location.loc=LOC_JUMP then
-                         begin
-                            otl:=truelabel;
-                            getlabel(truelabel);
-                            ofl:=falselabel;
-                            getlabel(falselabel);
-                         end;
-
-                       secondpass(p^.left);
-                       { if in flags then copy first to register, because the
-                         flags can be destroyed }
-                       case p^.left^.location.loc of
-                          LOC_FLAGS:
-                            locflags2reg(p^.left^.location,opsize);
-                          LOC_JUMP:
-                            locjump2reg(p^.left^.location,opsize, otl, ofl);
-                       end;
-                       set_location(p^.location,p^.left^.location);
-                       pushed:=maybe_push(p^.right^.registers32,p,false);
-                       if p^.right^.location.loc=LOC_JUMP then
-                         begin
-                            otl:=truelabel;
-                            getlabel(truelabel);
-                            ofl:=falselabel;
-                            getlabel(falselabel);
-                         end;
-                       secondpass(p^.right);
-                       if pushed then
-                         begin
-                            restore(p,false);
-                            set_location(p^.left^.location,p^.location);
-                         end;
-                       case p^.right^.location.loc of
-                          LOC_FLAGS:
-                            locflags2reg(p^.right^.location,opsize);
-                          LOC_JUMP:
-                            locjump2reg(p^.right^.location,opsize,otl,ofl);
-                       end;
-                       goto do_normal;
-                    end
              else
                CGMessage(type_e_mismatch);
              end
@@ -2324,7 +2375,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.5  2000-08-27 16:11:49  peter
+  Revision 1.6  2000-09-21 11:30:49  jonas
+    + support for full boolean evaluation (b+/b-), default remains short
+      circuit boolean evaluation
+
+  Revision 1.5  2000/08/27 16:11:49  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/globtype.pas

@@ -69,6 +69,7 @@ interface
          cs_check_overflow,cs_check_range,cs_check_object_ext,
          cs_check_io,cs_check_stack,
          cs_omitstackframe,cs_do_assertion,cs_generate_rtti,
+         cs_full_boolean_eval,
          { mmx }
          cs_mmx,cs_mmx_saturation,
          { parser }
@@ -207,7 +208,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2000-08-05 13:25:06  peter
+  Revision 1.6  2000-09-21 11:30:49  jonas
+    + support for full boolean evaluation (b+/b-), default remains short
+      circuit boolean evaluation
+
+  Revision 1.5  2000/08/05 13:25:06  peter
     * packenum 1 fixes (merged)
 
   Revision 1.4  2000/08/02 19:49:59  peter

compiler/switches.pas

@@ -45,7 +45,7 @@ type
 const
   SwitchTable:array['A'..'Z'] of SwitchRec=(
    {A} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
-   {B} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
+   {B} (typesw:localsw; setsw:ord(cs_full_boolean_eval)),
    {C} (typesw:localsw; setsw:ord(cs_do_assertion)),
    {D} (typesw:modulesw; setsw:ord(cs_debuginfo)),
    {E} (typesw:globalsw; setsw:ord(cs_fp_emulation)),
@@ -174,7 +174,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  2000-08-27 16:11:53  peter
+  Revision 1.4  2000-09-21 11:30:49  jonas
+    + support for full boolean evaluation (b+/b-), default remains short
+      circuit boolean evaluation
+
+  Revision 1.3  2000/08/27 16:11:53  peter
     * moved some util functions from globals,cobjects to cutils
     * splitted files into finput,fmodule
 

compiler/tcadd.pas

@@ -390,68 +390,70 @@ implementation
            { 2 booleans ? }
              if is_boolean(ld) and is_boolean(rd) then
               begin
-                case p^.treetype of
-                  andn,
-                  orn:
-                    begin
-                      make_bool_equal_size(p);
-                      calcregisters(p,0,0,0);
-                      p^.location.loc:=LOC_JUMP;
-                    end;
-                  xorn,ltn,lten,gtn,gten:
-                    begin
-                      make_bool_equal_size(p);
-                      if (p^.left^.location.loc in [LOC_JUMP,LOC_FLAGS]) and
-                        (p^.left^.location.loc in [LOC_JUMP,LOC_FLAGS]) then
-                        calcregisters(p,2,0,0)
-                      else
-                        calcregisters(p,1,0,0);
-                    end;
-                  unequaln,
-                  equaln:
-                    begin
-                      make_bool_equal_size(p);
-                      { Remove any compares with constants }
-                      if (p^.left^.treetype=ordconstn) then
-                       begin
-                         hp:=p^.right;
-                         b:=(p^.left^.value<>0);
-                         ot:=p^.treetype;
-                         disposetree(p^.left);
-                         putnode(p);
-                         p:=hp;
-                         if (not(b) and (ot=equaln)) or
-                            (b and (ot=unequaln)) then
-                          begin
-                            p:=gensinglenode(notn,p);
-                            firstpass(p);
-                          end;
-                         exit;
-                       end;
-                      if (p^.right^.treetype=ordconstn) then
-                       begin
-                         hp:=p^.left;
-                         b:=(p^.right^.value<>0);
-                         ot:=p^.treetype;
-                         disposetree(p^.right);
-                         putnode(p);
-                         p:=hp;
-                         if (not(b) and (ot=equaln)) or
-                            (b and (ot=unequaln)) then
-                          begin
-                            p:=gensinglenode(notn,p);
-                            firstpass(p);
-                          end;
-                         exit;
-                       end;
-                      if (p^.left^.location.loc in [LOC_JUMP,LOC_FLAGS]) and
-                        (p^.left^.location.loc in [LOC_JUMP,LOC_FLAGS]) then
-                        calcregisters(p,2,0,0)
-                      else
-                        calcregisters(p,1,0,0);
-                    end;
+                if (cs_full_boolean_eval in aktlocalswitches) or
+                   (p^.treetype in [xorn,ltn,lten,gtn,gten]) then
+                  begin
+                     make_bool_equal_size(p);
+                    if (p^.left^.location.loc in [LOC_JUMP,LOC_FLAGS]) and
+                       (p^.left^.location.loc in [LOC_JUMP,LOC_FLAGS]) then
+                      calcregisters(p,2,0,0)
+                    else
+                      calcregisters(p,1,0,0);
+                  end
                 else
-                  CGMessage(type_e_mismatch);
+                  case p^.treetype of
+                    andn,
+                    orn:
+                      begin
+                        make_bool_equal_size(p);
+                        calcregisters(p,0,0,0);
+                        p^.location.loc:=LOC_JUMP;
+                      end;
+                    unequaln,
+                    equaln:
+                      begin
+                        make_bool_equal_size(p);
+                        { Remove any compares with constants }
+                        if (p^.left^.treetype=ordconstn) then
+                         begin
+                           hp:=p^.right;
+                           b:=(p^.left^.value<>0);
+                           ot:=p^.treetype;
+                           disposetree(p^.left);
+                           putnode(p);
+                           p:=hp;
+                           if (not(b) and (ot=equaln)) or
+                              (b and (ot=unequaln)) then
+                            begin
+                              p:=gensinglenode(notn,p);
+                              firstpass(p);
+                            end;
+                           exit;
+                         end;
+                        if (p^.right^.treetype=ordconstn) then
+                         begin
+                           hp:=p^.left;
+                           b:=(p^.right^.value<>0);
+                           ot:=p^.treetype;
+                           disposetree(p^.right);
+                           putnode(p);
+                           p:=hp;
+                           if (not(b) and (ot=equaln)) or
+                              (b and (ot=unequaln)) then
+                            begin
+                              p:=gensinglenode(notn,p);
+                              firstpass(p);
+                            end;
+                           exit;
+                         end;
+                        if (p^.left^.location.loc in [LOC_JUMP,LOC_FLAGS]) and
+                          (p^.left^.location.loc in [LOC_JUMP,LOC_FLAGS]) then
+                          calcregisters(p,2,0,0)
+                        else
+                          calcregisters(p,1,0,0);
+                      end;
+                  else
+                    CGMessage(type_e_mismatch);
                 end;
 (*
                 { these one can't be in flags! }
@@ -1291,7 +1293,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.8  2000-09-10 20:19:23  peter
+  Revision 1.9  2000-09-21 11:30:49  jonas
+    + support for full boolean evaluation (b+/b-), default remains short
+      circuit boolean evaluation
+
+  Revision 1.8  2000/09/10 20:19:23  peter
     * fixed crash with smallset -> normalset conversion (merged)
 
   Revision 1.7  2000/08/29 08:24:45  jonas