Explorar el Código

* changed byte/word/longbool to be Delphi-compatible (+ similar changes
for qwordbool) + test:
o assigning true to such a variable now sets them to $ff/$ffff/$ffffffff
o these types are now all signed
o converting an integer type to a byte/word/long/qwordbool using an
explicit type cast keeps the integer's original value stored in the
bool, instead of forcing it to ord(true)/ord(false)
(mantis #10233 and #10613, implemented for all architectures, testsuite
tested for ppc32, sparc and x86)
* fixed some places where the rtl depended on longbool(true) having the
value 1
* extended several boolean tests (and adapted some to no longer assume
that byte/word/long/qwordbool(true)=1)
+ support for converting to qwordbool in second_int_to_bool for x86, ppc
and sparc

git-svn-id: trunk@9898 -

Jonas Maebe hace 17 años
padre
commit
8349cde7db

+ 1 - 0
.gitattributes

@@ -7964,6 +7964,7 @@ tests/webtbs/tw1021.pp svneol=native#text/plain
 tests/webtbs/tw10210.pp svneol=native#text/plain
 tests/webtbs/tw10224.pp svneol=native#text/plain
 tests/webtbs/tw1023.pp svneol=native#text/plain
+tests/webtbs/tw10233.pp svneol=native#text/plain
 tests/webtbs/tw10320.pp svneol=native#text/plain
 tests/webtbs/tw10350.pp svneol=native#text/plain
 tests/webtbs/tw10371.pp svneol=native#text/plain

+ 1 - 1
compiler/arm/cgcpu.pas

@@ -1817,7 +1817,7 @@ unit cgcpu;
 
               if not((def.typ=pointerdef) or
                     ((def.typ=orddef) and
-                     (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,bool8bit,bool16bit,bool32bit]))) then
+                     (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,pasbool]))) then
                  ai.SetCondition(C_VC)
               else
                 if TAiCpu(List.Last).opcode in [A_RSB,A_RSC,A_SBC,A_SUB] then

+ 15 - 3
compiler/arm/narmcnv.pas

@@ -189,13 +189,23 @@ implementation
          secondpass(left);
          if codegenerror then
           exit;
-         { byte(boolean) or word(wordbool) or longint(longbool) must
-           be accepted for var parameters                            }
+
+         { bytebool(byte) or wordbool(word) or longbool(longint) must }
+         { be accepted for var parameters, and must not change the    }
+         { the ordinal value                                          }
          if (nf_explicit in flags) and
             (left.resultdef.size=resultdef.size) and
-            (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
+            not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) and
+            is_cbool(resultdef) and
+            not is_pasbool(left.resultdef) then
            begin
               location_copy(location,left.location);
+              location.size:=def_cgsize(resultdef);
+              { change of sign? Then we have to sign/zero-extend in }
+              { case of a loc_(c)register                           }
+              if (location.size<>left.location.size) and
+                 (location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+                location_force_reg(current_asmdata.CurrAsmList,location,location.size,true);
               current_procinfo.CurrTrueLabel:=oldTrueLabel;
               current_procinfo.CurrFalseLabel:=oldFalseLabel;
               exit;
@@ -267,6 +277,8 @@ implementation
          location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
          location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
          cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,location.register);
+         if (is_cbool(resultdef)) then
+           cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,location.register,location.register);
          current_procinfo.CurrTrueLabel:=oldTrueLabel;
          current_procinfo.CurrFalseLabel:=oldFalseLabel;
       end;

+ 4 - 2
compiler/cgobj.pas

@@ -3276,7 +3276,10 @@ implementation
       begin
         { range checking on and range checkable value? }
         if not(cs_check_range in current_settings.localswitches) or
-           not(fromdef.typ in [orddef,enumdef]) then
+           not(fromdef.typ in [orddef,enumdef]) or
+           { C-style booleans can't really fail range checks, }
+           { all values are always valid                      }
+           is_cbool(todef) then
           exit;
 {$ifndef cpu64bit}
         { handle 64bit rangechecks separate for 32bit processors }
@@ -3297,7 +3300,6 @@ implementation
         if (todef.typ = arraydef) then
           todef := tarraydef(todef).rangedef;
         { no range check if from and to are equal and are both longint/dword }
-        { no range check if from and to are equal and are both longint/dword }
         { (if we have a 32bit processor) or int64/qword, since such          }
         { operations can at most cause overflows (JM)                        }
         { Note that these checks are mostly processor independent, they only }

+ 1 - 0
compiler/dbgdwarf.pas

@@ -1099,6 +1099,7 @@ implementation
                 ]);
               finish_entry;
             end;
