* Prepare compiler infrastructure for multiple ansistring types

compiler/cgobj.pas

@@ -1535,7 +1535,20 @@ implementation
          if is_interfacecom(t) then
           incrfunc:='FPC_INTF_INCR_REF'
          else if is_ansistring(t) then
-          incrfunc:='FPC_ANSISTR_INCR_REF'
+       {$ifdef ansistring_bits}
+           begin
+             case Tstringdef(t).string_typ of
+               st_ansistring16:
+                 incrfunc:='FPC_ANSISTR16_INCR_REF';
+               st_ansistring32:
+                 incrfunc:='FPC_ANSISTR32_INCR_REF';
+               st_ansistring64:
+                 incrfunc:='FPC_ANSISTR64_INCR_REF';
+             end;
+           end
+       {$else}
+            incrfunc:='FPC_ANSISTR_INCR_REF'
+       {$endif}
          else if is_widestring(t) then
           incrfunc:='FPC_WIDESTR_INCR_REF'
          else if is_dynamic_array(t) then
@@ -1586,7 +1599,20 @@ implementation
          if is_interfacecom(t) then
           decrfunc:='FPC_INTF_DECR_REF'
          else if is_ansistring(t) then
-          decrfunc:='FPC_ANSISTR_DECR_REF'
+       {$ifdef ansistring_bits}
+           begin
+             case Tstringdef(t).string_typ of
+               st_ansistring16:
+                 decrfunc:='FPC_ANSISTR16_DECR_REF';
+               st_ansistring32:
+                 decrfunc:='FPC_ANSISTR32_DECR_REF';
+               st_ansistring64:
+                 decrfunc:='FPC_ANSISTR64_DECR_REF';
+             end;
+           end
+       {$else}
+            decrfunc:='FPC_ANSISTR_DECR_REF'
+       {$endif}
          else if is_widestring(t) then
           decrfunc:='FPC_WIDESTR_DECR_REF'
          else if is_dynamic_array(t) then
@@ -2111,7 +2137,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.162  2004-04-18 07:52:43  florian
+  Revision 1.163  2004-04-29 19:56:36  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  Revision 1.162  2004/04/18 07:52:43  florian
     * fixed web bug 3048: comparision of dyn. arrays
 
   Revision 1.161  2004/03/06 20:35:19  florian

compiler/defutil.pas

@@ -506,13 +506,21 @@ implementation
                         );
       end;
 
+{$ifdef ansistring_bits}
+    { true if p is an ansi string def }
+    function is_ansistring(p : tdef) : boolean;
+      begin
+         is_ansistring:=(p.deftype=stringdef) and
+                        (tstringdef(p).string_typ in [st_ansistring16,st_ansistring32,st_ansistring64]);
+      end;
+{$else}
     { true if p is an ansi string def }
     function is_ansistring(p : tdef) : boolean;
       begin
          is_ansistring:=(p.deftype=stringdef) and
                         (tstringdef(p).string_typ=st_ansistring);
       end;
-
+{$endif}
 
     { true if p is an long string def }
     function is_longstring(p : tdef) : boolean;
@@ -886,7 +894,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.12  2004-03-29 14:44:10  peter
+  Revision 1.13  2004-04-29 19:56:36  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  Revision 1.12  2004/03/29 14:44:10  peter
     * fixes to previous constant integer commit
 
   Revision 1.11  2004/03/23 22:34:49  peter

compiler/globals.pas

@@ -193,6 +193,9 @@ interface
         Initsetalloc,                            {0=fixed, 1 =var}
        {$ENDIF}
        initpackenum       : shortint;
+     {$ifdef ansistring_bits}
+       initansistring_bits: Tstringbits;
+     {$endif}
        initalignment      : talignmentinfo;
        initoptprocessor,
        initspecificoptprocessor : tprocessors;
@@ -215,6 +218,9 @@ interface
        {$ENDIF}
        aktpackrecords,
        aktpackenum        : longint;
+     {$ifdef ansistring_bits}
+       aktansistring_bits : Tstringbits;
+     {$endif}
        aktmaxfpuregisters : longint;
        aktalignment       : talignmentinfo;
        aktoptprocessor,
@@ -1897,7 +1903,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.127  2004-04-28 15:19:03  florian
+  Revision 1.128  2004-04-29 19:56:36  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  Revision 1.127  2004/04/28 15:19:03  florian
     + syscall directive support for MorphOS added
 
   Revision 1.126  2004/03/14 20:08:37  peter

compiler/globtype.pas

@@ -167,6 +167,9 @@ interface
        );
        tproccalloptions = set of tproccalloption;
 
+{$ifdef ansistring_bits}
+       Tstringbits=(sb_16,sb_32,sb_64);
+{$endif}
 
      const
        proccalloptionStr : array[tproccalloption] of string[14]=('',
@@ -239,7 +242,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.52  2004-04-28 15:19:03  florian
+  Revision 1.53  2004-04-29 19:56:36  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  Revision 1.52  2004/04/28 15:19:03  florian
     + syscall directive support for MorphOS added
 
   Revision 1.51  2004/04/04 18:46:09  olle

compiler/nadd.pas

@@ -1005,9 +1005,35 @@ implementation
                 else if is_ansistring(rd) or is_ansistring(ld) then
                   begin
                      if not(is_ansistring(rd)) then
-                       inserttypeconv(right,cansistringtype);
+                       begin
+                       {$ifdef ansistring_bits}
+                         case Tstringdef(ld).string_typ of
+                           st_ansistring16:
+                             inserttypeconv(right,cansistringtype16);
+                           st_ansistring32:
+                             inserttypeconv(right,cansistringtype32);
+                           st_ansistring64:
+                             inserttypeconv(right,cansistringtype64);
+                         end;
+                       {$else}
+                         inserttypeconv(right,cansistringtype);
+                       {$endif}
+                       end;
                      if not(is_ansistring(ld)) then
-                       inserttypeconv(left,cansistringtype);
+                       begin
+                       {$ifdef ansistring_bits}
+                         case Tstringdef(rd).string_typ of
+                           st_ansistring16:
+                             inserttypeconv(left,cansistringtype16);
+                           st_ansistring32:
+                             inserttypeconv(left,cansistringtype32);
+                           st_ansistring64:
+                             inserttypeconv(left,cansistringtype64);
+                         end;
+                       {$else}
+                         inserttypeconv(left,cansistringtype);
+                       {$endif}
+                       end;
                   end
                 else if is_longstring(rd) or is_longstring(ld) then
                   begin
@@ -1926,7 +1952,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.116  2004-04-18 07:52:43  florian
+  Revision 1.117  2004-04-29 19:56:37  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  Revision 1.116  2004/04/18 07:52:43  florian
     * fixed web bug 3048: comparision of dyn. arrays
 
   Revision 1.115  2004/03/29 14:44:10  peter

compiler/ncgcnv.pas

@@ -126,7 +126,11 @@ interface
                location.register:=cg.getaddressregister(exprasmlist);
                cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,location.register);
              end;
