* some more support for widechars commited especially

    regarding type casting and constants

compiler/fppu.pas

@@ -1143,11 +1143,14 @@ uses
 end.
 {
   $Log$
-  Revision 1.2  2001-05-07 11:53:21  jonas
+  Revision 1.3  2001-05-08 21:06:30  florian
+    * some more support for widechars commited especially
+      regarding type casting and constants
+
+  Revision 1.2  2001/05/07 11:53:21  jonas
     * fix from Peter for short_on_file_handles code
 
   Revision 1.1  2001/05/06 14:49:17  peter
     * ppu object to class rewrite
     * move ppu read and write stuff to fppu
-
 }

compiler/i386/n386cnv.pas

@@ -49,6 +49,7 @@ interface
           procedure second_ansistring_to_pchar;virtual;
           procedure second_pchar_to_string;virtual;
           procedure second_class_to_intf;virtual;
+          procedure second_char_to_char;virtual;
           procedure second_nothing;virtual;
           procedure pass_2;override;
           procedure second_call_helper(c : tconverttype);
@@ -1081,6 +1082,23 @@ implementation
       end;
 
 
+    procedure ti386typeconvnode.second_char_to_char;
+      var
+         hreg : tregister;
+      begin
+         case torddef(resulttype.def).typ of
+            uwidechar:
+              begin
+                 internalerror(200105021);
+              end;
+            uchar:
+              begin
+                 internalerror(200105022);
+              end;
+         end;
+      end;
+
+
     procedure ti386typeconvnode.second_nothing;
       begin
       end;
@@ -1118,7 +1136,8 @@ implementation
            @ti386typeconvnode.second_cord_to_pointer,
            @ti386typeconvnode.second_nothing, { interface 2 string }
            @ti386typeconvnode.second_nothing, { interface 2 guid   }
-           @ti386typeconvnode.second_class_to_intf
+           @ti386typeconvnode.second_class_to_intf,
+           @ti386typeconvnode.second_char_to_char
          );
       type
          tprocedureofobject = procedure of object;
@@ -1312,7 +1331,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.14  2001-04-13 01:22:18  peter
+  Revision 1.15  2001-05-08 21:06:33  florian
+    * some more support for widechars commited especially
+      regarding type casting and constants
+
+  Revision 1.14  2001/04/13 01:22:18  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/ncnv.pas

@@ -47,6 +47,7 @@ interface
           function resulttype_int_to_real : tnode;
           function resulttype_real_to_real : tnode;
           function resulttype_cchar_to_pchar : tnode;
+          function resulttype_char_to_char : tnode;
           function resulttype_arrayconstructor_to_set : tnode;
           function resulttype_call_helper(c : tconverttype) : tnode;
        protected
@@ -72,6 +73,7 @@ interface
           function first_ansistring_to_pchar : tnode;virtual;
           function first_arrayconstructor_to_set : tnode;virtual;
           function first_class_to_intf : tnode;virtual;
+          function first_char_to_char : tnode;virtual;
           function first_call_helper(c : tconverttype) : tnode;
        end;
 
@@ -99,7 +101,7 @@ implementation
 
    uses
       globtype,systems,tokens,
-      cutils,verbose,globals,
+      cutils,verbose,globals,widestr,
       symconst,symdef,symsym,symtable,
       ncon,ncal,nset,nadd,
 {$ifdef newcg}
@@ -450,6 +452,28 @@ implementation
       end;
 
 
+    function ttypeconvnode.resulttype_char_to_char : tnode;
+      var
+         hp : tordconstnode;
+      begin
+         result:=nil;
+         if torddef(resulttype.def).typ=uchar then
+           begin
+              hp:=cordconstnode.create(
+                ord(unicode2asciichar(tcompilerwidechar(tordconstnode(left).value))),cchartype);
+              resulttypepass(hp);
+              result:=hp;
+           end
+         else
+           begin
+              hp:=cordconstnode.create(
+                asciichar2unicode(chr(tordconstnode(left).value)),cwidechartype);
+              resulttypepass(hp);
+              result:=hp;
+           end;
+      end;
+
+
     function ttypeconvnode.resulttype_int_to_real : tnode;
       var
         t : trealconstnode;
@@ -535,7 +559,8 @@ implementation
           { cord_2_pointer } @ttypeconvnode.resulttype_cord_to_pointer,
           { intf_2_string } nil,
           { intf_2_guid } nil,
-          { class_2_intf } nil
+          { class_2_intf } nil,
+          { char_2_char } @ttypeconvnode.resulttype_char_to_char
          );
       type
          tprocedureofobject = function : tnode of object;
@@ -750,6 +775,25 @@ implementation
                     end;
                  end
 
+              {Are we typecasting an ordconst to a wchar?}
+              else
+                if is_widechar(resulttype.def) and
+                   is_ordinal(left.resulttype.def) then
+                 begin
+                   if left.nodetype=ordconstn then
+                    begin
+                      hp:=cordconstnode.create(tordconstnode(left).value,resulttype);
+                      resulttypepass(hp);
+                      result:=hp;
+                      exit;
+                    end
+                   else
+                    begin
+                      if IsConvertable(left.resulttype.def,u16bittype.def,convtype,ordconstn,false)=0 then
+                        CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
+                    end;
+                 end
+
               { char to ordinal }
               else
                 if is_char(left.resulttype.def) and