+          pasbool,
           bool8bit :
             begin
               append_entry(DW_TAG_base_type,false,[

+ 2 - 0
compiler/dbgstabs.pas

@@ -558,6 +558,7 @@ implementation
                 case def.ordtype of
                   uvoid :
                     result:=strpnew(def_stab_number(def));
+                  pasbool,
                   bool8bit,
                   bool16bit,
                   bool32bit,
@@ -580,6 +581,7 @@ implementation
                     result:=strpnew('-20;');
                   uwidechar :
                     result:=strpnew('-30;');
+                  pasbool,
                   bool8bit :
                     result:=strpnew('-21;');
                   bool16bit :

+ 4 - 4
compiler/defcmp.pas

@@ -152,7 +152,7 @@ implementation
           (bvoid,
            bint,bint,bint,bint,
            bint,bint,bint,bint,
-           bbool,bbool,bbool,bbool,
+           bbool,bbool,bbool,bbool,bbool,
            bchar,bchar,bint);
 
         basedefconvertsimplicit : array[tbasedef,tbasedef] of tconverttype =
@@ -236,7 +236,7 @@ implementation
                                 end;
                             end;
                           uvoid,
-                          bool8bit,bool16bit,bool32bit,bool64bit:
+                          pasbool,bool8bit,bool16bit,bool32bit,bool64bit:
                             eq:=te_equal;
                           else
                             internalerror(200210061);
@@ -1451,8 +1451,8 @@ implementation
                 u8bit,u16bit,u32bit,u64bit,
                 s8bit,s16bit,s32bit,s64bit :
                   is_subequal:=(torddef(def2).ordtype in [s64bit,u64bit,s32bit,u32bit,u8bit,s8bit,s16bit,u16bit]);
-                bool8bit,bool16bit,bool32bit,bool64bit :
-                  is_subequal:=(torddef(def2).ordtype in [bool8bit,bool16bit,bool32bit,bool64bit]);
+                pasbool,bool8bit,bool16bit,bool32bit,bool64bit :
+                  is_subequal:=(torddef(def2).ordtype in [pasbool,bool8bit,bool16bit,bool32bit,bool64bit]);
                 uchar :
                   is_subequal:=(torddef(def2).ordtype=uchar);
                 uwidechar :

+ 21 - 1
compiler/defutil.pas

@@ -62,6 +62,12 @@ interface
     {# Returns true if definition is a boolean }
     function is_boolean(def : tdef) : boolean;
 
+    {# Returns true if definition is a Pascal-style boolean (1 = true, zero = false) }
+    function is_pasbool(def : tdef) : boolean;
+
+    {# Returns true if definition is a C-style boolean (non-zero value = true, zero = false) }
+    function is_cbool(def : tdef) : boolean;
+
     {# Returns true if definition is a char
 
        This excludes the unicode char.
@@ -352,7 +358,7 @@ implementation
                is_ordinal:=dt in [uchar,uwidechar,
                                   u8bit,u16bit,u32bit,u64bit,
                                   s8bit,s16bit,s32bit,s64bit,
-                                  bool8bit,bool16bit,bool32bit,bool64bit];
+                                  pasbool,bool8bit,bool16bit,bool32bit,bool64bit];
              end;
            enumdef :
              is_ordinal:=true;
@@ -401,6 +407,20 @@ implementation
 
     { true if p is a boolean }
     function is_boolean(def : tdef) : boolean;
+      begin
+        result:=(def.typ=orddef) and
+                    (torddef(def).ordtype in [pasbool,bool8bit,bool16bit,bool32bit,bool64bit]);
+      end;
+
+
+    function is_pasbool(def : tdef) : boolean;
+      begin
+        result:=(def.typ=orddef) and
+                    (torddef(def).ordtype = pasbool);
+      end;
+
+    { true if def is a C-style boolean (non-zero value = true, zero = false) }
+    function is_cbool(def : tdef) : boolean;
       begin
         result:=(def.typ=orddef) and
                     (torddef(def).ordtype in [bool8bit,bool16bit,bool32bit,bool64bit]);

+ 1 - 1
compiler/htypechk.pas

@@ -2205,7 +2205,7 @@ implementation
         variantorddef_cl: array[tordtype] of tvariantequaltype =
           (tve_incompatible,tve_byte,tve_word,tve_cardinal,tve_chari64,
            tve_shortint,tve_smallint,tve_longint,tve_chari64,
-           tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
+           tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
            tve_chari64,tve_chari64,tve_dblcurrency);
 {$warning fixme for 128 bit floats }
         variantfloatdef_cl: array[tfloattype] of tvariantequaltype =

+ 2 - 2
compiler/m68k/n68kadd.pas

@@ -358,8 +358,8 @@ implementation
         otl,ofl : tasmlabel;
       begin
 //        writeln('second_cmpboolean');
-        if (torddef(left.resultdef).ordtype=bool8bit) or
-           (torddef(right.resultdef).ordtype=bool8bit) then
+        if (torddef(left.resultdef).ordtype in [pasbool,bool8bit]) or
+           (torddef(right.resultdef).ordtype in [pasbool,bool8bit]) then
          cgsize:=OS_8
         else
           if (torddef(left.resultdef).ordtype=bool16bit) or

+ 22 - 3
compiler/m68k/n68kcnv.pas

@@ -161,15 +161,32 @@ implementation
         opsize   : tcgsize;
       begin
          secondpass(left);
-         { byte(boolean) or word(wordbool) or longint(longbool) must }
-         { be accepted for var parameters                            }
+
+{$warning needs LOC_JUMP support, because called for bool_to_bool from ncgcnv }
+
+         { bytebool(byte) or wordbool(word) or longbool(longint) must }
+         { be accepted for var parameters, and must not change the    }
+         { the ordinal value                                          }
          if (nf_explicit in flags) and
             (left.resultdef.size=resultdef.size) and
-            (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
+            not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) and
+            is_cbool(resultdef) and
+            not is_pasbool(left.resultdef) then
            begin
               location_copy(location,left.location);
+              location.size:=def_cgsize(resultdef);
+              { change of sign? Then we have to sign/zero-extend in }
+              { case of a loc_(c)register                           }
+              if (location.size<>left.location.size) and
+                 (location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+                location_force_reg(current_asmdata.CurrAsmList,location,location.size,true);
+{   ACTIVATE when loc_jump support is added 
+              current_procinfo.CurrTrueLabel:=oldTrueLabel;
+              current_procinfo.CurrFalseLabel:=oldFalseLabel;
+}
               exit;
            end;
+
          location_reset(location,LOC_REGISTER,def_cgsize(left.resultdef));
          opsize := def_cgsize(left.resultdef);
          case left.location.loc of
@@ -210,6 +227,8 @@ implementation
              internalerror(200512182);
          end;
          cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,hreg1);
+         if (is_cbool(resultdef)) then
+           cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,hreg1,hreg1);
          location.register := hreg1;
       end;
 

+ 4 - 2
compiler/nadd.pas

@@ -987,13 +987,15 @@ implementation
              if (is_boolean(ld) and is_boolean(rd)) or
                 (nf_short_bool in flags) then
               begin
-                if torddef(left.resultdef).size>torddef(right.resultdef).size then
+                if (torddef(left.resultdef).size>torddef(right.resultdef).size) or
+                   (is_cbool(left.resultdef) and not is_cbool(right.resultdef)) then
                  begin
                    right:=ctypeconvnode.create_internal(right,left.resultdef);
                    ttypeconvnode(right).convtype:=tc_bool_2_bool;
                    typecheckpass(right);
                  end
-                else if torddef(left.resultdef).size<torddef(right.resultdef).size then
+                else if (torddef(left.resultdef).size<torddef(right.resultdef).size) or
+                        (not is_cbool(left.resultdef) and is_cbool(right.resultdef)) then
                  begin
                    left:=ctypeconvnode.create_internal(left,right.resultdef);
                    ttypeconvnode(left).convtype:=tc_bool_2_bool;

+ 26 - 10
compiler/ncgcnv.pas

@@ -394,6 +394,7 @@ interface
 
     procedure tcgtypeconvnode.second_bool_to_int;
       var
+         newsize: tcgsize;
          oldTrueLabel,oldFalseLabel : tasmlabel;
       begin
          oldTrueLabel:=current_procinfo.CurrTrueLabel;
@@ -402,12 +403,26 @@ interface
          current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
          secondpass(left);
          location_copy(location,left.location);
-         { byte(boolean) or word(wordbool) or longint(longbool) must }
-         { be accepted for var parameters                            }
-         if not((nf_explicit in flags) and
-                (left.resultdef.size=resultdef.size) and
-                (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER])) then
-           location_force_reg(current_asmdata.CurrAsmList,location,def_cgsize(resultdef),false);
+         newsize:=def_cgsize(resultdef);
+         { byte(bytebool) or word(wordbool) or longint(longbool) must be }
+         { accepted for var parameters and assignments, and must not     }
+         { change the ordinal value or value location.                   }
+         { htypechk.valid_for_assign ensures that such locations with a  }
+         { size<sizeof(register) cannot be LOC_CREGISTER (they otherwise }
+         { could be in case of a plain assignment), and LOC_REGISTER can }
+         { never be an assignment target. The remaining LOC_REGISTER/    }
+         { LOC_CREGISTER locations do have to be sign/zero-extended.     }
+         if not(nf_explicit in flags) or
+            (location.loc in [LOC_FLAGS,LOC_JUMP]) or
+            { change of size/signedness? Then we have to sign/ }
+            { zero-extend in case of a loc_(c)register         }
+            ((newsize<>left.location.size) and
+             ((left.resultdef.size<>resultdef.size) or
+              not(location.loc in [LOC_REFERENCE,LOC_CREFERENCE]))) then
+           location_force_reg(current_asmdata.CurrAsmList,location,newsize,true)
+         else
+           { may differ in sign, e.g. bytebool -> byte   }
+           location.size:=newsize;
          current_procinfo.CurrTrueLabel:=oldTrueLabel;
          current_procinfo.CurrFalseLabel:=oldFalseLabel;
       end;
@@ -429,11 +444,12 @@ interface
               internalerror(20060409);
             location_copy(location,left.location);
           end
+         else if (resultdef.size=left.resultdef.size) and
+                 not(is_cbool(resultdef) xor
+                     is_cbool(left.resultdef)) then
+           second_bool_to_int
          else
-           if resultdef.size<left.resultdef.size then
-             second_int_to_bool
-           else
-             second_bool_to_int;
+           second_int_to_bool
       end;
 
 

+ 26 - 14
compiler/ncgld.pas

@@ -841,7 +841,10 @@ implementation
                 begin
                   current_asmdata.getjumplabel(hlabel);
                   cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
-                  cg.a_load_const_loc(current_asmdata.CurrAsmList,1,left.location);
+                  if is_pasbool(left.resultdef) then
+                    cg.a_load_const_loc(current_asmdata.CurrAsmList,1,left.location)
+                  else
+                    cg.a_load_const_loc(current_asmdata.CurrAsmList,-1,left.location);
                   cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel);
                   cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
                   cg.a_load_const_loc(current_asmdata.CurrAsmList,0,left.location);
@@ -850,20 +853,29 @@ implementation
 {$ifdef cpuflags}
               LOC_FLAGS :
                 begin
-                  {This can be a wordbool or longbool too, no?}
-                  case left.location.loc of
-                    LOC_REGISTER,LOC_CREGISTER:
-                      cg.g_flags2reg(current_asmdata.CurrAsmList,def_cgsize(left.resultdef),right.location.resflags,left.location.register);
-                    LOC_REFERENCE:
-                      cg.g_flags2ref(current_asmdata.CurrAsmList,def_cgsize(left.resultdef),right.location.resflags,left.location.reference);
-                    LOC_SUBSETREG,LOC_SUBSETREF:
-                      begin
-                        r:=cg.getintregister(current_asmdata.CurrAsmList,def_cgsize(left.resultdef));
-                        cg.g_flags2reg(current_asmdata.CurrAsmList,def_cgsize(left.resultdef),right.location.resflags,r);
-                        cg.a_load_reg_loc(current_asmdata.CurrAsmList,def_cgsize(left.resultdef),r,left.location);
+                  if is_pasbool(left.resultdef) then
+                    begin
+                      case left.location.loc of
+                        LOC_REGISTER,LOC_CREGISTER:
+                          cg.g_flags2reg(current_asmdata.CurrAsmList,left.location.size,right.location.resflags,left.location.register);
+                        LOC_REFERENCE:
+                          cg.g_flags2ref(current_asmdata.CurrAsmList,left.location.size,right.location.resflags,left.location.reference);
+                        LOC_SUBSETREG,LOC_SUBSETREF:
+                          begin
+                            r:=cg.getintregister(current_asmdata.CurrAsmList,left.location.size);
+                            cg.g_flags2reg(current_asmdata.CurrAsmList,left.location.size,right.location.resflags,r);
+                            cg.a_load_reg_loc(current_asmdata.CurrAsmList,left.location.size,r,left.location);
+                          end;
+                        else
+                          internalerror(200203273);
                       end;
-                    else
-                      internalerror(200203273);
+                    end
+                  else
+                    begin
+                      r:=cg.getintregister(current_asmdata.CurrAsmList,left.location.size);
+                      cg.g_flags2reg(current_asmdata.CurrAsmList,left.location.size,right.location.resflags,r);
+                      cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,left.location.size,r,r);
+                      cg.a_load_reg_loc(current_asmdata.CurrAsmList,left.location.size,r,left.location);
                     end;
                 end;
 {$endif cpuflags}

+ 2 - 2
compiler/ncgrtti.pas

@@ -430,7 +430,7 @@ implementation
               (otUByte{otNone},
                otUByte,otUWord,otULong,otUByte{otNone},
                otSByte,otSWord,otSLong,otUByte{otNone},
-               otUByte,otUWord,otULong,otUByte,
+               otUByte,otSByte,otSWord,otSLong,otSByte,
                otUByte,otUWord,otUByte);
           begin
             write_rtti_name(def);
@@ -469,7 +469,7 @@ implementation
                 { high }
                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(def.high.svalue));
               end;
