Merged revisions 4455,4462,4465 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

r4455 (florian)
* partial fix (not for 64 bit CPUs yet) for #5641 (tested only lower byte of result of object constructors)


r4462 (florian)
+ first part of qwordbool implementation


r4465 (florian)
* fixed object constructor handling for 64 bit CPUs

git-svn-id: branches/fixes_2_0@4469 -

compiler/defcmp.pas

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

compiler/defutil.pas

@@ -328,7 +328,7 @@ implementation
                is_ordinal:=dt in [uchar,uwidechar,
                                   u8bit,u16bit,u32bit,u64bit,
                                   s8bit,s16bit,s32bit,s64bit,
-                                  bool8bit,bool16bit,bool32bit];
+                                  bool8bit,bool16bit,bool32bit,bool64bit];
              end;
            enumdef :
              is_ordinal:=true;
@@ -379,7 +379,7 @@ implementation
     function is_boolean(def : tdef) : boolean;
       begin
         is_boolean:=(def.deftype=orddef) and
-                    (torddef(def).typ in [bool8bit,bool16bit,bool32bit]);
+                    (torddef(def).typ in [bool8bit,bool16bit,bool32bit,bool64bit]);
       end;
 
 

compiler/ninl.pas

@@ -658,7 +658,8 @@ implementation
 {$endif cpu64bit}
                         bool8bit,
                         bool16bit,
-                        bool32bit :
+                        bool32bit,
+                        bool64bit:
                           begin
                             if do_read then
                               begin
@@ -1227,7 +1228,6 @@ implementation
             end;
         end;
 
-
       var
          vl,vl2    : TConstExprInt;
          vr        : bestreal;
@@ -1416,6 +1416,13 @@ implementation
                                left:=nil;
                                result:=hp;
                              end;
+                           bool64bit :
+                             begin
+                               { change to qword() }
+                               hp:=ctypeconvnode.create_internal(left,u64inttype);
+                               left:=nil;
+                               result:=hp;
+                             end;
                            uvoid :
                              CGMessage1(type_e_ordinal_expr_expected,left.resulttype.def.typename);
                            else

compiler/nmat.pas

@@ -724,7 +724,8 @@ implementation
               case torddef(left.resulttype.def).typ of
                 bool8bit,
                 bool16bit,
-                bool32bit :
+                bool32bit,
+                bool64bit :
                   begin
                     { here we do a boolean(byte(..)) type cast because }
                     { boolean(<int64>) is buggy in 1.00                }

compiler/pdecobj.pas

@@ -76,9 +76,13 @@ implementation
            { Set return type, class constructors return the
              created instance, object constructors return boolean }
            if is_class(pd._class) then
-            pd.rettype.setdef(pd._class)
+             pd.rettype.setdef(pd._class)
            else
-            pd.rettype:=booltype;
+{$ifdef CPU64bit}
+             pd.rettype:=bool64type;
+{$else CPU64bit}
+             pd.rettype:=bool32type;
+{$endif CPU64bit}
            constructor_head:=pd;
         end;
 

compiler/pdecsub.pas

@@ -932,9 +932,13 @@ implementation
                   { Set return type, class constructors return the
                     created instance, object constructors return boolean }
                   if is_class(pd._class) then
-                   pd.rettype.setdef(pd._class)
+                    pd.rettype.setdef(pd._class)
                   else
-                   pd.rettype:=booltype;
+{$ifdef CPU64bit}
+                    pd.rettype:=bool64type;
+{$else CPU64bit}
+                    pd.rettype:=bool32type;
+{$endif CPU64bit}
                 end;
             end;
 

compiler/powerpc/cgcpu.pas

@@ -578,7 +578,7 @@ const
            end
          else
            instr := taicpu.op_reg_reg(A_MR,reg2,reg1);
-           
+
          list.concat(instr);
          rg[R_INTREGISTER].add_move_instruction(instr);
        end;
@@ -2065,7 +2065,7 @@ const
          if not ((def.deftype=pointerdef) or
                 ((def.deftype=orddef) and
                  (torddef(def).typ in [u64bit,u16bit,u32bit,u8bit,uchar,
-                                                  bool8bit,bool16bit,bool32bit]))) then
+                                                  bool8bit,bool16bit,bool32bit,bool64bit]))) then
            begin
              list.concat(taicpu.op_reg(A_MCRXR,NR_CR7));
              a_jmp(list,A_BC,C_NO,7,hl)

compiler/psystem.pas

@@ -164,8 +164,9 @@ implementation
         addtype('OpenString',openshortstringtype);
         addtype('Boolean',booltype);
         addtype('ByteBool',booltype);
-        adddef('WordBool',torddef.create(bool16bit,0,1));
-        adddef('LongBool',torddef.create(bool32bit,0,1));
+        addtype('WordBool',bool16type);
+        addtype('LongBool',bool32type);
+        addtype('QWordBool',bool64type);
         addtype('Byte',u8inttype);
         addtype('ShortInt',s8inttype);
         addtype('Word',u16inttype);
