Просмотр исходного кода

* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed

peter 21 лет назад
Родитель
Сommit
e46cdcea48

+ 20 - 9
compiler/browcol.pas

@@ -268,7 +268,7 @@ uses
   globtype,globals,comphook,
   finput,fmodule,
   cpuinfo,cgbase,aasmbase,aasmtai,paramgr,
-  symsym,symdef,symtype,symbase;
+  symsym,symdef,symtype,symbase,defutil;
 
 const
   RModuleNameCollection: TStreamRec = (
@@ -1369,18 +1369,24 @@ end;
     if Name='' then
     case sym.consttyp of
       constord :
-        Name:=sym.consttype.def.typesym.name+'('+IntToStr(sym.value.valueord)+')';
+        begin
+          if sym.consttype.def.deftype=enumdef then
+            Name:=sym.consttype.def.typesym.name+'('+IntToStr(sym.value.valueord)+')'
+          else
+            if is_boolean(sym.consttype.def) then
+              Name:='Longbool('+IntToStr(sym.value.valueord)+')'
+          else
+            if is_char(sym.consttype.def) or
+               is_widechar(sym.consttype.def) then
+              Name:=''''+chr(sym.value.valueord)+''''
+          else
+            Name:=IntToStr(sym.value.valueord);
+        end;
       constresourcestring,
       conststring :
         Name:=''''+StrPas(pchar(sym.value.valueptr))+'''';
       constreal:
         Name:=FloatToStr(PBestReal(sym.value.valueptr)^);
-      constbool:
-        Name:='Longbool('+IntToStr(sym.value.valueord)+')';
-      constint:
-        Name:=IntToStr(sym.value.valueord);
-      constchar:
-        Name:=''''+chr(sym.value.valueord)+'''';
       constset:
 {        Name:=SetToStr(pnormalset(sym.value.valueptr)) };
       constnil: ;
@@ -2112,7 +2118,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.36  2003-10-01 20:34:48  peter
+  Revision 1.37  2004-03-23 22:34:49  peter
+    * constants ordinals now always have a type assigned
+    * integer constants have the smallest type, unsigned prefered over
+      signed
+
+  Revision 1.36  2003/10/01 20:34:48  peter
     * procinfo unit contains tprocinfo
     * cginfo renamed to cgbase
     * moved cgmessage to verbose

+ 38 - 11
compiler/defutil.pas

@@ -48,7 +48,9 @@ interface
     function get_min_value(def : tdef) : TConstExprInt;
 
     {# Returns basetype of the specified integer range }
-    function range_to_basetype(low,high:TConstExprInt):tbasetype;
+    function range_to_basetype(l,h:TConstExprInt):tbasetype;
+
+    procedure int_to_type(v:TConstExprInt;var tt:ttype);
 
     {# Returns true, if definition defines an integer type }
     function is_integer(def : tdef) : boolean;
@@ -244,22 +246,42 @@ implementation
       end;
 
 
-    function range_to_basetype(low,high:TConstExprInt):tbasetype;
+    function range_to_basetype(l,h: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
+        if (l>=0) and (h<=255) then
          range_to_basetype:=u8bit
-        else if (low>=-128) and (high<=127) then
+        else if (l>=-128) and (h<=127) then
          range_to_basetype:=s8bit
-        else if (low>=0) and (high<=65536) then
+        else if (l>=0) and (h<=65535) then
          range_to_basetype:=u16bit
-        else if (low>=-32768) and (high<=32767) then
+        else if (l>=-32768) and (h<=32767) then
          range_to_basetype:=s16bit
+        else if (l>=low(longint)) and (h<=high(longint)) then
+         range_to_basetype:=s32bit
+        else if (l>=low(cardinal)) and (h<=high(cardinal)) then
+         range_to_basetype:=u32bit
         else
-         range_to_basetype:=s32bit;
-{$warning add support for range_to_basetype 64bit}
+         range_to_basetype:=s64bit;
+      end;
+
+
+    procedure int_to_type(v:TConstExprInt;var tt:ttype);
+      begin
+        if (v>=0) and (v<=255) then
+         tt:=u8inttype
+        else if (v>=-128) and (v<=127) then
+         tt:=s8inttype
+        else if (v>=0) and (v<=65535) then
+         tt:=u16inttype
+        else if (v>=-32768) and (v<=32767) then
+         tt:=s16inttype
+        else if (v>=low(longint)) and (v<=high(longint)) then
+         tt:=s32inttype
+        else if (v>=low(cardinal)) and (v<=high(cardinal)) then
+         tt:=u32inttype
+        else
+         tt:=s64inttype;
       end;
 
 
@@ -855,7 +877,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.10  2004-02-04 22:01:13  peter
+  Revision 1.11  2004-03-23 22:34:49  peter
+    * constants ordinals now always have a type assigned
+    * integer constants have the smallest type, unsigned prefered over
+      signed
+
+  Revision 1.10  2004/02/04 22:01:13  peter
     * first try to get cpupara working for x86_64
 
   Revision 1.9  2004/02/03 22:32:53  peter

+ 9 - 4
compiler/nadd.pas

@@ -340,11 +340,11 @@ implementation
                   else
                     t:=genintconstnode(int64(qword(lv)*qword(rv)));
                 xorn :
-                  t:=cordconstnode.create(lv xor rv,left.resulttype,true);
+                  t:=cordconstnode.create(lv xor rv,left.resulttype,false);
                 orn :
-                  t:=cordconstnode.create(lv or rv,left.resulttype,true);
+                  t:=cordconstnode.create(lv or rv,left.resulttype,false);
                 andn :
-                  t:=cordconstnode.create(lv and rv,left.resulttype,true);
+                  t:=cordconstnode.create(lv and rv,left.resulttype,false);
                 ltn :
                   t:=cordconstnode.create(ord(lv<rv),booltype,true);
                 lten :
@@ -1926,7 +1926,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.113  2004-03-18 16:19:03  peter
+  Revision 1.114  2004-03-23 22:34:49  peter
+    * constants ordinals now always have a type assigned
+    * integer constants have the smallest type, unsigned prefered over
+      signed
+
+  Revision 1.113  2004/03/18 16:19:03  peter
     * fixed operator overload allowing for pointer-string
     * replaced some type_e_mismatch with more informational messages
 

+ 32 - 3
compiler/ncnv.pas

@@ -199,7 +199,7 @@ interface
 implementation
 
    uses
-      globtype,systems,tokens,
+      globtype,systems,
       cutils,verbose,globals,widestr,
       symconst,symdef,symsym,symtable,
       ncon,ncal,nset,nadd,ninl,nmem,nmat,nutils,
@@ -593,7 +593,7 @@ implementation
     function ttypeconvnode.resulttype_string_to_chararray : tnode;
 
       var
-        arrsize: longint;
+        arrsize: aword;
 
       begin
          with tarraydef(resulttype.def) do
@@ -1121,6 +1121,7 @@ implementation
     function ttypeconvnode.det_resulttype:tnode;
 
       var
+        htype : ttype;
         hp : tnode;
         currprocdef,
         aprocdef : tprocdef;
@@ -1289,6 +1290,29 @@ implementation
                  { do common tc_equal cast }
                  convtype:=tc_equal;
 
+                 { ordinal constants can be resized to 1,2,4,8 bytes }
+                 if (left.nodetype=ordconstn) then
+                   begin
+                     { Insert typeconv for ordinal to the correct size first on left, after
+                       that the other conversion can be done }
+                     htype.reset;
+                     case resulttype.def.size of
+                       1 :
+                         htype:=s8inttype;
+                       2 :
+                         htype:=s16inttype;
+                       4 :
+                         htype:=s32inttype;
+                       8 :
+                         htype:=s64inttype;
+                     end;
+                     { we need explicit, because it can also be an enum }
+                     if assigned(htype.def) then
+                       inserttypeconv_explicit(left,htype)
+                     else
+                       CGMessage2(cg_e_illegal_type_conversion,left.resulttype.def.gettypename,resulttype.def.gettypename);
+                   end;
+
                  { check if the result could be in a register }
                  if (not(tstoreddef(resulttype.def).is_intregable) and
                      not(tstoreddef(resulttype.def).is_fpuregable)) or
@@ -2378,7 +2402,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.142  2004-03-18 16:19:03  peter
+  Revision 1.143  2004-03-23 22:34:49  peter
+    * constants ordinals now always have a type assigned
+    * integer constants have the smallest type, unsigned prefered over
+      signed
+
+  Revision 1.142  2004/03/18 16:19:03  peter
     * fixed operator overload allowing for pointer-string
     * replaced some type_e_mismatch with more informational messages
 

+ 11 - 22
compiler/ncon.pas

@@ -183,21 +183,11 @@ implementation
       nld;
 
     function genintconstnode(v : TConstExprInt) : tordconstnode;
-
       var
-         i,i2 : TConstExprInt;
-
+        htype : ttype;
       begin
-         { we need to bootstrap this code, so it's a little bit messy }
-         i:=2147483647;
-         { maxcardinal }
-         i2 := i+i+1;
-         if (v<=i) and (v>=-i-1) then
-           genintconstnode:=cordconstnode.create(v,s32inttype,true)
-         else if (v > i) and (v <= i2) then
-           genintconstnode:=cordconstnode.create(v,u32inttype,true)
-         else
-           genintconstnode:=cordconstnode.create(v,s64inttype,true);
+         int_to_type(v,htype);
+         genintconstnode:=cordconstnode.create(v,htype,true);
       end;
 
 
@@ -305,8 +295,8 @@ implementation
       begin
         p1:=nil;
         case p.consttyp of
-          constint :
-            p1:=genintconstnode(p.value.valueord);
+          constord :
+            p1:=cordconstnode.create(p.value.valueord,p.consttype,true);
           conststring :
             begin
               len:=p.value.len;
@@ -317,16 +307,10 @@ implementation
               pc[len]:=#0;
               p1:=cstringconstnode.createpchar(pc,len);
             end;
-          constchar :
-            p1:=cordconstnode.create(p.value.valueord,cchartype,true);
           constreal :
             p1:=crealconstnode.create(pbestreal(p.value.valueptr)^,pbestrealtype^);
-          constbool :
-            p1:=cordconstnode.create(p.value.valueord,booltype,true);
           constset :
             p1:=csetconstnode.create(pconstset(p.value.valueptr),p.consttype);
-          constord :
-            p1:=cordconstnode.create(p.value.valueord,p.consttype,true);
           constpointer :
             p1:=cpointerconstnode.create(p.value.valueordptr,p.consttype);
           constnil :
@@ -950,7 +934,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.59  2004-02-03 22:32:54  peter
+  Revision 1.60  2004-03-23 22:34:49  peter
+    * constants ordinals now always have a type assigned
+    * integer constants have the smallest type, unsigned prefered over
+      signed
+
+  Revision 1.59  2004/02/03 22:32:54  peter
     * renamed xNNbittype to xNNinttype
     * renamed registers32 to registersint
     * replace some s32bit,u32bit with torddef([su]inttype).def.typ

+ 20 - 17
compiler/nmat.pas

@@ -670,6 +670,7 @@ implementation
     function tnotnode.det_resulttype : tnode;
       var
          t : tnode;
+         tt : ttype;
          notdef : Tprocdef;
          v : tconstexprint;
       begin
@@ -709,6 +710,7 @@ implementation
          if (left.nodetype=ordconstn) then
            begin
               v:=tordconstnode(left).value;
+              tt:=left.resulttype;
               case torddef(left.resulttype.def).typ of
                 bool8bit,
                 bool16bit,
@@ -719,27 +721,23 @@ implementation
                     v:=byte(not(boolean(byte(v))));
                   end;
                 uchar,
-                u8bit :
-                  v:=byte(not byte(v));
-                s8bit :
-                  v:=shortint(not shortint(v));
                 uwidechar,
-                u16bit :
-                  v:=word(not word(v));
-                s16bit :
-                  v:=smallint(not smallint(v));
-                u32bit :
-                  v:=cardinal(not cardinal(v));
-                s32bit :
-                  v:=longint(not longint(v));
+                u8bit,
+                s8bit,
+                u16bit,
+                s16bit,
+                u32bit,
+                s32bit,
+                s64bit,
                 u64bit :
-                  v:=int64(not int64(v)); { maybe qword is required }
-                s64bit :
-                  v:=int64(not int64(v));
+                  begin
+                    v:=int64(not int64(v)); { maybe qword is required }
+                    int_to_type(v,tt);
+                  end;
                 else
                   CGMessage(type_e_mismatch);
               end;
-              t:=cordconstnode.create(v,left.resulttype,true);
+              t:=cordconstnode.create(v,tt,true);
               result:=t;
               exit;
            end;
@@ -858,7 +856,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.59  2004-02-24 16:12:39  peter
+  Revision 1.60  2004-03-23 22:34:49  peter
+    * constants ordinals now always have a type assigned
+    * integer constants have the smallest type, unsigned prefered over
+      signed
+
+  Revision 1.59  2004/02/24 16:12:39  peter
     * operator overload chooses rewrite
     * overload choosing is now generic and moved to htypechk
 

+ 9 - 3
compiler/options.pas

@@ -1108,8 +1108,8 @@ begin
                       include(initglobalswitches,cs_link_internal);
                     'm' :
                       include(initglobalswitches,cs_link_map);
-		    'f' :
-		      include(initglobalswitches,cs_link_pthread);
+                    'f' :
+                      include(initglobalswitches,cs_link_pthread);
                     's' :
                       include(initglobalswitches,cs_link_strip);
                     'c' : Cshared:=TRUE;
@@ -1704,6 +1704,7 @@ begin
   if pocall_default = pocall_register then
     def_symbol('REGCALL');
   def_symbol('DECRREFNOTNIL');
+  def_symbol('HAS_INTERNAL_INTTYPES');
 
 { using a case is pretty useless here (FK) }
 { some stuff for TP compatibility }
@@ -2034,7 +2035,12 @@ finalization
 end.
 {
   $Log$
-  Revision 1.129  2004-03-21 22:40:15  florian
+  Revision 1.130  2004-03-23 22:34:49  peter
+    * constants ordinals now always have a type assigned
+    * integer constants have the smallest type, unsigned prefered over
+      signed
+
+  Revision 1.129  2004/03/21 22:40:15  florian
     + added interface support for the arm
     * added  FPC_REQUIRES_PROPER_ALIGNMENT define for targets which require proper alignment
 

+ 15 - 19
compiler/pdecl.pas

@@ -91,19 +91,10 @@ implementation
         case p.nodetype of
            ordconstn:
              begin
-                if is_constintnode(p) then
-                  hp:=tconstsym.create_ord_typed(orgname,constint,tordconstnode(p).value,tordconstnode(p).resulttype)
-                else if is_constcharnode(p) then
-                  hp:=tconstsym.create_ord(orgname,constchar,tordconstnode(p).value)
-                else if is_constboolnode(p) then
-                  hp:=tconstsym.create_ord(orgname,constbool,tordconstnode(p).value)
-                else if is_constwidecharnode(p) then
-                  hp:=tconstsym.create_ord(orgname,constwchar,tordconstnode(p).value)
-                else if p.resulttype.def.deftype=enumdef then
-                  hp:=tconstsym.create_ord_typed(orgname,constord,tordconstnode(p).value,p.resulttype)
-                else if p.resulttype.def.deftype=pointerdef then
-                  hp:=tconstsym.create_ordptr_typed(orgname,constpointer,tordconstnode(p).value,p.resulttype)
-                else internalerror(111);
+               if p.resulttype.def.deftype=pointerdef then
+                 hp:=tconstsym.create_ordptr(orgname,constpointer,tordconstnode(p).value,p.resulttype)
+               else
+                 hp:=tconstsym.create_ord(orgname,constord,tordconstnode(p).value,p.resulttype);
              end;
            stringconstn:
              begin
@@ -115,21 +106,21 @@ implementation
              begin
                 new(pd);
                 pd^:=trealconstnode(p).value_real;
-                hp:=tconstsym.create_ptr(orgname,constreal,pd);
+                hp:=tconstsym.create_ptr(orgname,constreal,pd,p.resulttype);
              end;
            setconstn :
              begin
                new(ps);
                ps^:=tsetconstnode(p).value_set^;
-               hp:=tconstsym.create_ptr_typed(orgname,constset,ps,p.resulttype);
+               hp:=tconstsym.create_ptr(orgname,constset,ps,p.resulttype);
              end;
            pointerconstn :
              begin
-               hp:=tconstsym.create_ordptr_typed(orgname,constpointer,tpointerconstnode(p).value,p.resulttype);
+               hp:=tconstsym.create_ordptr(orgname,constpointer,tpointerconstnode(p).value,p.resulttype);
              end;
            niln :
              begin
-               hp:=tconstsym.create_ord_typed(orgname,constnil,0,p.resulttype);
+               hp:=tconstsym.create_ord(orgname,constnil,0,p.resulttype);
              end;
            typen :
              begin
@@ -139,7 +130,7 @@ implementation
                    begin
                      new(pg);
                      pg^:=tobjectdef(p.resulttype.def).iidguid^;
-                     hp:=tconstsym.create_ptr(orgname,constguid,pg);
+                     hp:=tconstsym.create_ptr(orgname,constguid,pg,p.resulttype);
                    end
                   else
                    Message1(parser_e_interface_has_no_guid,tobjectdef(p.resulttype.def).objrealname^);
@@ -668,7 +659,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.84  2004-03-20 20:55:36  florian
+  Revision 1.85  2004-03-23 22:34:49  peter
+    * constants ordinals now always have a type assigned
+    * integer constants have the smallest type, unsigned prefered over
+      signed
+
+  Revision 1.84  2004/03/20 20:55:36  florian
     + implemented cdecl'd varargs on arm
     + -dCMEM supported by the compiler
     * label/goto asmsymbol type with -dextdebug fixed

+ 8 - 1
compiler/pdecvar.pas

@@ -342,6 +342,8 @@ implementation
                        Message(parser_e_invalid_property_index_value);
                        p.index:=0;
                      end;
+{$warning FIXME: force 32bit int for property index}
+                   inserttypeconv(pt,s32inttype);
                    p.indextype.setdef(pt.resulttype.def);
                    include(p.propoptions,ppo_indexed);
                    { concat a longint to the para templates }
@@ -1170,7 +1172,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.71  2004-03-05 22:17:11  jonas
+  Revision 1.72  2004-03-23 22:34:49  peter
+    * constants ordinals now always have a type assigned
+    * integer constants have the smallest type, unsigned prefered over
+      signed
+
+  Revision 1.71  2004/03/05 22:17:11  jonas
     * fixed importing of variables from shared libraries, but disabled
       PIC support for now. You have to save/restore r31 when you us it! :)
       Also, it's not necessary to support the imported variables

+ 18 - 34
compiler/pexpr.pas

@@ -1313,21 +1313,11 @@ implementation
                 constsym :
                   begin
                     case tconstsym(srsym).consttyp of
-                      constint :
+                      constord :
                         begin
-{$ifdef cpu64bit}
-                          p1:=cordconstnode.create(tconstsym(srsym).value.valueord,sinttype,true);
-{$else cpu64bit}
-                          { do a very dirty trick to bootstrap this code }
-                          if (tconstsym(srsym).value.valueord>=-(int64(2147483647)+int64(1))) and
-                             (tconstsym(srsym).value.valueord<=2147483647) then
-                           p1:=cordconstnode.create(tconstsym(srsym).value.valueord,s32inttype,true)
-                          else if (tconstsym(srsym).value.valueord > maxlongint) and
-                                  (tconstsym(srsym).value.valueord <= int64(maxlongint)+int64(maxlongint)+1) then
-                           p1:=cordconstnode.create(tconstsym(srsym).value.valueord,u32inttype,true)
-                          else
-                           p1:=cordconstnode.create(tconstsym(srsym).value.valueord,s64inttype,true);
-{$endif cpu64bit}
+                          if tconstsym(srsym).consttype.def=nil then
+                            internalerror(200403232);
+                          p1:=cordconstnode.create(tconstsym(srsym).value.valueord,tconstsym(srsym).consttype,true);
                         end;
                       conststring :
                         begin
@@ -1339,16 +1329,10 @@ implementation
                           pc[len]:=#0;
                           p1:=cstringconstnode.createpchar(pc,len);
                         end;
-                      constchar :
-                        p1:=cordconstnode.create(tconstsym(srsym).value.valueord,cchartype,true);
                       constreal :
                         p1:=crealconstnode.create(pbestreal(tconstsym(srsym).value.valueptr)^,pbestrealtype^);
-                      constbool :
-                        p1:=cordconstnode.create(tconstsym(srsym).value.valueord,booltype,true);
                       constset :
                         p1:=csetconstnode.create(pconstset(tconstsym(srsym).value.valueptr),tconstsym(srsym).consttype);
-                      constord :
-                        p1:=cordconstnode.create(tconstsym(srsym).value.valueord,tconstsym(srsym).consttype,true);
                       constpointer :
                         p1:=cpointerconstnode.create(tconstsym(srsym).value.valueordptr,tconstsym(srsym).consttype);
                       constnil :
@@ -1903,7 +1887,8 @@ implementation
                if code=0 then
                  begin
                     consume(_INTCONST);
-                    p1:=cordconstnode.create(ic,sinttype,true);
+                    int_to_type(card,htype);
+                    p1:=cordconstnode.create(ic,htype,true);
                  end;
 {$else cpu64bit}
                { try cardinal first }
@@ -1911,16 +1896,8 @@ implementation
                if code=0 then
                  begin
                     consume(_INTCONST);
-                    { check whether the value isn't in the longint range as well }
-                    { (longint is easier to perform calculations with) (JM)      }
-                    if card <= $7fffffff then
-                      { no sign extension necessary, so not longint typecast (JM) }
-                      { use the native int types here instead of fixed 32bit,
-                        this is needed to have integer values the same size as
-                        pointers (PFV) }
-                      p1:=cordconstnode.create(card,s32inttype,true)
-                    else
-                      p1:=cordconstnode.create(card,u32inttype,true)
+                    int_to_type(card,htype);
+                    p1:=cordconstnode.create(card,htype,true);
                  end
                else
                  begin
@@ -1929,7 +1906,8 @@ implementation
                    if code = 0 then
                      begin
                        consume(_INTCONST);
-                       p1:=cordconstnode.create(l,sinttype,true)
+                       int_to_type(l,htype);
+                       p1:=cordconstnode.create(l,htype,true);
                      end
                    else
                      begin
@@ -1938,7 +1916,8 @@ implementation
                        if code=0 then
                          begin
                             consume(_INTCONST);
-                            p1:=cordconstnode.create(ic,s64inttype,true);
+                            int_to_type(ic,htype);
+                            p1:=cordconstnode.create(ic,htype,true);
                          end;
                      end;
                  end;
@@ -2419,7 +2398,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.150  2004-02-20 21:55:59  peter
+  Revision 1.151  2004-03-23 22:34:49  peter
+    * constants ordinals now always have a type assigned
+    * integer constants have the smallest type, unsigned prefered over
+      signed
+
+  Revision 1.150  2004/02/20 21:55:59  peter
     * procvar cleanup
 
   Revision 1.149  2004/02/18 21:58:53  peter

+ 7 - 2
compiler/ppu.pas

@@ -44,7 +44,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion=39;
+  CurrentPPUVersion=40;
 
 { buffer sizes }
   maxentrysize = 1024;
@@ -1042,7 +1042,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.46  2004-02-27 10:21:05  florian
+  Revision 1.47  2004-03-23 22:34:49  peter
+    * constants ordinals now always have a type assigned
+    * integer constants have the smallest type, unsigned prefered over
+      signed
+
+  Revision 1.46  2004/02/27 10:21:05  florian
     * top_symbol killed
     + refaddr to treference added
     + refsymbol to treference added

+ 65 - 36
compiler/psystem.pas

@@ -42,7 +42,7 @@ interface
 implementation
 
     uses
-      globals,globtype,
+      globals,globtype,verbose,
       symconst,symtype,symsym,symdef,symtable,
       aasmtai,aasmcpu,ncgutil,
 {$ifdef GDB}
@@ -157,12 +157,17 @@ implementation
         addtype('ByteBool',booltype);
         adddef('WordBool',torddef.create(bool16bit,0,1));
         adddef('LongBool',torddef.create(bool32bit,0,1));
+        addtype('Byte',u8inttype);
+        addtype('ShortInt',s8inttype);
+        addtype('Word',u16inttype);
+        addtype('SmallInt',s16inttype);
+        addtype('LongWord',u32inttype);
+        addtype('LongInt',s32inttype);
+        addtype('QWord',u64inttype);
+        addtype('Int64',s64inttype);
         addtype('Char',cchartype);
         addtype('WideChar',cwidechartype);
         adddef('Text',tfiledef.createtext);
-        addtype('Longword',u32inttype);
-        addtype('QWord',u64inttype);
-        addtype('Int64',s64inttype);
         adddef('TypedFile',tfiledef.createtyped(voidtype));
         addtype('Variant',cvarianttype);
         addtype('OleVariant',colevarianttype);
@@ -170,7 +175,9 @@ implementation
         addtype('$formal',cformaltype);
         addtype('$void',voidtype);
         addtype('$byte',u8inttype);
+        addtype('$shortint',s8inttype);
         addtype('$word',u16inttype);
+        addtype('$smallint',s16inttype);
         addtype('$ulong',u32inttype);
         addtype('$longint',s32inttype);
         addtype('$qword',u64inttype);
@@ -224,38 +231,53 @@ implementation
       {
         Load all default definitions for consts from the system unit
       }
+
+
+        procedure loadtype(const s:string;var t:ttype);
+        var
+          srsym : tsym;
+        begin
+          srsym:=searchsymonlyin(systemunit,s);
+          if not(assigned(srsym) and
+                 (srsym.typ=typesym)) then
+            internalerror(200403231);
+          t:=ttypesym(srsym).restype;
+        end;
+
       begin
-        globaldef('byte',u8inttype);
-        globaldef('word',u16inttype);
-        globaldef('ulong',u32inttype);
-        globaldef('longint',s32inttype);
-        globaldef('qword',u64inttype);
-        globaldef('int64',s64inttype);
-        globaldef('formal',cformaltype);
-        globaldef('void',voidtype);
-        globaldef('char',cchartype);
-        globaldef('widechar',cwidechartype);
-        globaldef('shortstring',cshortstringtype);
-        globaldef('longstring',clongstringtype);
-        globaldef('ansistring',cansistringtype);
-        globaldef('widestring',cwidestringtype);
-        globaldef('openshortstring',openshortstringtype);
-        globaldef('openchararray',openchararraytype);
-        globaldef('s32real',s32floattype);
-        globaldef('s64real',s64floattype);
-        globaldef('s80real',s80floattype);
-        globaldef('s64currency',s64currencytype);
-        globaldef('boolean',booltype);
-        globaldef('void_pointer',voidpointertype);
-        globaldef('char_pointer',charpointertype);
-        globaldef('void_farpointer',voidfarpointertype);
-        globaldef('file',cfiletype);
-        globaldef('pvmt',pvmttype);
-        globaldef('vtblarray',vmtarraytype);
-        globaldef('__vtbl_ptr_type',vmttype);
-        globaldef('variant',cvarianttype);
-        globaldef('olevariant',colevarianttype);
-        globaldef('methodpointer',methodpointertype);
+        loadtype('byte',u8inttype);
+        loadtype('shortint',s8inttype);
+        loadtype('word',u16inttype);
+        loadtype('smallint',s16inttype);
+        loadtype('ulong',u32inttype);
+        loadtype('longint',s32inttype);
+        loadtype('qword',u64inttype);
+        loadtype('int64',s64inttype);
+        loadtype('formal',cformaltype);
+        loadtype('void',voidtype);
+        loadtype('char',cchartype);
+        loadtype('widechar',cwidechartype);
+        loadtype('shortstring',cshortstringtype);
+        loadtype('longstring',clongstringtype);
+        loadtype('ansistring',cansistringtype);
+        loadtype('widestring',cwidestringtype);
+        loadtype('openshortstring',openshortstringtype);
+        loadtype('openchararray',openchararraytype);
+        loadtype('s32real',s32floattype);
+        loadtype('s64real',s64floattype);
+        loadtype('s80real',s80floattype);
+        loadtype('s64currency',s64currencytype);
+        loadtype('boolean',booltype);
+        loadtype('void_pointer',voidpointertype);
+        loadtype('char_pointer',charpointertype);
+        loadtype('void_farpointer',voidfarpointertype);
+        loadtype('file',cfiletype);
+        loadtype('pvmt',pvmttype);
+        loadtype('vtblarray',vmtarraytype);
+        loadtype('__vtbl_ptr_type',vmttype);
+        loadtype('variant',cvarianttype);
+        loadtype('olevariant',colevarianttype);
+        loadtype('methodpointer',methodpointertype);
 {$ifdef cpu64bit}
         uinttype:=u64inttype;
         sinttype:=s64inttype;
@@ -281,7 +303,9 @@ implementation
         cformaltype.setdef(tformaldef.create);
         voidtype.setdef(torddef.create(uvoid,0,0));
         u8inttype.setdef(torddef.create(u8bit,0,255));
+        s8inttype.setdef(torddef.create(s8bit,-128,127));
         u16inttype.setdef(torddef.create(u16bit,0,65535));
+        s16inttype.setdef(torddef.create(s16bit,-32768,32767));
         u32inttype.setdef(torddef.create(u32bit,0,high(longword)));
         s32inttype.setdef(torddef.create(s32bit,low(longint),high(longint)));
         u64inttype.setdef(torddef.create(u64bit,low(qword),TConstExprInt(high(qword))));
@@ -488,7 +512,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.66  2004-03-08 22:07:47  peter
+  Revision 1.67  2004-03-23 22:34:49  peter
+    * constants ordinals now always have a type assigned
+    * integer constants have the smallest type, unsigned prefered over
+      signed
+
+  Revision 1.66  2004/03/08 22:07:47  peter
     * stabs updates to write stabs for def for all implictly used
       units
 

+ 12 - 3
compiler/ptype.pas

@@ -289,8 +289,12 @@ implementation
                consume(_POINTPOINT);
                { get high value of range }
                pt2:=comp_expr(not(ignore_equal));
-               { make both the same type }
-               inserttypeconv(pt1,pt2.resulttype);
+               { make both the same type or give an error. This is not
+                 done when both are integer values, because typecasting
+                 between -3200..3200 will result in a signed-unsigned
+                 conflict and give a range check error (PFV) }
+               if not(is_integer(pt1.resulttype.def) and is_integer(pt2.resulttype.def)) then
+                 inserttypeconv(pt1,pt2.resulttype);
                { both must be evaluated to constants now }
                if (pt1.nodetype=ordconstn) and
                   (pt2.nodetype=ordconstn) then
@@ -643,7 +647,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.64  2004-02-03 22:32:54  peter
+  Revision 1.65  2004-03-23 22:34:49  peter
+    * constants ordinals now always have a type assigned
+    * integer constants have the smallest type, unsigned prefered over
+      signed
+
+  Revision 1.64  2004/02/03 22:32:54  peter
     * renamed xNNbittype to xNNinttype
     * renamed registers32 to registersint
     * replace some s32bit,u32bit with torddef([su]inttype).def.typ

+ 9 - 4
compiler/rautils.pas

@@ -962,7 +962,7 @@ Begin
       end;
     constsym :
       begin
-        if tconstsym(sym).consttyp in [constint,constchar,constbool] then
+        if tconstsym(sym).consttyp=constord then
          begin
            setconst(tconstsym(sym).value.valueord);
            SetupVar:=true;
@@ -1312,7 +1312,7 @@ Begin
      case srsym.typ of
        constsym :
          begin
-           if (tconstsym(srsym).consttyp in [constord,constint,constchar,constbool]) then
+           if tconstsym(srsym).consttyp=constord then
             Begin
               l:=tconstsym(srsym).value.valueord;
               SearchIConstant:=TRUE;
@@ -1368,7 +1368,7 @@ Begin
                st:=tobjectdef(def).symtable;
            end;
        typesym :
-		 with Ttypesym(sym).restype do
+                 with Ttypesym(sym).restype do
            case def.deftype of
              recorddef :
                st:=trecorddef(def).symtable;
@@ -1632,7 +1632,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.84  2004-03-18 11:43:57  olle
+  Revision 1.85  2004-03-23 22:34:49  peter
+    * constants ordinals now always have a type assigned
+    * integer constants have the smallest type, unsigned prefered over
+      signed
+
+  Revision 1.84  2004/03/18 11:43:57  olle
     * change AT_FUNCTION to AT_DATA where appropriate
 
   Revision 1.83  2004/03/17 22:27:41  florian

+ 9 - 4
compiler/symconst.pas

@@ -303,9 +303,9 @@ type
   absolutetyp = (tovar,toasm,toaddr);
 
   tconsttyp = (constnone,
-    constord,conststring,constreal,constbool,
-    constint,constchar,constset,constpointer,constnil,
-    constresourcestring,constwstring,constwchar,constguid
+    constord,conststring,constreal,
+    constset,constpointer,constnil,
+    constresourcestring,constwstring,constguid
   );
 
   { RTTI information to store }
@@ -404,7 +404,12 @@ initialization
 end.
 {
   $Log$
-  Revision 1.77  2004-03-08 22:07:47  peter
+  Revision 1.78  2004-03-23 22:34:49  peter
+    * constants ordinals now always have a type assigned
+    * integer constants have the smallest type, unsigned prefered over
+      signed
+
+  Revision 1.77  2004/03/08 22:07:47  peter
     * stabs updates to write stabs for def for all implictly used
       units
 

+ 27 - 19
compiler/symdef.pas

@@ -717,16 +717,18 @@ interface
        charpointertype,           { pointer for Char-Pointerdef }
        voidfarpointertype,
        cformaltype,               { unique formal definition }
-       voidtype,                  { Pointer to Void (procedure) }
-       cchartype,                 { Pointer to Char }
-       cwidechartype,             { Pointer to WideChar }
-       booltype,                  { pointer to boolean type }
-       u8inttype,                 { Pointer to 8-Bit unsigned }
-       u16inttype,                { Pointer to 16-Bit unsigned }
-       u32inttype,                { Pointer to 32-Bit unsigned }
-       s32inttype,                { Pointer to 32-Bit signed }
-       u64inttype,               { pointer to 64 bit unsigned def }
-       s64inttype,               { pointer to 64 bit signed def, }
+       voidtype,                  { Void (procedure) }
+       cchartype,                 { Char }
+       cwidechartype,             { WideChar }
+       booltype,                  { boolean type }
+       u8inttype,                 { 8-Bit unsigned integer }
+       s8inttype,                 { 8-Bit signed integer }
+       u16inttype,                { 16-Bit unsigned integer }
+       s16inttype,                { 16-Bit signed integer }
+       u32inttype,                { 32-Bit unsigned integer }
+       s32inttype,                { 32-Bit signed integer }
+       u64inttype,                { 64-bit unsigned integer }
+       s64inttype,                { 64-bit signed integer }
        s32floattype,              { pointer for realconstn }
        s64floattype,              { pointer for realconstn }
        s80floattype,              { pointer to type of temp. floats }
@@ -3519,21 +3521,22 @@ implementation
                       hs:=strpas(pchar(hpc.value.valueptr));
                     constreal :
                       str(pbestreal(hpc.value.valueptr)^,hs);
-                    constord :
-                      hs:=tostr(hpc.value.valueord);
                     constpointer :
                       hs:=tostr(hpc.value.valueordptr);
-                    constbool :
+                    constord :
                       begin
-                        if hpc.value.valueord<>0 then
-                         hs:='TRUE'
+                        if is_boolean(hpc.consttype.def) then
+                          begin
+                            if hpc.value.valueord<>0 then
+                             hs:='TRUE'
+                            else
+                             hs:='FALSE';
+                          end
                         else
-                         hs:='FALSE';
+                          hs:=tostr(hpc.value.valueord);
                       end;
                     constnil :
                       hs:='nil';
-                    constchar :
-                      hs:=chr(hpc.value.valueord);
                     constset :
                       hs:='<set>';
                   end;
@@ -6061,7 +6064,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.232  2004-03-18 11:43:57  olle
+  Revision 1.233  2004-03-23 22:34:49  peter
+    * constants ordinals now always have a type assigned
+    * integer constants have the smallest type, unsigned prefered over
+      signed
+
+  Revision 1.232  2004/03/18 11:43:57  olle
     * change AT_FUNCTION to AT_DATA where appropriate
 
   Revision 1.231  2004/03/14 22:51:46  peter

+ 14 - 52
compiler/symsym.pas

@@ -251,15 +251,12 @@ interface
           consttyp    : tconsttyp;
           value       : tconstvalue;
           resstrindex  : longint;     { needed for resource strings }
-          constructor create_ord(const n : string;t : tconsttyp;v : tconstexprint);
-          constructor create_ord_typed(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
-          constructor create_ordptr_typed(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);
-          constructor create_ptr(const n : string;t : tconsttyp;v : pointer);
-          constructor create_ptr_typed(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
+          constructor create_ord(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
+          constructor create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);
+          constructor create_ptr(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
           constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor  destroy;override;
-{          function  mangledname : string;}
           procedure buildderef;override;
           procedure deref;override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -860,7 +857,7 @@ implementation
            if (eq>=te_equal) or
               ((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
             begin
-              eq:=compare_paras(pd^.def.para,params,cp_value_equal_const,cpoptions);
+              eq:=compare_paras(params,pd^.def.para,cp_value_equal_const,cpoptions);
               if (eq>=te_equal) or
                  ((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
                 begin
@@ -1720,19 +1717,7 @@ implementation
                                   TCONSTSYM
 ****************************************************************************}
 
-    constructor tconstsym.create_ord(const n : string;t : tconsttyp;v : TConstExprInt);
-      begin
-         inherited create(n);
-         fillchar(value, sizeof(value), #0);
-         typ:=constsym;
-         consttyp:=t;
-         value.valueord:=v;
-         ResStrIndex:=0;
-         consttype.reset;
-      end;
-
-
-    constructor tconstsym.create_ord_typed(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
+    constructor tconstsym.create_ord(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
       begin
          inherited create(n);
          fillchar(value, sizeof(value), #0);
@@ -1744,7 +1729,7 @@ implementation
       end;
 
 
-    constructor tconstsym.create_ordptr_typed(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);
+    constructor tconstsym.create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);
       begin
          inherited create(n);
          fillchar(value, sizeof(value), #0);
@@ -1756,19 +1741,7 @@ implementation
       end;
 
 
-    constructor tconstsym.create_ptr(const n : string;t : tconsttyp;v : pointer);
-      begin
-         inherited create(n);
-         fillchar(value, sizeof(value), #0);
-         typ:=constsym;
-         consttyp:=t;
-         value.valueptr:=v;
-         ResStrIndex:=0;
-         consttype.reset;
-      end;
-
-
-    constructor tconstsym.create_ptr_typed(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
+    constructor tconstsym.create_ptr(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
       begin
          inherited create(n);
          fillchar(value, sizeof(value), #0);
@@ -1806,12 +1779,6 @@ implementation
          consttyp:=tconsttyp(ppufile.getbyte);
          fillchar(value, sizeof(value), #0);
          case consttyp of
-           constint:
-             value.valueord:=ppufile.getexprint;
-           constwchar,
-           constbool,
-           constchar :
-             value.valueord:=ppufile.getlongint;
            constord :
              begin
                ppufile.gettype(consttype);
@@ -1894,12 +1861,6 @@ implementation
          ppufile.putbyte(byte(consttyp));
          case consttyp of
            constnil : ;
-           constint:
-             ppufile.putexprint(value.valueord);
-           constbool,
-           constchar,
-           constwchar :
-             ppufile.putlongint(value.valueord);
            constord :
              begin
                ppufile.puttype(consttype);
@@ -1943,11 +1904,7 @@ implementation
       case consttyp of
         conststring:
           st:='s'''+backspace_quote(strpas(pchar(value.valueptr)),['''','"','\',#10,#13])+'''';
-        constbool,
-        constint,
-        constord,
-        constwchar,
-        constchar:
+        constord:
           st:='i'+int64tostr(value.valueord);
         constpointer:
           st:='i'+int64tostr(value.valueordptr);
@@ -2243,7 +2200,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.167  2004-03-10 22:52:57  peter
+  Revision 1.168  2004-03-23 22:34:49  peter
+    * constants ordinals now always have a type assigned
+    * integer constants have the smallest type, unsigned prefered over
+      signed
+
+  Revision 1.167  2004/03/10 22:52:57  peter
     * more stabs fixes
     * special mode -gv for valgrind compatible stabs
 

+ 6 - 4
compiler/symutil.pas

@@ -70,9 +70,6 @@ implementation
         if sym1.consttyp<>sym2.consttyp then
          exit;
         case sym1.consttyp of
-           constint,
-           constbool,
-           constchar,
            constord :
              equal_constsym:=(sym1.value.valueord=sym2.value.valueord);
            constpointer :
@@ -119,7 +116,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.3  2003-12-07 16:40:45  jonas
+  Revision 1.4  2004-03-23 22:34:50  peter
+    * constants ordinals now always have a type assigned
+    * integer constants have the smallest type, unsigned prefered over
+      signed
+
+  Revision 1.3  2003/12/07 16:40:45  jonas
     * moved count_locals from pstatmnt to symutils
     * use count_locals in powerpc/cpupi to check whether we should set the
       first temp offset (and as such generate a stackframe)