-            bool8bit:
+            pasbool:
               begin
                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkBool));
                 dointeger;

+ 16 - 2
compiler/ncnv.pas

@@ -2135,7 +2135,21 @@ implementation
                    else
                      { no longer an ordconst with an explicit typecast }
                      exclude(left.flags, nf_explicit);
-                   testrange(resultdef,tordconstnode(left).value,(nf_explicit in flags));
+                   { when converting from one boolean type to another, force }
+                   { booleans to 0/1, and byte/word/long/qwordbool to 0/-1   }
+                   { (Delphi-compatibile)                                    }
+                   if is_boolean(left.resultdef) and
+                      is_boolean(resultdef) and
+                      (is_cbool(left.resultdef) or
+                       is_cbool(resultdef)) then
+                     begin
+                       if is_pasbool(resultdef) then
+                         tordconstnode(left).value:=ord(tordconstnode(left).value<>0)
+                       else
+                         tordconstnode(left).value:=-ord(tordconstnode(left).value<>0);
+                     end
+                   else
+                     testrange(resultdef,tordconstnode(left).value,(nf_explicit in flags));
                    left.resultdef:=resultdef;
                    result:=left;
                    left:=nil;
@@ -2464,7 +2478,7 @@ implementation
          { convert to a 64bit int (only necessary for 32bit processors) (JM) }
          if resultdef.size > sizeof(aint) then
            begin
-             result := ctypeconvnode.create_internal(left,u32inttype);
+             result := ctypeconvnode.create_internal(left,s32inttype);
              result := ctypeconvnode.create(result,resultdef);
              left := nil;
              firstpass(result);

+ 18 - 6
compiler/ninl.pas

@@ -493,6 +493,7 @@ implementation
                       readfunctype:=s64currencytype;
                       is_real:=true;
                     end;
+                  pasbool,
                   bool8bit,
                   bool16bit,
                   bool32bit,
@@ -1508,30 +1509,41 @@ implementation
                     orddef :
                       begin
                         case torddef(left.resultdef).ordtype of
-                          bool8bit,
+                          pasbool,
                           uchar:
                             begin
                               { change to byte() }
                               result:=ctypeconvnode.create_internal(left,u8inttype);
                               left:=nil;
                             end;
-                          bool16bit,
                           uwidechar :
                             begin
                               { change to word() }
                               result:=ctypeconvnode.create_internal(left,u16inttype);
                               left:=nil;
                             end;
+                          bool8bit:
+                            begin
+                              { change to shortint() }
+                              result:=ctypeconvnode.create_internal(left,s8inttype);
+                              left:=nil;
+                            end;
+                          bool16bit :
+                            begin
+                              { change to smallint() }
+                              result:=ctypeconvnode.create_internal(left,s16inttype);
+                              left:=nil;
+                            end;
                           bool32bit :
                             begin
-                              { change to dword() }
-                              result:=ctypeconvnode.create_internal(left,u32inttype);
+                              { change to longint() }
+                              result:=ctypeconvnode.create_internal(left,s32inttype);
                               left:=nil;
                             end;
                           bool64bit :
                             begin
-                              { change to qword() }
-                              result:=ctypeconvnode.create_internal(left,u64inttype);
+                              { change to int64() }
+                              result:=ctypeconvnode.create_internal(left,s64inttype);
                               left:=nil;
                             end;
                           uvoid :

+ 1 - 0
compiler/nmat.pas

@@ -783,6 +783,7 @@ implementation
              v:=tordconstnode(left).value;
              def:=left.resultdef;
              case torddef(left.resultdef).ordtype of
+               pasbool,
                bool8bit,
                bool16bit,
                bool32bit,

+ 1 - 1
compiler/nset.pas

@@ -247,7 +247,7 @@ implementation
              }
              if  (
                    (left.resultdef.typ = orddef) and not
-                   (torddef(left.resultdef).ordtype in [s8bit,u8bit,uchar,bool8bit])
+                   (torddef(left.resultdef).ordtype in [s8bit,u8bit,uchar,pasbool,bool8bit])
                  )
                 or
                  (

+ 1 - 1
compiler/pdecsub.pas

@@ -1103,7 +1103,7 @@ implementation
                      single_type(pd.returndef,false);
                      if (optoken in [_EQUAL,_GT,_LT,_GTE,_LTE]) and
                         ((pd.returndef.typ<>orddef) or
-                         (torddef(pd.returndef).ordtype<>bool8bit)) then
+                         (torddef(pd.returndef).ordtype<>pasbool)) then
                         Message(parser_e_comparative_operator_return_boolean);
                      if (optoken=_ASSIGNMENT) and
                         equal_defs(pd.returndef,tparavarsym(pd.parast.SymList[0]).vardef) then

+ 1 - 2
compiler/ppcgen/cgppc.pas

@@ -601,8 +601,7 @@ unit cgppc;
       current_asmdata.getjumplabel(hl);
       if not ((def.typ=pointerdef) or
              ((def.typ=orddef) and
-              (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
-                                        bool8bit,bool16bit,bool32bit,bool64bit]))) then
+              (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,pasbool]))) then
         begin
           if (current_settings.optimizecputype >= cpu_ppc970) or
              (current_settings.cputype >= cpu_ppc970) then

+ 2 - 2
compiler/ppcgen/ngppcadd.pas

@@ -177,8 +177,8 @@ implementation
         firstcomplex(self);
 
         cmpop:=false;
-        if (torddef(left.resultdef).ordtype=bool8bit) or
-           (torddef(right.resultdef).ordtype=bool8bit) then
+        if (torddef(left.resultdef).ordtype in [pasbool,bool8bit]) or
+           (torddef(right.resultdef).ordtype in [pasbool,bool8bit]) then
          cgsize:=OS_8
         else
           if (torddef(left.resultdef).ordtype=bool16bit) or

+ 55 - 9
compiler/ppcgen/ngppccnv.pas

@@ -85,20 +85,33 @@ implementation
          if codegenerror then
           exit;
 