@@ -205,6 +206,9 @@ implementation
         addtype('$widestring',cwidestringtype);
         addtype('$openshortstring',openshortstringtype);
         addtype('$boolean',booltype);
+        addtype('$boolean16',bool16type);
+        addtype('$boolean32',bool32type);
+        addtype('$boolean64',bool64type);
         addtype('$void_pointer',voidpointertype);
         addtype('$char_pointer',charpointertype);
         addtype('$widechar_pointer',widecharpointertype);
@@ -294,6 +298,9 @@ implementation
         loadtype('s80real',s80floattype);
         loadtype('s64currency',s64currencytype);
         loadtype('boolean',booltype);
+        loadtype('boolean16',bool16type);
+        loadtype('boolean32',bool32type);
+        loadtype('boolean64',bool64type);
         loadtype('void_pointer',voidpointertype);
         loadtype('char_pointer',charpointertype);
         loadtype('widechar_pointer',widecharpointertype);
@@ -339,6 +346,9 @@ implementation
         u64inttype.setdef(torddef.create(u64bit,low(qword),TConstExprInt(high(qword))));
         s64inttype.setdef(torddef.create(s64bit,low(int64),high(int64)));
         booltype.setdef(torddef.create(bool8bit,0,1));
+        bool16type.setdef(torddef.create(bool16bit,0,1));
+        bool32type.setdef(torddef.create(bool32bit,0,1));
+        bool64type.setdef(torddef.create(bool64bit,0,1));
         cchartype.setdef(torddef.create(uchar,0,255));
         cwidechartype.setdef(torddef.create(uwidechar,0,65535));
         cshortstringtype.setdef(tstringdef.createshort(255));

compiler/ptconst.pas

@@ -155,6 +155,13 @@ implementation
                          else
                            Message(parser_e_illegal_expression);
                       end;
+                    bool64bit :
+                      begin
+                         if is_constboolnode(p) then
+                           curconstSegment.concat(Tai_const.Create_64bit(int64(tordconstnode(p).value)))
+                         else
+                           Message(parser_e_illegal_expression);
+                      end;
                     uchar :
                       begin
                          if is_constcharnode(p) then

compiler/ptype.pas

@@ -392,7 +392,7 @@ implementation
 {$ifdef cpu64bit}
                     u32bit,s64bit,
 {$endif cpu64bit}
-                    bool8bit,bool16bit,bool32bit,
+                    bool8bit,bool16bit,bool32bit,bool64bit,
                     uwidechar] then
                     begin
                        lowval:=torddef(t.def).low;

compiler/symconst.pas

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

compiler/symdef.pas

@@ -754,6 +754,9 @@ interface
        cchartype,                 { Char }
        cwidechartype,             { WideChar }
        booltype,                  { boolean type }
+       bool16type,
+       bool32type,
+       bool64type,                { implement me }
        u8inttype,                 { 8-Bit unsigned integer }
        s8inttype,                 { 8-Bit signed integer }
        u16inttype,                { 16-Bit unsigned integer }
@@ -2031,7 +2034,7 @@ implementation
           0,
           1,2,4,8,
           1,2,4,8,
-          1,2,4,
+          1,2,4,8,
           1,2,8
         );
       begin
@@ -2045,7 +2048,7 @@ implementation
           varUndefined,
           varbyte,varqword,varlongword,varqword,
           varshortint,varsmallint,varinteger,varint64,
-          varboolean,varUndefined,varUndefined,
+          varboolean,varUndefined,varUndefined,varUndefined,
           varUndefined,varUndefined,varCurrency);
       begin
         result:=basetype2vartype[typ];
@@ -2126,7 +2129,7 @@ implementation
             (otUByte{otNone},
              otUByte,otUWord,otULong,otUByte{otNone},
              otSByte,otSWord,otSLong,otUByte{otNone},
-             otUByte,otUWord,otULong,
+             otUByte,otUWord,otULong,otUByte,
              otUByte,otUWord,otUByte);
         begin
           write_rtti_name;
@@ -2204,7 +2207,7 @@ implementation
           'untyped',
           'Byte','Word','DWord','QWord',
           'ShortInt','SmallInt','LongInt','Int64',
-          'Boolean','WordBool','LongBool',
+          'Boolean','WordBool','LongBool','QWordBool',
           'Char','WideChar','Currency');
 
       begin
@@ -4629,7 +4632,7 @@ implementation
              '',
              'Uc','Us','Ui','Us',
              'Sc','s','i','x',
-             'b','b','b',
+             'b','b','b','b',
              'c','w','x');
 
         var

compiler/x86/cgx86.pas

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

rtl/inc/objects.pp

@@ -2221,6 +2221,9 @@ BEGIN
    Search := False;                                   { Preset failure }
    L := 0;                                            { Start count }
    H := Count - 1;                                    { End count }
+   Index := 0;
+   if H<=0 then
+     exit;
    While (L <= H) Do Begin
      I := (L + H) SHR 1;                              { Mid point }
      C := Compare(KeyOf(Items^[I]), Key);             { Compare with key }