소스 검색

* removed uauto from orddef, use new range_to_basetype generating
the correct ordinal type for a range

peter 23 년 전
부모
커밋
d24762aeba
6개의 변경된 파일118개의 추가작업 그리고 105개의 파일을 삭제
  1. 5 2
      compiler/pdecobj.pas
  2. 11 7
      compiler/ptype.pas
  3. 9 5
      compiler/symconst.pas
  4. 37 66
      compiler/symdef.pas
  5. 43 15
      compiler/types.pas
  6. 13 10
      compiler/utils/ppudump.pp

+ 5 - 2
compiler/pdecobj.pas

@@ -506,6 +506,8 @@ implementation
                             is_64bitint(p.proptype.def) or
                             ((p.proptype.def.deftype=setdef) and
                              (tsetdef(p.proptype.def).settype=smallset))) or
+                            ((p.proptype.def.deftype=arraydef) and
+                             (ppo_indexed in p.propoptions)) or
                         not(propertyparas.empty) then
                        Message(parser_e_property_cant_have_a_default_value);
                      { Get the result of the default, the firstpass is
@@ -1109,8 +1111,9 @@ implementation
 end.
 {
   $Log$
-  Revision 1.35  2001-12-31 16:59:41  peter
-    * protected/private symbols parsing fixed
+  Revision 1.36  2002-01-06 12:08:15  peter
+    * removed uauto from orddef, use new range_to_basetype generating
+      the correct ordinal type for a range
 
   Revision 1.34  2001/12/06 17:57:35  florian
     + parasym to tparaitem added

+ 11 - 7
compiler/ptype.pas

@@ -246,6 +246,7 @@ implementation
         procedure expr_type;
         var
            pt1,pt2 : tnode;
+           lv,hv   : TConstExprInt;
         begin
            { use of current parsed object ? }
            if (token=_ID) and (testcurobject=2) and (curobjectname=pattern) then
@@ -274,24 +275,26 @@ implementation
                if (pt1.nodetype=ordconstn) and
                   (pt2.nodetype=ordconstn) then
                  begin
+                   lv:=tordconstnode(pt1).value;
+                   hv:=tordconstnode(pt2).value;
                    { Check bounds }
-                   if tordconstnode(pt2).value<tordconstnode(pt1).value then
+                   if hv<lv then
                      Message(cg_e_upper_lower_than_lower)
                    else
                      begin
                        { All checks passed, create the new def }
                        case pt1.resulttype.def.deftype of
                          enumdef :
-                           tt.setdef(tenumdef.create_subrange(tenumdef(pt1.resulttype.def),tordconstnode(pt1).value,tordconstnode(pt2).value));
+                           tt.setdef(tenumdef.create_subrange(tenumdef(pt1.resulttype.def),lv,hv));
                          orddef :
                            begin
                              if is_char(pt1.resulttype.def) then
-                               tt.setdef(torddef.create(uchar,tordconstnode(pt1).value,tordconstnode(pt2).value))
+                               tt.setdef(torddef.create(uchar,lv,hv))
                              else
                                if is_boolean(pt1.resulttype.def) then
-                                 tt.setdef(torddef.create(bool8bit,tordconstnode(pt1).value,tordconstnode(pt2).value))
+                                 tt.setdef(torddef.create(bool8bit,l,hv))
                                else
-                                 tt.setdef(torddef.create(uauto,tordconstnode(pt1).value,tordconstnode(pt2).value));
+                                 tt.setdef(torddef.create(range_to_basetype(lv,hv),lv,hv));
                            end;
                        end;
                      end;
@@ -607,8 +610,9 @@ implementation
 end.
 {
   $Log$
-  Revision 1.31  2001-12-31 16:59:43  peter
-    * protected/private symbols parsing fixed
+  Revision 1.32  2002-01-06 12:08:15  peter
+    * removed uauto from orddef, use new range_to_basetype generating
+      the correct ordinal type for a range
 
   Revision 1.30  2001/08/30 20:13:53  peter
     * rtti/init table updates

+ 9 - 5
compiler/symconst.pas

@@ -132,11 +132,11 @@ type
 
   { base types for orddef }
   tbasetype = (
-    uauto,uvoid,uchar,
-    u8bit,u16bit,u32bit,
-    s8bit,s16bit,s32bit,
+    uvoid,
+    u8bit,u16bit,u32bit,u64bit,
+    s8bit,s16bit,s32bit,s64bit,
     bool8bit,bool16bit,bool32bit,
-    u64bit,s64bit,uwidechar
+    uchar,uwidechar
   );
 
   { float types }
@@ -326,7 +326,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.27  2001-10-25 21:22:37  peter
+  Revision 1.28  2002-01-06 12:08:15  peter
+    * removed uauto from orddef, use new range_to_basetype generating
+      the correct ordinal type for a range
+
+  Revision 1.27  2001/10/25 21:22:37  peter
     * calling convention rewrite
 
   Revision 1.26  2001/10/23 21:49:43  peter

+ 37 - 66
compiler/symdef.pas

@@ -1655,65 +1655,26 @@ implementation
 
     procedure torddef.setsize;
       begin
-         if typ=uauto then
-           begin
-              { generate a unsigned range if high<0 and low>=0 }
-              if (low>=0) and (high<0) then
-                begin
-                   savesize:=4;
-                   typ:=u32bit;
-                end
-              else if (low>=0) and (high<=255) then
-                begin
-                   savesize:=1;
-                   typ:=u8bit;
-                end
-              else if (low>=-128) and (high<=127) then
-                begin
-                   savesize:=1;
-                   typ:=s8bit;
-                end
-              else if (low>=0) and (high<=65536) then
-                begin
-                   savesize:=2;
-                   typ:=u16bit;
-                end
-              else if (low>=-32768) and (high<=32767) then
-                begin
-                   savesize:=2;
-                   typ:=s16bit;
-                end
-              else
-                begin
-                   savesize:=4;
-                   typ:=s32bit;
-                end;
-           end
-         else
-           begin
-             case typ of
-                u8bit,s8bit,
-                uchar,bool8bit:
-                  savesize:=1;
-
-                u16bit,s16bit,
-                bool16bit,uwidechar:
-                  savesize:=2;
-
-                s32bit,u32bit,
-                bool32bit:
-                  savesize:=4;
-
-                u64bit,s64bit:
-                  savesize:=8;
-             else
-               savesize:=0;
-             end;
-           end;
+         case typ of
+            u8bit,s8bit,
+            uchar,bool8bit:
+              savesize:=1;
+            u16bit,s16bit,
+            bool16bit,uwidechar:
+              savesize:=2;
+            s32bit,u32bit,
+            bool32bit:
+              savesize:=4;
+            u64bit,s64bit:
+              savesize:=8;
+            else
+              savesize:=0;
+         end;
        { there are no entrys for range checking }
          rangenr:=0;
       end;
 
+
     function torddef.getrangecheckstring : string;
 
       begin
@@ -1808,8 +1769,12 @@ implementation
 
         procedure dointeger;
         const
-          trans : array[uchar..bool8bit] of byte =
-            (otUByte,otUByte,otUWord,otULong,otSByte,otSWord,otSLong,otUByte);
+          trans : array[tbasetype] of byte =
+            (otUByte{otNone},
+             otUByte,otUWord,otULong,otUByte{otNone},
+             otSByte,otSWord,otSLong,otUByte{otNone},
+             otUByte,otUWord,otULong,
+             otUByte,otUWord);
         begin
           write_rtti_name;
           rttiList.concat(Tai_const.Create_8bit(byte(trans[typ])));
@@ -1873,10 +1838,12 @@ implementation
     function torddef.gettypename : string;
 
       const
-        names : array[tbasetype] of string[20] = ('<unknown type>',
-          'untyped','Char','Byte','Word','DWord','ShortInt',
-          'SmallInt','LongInt','Boolean','WordBool',
-          'LongBool','QWord','Int64','WideChar');
+        names : array[tbasetype] of string[20] = (
+          'untyped',
+          'Byte','Word','DWord','QWord',
+          'ShortInt','SmallInt','LongInt','Int64',
+          'Boolean','WordBool','LongBool',
+          'Char','WideChar');
 
       begin
          gettypename:=names[typ];
@@ -3805,11 +3772,11 @@ implementation
 
         const
            ordtype2str : array[tbasetype] of string[2] = (
-             '','','c',
-             'Uc','Us','Ui',
-             'Sc','s','i',
+             '',
+             'Uc','Us','Ui','Us',
+             'Sc','s','i','x',
              'b','b','b',
-             'Us','x','w');
+             'c','w');
 
         var
            s : string;
@@ -5506,7 +5473,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.61  2001-12-19 09:34:51  florian
+  Revision 1.62  2002-01-06 12:08:15  peter
+    * removed uauto from orddef, use new range_to_basetype generating
+      the correct ordinal type for a range
+
+  Revision 1.61  2001/12/19 09:34:51  florian
     * publishing of publishable classes fixed
 
   Revision 1.60  2001/12/06 17:57:39  florian

+ 43 - 15
compiler/types.pas

@@ -30,7 +30,7 @@ interface
        cclasses,
        cpuinfo,
        node,
-       symbase,symtype,symdef,symsym;
+       symconst,symbase,symtype,symdef,symsym;
 
     type
        tmmxtype = (mmxno,mmxu8bit,mmxs8bit,mmxu16bit,mmxs16bit,
@@ -50,6 +50,9 @@ interface
     { returns the min. value of the type }
     function get_min_value(def : tdef) : longint;
 
+    { returns basetype of the specified range }
+    function range_to_basetype(low,high:TConstExprInt):tbasetype;
+
     { returns true, if def defines an ordinal type }
     function is_integer(def : tdef) : boolean;
 
@@ -250,7 +253,7 @@ implementation
 
     uses
        globtype,globals,systems,tokens,verbose,
-       symconst,symtable;
+       symtable;
 
 
     function needs_prop_entry(sym : tsym) : boolean;
@@ -510,6 +513,24 @@ implementation
       end;
 
 
+    function range_to_basetype(low,high:TConstExprInt):tbasetype;
+      begin
+        { generate a unsigned range if high<0 and low>=0 }
+        if (low>=0) and (high<0) then
+         range_to_basetype:=u32bit
+        else if (low>=0) and (high<=255) then
+         range_to_basetype:=u8bit
+        else if (low>=-128) and (high<=127) then
+         range_to_basetype:=s8bit
+        else if (low>=0) and (high<=65536) then
+         range_to_basetype:=u16bit
+        else if (low>=-32768) and (high<=32767) then
+         range_to_basetype:=s16bit
+        else
+         range_to_basetype:=s32bit;
+      end;
+
+
     { true if p is an ordinal }
     function is_ordinal(def : tdef) : boolean;
       var
@@ -550,8 +571,8 @@ implementation
     function is_integer(def : tdef) : boolean;
       begin
         is_integer:=(def.deftype=orddef) and
-                    (torddef(def).typ in [uauto,u8bit,u16bit,u32bit,u64bit,
-                                           s8bit,s16bit,s32bit,s64bit]);
+                    (torddef(def).typ in [u8bit,u16bit,u32bit,u64bit,
+                                          s8bit,s16bit,s32bit,s64bit]);
       end;
 
 
@@ -1184,7 +1205,7 @@ implementation
                     b := is_dynamic_array(def1) and is_dynamic_array(def2) and
                          is_equal(tarraydef(def1).elementtype.def,tarraydef(def2).elementtype.def);
                   end
-               else   
+               else
                 if is_open_array(def1) or is_open_array(def2) then
                  begin
                    b:=is_equal(tarraydef(def1).elementtype.def,tarraydef(def2).elementtype.def);
@@ -1322,19 +1343,22 @@ implementation
              fromtreetype : tnodetype;
              explicit : boolean) : byte;
 
-      { Tbasetype:  uauto,uvoid,uchar,
-                    u8bit,u16bit,u32bit,
-                    s8bit,s16bit,s32,
-                    bool8bit,bool16bit,bool32bit,
-                    u64bit,s64bitint,uwidechar }
+      { Tbasetype:
+           uvoid,
+           u8bit,u16bit,u32bit,u64bit,
+           s8bit,s16bit,s32bit,s64bit,
+           bool8bit,bool16bit,bool32bit,
+           uchar,uwidechar }
+
       type
         tbasedef=(bvoid,bchar,bint,bbool);
       const
         basedeftbl:array[tbasetype] of tbasedef =
-          (bvoid,bvoid,bchar,
-           bint,bint,bint,
-           bint,bint,bint,
-           bbool,bbool,bbool,bint,bint,bchar);
+          (bvoid,
+           bint,bint,bint,bint,
+           bint,bint,bint,bint,
+           bbool,bbool,bbool,
+           bchar,bchar);
 
         basedefconverts : array[tbasedef,tbasedef] of tconverttype =
          ((tc_not_possible,tc_not_possible,tc_not_possible,tc_not_possible),
@@ -1897,7 +1921,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.60  2001-12-17 12:49:08  jonas
+  Revision 1.61  2002-01-06 12:08:16  peter
+    * removed uauto from orddef, use new range_to_basetype generating
+      the correct ordinal type for a range
+
+  Revision 1.60  2001/12/17 12:49:08  jonas
     * added type conversion from procvar to procvar (if their arguments are
       convertable, two procvars are convertable too) ("merged")
 

+ 13 - 10
compiler/utils/ppudump.pp

@@ -87,7 +87,7 @@ type
              target_i386_netbsd,        { 17 }
              target_m68k_netbsd,        { 18 }
              target_i386_Netware,       { 19 }
-             target_i386_qnx            { 20 }    
+             target_i386_qnx            { 20 }
        );
 const
   Targets : array[ttarget] of string[12]=(
@@ -933,11 +933,11 @@ procedure readdefinitions(start_read : boolean);
 type
   tsettype  = (normset,smallset,varset);
   tbasetype = (
-    uauto,uvoid,uchar,
-    u8bit,u16bit,u32bit,
-    s8bit,s16bit,s32bit,
+    uvoid,
+    u8bit,u16bit,u32bit,u64bit,
+    s8bit,s16bit,s32bit,s64bit,
     bool8bit,bool16bit,bool32bit,
-    u64bit,s64bit,uwidechar
+    uchar,uwidechar
   );
   tobjectdeftype = (odt_none,
     odt_class,
@@ -989,20 +989,19 @@ begin
              write  (space,'        Base type : ');
              b:=getbyte;
              case tbasetype(b) of
-               uauto     : writeln('uauto');
                uvoid     : writeln('uvoid');
-               uchar     : writeln('uchar');
                u8bit     : writeln('u8bit');
                u16bit    : writeln('u16bit');
                u32bit    : writeln('s32bit');
+               u64bit    : writeln('u64bit');
                s8bit     : writeln('s8bit');
                s16bit    : writeln('s16bit');
                s32bit    : writeln('s32bit');
+               s64bit    : writeln('s64bit');
                bool8bit  : writeln('bool8bit');
                bool16bit : writeln('bool16bit');
                bool32bit : writeln('bool32bit');
-               u64bit    : writeln('u64bit');
-               s64bit    : writeln('s64bit');
+               uchar     : writeln('uchar');
                uwidechar : writeln('uwidechar');
                else        writeln('!! Warning: Invalid base type ',b);
              end;
@@ -1645,7 +1644,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.10  2001-12-15 05:28:01  carl
+  Revision 1.11  2002-01-06 12:08:16  peter
+    * removed uauto from orddef, use new range_to_basetype generating
+      the correct ordinal type for a range
+
+  Revision 1.10  2001/12/15 05:28:01  carl
   + Added QNX target
 
   Revision 1.9  2001/11/02 22:58:12  peter