-         { byte(boolean) or word(wordbool) or longint(longbool) must }
-         { be accepted for var parameters                            }
+         { bytebool(byte) or wordbool(word) or longbool(longint) must }
+         { be accepted for var parameters, and must not change the    }
+         { the ordinal value                                          }
          if (nf_explicit in flags) and
             (left.resultdef.size=resultdef.size) and
-            (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
+            not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) and
+            is_cbool(resultdef) and
+            not is_pasbool(left.resultdef) then
            begin
+              location_copy(location,left.location);
+              location.size:=def_cgsize(resultdef);
+              { change of sign? Then we have to sign/zero-extend in }
+              { case of a loc_(c)register                           }
+              if (location.size<>left.location.size) and
+                 (location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+                location_force_reg(current_asmdata.CurrAsmList,location,location.size,true);
               current_procinfo.CurrTrueLabel:=oldTrueLabel;
               current_procinfo.CurrFalseLabel:=oldFalseLabel;
-              location_copy(location,left.location);
               exit;
            end;
 
          location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
          opsize := def_cgsize(left.resultdef);
+{$ifndef cpu64bit}
+         if (opsize in [OS_64,OS_S64]) then
+           opsize:=OS_32;
+{$endif cpu64bit}
          case left.location.loc of
             LOC_CREFERENCE,LOC_REFERENCE,LOC_REGISTER,LOC_CREGISTER :
               begin
@@ -132,21 +145,39 @@ implementation
                        hreg1 := left.location.register;
                   end;
                 hreg2 := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
-                current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBIC,hreg2,hreg1,1));
-                current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBFE,hreg1,hreg2,hreg1));
+                
+                if not(is_cbool(resultdef)) then
+                  begin
+                    { hreg2:=hreg1-1; carry:=hreg1=0 }
+                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBIC,hreg2,hreg1,1));
+                    { hreg1:=hreg1-hreg2+carry (= hreg1-(hreg1-1)-carry) }
+                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBFE,hreg1,hreg2,hreg1));
+                  end
+                else
+                  begin
+                    { carry:=hreg1<>0 }
+                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBFIC,hreg2,hreg1,0));
+                    { hreg1:=hreg1-hreg1-carry }
+                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBFE,hreg1,hreg1,hreg1));
+                  end;
               end;
             LOC_FLAGS :
               begin
                 hreg1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
                 resflags:=left.location.resflags;
                 cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,hreg1);
+                if (is_cbool(resultdef)) then
+                  cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,hreg1,hreg1);
               end;
             LOC_JUMP :
               begin
                 hreg1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
                 current_asmdata.getjumplabel(hlabel);
                 cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
-                cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,hreg1);
+                if not(is_cbool(resultdef)) then
+                  cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,hreg1)
+                else
+                  cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,-1,hreg1);
                 cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel);
                 cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
                 cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,hreg1);
@@ -155,9 +186,24 @@ implementation
             else
               internalerror(10062);
          end;
-         location.register := hreg1;
+{$ifndef cpu64bit}
+         if (location.size in [OS_64,OS_S64]) then
+           begin
+             location.register64.reglo:=hreg1;
+             location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
+             if (is_cbool(resultdef)) then
+               { reglo is either 0 or -1 -> reghi has to become the same }
+               cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,location.register64.reglo,location.register64.reghi)
+             else
+               { unsigned }
+               cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,location.register64.reghi);
+           end
+         else
+{$endif cpu64bit}
+           location.register:=hreg1;
+
          current_procinfo.CurrTrueLabel:=oldTrueLabel;
          current_procinfo.CurrFalseLabel:=oldFalseLabel;
       end;
 
-end.
+end.

+ 1 - 1
compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 89;
+  CurrentPPUVersion = 90;
 
 { buffer sizes }
   maxentrysize = 1024;

+ 8 - 5
compiler/psystem.pas

@@ -132,10 +132,11 @@ implementation
         s32inttype:=torddef.create(s32bit,int64(low(longint)),int64(high(longint)));
         u64inttype:=torddef.create(u64bit,low(qword),high(qword));
         s64inttype:=torddef.create(s64bit,low(int64),high(int64));
-        booltype:=torddef.create(bool8bit,0,1);
-        bool16type:=torddef.create(bool16bit,0,1);
-        bool32type:=torddef.create(bool32bit,0,1);
-        bool64type:=torddef.create(bool64bit,0,1);
+        booltype:=torddef.create(pasbool,0,1);
+        bool8type:=torddef.create(bool8bit,low(int64),high(int64));
+        bool16type:=torddef.create(bool16bit,low(int64),high(int64));
+        bool32type:=torddef.create(bool32bit,low(int64),high(int64));
+        bool64type:=torddef.create(bool64bit,low(int64),high(int64));
         cchartype:=torddef.create(uchar,0,255);
         cwidechartype:=torddef.create(uwidechar,0,65535);
         cshortstringtype:=tstringdef.createshort(255);
@@ -250,7 +251,7 @@ implementation
         addtype('UnicodeString',cunicodestringtype);
         addtype('OpenString',openshortstringtype);
         addtype('Boolean',booltype);
-        addtype('ByteBool',booltype);
+        addtype('ByteBool',bool8type);
         addtype('WordBool',bool16type);
         addtype('LongBool',bool32type);
         addtype('QWordBool',bool64type);
@@ -290,6 +291,7 @@ implementation
         addtype('$unicodestring',cwidestringtype);
         addtype('$openshortstring',openshortstringtype);
         addtype('$boolean',booltype);
+        addtype('$boolean8',bool8type);
         addtype('$boolean16',bool16type);
         addtype('$boolean32',bool32type);
         addtype('$boolean64',bool64type);
@@ -386,6 +388,7 @@ implementation
         loadtype('s80real',s80floattype);
         loadtype('s64currency',s64currencytype);
         loadtype('boolean',booltype);
+        loadtype('boolean8',bool8type);
         loadtype('boolean16',bool16type);
         loadtype('boolean32',bool32type);
         loadtype('boolean64',bool64type);

+ 4 - 0
compiler/ptconst.pas

@@ -184,7 +184,11 @@ implementation
 
         begin
            n:=comp_expr(true);
+           { for C-style booleans, true=-1 and false=0) }
+           if is_cbool(def) then
+             inserttypeconv(n,def);
            case def.ordtype of
+              pasbool,
               bool8bit :
                 begin
                    if is_constboolnode(n) then

+ 2 - 2
compiler/ptype.pas

@@ -510,7 +510,7 @@ implementation
                                def:=torddef.create(uchar,lv,hv)
                              else
                                if is_boolean(pt1.resultdef) then
-                                 def:=torddef.create(bool8bit,lv,hv)
+                                 def:=torddef.create(pasbool,lv,hv)
                                else if is_signed(pt1.resultdef) then
                                  def:=torddef.create(range_to_basetype(lv,hv),lv,hv)
                                else
@@ -614,7 +614,7 @@ implementation
 {$ifdef cpu64bit}
                     u32bit,s64bit,
 {$endif cpu64bit}
-                    bool8bit,bool16bit,bool32bit,bool64bit,
+                    pasbool,bool8bit,bool16bit,bool32bit,bool64bit,
                     uwidechar] then
                     begin
                        lowval:=torddef(def).low;

+ 1 - 1
compiler/sparc/cgcpu.pas

@@ -1010,7 +1010,7 @@ implementation
             begin
               if not((def.typ=pointerdef) or
                     ((def.typ=orddef) and
-                     (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,bool8bit,bool16bit,bool32bit]))) then
+                     (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,pasbool]))) then
                 begin
                   ai:=TAiCpu.Op_sym(A_Bxx,hl);
                   ai.SetCondition(C_NO);

+ 48 - 19
compiler/sparc/ncpucnv.pas

@@ -233,17 +233,27 @@ implementation
         if codegenerror then
           exit;
 
-        { byte(boolean) or word(wordbool) or longint(longbool) must }
-        { be accepted for var parameters                            }
-        if (nf_explicit in flags)and
-           (left.resultdef.size=resultdef.size)and
-           (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
-          begin
-            location_copy(location,left.location);
-            current_procinfo.CurrTrueLabel:=oldTrueLabel;
-            current_procinfo.CurrFalseLabel:=oldFalseLabel;
-            exit;
-          end;
+         { bytebool(byte) or wordbool(word) or longbool(longint) must }
+         { be accepted for var parameters, and must not change the    }
+         { the ordinal value                                          }
+         if (nf_explicit in flags) and
+            (left.resultdef.size=resultdef.size) and
+            not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) and
+            is_cbool(resultdef) and
+            not is_pasbool(left.resultdef) then
+           begin
+              location_copy(location,left.location);
+              location.size:=def_cgsize(resultdef);
+              { change of sign? Then we have to sign/zero-extend in }
+              { case of a loc_(c)register                           }
+              if (location.size<>left.location.size) and
+                 (location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+                location_force_reg(current_asmdata.CurrAsmList,location,location.size,true);
+              current_procinfo.CurrTrueLabel:=oldTrueLabel;
+              current_procinfo.CurrFalseLabel:=oldFalseLabel;
+              exit;
+           end;
+
         location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
         opsize:=def_cgsize(left.resultdef);
         case left.location.loc of
@@ -260,27 +270,35 @@ implementation
               if left.location.size in [OS_64,OS_S64] then
                 begin
                   hreg1:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
-                  cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,hreg2,tregister(succ(longint(hreg2))),hreg1);
+                  cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,hreg2,left.location.register64.reghi,hreg1);
                   hreg2:=hreg1;
                   opsize:=OS_32;
                 end;
 {$endif cpu64bit}
-              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBCC,NR_G0,hreg2,NR_G0));
               hreg1:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
-              current_asmdata.CurrAsmList.concat(taicpu.op_reg_const_reg(A_ADDX,NR_G0,0,hreg1));
+              current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBCC,NR_G0,hreg2,NR_G0));
+              if is_pasbool(resultdef) then
+                current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ADDX,NR_G0,NR_G0,hreg1))
+              else
+                current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBX,NR_G0,NR_G0,hreg1));
             end;
           LOC_FLAGS :
             begin
               hreg1:=cg.GetIntRegister(current_asmdata.CurrAsmList,location.size);
               resflags:=left.location.resflags;
               cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,hreg1);
+              if (is_cbool(resultdef)) then
+                cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,hreg1,hreg1);
             end;
           LOC_JUMP :
             begin
               hreg1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
               current_asmdata.getjumplabel(hlabel);
               cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
-              cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,hreg1);
+              if not(is_cbool(resultdef)) then
+                cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,hreg1)
+              else
+                cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,-1,hreg1);
               cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel);
               cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
               cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,hreg1);
@@ -289,10 +307,21 @@ implementation
           else
             internalerror(10062);
         end;
-        location.register:=hreg1;
-
-         if location.size in [OS_64, OS_S64] then
-           internalerror(200408241);
+{$ifndef cpu64bit}
+         if (location.size in [OS_64,OS_S64]) then
+           begin
+             location.register64.reglo:=hreg1;
+             location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
+             if (is_cbool(resultdef)) then
+               { reglo is either 0 or -1 -> reghi has to become the same }
+               cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,location.register64.reglo,location.register64.reghi)
+             else
+               { unsigned }
+               cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,location.register64.reghi);
+           end
+         else
+{$endif cpu64bit}
+           location.register:=hreg1;
 
         current_procinfo.CurrTrueLabel:=oldTrueLabel;
         current_procinfo.CurrFalseLabel:=oldFalseLabel;

+ 1 - 1
compiler/symconst.pas

@@ -177,7 +177,7 @@ type
     uvoid,
     u8bit,u16bit,u32bit,u64bit,
     s8bit,s16bit,s32bit,s64bit,
-    bool8bit,bool16bit,bool32bit,bool64bit,
+    pasbool,bool8bit,bool16bit,bool32bit,bool64bit,
     uchar,uwidechar,scurrency
   );
 

+ 5 - 4
compiler/symdef.pas

@@ -576,6 +576,7 @@ interface
        cchartype,                 { Char }
        cwidechartype,             { WideChar }
        booltype,                  { boolean type }
+       bool8type,
        bool16type,
        bool32type,
        bool64type,                { implement me }
@@ -1510,7 +1511,7 @@ implementation
           0,
           1,2,4,8,
           1,2,4,8,
-          1,2,4,8,
+          1,1,2,4,8,
           1,2,8
         );
       begin
@@ -1555,7 +1556,7 @@ implementation
           varUndefined,
           varbyte,varqword,varlongword,varqword,
           varshortint,varsmallint,varinteger,varint64,
-          varboolean,varboolean,varUndefined,varUndefined,
+          varboolean,varboolean,varboolean,varUndefined,varUndefined,
           varUndefined,varUndefined,varCurrency);
       begin
         result:=basetype2vardef[ordtype];
@@ -1584,7 +1585,7 @@ implementation
           'untyped',
           'Byte','Word','DWord','QWord',
           'ShortInt','SmallInt','LongInt','Int64',
-          'Boolean','WordBool','LongBool','QWordBool',
+          'Boolean','ByteBool','WordBool','LongBool','QWordBool',
           'Char','WideChar','Currency');
 
       begin
@@ -3367,7 +3368,7 @@ implementation
              '',
              'Uc','Us','Ui','Us',
              'Sc','s','i','x',
-             'b','b','b','b',
+             'b','b','b','b','b',
              'c','w','x');
 
         var

+ 1 - 2
compiler/x86/cgx86.pas

@@ -2053,8 +2053,7 @@ unit cgx86;
          current_asmdata.getjumplabel(hl);
          if not ((def.typ=pointerdef) or
                 ((def.typ=orddef) and
-                 (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
-                                       bool8bit,bool16bit,bool32bit,bool64bit]))) then
+                 (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,pasbool]))) then
            cond:=C_NO
          else
            cond:=C_NB;

+ 51 - 11
compiler/x86/nx86cnv.pas

@@ -85,6 +85,9 @@ implementation
 
     procedure tx86typeconvnode.second_int_to_bool;
       var
+{$ifndef cpu64bit}
+        hreg2,
+{$endif cpu64bit}
         hregister : tregister;
 {$ifndef cpu64bit}
         href      : treference;
@@ -99,13 +102,22 @@ implementation
          secondpass(left);
          if codegenerror then
           exit;
-         { byte(boolean) or word(wordbool) or longint(longbool) must }
-         { be accepted for var parameters                            }
+         { bytebool(byte) or wordbool(word) or longbool(longint) must }
+         { be accepted for var parameters, and must not change the    }
+         { the ordinal value                                          }
          if (nf_explicit in flags) and
             (left.resultdef.size=resultdef.size) and
-            (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
+            not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) and
+            is_cbool(resultdef) and
+            not is_pasbool(left.resultdef) then
            begin
               location_copy(location,left.location);
+              location.size:=def_cgsize(resultdef);
+              { change of sign? Then we have to sign/zero-extend in }
+              { case of a loc_(c)register                           }
+              if (location.size<>left.location.size) and
+                 (location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+                location_force_reg(current_asmdata.CurrAsmList,location,location.size,true);
               current_procinfo.CurrTrueLabel:=oldTrueLabel;
               current_procinfo.CurrFalseLabel:=oldFalseLabel;
               exit;
@@ -156,23 +168,51 @@ implementation
               end;
             LOC_JUMP :
               begin
-                hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+                location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
+                location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
                 current_asmdata.getjumplabel(hlabel);
                 cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
-                cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,hregister);
+                if not(is_cbool(resultdef)) then
+                  cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size,1,location.register)
+                else
+                  cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size,-1,location.register);
                 cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel);
                 cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
-                cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,hregister);
+                cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size,0,location.register);
                 cg.a_label(current_asmdata.CurrAsmList,hlabel);
-                cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_INT,hregister,hregister);
               end;
             else
               internalerror(10062);
          end;
-         { load flags to register }
-         location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
-         location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
-         cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,location.register);
+         if (left.location.loc<>LOC_JUMP) then
+           begin
+             { load flags to register }
+             location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
+{$ifndef cpu64bit}
+              if (location.size in [OS_64,OS_S64]) then
+                begin
+                  hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
+                  cg.g_flags2reg(current_asmdata.CurrAsmList,OS_32,resflags,hreg2);
+                  if (is_cbool(resultdef)) then
+                    cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,OS_32,hreg2,hreg2);
+                  location.register64.reglo:=hreg2;
+                  location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
+                  if (is_cbool(resultdef)) then
+                    { reglo is either 0 or -1 -> reghi has to become the same }
+                    cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,location.register64.reglo,location.register64.reghi)
+                  else
+                    { unsigned }
+                    cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,location.register64.reghi);
+                end
+             else
+{$endif cpu64bit}
+               begin
+                 location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
+                 cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,location.register);
+                 if (is_cbool(resultdef)) then
+                   cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,location.register,location.register);
+               end
+           end;
          current_procinfo.CurrTrueLabel:=oldTrueLabel;
          current_procinfo.CurrFalseLabel:=oldFalseLabel;
        end;