@@ -768,6 +812,24 @@ implementation
                         CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
                     end;
                  end
+              { widechar to ordinal }
+              else
+                if is_widechar(left.resulttype.def) and
+                   is_ordinal(resulttype.def) then
+                 begin
+                   if left.nodetype=ordconstn then
+                    begin
+                      hp:=cordconstnode.create(tordconstnode(left).value,resulttype);
+                      resulttypepass(hp);
+                      result:=hp;
+                      exit;
+                    end
+                   else
+                    begin
+                      if IsConvertable(u16bittype.def,resulttype.def,convtype,ordconstn,false)=0 then
+                        CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
+                    end;
+                 end
 
                { only if the same size or formal def }
                { why do we allow typecasting of voiddef ?? (PM) }
@@ -788,7 +850,7 @@ implementation
                 end;
 
                { the conversion into a strutured type is only }
-               { possible, if the source is no register    }
+               { possible, if the source is not a register    }
                if ((resulttype.def.deftype in [recorddef,stringdef,arraydef]) or
                    ((resulttype.def.deftype=objectdef) and not(is_class(resulttype.def)))
                   ) and (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) { and
@@ -1022,6 +1084,15 @@ implementation
       end;
 
 
+    function ttypeconvnode.first_char_to_char : tnode;
+      begin
+         first_char_to_char:=nil;
+         location.loc:=LOC_REGISTER;
+         if registers32<1 then
+           registers32:=1;
+      end;
+
+
     function ttypeconvnode.first_proc_to_procvar : tnode;
       begin
          first_proc_to_procvar:=nil;
@@ -1099,7 +1170,8 @@ implementation
            @ttypeconvnode.first_cord_to_pointer,
            @ttypeconvnode.first_nothing,
            @ttypeconvnode.first_nothing,
-           @ttypeconvnode.first_class_to_intf
+           @ttypeconvnode.first_class_to_intf,
+           @ttypeconvnode.first_char_to_char
          );
       type
          tprocedureofobject = function : tnode of object;
@@ -1291,7 +1363,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.26  2001-05-04 15:52:03  florian
+  Revision 1.27  2001-05-08 21:06:30  florian
+    * some more support for widechars commited especially
+      regarding type casting and constants
+
+  Revision 1.26  2001/05/04 15:52:03  florian
     * some Delphi incompatibilities fixed:
        - out, dispose and new can be used as idenfiers now
        - const p = apointerype(nil); is supported now

compiler/ncon.pas

@@ -121,6 +121,7 @@ interface
     function is_constrealnode(p : tnode) : boolean;
     function is_constboolnode(p : tnode) : boolean;
     function is_constresourcestringnode(p : tnode) : boolean;
+    function is_constwidecharnode(p : tnode) : boolean;
     function str_length(p : tnode) : longint;
     function is_emptyset(p : tnode):boolean;
     function genconstsymtree(p : tconstsym) : tnode;
@@ -194,6 +195,13 @@ implementation
       end;
 
 
+    function is_constwidecharnode(p : tnode) : boolean;
+
+      begin
+         is_constwidecharnode:=(p.nodetype=ordconstn) and is_widechar(p.resulttype.def);
+      end;
+
+
     function is_constrealnode(p : tnode) : boolean;
 
       begin
@@ -644,7 +652,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.17  2001-04-13 01:22:09  peter
+  Revision 1.18  2001-05-08 21:06:30  florian
+    * some more support for widechars commited especially
+      regarding type casting and constants
+
+  Revision 1.17  2001/04/13 01:22:09  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/pdecl.pas

@@ -87,6 +87,8 @@ implementation
                   hp:=tconstsym.create(name,constchar,tordconstnode(p).value)
                 else if is_constboolnode(p) then
                   hp:=tconstsym.create(name,constbool,tordconstnode(p).value)
+                else if is_constwidecharnode(p) then
+                  hp:=tconstsym.create(name,constwchar,tordconstnode(p).value)
                 else if p.resulttype.def.deftype=enumdef then
                   hp:=tconstsym.create_typed(name,constord,tordconstnode(p).value,p.resulttype)
                 else if p.resulttype.def.deftype=pointerdef then
@@ -541,7 +543,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.29  2001-04-13 01:22:11  peter
+  Revision 1.30  2001-05-08 21:06:31  florian
+    * some more support for widechars commited especially
+      regarding type casting and constants
+
+  Revision 1.29  2001/04/13 01:22:11  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/pdecsub.pas

@@ -115,7 +115,7 @@ implementation
         { Delphi/Kylix supports nonsense like }
         { procedure p();                      }
         if try_to_consume(_RKLAMMER) and
-          not(m_tp in aktmodeswitches) then
+          not(m_tp7 in aktmodeswitches) then
           exit;
         inc(testcurobject);
         repeat