+         {$ifdef ansistring_bits}
+           st_ansistring16,st_ansistring32,st_ansistring64 :
+         {$else}
            st_ansistring :
+         {$endif}
              begin
                if (left.nodetype=stringconstn) and
                   (str_length(left)=0) then
@@ -535,7 +539,10 @@ end.
 
 {
   $Log$
-  Revision 1.56  2004-03-02 00:36:33  olle
+  Revision 1.57  2004-04-29 19:56:37  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  Revision 1.56  2004/03/02 00:36:33  olle
     * big transformation of Tai_[const_]Symbol.Create[data]name*
 
   Revision 1.55  2004/02/27 10:21:05  florian

compiler/ncgcon.pas

@@ -222,8 +222,11 @@ implementation
          i,mylength  : longint;
       begin
          { for empty ansistrings we could return a constant 0 }
-         if (st_type in [st_ansistring,st_widestring]) and
-            (len=0) then
+       {$ifdef ansistring_bits}
+         if (st_type in [st_ansistring16,st_ansistring32,st_ansistring64,st_widestring]) and (len=0) then
+       {$else}
+         if (st_type in [st_ansistring,st_widestring]) and (len=0) then
+       {$endif}
           begin
             location_reset(location,LOC_CONSTANT,OS_ADDR);
             location.value:=0;
@@ -282,7 +285,55 @@ implementation
                                              end;
                                          end;
                                      end;
+                                 {$ifdef ansistring_bits}
+                                   st_ansistring16:
+                                     begin
+                                       { before the string the following sequence must be found:
+                                         <label>
+                                           constsymbol <datalabel>
+                                           const32 <len>
+                                           const32 <len>
+                                           const32 -1
+                                         we must then return <label> to reuse
+                                       }
+                                       hp2:=tai(lastlabelhp.previous);
+                                       if assigned(hp2) and
+                                          (hp2.typ=ait_const_16bit) and
+                                          (tai_const(hp2).value=aword(-1)) and
+                                          assigned(hp2.previous) and
+                                          (tai(hp2.previous).typ=ait_const_16bit) and
+                                          (tai_const(hp2.previous).value=len) and
+                                          assigned(hp2.previous.previous) and
+                                          (tai(hp2.previous.previous).typ=ait_const_16bit) and
+                                          (tai_const(hp2.previous.previous).value=len) and
+                                          assigned(hp2.previous.previous.previous) and
+                                          (tai(hp2.previous.previous.previous).typ=ait_const_symbol) and
+                                          assigned(hp2.previous.previous.previous.previous) and
+                                          (tai(hp2.previous.previous.previous.previous).typ=ait_label) then
+                                         begin
+                                           lastlabel:=tai_label(hp2.previous.previous.previous.previous).l;
+                                           same_string:=true;
+                                           j:=0;
+                                           if len>0 then
+                                             begin
+                                               for i:=0 to len-1 do
+                                                begin
+                                                  if tai_string(hp1).str[j]<>value_str[i] then
+                                                   begin
+                                                     same_string:=false;
+                                                     break;
+                                                   end;
+                                                  inc(j);
+                                                end;
+                                             end;
+                                         end;
+                                     end;
+                                 {$endif}
+                                 {$ifdef ansistring_bits}
+                                   st_ansistring32,
+                                 {$else}
                                    st_ansistring,
+                                 {$endif}
                                    st_widestring :
                                      begin
                                        { before the string the following sequence must be found:
@@ -325,6 +376,50 @@ implementation
                                              end;
                                          end;
                                      end;
+                                 {$ifdef ansistring_bits}
+                                   st_ansistring64:
+                                     begin
+                                       { before the string the following sequence must be found:
+                                         <label>
+                                           constsymbol <datalabel>
+                                           const32 <len>
+                                           const32 <len>
+                                           const32 -1
+                                         we must then return <label> to reuse
+                                       }
+                                       hp2:=tai(lastlabelhp.previous);
+                                       if assigned(hp2) and
+                                          (hp2.typ=ait_const_64bit) and
+                                          (tai_const(hp2).value=aword(-1)) and
+                                          assigned(hp2.previous) and
+                                          (tai(hp2.previous).typ=ait_const_64bit) and
+                                          (tai_const(hp2.previous).value=len) and
+                                          assigned(hp2.previous.previous) and
+                                          (tai(hp2.previous.previous).typ=ait_const_64bit) and
+                                          (tai_const(hp2.previous.previous).value=len) and
+                                          assigned(hp2.previous.previous.previous) and
+                                          (tai(hp2.previous.previous.previous).typ=ait_const_symbol) and
+                                          assigned(hp2.previous.previous.previous.previous) and
+                                          (tai(hp2.previous.previous.previous.previous).typ=ait_label) then
+                                         begin
+                                           lastlabel:=tai_label(hp2.previous.previous.previous.previous).l;
+                                           same_string:=true;
+                                           j:=0;
+                                           if len>0 then
+                                             begin
+                                               for i:=0 to len-1 do
+                                                begin
+                                                  if tai_string(hp1).str[j]<>value_str[i] then
+                                                   begin
+                                                     same_string:=false;
+                                                     break;
+                                                   end;
+                                                  inc(j);
+                                                end;
+                                             end;
+                                         end;
+                                     end;
+                                 {$endif}
                                  end;
                                  { found ? }
                                  if same_string then
@@ -349,7 +444,34 @@ implementation
                    Consts.concat(Tai_label.Create(lastlabel));
                    { generate an ansi string ? }
                    case st_type of
-                      st_ansistring:
+                    {$ifdef ansistring_bits}
+                      st_ansistring16:
+                        begin
+                           { an empty ansi string is nil! }
+                           if len=0 then
+                             Consts.concat(Tai_const.Create_ptr(0))
+                           else
+                             begin
+                                objectlibrary.getdatalabel(l1);
+                                objectlibrary.getdatalabel(l2);
+                                Consts.concat(Tai_label.Create(l2));
+                                Consts.concat(Tai_const_symbol.Create(l1));
+                                Consts.concat(Tai_const.Create_32bit(len));
+                                Consts.concat(Tai_const.Create_32bit(len));
+                                Consts.concat(Tai_const.Create_32bit(Cardinal(-1)));
+                                Consts.concat(Tai_label.Create(l1));
+                                getmem(pc,len+2);
+                                move(value_str^,pc^,len);
+                                pc[len]:=#0;
+                                { to overcome this problem we set the length explicitly }
+                                { with the ending null char }
+                                Consts.concat(Tai_string.Create_length_pchar(pc,len+1));
+                                { return the offset of the real string }
+                                lab_str:=l2;
+                             end;
+                        end;
+                    {$endif}
+                      {$ifdef ansistring_bits}st_ansistring32:{$else}st_ansistring:{$endif}
                         begin
                            { an empty ansi string is nil! }
                            if len=0 then
@@ -374,6 +496,33 @@ implementation
                                 lab_str:=l2;
                              end;
                         end;
+                    {$ifdef ansistring_bits}
+                      st_ansistring64:
+                        begin
+                           { an empty ansi string is nil! }
+                           if len=0 then
+                             Consts.concat(Tai_const.Create_ptr(0))
+                           else
+                             begin
+                                objectlibrary.getdatalabel(l1);
+                                objectlibrary.getdatalabel(l2);
+                                Consts.concat(Tai_label.Create(l2));
+                                Consts.concat(Tai_const_symbol.Create(l1));
+                                Consts.concat(Tai_const.Create_32bit(len));
+                                Consts.concat(Tai_const.Create_32bit(len));
+                                Consts.concat(Tai_const.Create_32bit(Cardinal(-1)));
+                                Consts.concat(Tai_label.Create(l1));
+                                getmem(pc,len+2);
+                                move(value_str^,pc^,len);
+                                pc[len]:=#0;
+                                { to overcome this problem we set the length explicitly }
+                                { with the ending null char }
+                                Consts.concat(Tai_string.Create_length_pchar(pc,len+1));
+                                { return the offset of the real string }
+                                lab_str:=l2;
+                             end;
+                        end;
+                    {$endif}
                       st_widestring:
                         begin
                            { an empty wide string is nil! }
@@ -578,7 +727,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.39  2004-03-18 17:29:40  peter
+  Revision 1.40  2004-04-29 19:56:37  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  Revision 1.39  2004/03/18 17:29:40  peter
     * fix overflow
 
   Revision 1.38  2004/03/16 16:19:44  peter

compiler/ncgld.pas

@@ -715,13 +715,15 @@ implementation
         vtClass      = 8;
         vtWideChar   = 9;
         vtPWideChar  = 10;
-        vtAnsiString = 11;
+        vtAnsiString32 = 11;
         vtCurrency   = 12;
         vtVariant    = 13;
         vtInterface  = 14;
         vtWideString = 15;
         vtInt64      = 16;
         vtQWord      = 17;
+        vtAnsiString16 = 18;
+        vtAnsiString64 = 19;
 
     procedure tcgarrayconstructornode.pass_2;
       var
@@ -835,10 +837,24 @@ implementation
                         end
                        else
                         if is_ansistring(lt) then
+                        {$ifdef ansistring_bits}
+                         begin
+                           case Tstringdef(lt).string_typ of
+                             st_ansistring16:
+                               vtype:=vtAnsiString16;
+                             st_ansistring32:
+                               vtype:=vtAnsiString32;
+                             st_ansistring64:
+                               vtype:=vtAnsiString64;
+                           end;
+                           freetemp:=false;
+                         end
+                        {$else}
                          begin
                            vtype:=vtAnsiString;
                            freetemp:=false;
                          end
+                        {$endif}
                        else
                         if is_widestring(lt) then
                          begin
@@ -926,7 +942,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.114  2004-03-02 17:32:12  florian
+  Revision 1.115  2004-04-29 19:56:37  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  Revision 1.114  2004/03/02 17:32:12  florian
     * make cycle fixed
     + pic support for darwin
     + support of importing vars from shared libs on darwin implemented

compiler/ncgmem.pas

@@ -604,6 +604,7 @@ implementation
               if nf_callunique in flags then
                 internalerror(200304236);
 
+              {DM!!!!!}
               case left.location.loc of
                 LOC_REGISTER,
                 LOC_CREGISTER :
@@ -700,7 +701,11 @@ implementation
                        case tstringdef(left.resulttype.def).string_typ of
                          { it's the same for ansi- and wide strings }
                          st_widestring,
+                       {$ifdef ansistring_bits}
+                         st_ansistring16,st_ansistring32,st_ansistring64:
+                       {$else}
                          st_ansistring:
+                       {$endif}
                            begin
                               paraloc1:=paramanager.getintparaloc(pocall_default,1);
                               paraloc2:=paramanager.getintparaloc(pocall_default,2);
@@ -834,7 +839,11 @@ implementation
                       case tstringdef(left.resulttype.def).string_typ of
                          { it's the same for ansi- and wide strings }
                          st_widestring,
+                       {$ifdef ansistring_bits}
+                         st_ansistring16,st_ansistring32,st_ansistring64:
+                       {$else}
                          st_ansistring:
+                       {$endif}
                            begin
                               paraloc1:=paramanager.getintparaloc(pocall_default,1);
                               paraloc2:=paramanager.getintparaloc(pocall_default,2);
@@ -882,7 +891,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.90  2004-04-21 17:39:40  jonas
+  Revision 1.91  2004-04-29 19:56:37  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  Revision 1.90  2004/04/21 17:39:40  jonas
     - disabled with-symtable debugging code since it was broken and
       at the same time confused the register allocator and therefore also
       the optimizer. May be fixed in the future using dwarf support

compiler/ncnv.pas

@@ -632,8 +632,14 @@ implementation
          if left.nodetype=stringconstn then
           begin
              { convert ascii 2 unicode }
+           {$ifdef ansistring_bits}
+             if (tstringdef(resulttype.def).string_typ=st_widestring) and
+                (tstringconstnode(left).st_type in [st_ansistring16,st_ansistring32,
+                       st_ansistring64,st_shortstring,st_longstring]) then
+           {$else}
              if (tstringdef(resulttype.def).string_typ=st_widestring) and
                 (tstringconstnode(left).st_type in [st_ansistring,st_shortstring,st_longstring]) then
+           {$endif}
               begin
                 initwidestring(pw);
                 ascii2unicode(tstringconstnode(left).value_str,tstringconstnode(left).len,pw);
@@ -642,8 +648,14 @@ implementation
               end
              else
              { convert unicode 2 ascii }
+           {$ifdef ansistring_bits}
+             if (tstringconstnode(left).st_type=st_widestring) and
+                (tstringdef(resulttype.def).string_typ in [st_ansistring16,st_ansistring32,
+                           st_ansistring64,st_shortstring,st_longstring]) then
+           {$else}
              if (tstringconstnode(left).st_type=st_widestring) and
                 (tstringdef(resulttype.def).string_typ in [st_ansistring,st_shortstring,st_longstring]) then
+           {$endif}
               begin
                 pw:=pcompilerwidestring(tstringconstnode(left).value_str);
                 getmem(pc,getlengthwidestring(pw)+1);
@@ -2402,7 +2414,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.143  2004-03-23 22:34:49  peter
+  Revision 1.144  2004-04-29 19:56:37  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  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

compiler/ncon.pas

@@ -599,7 +599,18 @@ implementation
          if st=st_default then
           begin
             if cs_ansistrings in aktlocalswitches then
+            {$ifdef ansistring_bits}
+              case aktansistring_bits of
+                sb_16:
+                  st_type:=st_ansistring16;
+                sb_32:
+                  st_type:=st_ansistring32;
+                sb_64:
+                  st_type:=st_ansistring64;
+              end
+            {$else}
               st_type:=st_ansistring
+            {$endif}
             else
               st_type:=st_shortstring;
           end
@@ -626,7 +637,18 @@ implementation
          value_str:=s;
          if (cs_ansistrings in aktlocalswitches) or
             (len>255) then
-          st_type:=st_ansistring
+          {$ifdef ansistring_bits}
+            case aktansistring_bits of
+              sb_16:
+                st_type:=st_ansistring16;
+              sb_32:
+                st_type:=st_ansistring32;
+              sb_64:
+                st_type:=st_ansistring64;
+            end
+          {$else}
+            st_type:=st_ansistring
+          {$endif}
          else
           st_type:=st_shortstring;
          lab_str:=nil;
@@ -704,8 +726,17 @@ implementation
         case st_type of
           st_shortstring :
             resulttype:=cshortstringtype;
+        {$ifdef ansistring_bits}
+          st_ansistring16:
+            resulttype:=cansistringtype16;
+          st_ansistring32:
+            resulttype:=cansistringtype32;
+          st_ansistring64:
+            resulttype:=cansistringtype64;
+        {$else}
           st_ansistring :
             resulttype:=cansistringtype;
+        {$endif}
           st_widestring :
             resulttype:=cwidestringtype;
           st_longstring :
@@ -716,7 +747,11 @@ implementation
     function tstringconstnode.pass_1 : tnode;
       begin
         result:=nil;
+      {$ifdef ansistring_bits}
+        if (st_type in [st_ansistring16,st_ansistring32,st_ansistring64,st_widestring]) and
+      {$else}
         if (st_type in [st_ansistring,st_widestring]) and
+      {$endif}
            (len=0) then
          expectloc:=LOC_CONSTANT
         else
@@ -934,7 +969,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.60  2004-03-23 22:34:49  peter
+  Revision 1.61  2004-04-29 19:56:37  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  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

compiler/nld.pas

@@ -236,7 +236,20 @@ implementation
            constsym:
              begin
                if tconstsym(symtableentry).consttyp=constresourcestring then
-                 resulttype:=cansistringtype
+                 begin
+                 {$ifdef ansistring_bits}
+                   case aktansistring_bits of
+                     sb_16:
+                       resulttype:=cansistringtype16;
+                     sb_32:
+                       resulttype:=cansistringtype32;
+                     sb_64:
+                       resulttype:=cansistringtype64;
+                   end;
+                 {$else}
+                   resulttype:=cansistringtype
+                 {$endif}
+                 end
                else
                  internalerror(22799);
              end;
@@ -469,11 +482,11 @@ implementation
                     hp:=ccallparanode.create(tbinarynode(right).right,
                       ccallparanode.create(left,nil));
                     if is_char(tbinarynode(right).right.resulttype.def) then
-                      result:=ccallnode.createintern('fpc_ansistr_append_char',hp)
+                      result:=ccallnode.createintern('fpc_'+Tstringdef(left.resulttype.def).stringtypname+'_append_char',hp)
                     else if is_shortstring(tbinarynode(right).right.resulttype.def) then
-                      result:=ccallnode.createintern('fpc_ansistr_append_shortstring',hp)
+                      result:=ccallnode.createintern('fpc_'+Tstringdef(left.resulttype.def).stringtypname+'_append_shortstring',hp)
                     else
-                      result:=ccallnode.createintern('fpc_ansistr_append_ansistring',hp);
+                      result:=ccallnode.createintern('fpc_'+Tstringdef(left.resulttype.def).stringtypname+'_append_ansistring',hp);
                     tbinarynode(right).right:=nil;
                     left:=nil;
                     exit;
@@ -1124,7 +1137,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.125  2004-03-02 17:32:12  florian
+  Revision 1.126  2004-04-29 19:56:37  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  Revision 1.125  2004/03/02 17:32:12  florian
     * make cycle fixed
     + pic support for darwin
     + support of importing vars from shared libs on darwin implemented

compiler/nmem.pas

@@ -727,7 +727,11 @@ implementation
                 case tstringdef(left.resulttype.def).string_typ of
                    st_widestring :
                      resulttype:=cwidechartype;
+                 {$ifdef ansistring_bits}
+                   st_ansistring16,st_ansistring32,st_ansistring64 :
+                 {$else}
                    st_ansistring :
+                 {$endif}
                      resulttype:=cchartype;
                    st_longstring :
                      resulttype:=cchartype;
@@ -977,7 +981,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.82  2004-03-29 14:42:52  peter
+  Revision 1.83  2004-04-29 19:56:37  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  Revision 1.82  2004/03/29 14:42:52  peter
     * variant array support
 
   Revision 1.81  2004/03/18 16:19:03  peter

compiler/pexpr.pas

@@ -142,7 +142,18 @@ implementation
           else
             begin
                if cs_ansistrings in aktlocalswitches then
+                 {$ifdef ansistring_bits}
+                 case aktansistring_bits of
+                   sb_16:
+                     t:=cansistringtype16;
+                   sb_32:
+                     t:=cansistringtype32;
+                   sb_64:
+                     t:=cansistringtype64;
+                 end
+                 {$else}
                  t:=cansistringtype
+                 {$endif}
                else
                  t:=cshortstringtype;
             end;
@@ -1341,7 +1352,18 @@ implementation
                         begin
                           p1:=cloadnode.create(srsym,srsymtable);
                           do_resulttypepass(p1);
+                        {$ifdef ansistring_bits}
+                          case aktansistring_bits of
+                            sb_16:
+                              p1.resulttype:=cansistringtype16;
+                            sb_32:
+                              p1.resulttype:=cansistringtype32;
+                            sb_64:
+                              p1.resulttype:=cansistringtype64;
+                          end;
+                        {$else}
                           p1.resulttype:=cansistringtype;
+                        {$endif}
                         end;
                       constguid :
                         p1:=cguidconstnode.create(pguid(tconstsym(srsym).value.valueptr)^);
@@ -2399,7 +2421,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.153  2004-04-12 18:59:32  florian
+  Revision 1.154  2004-04-29 19:56:37  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  Revision 1.153  2004/04/12 18:59:32  florian
     * small x86_64 fixes
 
   Revision 1.152  2004/03/29 14:42:52  peter

compiler/pinline.pas

@@ -633,6 +633,7 @@ implementation
         paradef : tdef;
         counter : integer;
         newstatement : tstatementnode;
+        mode    : byte;
       begin
         { for easy exiting if something goes wrong }
         result := cerrornode.create;
@@ -656,12 +657,40 @@ implementation
            ppn:=tcallparanode(ppn.right);
          end;
         paradef:=ppn.left.resulttype.def;
+{$ifdef ansistring_bits}
+        if is_ansistring(paradef) then
+          case Tstringdef(paradef).string_typ of
+            st_ansistring16:
+              mode:=16;
+            st_ansistring32:
+              mode:=32;
+            st_ansistring64:
+              mode:=64;
+          end;
+        if (is_chararray(paradef) and (paradef.size>255)) or
+           ((cs_ansistrings in aktlocalswitches) and is_pchar(paradef)) then
+          case aktansistring_bits of
+            sb_16:
+              mode:=16;
+            sb_32:
+              mode:=32;
+            sb_64:
+              mode:=64;
+          end;
+        if mode=16 then
+          copynode:=ccallnode.createintern('fpc_ansistr16_copy',paras)
+        else if mode=32 then
+          copynode:=ccallnode.createintern('fpc_ansistr32_copy',paras)
+        else if mode=64 then
+          copynode:=ccallnode.createintern('fpc_ansistr64_copy',paras)
+{$else}
         if is_ansistring(paradef) or
            (is_chararray(paradef) and
             (paradef.size>255)) or
            ((cs_ansistrings in aktlocalswitches) and
             is_pchar(paradef)) then
           copynode:=ccallnode.createintern('fpc_ansistr_copy',paras)
+{$endif}
         else
          if is_widestring(paradef) or
             is_widechararray(paradef) or
@@ -734,7 +763,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.29  2004-02-04 18:45:29  jonas
+  Revision 1.30  2004-04-29 19:56:37  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  Revision 1.29  2004/02/04 18:45:29  jonas
     + some more usage of register temps
 
   Revision 1.28  2004/02/03 22:32:54  peter

compiler/ppu.pas

@@ -44,7 +44,11 @@ type
 {$endif Test_Double_checksum}
 
 const
+{$ifdef ansistring_bits}
+  CurrentPPUVersion=41;
+{$else}
   CurrentPPUVersion=40;
+{$endif}
 
 { buffer sizes }
   maxentrysize = 1024;
@@ -111,7 +115,13 @@ const
   ibfloatdef       = 52;
   ibclassrefdef    = 53;
   iblongstringdef  = 54;
+{$ifdef ansistring_bits}
+  ibansistring16def  = 58;
+  ibansistring32def  = 55;
+  ibansistring64def  = 59;
+{$else}
   ibansistringdef  = 55;
+{$endif}
   ibwidestringdef  = 56;
   ibvariantdef     = 57;
   {implementation/objectdata}
@@ -1042,7 +1052,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.47  2004-03-23 22:34:49  peter
+  Revision 1.48  2004-04-29 19:56:37  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  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

compiler/psystem.pas

@@ -151,7 +151,13 @@ implementation
         addtype('FarPointer',voidfarpointertype);
         addtype('ShortString',cshortstringtype);
         addtype('LongString',clongstringtype);
+{$ifdef ansistring_bits}
+        addtype('AnsiString',cansistringtype16);
+        addtype('AnsiString',cansistringtype32);
+        addtype('AnsiString',cansistringtype64);
+{$else}
         addtype('AnsiString',cansistringtype);
+{$endif}
         addtype('WideString',cwidestringtype);
         addtype('Boolean',booltype);
         addtype('ByteBool',booltype);
@@ -186,7 +192,13 @@ implementation
         addtype('$widechar',cwidechartype);
         addtype('$shortstring',cshortstringtype);
         addtype('$longstring',clongstringtype);
+      {$ifdef ansistring_bits}
+        addtype('$ansistring16',cansistringtype16);
+        addtype('$ansistring32',cansistringtype32);
+        addtype('$ansistring64',cansistringtype64);
+      {$else}
         addtype('$ansistring',cansistringtype);
+      {$endif}
         addtype('$widestring',cwidestringtype);
         addtype('$openshortstring',openshortstringtype);
         addtype('$boolean',booltype);
@@ -259,7 +271,13 @@ implementation
         loadtype('widechar',cwidechartype);
         loadtype('shortstring',cshortstringtype);
         loadtype('longstring',clongstringtype);
+      {$ifdef ansistring_bits}
+        loadtype('ansistring16',cansistringtype16);
+        loadtype('ansistring32',cansistringtype32);
+        loadtype('ansistring64',cansistringtype64);
+      {$else}
         loadtype('ansistring',cansistringtype);
+      {$endif}
         loadtype('widestring',cwidestringtype);
         loadtype('openshortstring',openshortstringtype);
         loadtype('openchararray',openchararraytype);
@@ -316,7 +334,13 @@ implementation
         cshortstringtype.setdef(tstringdef.createshort(255));
         { should we give a length to the default long and ansi string definition ?? }
         clongstringtype.setdef(tstringdef.createlong(-1));
+      {$ifdef ansistring_bits}
+        cansistringtype16.setdef(tstringdef.createansi(-1,sb_16));
+        cansistringtype32.setdef(tstringdef.createansi(-1,sb_32));
+        cansistringtype64.setdef(tstringdef.createansi(-1,sb_64));
+      {$else}
         cansistringtype.setdef(tstringdef.createansi(-1));
+      {$endif}
         cwidestringtype.setdef(tstringdef.createwide(-1));
         { length=0 for shortstring is open string (needed for readln(string) }
         openshortstringtype.setdef(tstringdef.createshort(0));
@@ -512,7 +536,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.67  2004-03-23 22:34:49  peter
+  Revision 1.68  2004-04-29 19:56:37  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  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

compiler/ptconst.pas

@@ -583,7 +583,38 @@ implementation
                           curconstSegment.concat(Tai_string.Create_length_pchar(ca,t.def.size-strlength-1));
                         end;
                      end;
-                   st_ansistring:
+                 {$ifdef ansistrings_bits}
+                   st_ansistring16:
+                     begin
+                        { an empty ansi string is nil! }
+                        if (strlength=0) then
+                          curconstSegment.concat(Tai_const.Create_ptr(0))
+                        else
+                          begin
+                            objectlibrary.getdatalabel(ll);
+                            curconstSegment.concat(Tai_const_symbol.Create(ll));
+                            { the actual structure starts at -12 from start label - CEC }
+                            Consts.concat(tai_align.create(const_align(pointer_size)));
+                            { first write the maximum size }
+                            Consts.concat(Tai_const.Create_16bit(strlength));
+                            { second write the real length }
+                            Consts.concat(Tai_const.Create_16bit(strlength));
+                            { redondent with maxlength but who knows ... (PM) }
+                            { third write use count (set to -1 for safety ) }
+                            Consts.concat(Tai_const.Create_16bit(Cardinal(-1)));
+                            Consts.concat(Tai_label.Create(ll));
+                            getmem(ca,strlength+2);
+                            move(strval^,ca^,strlength);
+                            { The terminating #0 to be stored in the .data section (JM) }
+                            ca[strlength]:=#0;
+                            { End of the PChar. The memory has to be allocated because in }
+                            { tai_string.done, there is a freemem(len+1) (JM)             }
+                            ca[strlength+1]:=#0;
+                            Consts.concat(Tai_string.Create_length_pchar(ca,strlength+1));
+                          end;
+                     end;
+                 {$endif}
+                   {$ifdef ansistring_bits}st_ansistring32{$else}st_ansistring{$endif}:
                      begin
                         { an empty ansi string is nil! }
                         if (strlength=0) then
@@ -612,6 +643,37 @@ implementation
                             Consts.concat(Tai_string.Create_length_pchar(ca,strlength+1));
                           end;
                      end;
+                 {$ifdef ansistring_bits}
+                   st_ansistring64:
+                     begin
+                        { an empty ansi string is nil! }
+                        if (strlength=0) then
+                          curconstSegment.concat(Tai_const.Create_ptr(0))
+                        else
+                          begin
+                            objectlibrary.getdatalabel(ll);
+                            curconstSegment.concat(Tai_const_symbol.Create(ll));
+                            { the actual structure starts at -12 from start label - CEC }
+                            Consts.concat(tai_align.create(const_align(pointer_size)));
+                            { first write the maximum size }
+                            Consts.concat(Tai_const.Create_64bit(strlength));
+                            { second write the real length }
+                            Consts.concat(Tai_const.Create_64bit(strlength));
+                            { redondent with maxlength but who knows ... (PM) }
+                            { third write use count (set to -1 for safety ) }
+                            Consts.concat(Tai_const.Create_64bit(Cardinal(-1)));
+                            Consts.concat(Tai_label.Create(ll));
+                            getmem(ca,strlength+2);
+                            move(strval^,ca^,strlength);
+                            { The terminating #0 to be stored in the .data section (JM) }
+                            ca[strlength]:=#0;
+                            { End of the PChar. The memory has to be allocated because in }
+                            { tai_string.done, there is a freemem(len+1) (JM)             }
+                            ca[strlength+1]:=#0;
+                            Consts.concat(Tai_string.Create_length_pchar(ca,strlength+1));
+                          end;
+                     end;
+                 {$endif}
                    st_widestring:
                      begin
                         { an empty ansi string is nil! }
@@ -1028,7 +1090,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.83  2004-04-11 10:44:23  peter
+  Revision 1.84  2004-04-29 19:56:37  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  Revision 1.83  2004/04/11 10:44:23  peter
     * block_type is bt_const when parsing typed consts
 
   Revision 1.82  2004/03/18 11:43:57  olle

compiler/symconst.pas

@@ -44,7 +44,11 @@ const
   tkSString  = 7;
   tkString   = tkSString;
   tkLString  = 8;
+{$ifdef ansistring_bits}
+  tkA32String  = 9;
+{$else}
   tkAString  = 9;
+{$endif}
   tkWString  = 10;
   tkVariant  = 11;
   tkArray    = 12;
@@ -58,6 +62,10 @@ const
   tkQWord    = 20;
   tkDynArray = 21;
   tkInterfaceCorba = 22;
+{$ifdef ansistring_bits}
+  tkA16string = 23;
+  tkA64string = 24;
+{$endif}
 
   otSByte    = 0;
   otUByte    = 1;
@@ -162,7 +170,16 @@ type
 
   { string types }
   tstringtype = (st_default,
-    st_shortstring, st_longstring, st_ansistring, st_widestring
+    st_shortstring,
+    st_longstring,
+  {$ifndef ansistring_bits}
+    st_ansistring,
+  {$else}
+    st_ansistring16,
+    st_ansistring32,
+    st_ansistring64,
+  {$endif}
+    st_widestring
   );
 
   { set types }
@@ -407,7 +424,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.80  2004-04-28 15:19:03  florian
+  Revision 1.81  2004-04-29 19:56:37  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  Revision 1.80  2004/04/28 15:19:03  florian
     + syscall directive support for MorphOS added
 
   Revision 1.79  2004/04/18 15:22:24  florian

compiler/symdef.pas

@@ -625,8 +625,13 @@ interface
           constructor loadshort(ppufile:tcompilerppufile);
           constructor createlong(l : longint);
           constructor loadlong(ppufile:tcompilerppufile);
+       {$ifdef ansistring_bits}
+          constructor createansi(l:longint;bits:Tstringbits);
+          constructor loadansi(ppufile:tcompilerppufile;bits:Tstringbits);
+       {$else}
           constructor createansi(l : longint);
           constructor loadansi(ppufile:tcompilerppufile);
+       {$endif}
           constructor createwide(l : longint);
           constructor loadwide(ppufile:tcompilerppufile);
           function getcopy : tstoreddef;override;
@@ -736,7 +741,13 @@ interface
        s32fixedtype,              { pointer to type of temp. fixed }
        cshortstringtype,          { pointer to type of short string const   }
        clongstringtype,           { pointer to type of long string const   }
+{$ifdef ansistring_bits}
+       cansistringtype16,         { pointer to type of ansi string const  }
+       cansistringtype32,         { pointer to type of ansi string const  }
+       cansistringtype64,         { pointer to type of ansi string const  }
+{$else}
        cansistringtype,           { pointer to type of ansi string const  }
+{$endif}
        cwidestringtype,           { pointer to type of wide string const  }
        openshortstringtype,       { pointer to type of an open shortstring,
                                     needed for readln() }
@@ -1302,8 +1313,40 @@ implementation
          savesize:=POINTER_SIZE;
       end;
 
+{$ifdef ansistring_bits}
+    constructor tstringdef.createansi(l:longint;bits:Tstringbits);
+      begin
+         inherited create;
+         case bits of
+           sb_16:
+             string_typ:=st_ansistring16;
+           sb_32:
+             string_typ:=st_ansistring32;
+           sb_64:
+             string_typ:=st_ansistring64;
+         end;
+         deftype:=stringdef;
+         len:=l;
+         savesize:=POINTER_SIZE;
+      end;
 
-    constructor tstringdef.createansi(l : longint);
+    constructor tstringdef.loadansi(ppufile:tcompilerppufile;bits:Tstringbits);
+      begin
+         inherited ppuloaddef(ppufile);
+         deftype:=stringdef;
+         case bits of
+           sb_16:
+             string_typ:=st_ansistring16;
+           sb_32:
+             string_typ:=st_ansistring32;
+           sb_64:
+             string_typ:=st_ansistring64;
+         end;
+         len:=ppufile.getlongint;
+         savesize:=POINTER_SIZE;
+      end;
+{$else}
+    constructor tstringdef.createansi(l:longint);
       begin
          inherited create;
          string_typ:=st_ansistring;
@@ -1312,8 +1355,8 @@ implementation
          savesize:=POINTER_SIZE;
       end;
 
-
     constructor tstringdef.loadansi(ppufile:tcompilerppufile);
+
       begin
          inherited ppuloaddef(ppufile);
          deftype:=stringdef;
@@ -1321,7 +1364,7 @@ implementation
          len:=ppufile.getlongint;
          savesize:=POINTER_SIZE;
       end;
-
+{$endif}
 
     constructor tstringdef.createwide(l : longint);
       begin
@@ -1354,10 +1397,17 @@ implementation
 
 
     function tstringdef.stringtypname:string;
+{$ifdef ansistring_bits}
+      const
+        typname:array[tstringtype] of string[9]=('',
+          'shortstr','longstr','ansistr16','ansistr32','ansistr64','widestr'
+        );
+{$else}
       const
         typname:array[tstringtype] of string[8]=('',
           'shortstr','longstr','ansistr','widestr'
         );
+{$endif}
       begin
         stringtypname:=typname[string_typ];
       end;
@@ -1384,7 +1434,13 @@ implementation
          case string_typ of
             st_shortstring : ppufile.writeentry(ibshortstringdef);
             st_longstring : ppufile.writeentry(iblongstringdef);
+         {$ifdef ansistring_bits}
+            st_ansistring16 : ppufile.writeentry(ibansistring16def);
+            st_ansistring32 : ppufile.writeentry(ibansistring32def);
+            st_ansistring64 : ppufile.writeentry(ibansistring64def);
+         {$else}
             st_ansistring : ppufile.writeentry(ibansistringdef);
+         {$endif}
             st_widestring : ppufile.writeentry(ibwidestringdef);
          end;
       end;
@@ -1423,7 +1479,11 @@ implementation
                             [tostr(len+5),longst,tostr(len),charst,tostr(len*8),bytest]);
               {$EndIf}
              end;
+         {$ifdef ansistring_bits}
+           st_ansistring16,st_ansistring32,st_ansistring64:
+         {$else}
            st_ansistring:
+         {$endif}
              begin
                { an ansi string looks like a pchar easy !! }
                charst:=tstoreddef(cchartype.def).numberstring;
@@ -1459,7 +1519,11 @@ implementation
                tstoreddef(u32inttype.def).concatstabto(asmlist);
              {$EndIf}
              end;
+         {$ifdef ansistring_bits}
+           st_ansistring16,st_ansistring32,st_ansistring64:
+         {$else}
            st_ansistring:
+         {$endif}
              tstoreddef(cchartype.def).concatstabto(asmlist);
            st_widestring:
              tstoreddef(cwidechartype.def).concatstabto(asmlist);
@@ -1471,14 +1535,24 @@ implementation
 
     function tstringdef.needs_inittable : boolean;
       begin
+      {$ifdef ansistring_bits}
+         needs_inittable:=string_typ in [st_ansistring16,st_ansistring32,st_ansistring64,st_widestring];
+      {$else}
          needs_inittable:=string_typ in [st_ansistring,st_widestring];
+      {$endif}
       end;
 
 
     function tstringdef.gettypename : string;
+{$ifdef ansistring_bits}
+      const
+         names : array[tstringtype] of string[20] = ('',
+           'shortstring','longstring','ansistring16','ansistring32','ansistring64','widestring');
+{$else}
       const
          names : array[tstringtype] of string[20] = ('',
            'ShortString','LongString','AnsiString','WideString');
+{$endif}
       begin
          gettypename:=names[string_typ];
       end;
@@ -1487,11 +1561,29 @@ implementation
     procedure tstringdef.write_rtti_data(rt:trttitype);
       begin
          case string_typ of
+          {$ifdef ansistring_bits}
+            st_ansistring16:
+              begin
+                 rttiList.concat(Tai_const.Create_8bit(tkA16String));
+                 write_rtti_name;
+              end;
+            st_ansistring32:
+              begin
+                 rttiList.concat(Tai_const.Create_8bit(tkA32String));
+                 write_rtti_name;
+              end;
+            st_ansistring64:
+              begin
+                 rttiList.concat(Tai_const.Create_8bit(tkA64String));
+                 write_rtti_name;
+              end;
+          {$else}
             st_ansistring:
               begin
                  rttiList.concat(Tai_const.Create_8bit(tkAString));
                  write_rtti_name;
               end;
+          {$endif}
             st_widestring:
               begin
                  rttiList.concat(Tai_const.Create_8bit(tkWString));
@@ -6073,7 +6165,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.234  2004-04-18 15:22:24  florian
+  Revision 1.235  2004-04-29 19:56:37  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  Revision 1.234  2004/04/18 15:22:24  florian
     + location support for arguments, currently PowerPC/MorphOS only
 
   Revision 1.233  2004/03/23 22:34:49  peter

compiler/symtable.pas

@@ -310,7 +310,13 @@ implementation
                  ibprocdef : hp:=tprocdef.ppuload(ppufile);
           ibshortstringdef : hp:=tstringdef.loadshort(ppufile);
            iblongstringdef : hp:=tstringdef.loadlong(ppufile);
+{$ifdef ansistring_bits}
+         ibansistring16def : hp:=tstringdef.loadansi(ppufile,sb_16);
+         ibansistring32def : hp:=tstringdef.loadansi(ppufile,sb_32);
+         ibansistring64def : hp:=tstringdef.loadansi(ppufile,sb_64);
+{$else}
            ibansistringdef : hp:=tstringdef.loadansi(ppufile);
+{$endif}
            ibwidestringdef : hp:=tstringdef.loadwide(ppufile);
                ibrecorddef : hp:=trecorddef.ppuload(ppufile);
                ibobjectdef : hp:=tobjectdef.ppuload(ppufile);
@@ -2302,7 +2308,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.144  2004-03-14 20:08:37  peter
+  Revision 1.145  2004-04-29 19:56:37  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  Revision 1.144  2004/03/14 20:08:37  peter
     * packrecords fixed for settings from $PACKRECORDS
     * default packrecords now uses value 0 and uses info from aligment
       structure only, initpackrecords removed