+ 1 - 1
rtl/powerpc/int64p.inc

@@ -152,7 +152,7 @@
 
         or.     r10,r3,r5    // are both msw's 0?
         mulhwu  r8,r4,r6    // msw of product of lsw's
-        subi    r0,r7,1     // if no overflowcheck, r0 := $ffffffff, else r0 := 0;
+        not     r0,r7       // if no overflowcheck, r0 := $ffffffff, else r0 := 0;
         beq     .LDone      // if both msw's are zero, skip cross products
         mullw   r9,r4,r5    // lsw of first cross-product
         cntlzw  r11,r3      // count leading zeroes of msw1

+ 4 - 2
rtl/unix/tthread.inc

@@ -247,7 +247,7 @@ begin
   if FThreadID = GetCurrentThreadID then
     begin
       if not FSuspended and
-         (InterLockedExchange(longint(FSuspended),ord(true)) = ord(false)) then
+         (InterLockedExchange(longint(FSuspended),longint(longbool(true))) = longint(longbool(false))) then
         CurrentTM.SemaphoreWait(FSem)
     end
   else
@@ -264,7 +264,9 @@ begin
   if (not FSuspendedExternal) then
     begin
       if FSuspended and
-         (InterLockedExchange(longint(FSuspended),ord(false)) = ord(true)) then
+         { don't compare with ord(true) or ord(longbool(true)), }
+         { becaue a longbool's "true" value is anyting <> false }
+         (InterLockedExchange(longint(FSuspended),longint(false)) <> longint(longbool(false))) then
         begin
           WRITE_DEBUG('resuming ',ptruint(self));
           CurrentTM.SemaphorePost(FSem);

+ 154 - 5
tests/test/cg/taddbool.pp

@@ -25,7 +25,8 @@ end;
 
 procedure BoolTestAnd;
 var
- bb1, bb2: boolean;
+ b1, b2: boolean;
+ bb1, bb2: bytebool;
  wb1, wb2: wordbool;
  lb1, lb2: longbool;
  result : boolean;
@@ -33,6 +34,36 @@ begin
  result := true;
  { BOOLEAN AND BOOLEAN }
  Write('boolean AND boolean test...');
+ b1 := true;
+ b2 := false;
+ if b1 and b2 then
+   result := false;
+ if b2 then
+   result := false;
+ b1 := false;
+ b2 := false;
+ if b1 and b2 then
+   result := false;
+
+ b1 := b1 and b2;
+ if b1 then
+   result := false;
+ if b1 and FALSE then
+   result := false;
+ b1 := true;
+ b2 := true;
+ if b1 and b2 then
+  begin
+    if result then
+      WriteLn('Success.')
+    else
+      Fail;
+  end
+ else
+   Fail;
+
+ { BYTEBOOL AND BYTEBOOL }
+ Write('bytebool AND bytebool test...');
  bb1 := true;
  bb2 := false;
  if bb1 and bb2 then
@@ -129,7 +160,8 @@ end;
 
 procedure BoolTestOr;
 var
- bb1, bb2: boolean;
+ b1, b2: boolean;
+ bb1, bb2: bytebool;
  wb1, wb2: wordbool;
  lb1, lb2: longbool;
  result : boolean;
@@ -137,6 +169,36 @@ begin
  result := false;
  { BOOLEAN AND BOOLEAN }
  Write('boolean OR boolean test...');
+ b1 := true;
+ b2 := false;
+ if b1 or b2 then
+   result := true;
+ b1 := false;
+ b2 := false;
+ if b1 or b2 then
+   result := false;
+
+ b1 := b1 or b2;
+ if b1 then
+   result := false;
+ if b1 or FALSE then
+   result := false;
+
+
+ b1 := true;
+ b2 := true;
+ if b1 or b2 then
+  begin
+    if result then
+      WriteLn('Success.')
+    else
+      Fail;
+  end
+ else
+   Fail;
+
+ { BYTEBOOL AND BYTEBOOL }
+ Write('bytebool OR bytebool test...');
  bb1 := true;
  bb2 := false;
  if bb1 or bb2 then
@@ -231,7 +293,8 @@ end;
 
 Procedure BoolTestXor;
 var
- bb1, bb2: boolean;
+ b1, b2: boolean;
+ bb1, bb2: bytebool;
  wb1, wb2: wordbool;
  lb1, lb2: longbool;
  result : boolean;
@@ -239,6 +302,38 @@ begin
  result := false;
  { BOOLEAN XOR BOOLEAN }
  Write('boolean XOR boolean test...');
+ b1 := true;
+ b2 := false;
+ if b1 xor b2 then
+   result := true;
+ b1 := false;
+ b2 := false;
+ if b1 xor b2 then
+   result := false;
+
+ b1 := b1 xor b2;
+ if b1 then
+   result := false;
+ if b1 xor FALSE then
+   result := false;
+
+
+ b1 := true;
+ b2 := true;
+ if b1 xor b2 then
+  begin
+     Fail;
+  end
+ else
+  begin
+    if result then
+      WriteLn('Success.')
+    else
+      Fail;
+  end;
+
+ { BYTEBOOL XOR BYTEBOOL }
+ Write('bytebool XOR bytebool test...');
  bb1 := true;
  bb2 := false;
  if bb1 xor bb2 then
@@ -338,7 +433,8 @@ end;
 
 Procedure BoolTestEqual;
 var
- bb1, bb2, bb3: boolean;
+ b1, b2, b3: boolean;
+ bb1, bb2, bb3: bytebool;
  wb1, wb2, wb3: wordbool;
  lb1, lb2, lb3: longbool;
  result : boolean;
@@ -348,6 +444,30 @@ Begin
  { BOOLEAN = BOOLEAN }
  result := true;
  Write('boolean = boolean test...');
+ b1 := true;
+ b2 := true;
+ b3 := false;
+ b1 := (b1 = b2) and (b2 and false);
+ if b1 then
+   result := false;
+ b1 := true;
+ b2 := true;
+ b3 := false;
+ b1 := (b1 = b2) and (b2 and true);
+ if not b1 then
+   result := false;
+ if b1 = b2 then
+  begin
+    if result then
+      WriteLn('Success.')
+    else
+      Fail;
+  end
+ else
+   Fail;
+ { BYTEBOOL = BYTEBOOL }
+ result := true;
+ Write('bytebool = bytebool test...');
  bb1 := true;
  bb2 := true;
  bb3 := false;
@@ -440,7 +560,8 @@ end;
 
 Procedure BoolTestNotEqual;
 var
- bb1, bb2, bb3: boolean;
+ b1, b2, b3: boolean;
+ bb1, bb2, bb3: bytebool;
  wb1, wb2, wb3: wordbool;
  lb1, lb2, lb3: longbool;
  result : boolean;
@@ -448,6 +569,34 @@ Begin
  { BOOLEAN <> BOOLEAN }
  result := true;
  Write('boolean <> boolean test...');
+ b1 := true;
+ b2 := true;
+ b3 := false;
+ b1 := (b1 <> b2) and (b2 <> false);
+ if b1 then
+   result := false;
+ b1 := true;
+ b2 := true;
+ b3 := false;
+ b1 := (b1 <> b2) and (b2 <> true);
+ if b1 then
+   result := false;
+ b1 := false;
+ b2 := false;
+ if b1 <> b2 then
+  begin
+      Fail;
+  end
+ else
+  begin
+   if result then
+     WriteLn('Success.')
+   else
+     Fail;
+  end;
+ { BYTEBOOL <> BYTEBOOL }
+ result := true;
+ Write('bytebool <> bytebool test...');
  bb1 := true;
  bb2 := true;
  bb3 := false;

+ 117 - 44
tests/test/cg/tcnvint1.pp

@@ -25,9 +25,11 @@ var
 {$ifndef tp}
  toint64 : int64;
 {$endif}
+ b1  : boolean;
  bb1 : bytebool;
  wb1 : wordbool;
  lb1 : longbool;
+ b2  : boolean;
  bb2 : bytebool;
  wb2 : wordbool;
  lb2 : longbool;
@@ -35,40 +37,70 @@ begin
  { left : LOC_REGISTER  }
  { from : LOC_REFERENCE/LOC_REGISTER }
  WriteLn('Testing LOC_REFERENCE...');
- bb1 := TRUE;
- tobyte := byte(bb1);
+ b1 := TRUE;
+ tobyte := byte(b1);
  WriteLn('boolean->byte : value should be 1...',tobyte);
  if tobyte <> 1 then 
    halt(1);
+ b1 := FALSE;
+ tobyte := byte(b1);
+ WriteLn('boolean->byte : value should be 0...',tobyte);
+ if tobyte <> 0 then 
+   halt(1);
+ b1 := TRUE;
+ toword := word(b1);
+ WriteLn('boolean->word : value should be 1...',toword);
+ if toword <> 1 then 
+   halt(1);
+ b1 := FALSE;
+ toword := word(b1);
+ WriteLn('boolean->word : value should be 0...',toword);
+ if toword <> 0 then 
+   halt(1);
+ b1 := TRUE;
+ tolong := longint(b1);
+ WriteLn('boolean->longint : value should be 1...',tolong);
+ if tolong <> 1 then 
+   halt(1);
+ b1 := FALSE;
+ tolong := longint(b1);
+ WriteLn('boolean->longint : value should be 0...',tolong);
+ if tolong <> 0 then 
+   halt(1);
+ bb1 := TRUE;
+ tobyte := byte(bb1);
+ WriteLn('bytebool->byte : value should be 255...',tobyte);
+ if tobyte <> 255 then 
+   halt(1);
  bb1 := FALSE;
  tobyte := byte(bb1);
- WriteLn('boolean->byte : value should be 0...',tobyte);
+ WriteLn('bytebool->byte : value should be 0...',tobyte);
  if tobyte <> 0 then 
    halt(1);
  bb1 := TRUE;
  toword := word(bb1);
- WriteLn('boolean->word : value should be 1...',toword);
- if toword <> 1 then 
+ WriteLn('bytebool->word : value should be 65535...',toword);
+ if toword <> 65535 then 
    halt(1);
  bb1 := FALSE;
  toword := word(bb1);
- WriteLn('boolean->word : value should be 0...',toword);
+ WriteLn('bytebool->word : value should be 0...',toword);
  if toword <> 0 then 
    halt(1);
  bb1 := TRUE;
  tolong := longint(bb1);
- WriteLn('boolean->longint : value should be 1...',tolong);
- if tolong <> 1 then 
+ WriteLn('bytebool->longint : value should be -1...',tolong);
+ if tolong <> -1 then 
    halt(1);
  bb1 := FALSE;
  tolong := longint(bb1);
- WriteLn('boolean->longint : value should be 0...',tolong);
+ WriteLn('bytebool->longint : value should be 0...',tolong);
  if tolong <> 0 then 
    halt(1);
  wb1 := TRUE;
  tobyte := byte(wb1);
- WriteLn('wordbool->byte : value should be 1...',tobyte);
- if tobyte <> 1 then 
+ WriteLn('wordbool->byte : value should be 255...',tobyte);
+ if tobyte <> 255 then 
    halt(1);
  wb1 := FALSE;
  tobyte := byte(wb1);
@@ -77,8 +109,8 @@ begin
    halt(1);
  wb1 := TRUE;
  toword := word(wb1);
- WriteLn('wordbool->word : value should be 1...',toword);
- if toword <> 1 then 
+ WriteLn('wordbool->word : value should be 65535...',toword);
+ if toword <> 65535 then 
    halt(1);
  wb1 := FALSE;
  toword := word(wb1);
@@ -87,8 +119,8 @@ begin
    halt(1);
  wb1 := TRUE;
  tolong := longint(wb1);
- WriteLn('wordbool->longint : value should be 1...',tolong);
- if tolong <> 1 then 
+ WriteLn('wordbool->longint : value should be -1...',tolong);
+ if tolong <> -1 then 
    halt(1);
  wb1 := FALSE;
  tolong := longint(wb1);
@@ -96,20 +128,30 @@ begin
  if tolong <> 0 then 
    halt(1);
 {$ifndef tp}
- bb1 := TRUE;
- toint64 :=int64(bb1);
+ b1 := TRUE;
+ toint64 :=int64(b1);
  WriteLn('boolean->int64 : value should be 1...',toint64);
  if toint64 <> 1 then 
    halt(1);
+ b1 := FALSE;
+ toint64 :=int64(b1);
+ WriteLn('boolean->int64 : value should be 0...',toint64);
+ if toint64 <> 0 then 
+   halt(1);
+ bb1 := TRUE;
+ toint64 :=int64(bb1);
+ WriteLn('bytebool->int64 : value should be -1...',toint64);
+ if toint64 <> -1 then 
+   halt(1);
  bb1 := FALSE;
  toint64 :=int64(bb1);
- WriteLn('boolean->int64 : value should be 0...',toint64);
+ WriteLn('bytebool->int64 : value should be 0...',toint64);
  if toint64 <> 0 then 
    halt(1);
  wb1 := TRUE;
  toint64 :=int64(wb1);
- WriteLn('wordbool->int64 : value should be 1...',toint64);
- if toint64 <> 1 then 
+ WriteLn('wordbool->int64 : value should be -1...',toint64);
+ if toint64 <> -1 then 
    halt(1);
  wb1 := FALSE;
  toint64 :=int64(wb1);
@@ -119,8 +161,8 @@ begin
 {$endif}
  lb1 := TRUE;
  tobyte := byte(lb1);
- WriteLn('longbool->byte : value should be 1...',tobyte);
- if tobyte <> 1 then 
+ WriteLn('longbool->byte : value should be 255...',tobyte);
+ if tobyte <> 255 then 
    halt(1);
  lb1 := FALSE;
  tobyte := byte(lb1);
@@ -129,8 +171,8 @@ begin
    halt(1);
  lb1 := TRUE;
  toword := word(lb1);
- WriteLn('longbool->word : value should be 1...',toword);
- if toword <> 1 then 
+ WriteLn('longbool->word : value should be 65535...',toword);
+ if toword <> 65535 then 
    halt(1);
  lb1 := FALSE;
  toword := word(lb1);
@@ -139,8 +181,8 @@ begin
    halt(1);
  lb1 := TRUE;
  tolong := longint(lb1);
- WriteLn('longbool->longint : value should be 1...',tolong);
- if tolong <> 1 then 
+ WriteLn('longbool->longint : value should be -1...',tolong);
+ if tolong <> -1 then 
    halt(1);
  lb1 := FALSE;
  tolong := longint(lb1);
@@ -149,34 +191,65 @@ begin
    halt(1);
  { left : LOC_REGISTER }
  { from : LOC_REFERENCE }
+ wb1 := TRUE;
+ b2 := wb1;
+ WriteLn('wordbool->boolean : value should be TRUE...',b2);
+ if not b2 then 
+   halt(1);
+ wb1 := FALSE;
+ b2 := wb1;
+ WriteLn('wordbool->boolean : value should be FALSE...',b2);
+ if b2 then 
+   halt(1);
+ lb1 := TRUE;
+ b2 := lb1;
+ WriteLn('longbool->boolean : value should be TRUE...',b2);
+ if not b2 then 
+   halt(1);
+ lb1 := FALSE;
+ b2 := lb1;
+ WriteLn('longbool->boolean : value should be FALSE...',b2);
+ if b2 then 
+   halt(1);
+
  wb1 := TRUE;
  bb2 := wb1;
- WriteLn('wordbool->boolean : value should be TRUE...',bb2);
+ WriteLn('wordbool->bytebool : value should be TRUE...',bb2);
  if not bb2 then 
    halt(1);
  wb1 := FALSE;
  bb2 := wb1;
- WriteLn('wordbool->boolean : value should be FALSE...',bb2);
+ WriteLn('wordbool->bytebool : value should be FALSE...',bb2);
  if bb2 then 
    halt(1);
  lb1 := TRUE;
  bb2 := lb1;
- WriteLn('longbool->boolean : value should be TRUE...',bb2);
+ WriteLn('longbool->bytebool : value should be TRUE...',bb2);
  if not bb2 then 
    halt(1);
  lb1 := FALSE;
  bb2 := lb1;
- WriteLn('longbool->boolean : value should be FALSE...',bb2);
+ WriteLn('longbool->bytebool : value should be FALSE...',bb2);
  if bb2 then 
    halt(1);
+ b1 := TRUE;
+ lb2 := b1;
+ WriteLn('boolean->longbool : value should be TRUE...',lb2);
+ if not lb2 then 
+   halt(1);
+ b1 := FALSE;
+ lb2 := b1;
+ WriteLn('boolean->longbool : value should be FALSE...',lb2);
+ if lb2 then 
+   halt(1);
  bb1 := TRUE;
  lb2 := bb1;
- WriteLn('boolean->longbool : value should be TRUE...',lb2);
+ WriteLn('bytebool->longbool : value should be TRUE...',lb2);
  if not lb2 then 
    halt(1);
  bb1 := FALSE;
  lb2 := bb1;
- WriteLn('boolean->longbool : value should be FALSE...',lb2);
+ WriteLn('bytebool->longbool : value should be FALSE...',lb2);
  if lb2 then 
    halt(1);
  { left : LOC_REGISTER }
@@ -237,61 +310,61 @@ begin
  WriteLn('Testing LOC_FLAGS...');
  wb1 := TRUE;
  bb1 := FALSE;
- bb1 := (wb1 > bb1);
+ bb1 := (wb1 <> bb1);
  WriteLn('Value should be TRUE...',bb1);
  if not bb1 then 
    halt(1);
  wb1 := FALSE;
  bb1 := FALSE;
- bb1 := (wb1 > bb1);
+ bb1 := (wb1 <> bb1);
  WriteLn('Value should be FALSE...',bb1);
  if bb1 then 
    halt(1);
  lb1 := TRUE;
  bb1 := FALSE;
- bb1 := (bb1 > lb1);
+ bb1 := (bb1 = lb1);
  WriteLn('Value should be FALSE...',bb1);
  if bb1 then 
    halt(1);
  lb1 := FALSE;
  bb1 := TRUE;
- bb1 := (bb1 > lb1);
+ bb1 := (bb1 <> lb1);
  WriteLn('Value should be TRUE...',bb1);
  if not bb1 then 
    halt(1);
  lb1 := TRUE;
  bb1 := FALSE;
- wb1 := (bb1 > lb1);
+ wb1 := (bb1 = lb1);
  WriteLn('Value should be FALSE...',wb1);
  if wb1 then 
    halt(1);
- lb1 := FALSE;
+ lb1 := TRUE;
  bb1 := TRUE;
- wb1 := (bb1 > lb1);
+ wb1 := (bb1 = lb1);
  WriteLn('Value should be TRUE...',wb1);
  if not wb1 then 
    halt(1);
  lb1 := TRUE;
  bb1 := FALSE;
- lb1 := (bb1 > lb1);
+ lb1 := (bb1 = lb1);
  WriteLn('Value should be FALSE...',lb1);
  if lb1 then 
    halt(1);
  lb1 := FALSE;
- bb1 := TRUE;
- lb1 := (bb1 > lb1);
+ bb1 := FALSE;
+ lb1 := (bb1 = lb1);
  WriteLn('Value should be TRUE...',lb1);
  if not lb1 then 
    halt(1);
  bb1 := TRUE;
  bb2 := FALSE;
- lb1 := (bb1 > bb2);
+ lb1 := (bb1 <> bb2);
  WriteLn('Value should be TRUE...',lb1);
  if not lb1 then 
    halt(1);
  bb1 := FALSE;
  bb2 := TRUE;
- lb1 := (bb1 > bb2);
+ lb1 := (bb1 = bb2);
  WriteLn('Value should be FALSE...',lb1);
  if lb1 then 
    halt(1);

+ 2 - 6
tests/test/cg/tcnvint2.pp

@@ -103,8 +103,6 @@ begin
  fromword := $1000;
  lb1 := longbool(fromword);
  Test('word -> longbool : Value should be TRUE...',lb1);
- if not lb1 then
-  failed:=true;
  { ------------------------------------------------------------   }
  { WARNING : This test fails under Borland Pascal v7, but         }
  { works under Delphi 3.0 (normally it should give TRUE).         }
@@ -161,9 +159,8 @@ begin
  lb1 := longbool(getint64_2);
  Test('int64 -> longbool : Value should be TRUE...',lb1);
 {$endif}
-(* CURRENTLY NEVER GOES INTO THE LOC_FLAGS LOCATION!
  { left : LOC_FLAGS  }
- Test('Testing LOC_FLAGS...');
+ Writeln('Testing LOC_FLAGS...');
  frombyte := 10;
  fromword := 2;
  bb1 := bytebool(frombyte > fromword);
@@ -183,14 +180,13 @@ begin
  fromword := $1000;
  fromlong := $0100;
  lb1 := longbool(fromlong > fromword);
- Test('Value should be FALSE...',lb1);
+ Test('Value should be TRUE...',not lb1);
 {$ifndef tp}
  fromint64 := $10000000;
  fromlong := $02;
  lb1 := longbool(fromint64 > fromlong);
  Test('Value should be TRUE...',lb1);
 {$endif}
-*)
   if failed then
    begin
      Writeln('Some tests failed!');

+ 19 - 1
tests/test/cg/tnot.pp

@@ -41,11 +41,16 @@ begin
  getintres := $7F7F;
 end;
 
-function getbyteboolval : boolean;
+function getbyteboolval : bytebool;
 begin
   getbyteboolval := TRUE;
 end;
 
+function getbooleanval : boolean;
+begin
+  getbooleanval := TRUE;
+end;
+
 procedure test(value, required: longint);
 begin
   if value <> required then
@@ -62,9 +67,11 @@ end;
 var
  longres :  longint;
  intres : smallint;
+ booleanval  : boolean;
  byteboolval : bytebool;
  wordboolval : wordbool;
  longboolval : longbool;
+ booleanres  : boolean;
  byteboolres : bytebool;
  wordboolres : wordbool;
  longboolres : longbool;
@@ -96,6 +103,11 @@ Begin
    { CURRENT NODE : LOC_REGISTER }
    { LEFT NODE :  LOC_REFERENCE  }
    WriteLn('(current) : LOC_REGISTER; (left) : LOC_REFERENCE');
+   booleanval := TRUE;
+   booleanres := not booleanval;
+   Write('Value should be FALSE...');
+   test(ord(booleanres),0);
+
    byteboolval := TRUE;
    byteboolres := not byteboolval;
    Write('Value should be FALSE...');
@@ -121,6 +133,12 @@ Begin
    { CURRENT NODE : LOC_FLAGS }
    { LEFT NODE :  LOC_FLAGS  }
    WriteLn('(current) : LOC_FLAGS; (left) : LOC_FLAGS');
+   intres := 1;
+   booleanres := TRUE;
+   booleanres:= not ((intres = 1));
+   Write('Value should be FALSE...');
+   test(ord(booleanres),0);
+
    intres := 1;
    byteboolres := TRUE;
    byteboolres:= not ((intres = 1));

+ 30 - 0
tests/webtbs/tw10233.pp

@@ -0,0 +1,30 @@
+var
+  i: Byte;
+  w: word;
+  l: cardinal;
+  g: qword;
+begin
+  i := 128;
+  if Byte(ByteBool(i))<>128 then
+    halt(1);
+  w := 32768;
+  if Word(WordBool(w))<>32768 then
+    halt(2);
+  l := $80000000;
+  if Cardinal(LongBool(l))<>$80000000 then
+    halt(3);
+  g := qword($8000000000000000);
+  if qword(qwordBool(g))<>qword($8000000000000000) then
+    halt(4);
+
+  if Byte(ByteBool(w))<>high(byte) then
+    halt(5);
+  if Word(WordBool(l))<>high(word) then
+    halt(6);
+  l := $80000000;
+  if Cardinal(LongBool(g))<>high(cardinal) then
+    halt(7);
+  g := qword($8000000000000000);
+  if qword(qwordBool(i))<>high(qword) then
+    halt(8);
+end.