@@ -1851,7 +1851,11 @@ const
 end.
 {
   $Log$
-  Revision 1.23  2001-05-08 14:32:58  jonas
+  Revision 1.24  2001-05-08 21:06:31  florian
+    * some more support for widechars commited especially
+      regarding type casting and constants
+
+  Revision 1.23  2001/05/08 14:32:58  jonas
     * fixed bug for overloaded operators with a return type that has a size
       which isn't a multiple of the target_os.stackalignment (main branch
       patch from Peter)

compiler/symconst.pas

@@ -405,7 +405,7 @@ type
   tconsttyp = (constnone,
     constord,conststring,constreal,constbool,
     constint,constchar,constset,constpointer,constnil,
-    constresourcestring
+    constresourcestring,constwstring,constwchar
   );
 
 {$ifdef GDB}
@@ -451,7 +451,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.16  2001-04-13 01:22:15  peter
+  Revision 1.17  2001-05-08 21:06:31  florian
+    * some more support for widechars commited especially
+      regarding type casting and constants
+
+  Revision 1.16  2001/04/13 01:22:15  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/symsym.pas

@@ -1931,6 +1931,7 @@ implementation
                end
              else
                value:=ppufile.getlongint;
+           constwchar,
            constbool,
            constchar :
              value:=ppufile.getlongint;
@@ -2328,7 +2329,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.12  2001-05-06 14:49:17  peter
+  Revision 1.13  2001-05-08 21:06:32  florian
+    * some more support for widechars commited especially
+      regarding type casting and constants
+
+  Revision 1.12  2001/05/06 14:49:17  peter
     * ppu object to class rewrite
     * move ppu read and write stuff to fppu
 

compiler/types.pas

@@ -59,6 +59,9 @@ interface
     { true if p is a char }
     function is_char(def : tdef) : boolean;
 
+    { true if p is a widechar }
+    function is_widechar(def : tdef) : boolean;
+
     { true if p is a void}
     function is_void(def : tdef) : boolean;
 
@@ -180,7 +183,8 @@ interface
           tc_cord_2_pointer,
           tc_intf_2_string,
           tc_intf_2_guid,
-          tc_class_2_intf
+          tc_class_2_intf,
+          tc_char_2_char
        );
 
     function assignment_overloaded(from_def,to_def : tdef) : tprocdef;
@@ -516,6 +520,14 @@ implementation
       end;
 
 
+    { true if p is a wchar }
+    function is_widechar(def : tdef) : boolean;
+      begin
+        is_widechar:=(def.deftype=orddef) and
+                 (torddef(def).typ=uwidechar);
+      end;
+
+
     { true if p is signed (integer) }
     function is_signed(def : tdef) : boolean;
       var
@@ -1217,7 +1229,7 @@ implementation
                     u8bit,u16bit,u32bit,
                     s8bit,s16bit,s32,
                     bool8bit,bool16bit,bool32bit,
-                    u64bit,s64bitint }
+                    u64bit,s64bitint,uwidechar }
       type
         tbasedef=(bvoid,bchar,bint,bbool);
       const
@@ -1229,7 +1241,7 @@ implementation
 
         basedefconverts : array[tbasedef,tbasedef] of tconverttype =
          ((tc_not_possible,tc_not_possible,tc_not_possible,tc_not_possible),
-          (tc_not_possible,tc_equal,tc_not_possible,tc_not_possible),
+          (tc_not_possible,tc_char_2_char,tc_not_possible,tc_not_possible),
           (tc_not_possible,tc_not_possible,tc_int_2_int,tc_int_2_bool),
           (tc_not_possible,tc_not_possible,tc_bool_2_int,tc_bool_2_bool));
 
@@ -1733,7 +1745,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.41  2001-04-22 22:46:49  florian
+  Revision 1.42  2001-05-08 21:06:33  florian
+    * some more support for widechars commited especially
+      regarding type casting and constants
+
+  Revision 1.41  2001/04/22 22:46:49  florian
     * more variant support
 
   Revision 1.40  2001/04/18 22:02:00  peter

compiler/widestr.pas

@@ -55,6 +55,7 @@ unit widestr;
       var r : tcompilerwidestring);
     procedure copywidestring(const s : tcompilerwidestring;var d : tcompilerwidestring);
     function asciichar2unicode(c : char) : tcompilerwidechar;
+    function unicode2asciichar(c : tcompilerwidechar) : char;
     procedure ascii2unicode(const s : string;var r : tcompilerwidestring);
     function getcharwidestring(const r : tcompilerwidestring;l : longint) : tcompilerwidechar;
     function cpavailable(const s : string) : boolean;
@@ -157,6 +158,11 @@ unit widestr;
         asciichar2unicode:=0;
       end;
 
+    function unicode2asciichar(c : tcompilerwidechar) : char;
+
+      begin
+      end;
+
     procedure ascii2unicode(const s : string;var r : tcompilerwidestring);
 (*
       var
@@ -190,7 +196,11 @@ unit widestr;
 end.
 {
   $Log$
-  Revision 1.3  2001-04-13 01:22:17  peter
+  Revision 1.4  2001-05-08 21:06:33  florian
+    * some more support for widechars commited especially
+      regarding type casting and constants
+
+  Revision 1.3  2001/04/13 01:22:17  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed