* type casts pchar<->ansistring fixed

  * ansistring[..] calls does now an unique call

compiler/cg386cnv.pas

@@ -637,7 +637,7 @@ implementation
       begin
          stringdispose(p^.location.reference.symbol);
          gettempofsizereference(256,p^.location.reference);
-      { call loadstring with correct left and right }
+         { call loadstring with correct left and right }
          p^.right:=p^.left;
          p^.left:=p;
          loadstring(p);
@@ -1084,27 +1084,51 @@ implementation
         pushed : tpushed;
       begin
          case pstringdef(p^.resulttype)^.string_typ of
-           st_shortstring : begin
-                              pushusedregisters(pushed,$ff);
-                              stringdispose(p^.location.reference.symbol);
-                              gettempofsizereference(p^.resulttype^.size,p^.location.reference);
-                              case p^.left^.location.loc of
-                                 LOC_REGISTER,LOC_CREGISTER:
-                                   begin
-                                      exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
-                                      ungetregister32(p^.left^.location.register);
-                                   end;
-                                 LOC_REFERENCE,LOC_MEM:
-                                   begin
-                                      emit_push_mem(p^.left^.location.reference);
-                                      del_reference(p^.left^.location.reference);
-                                   end;
-                              end;
-                              emitpushreferenceaddr(exprasmlist,p^.location.reference);
-                              emitcall('FPC_PCHAR_TO_STR',true);
-                              maybe_loadesi;
-                              popusedregisters(pushed);
-                            end;
+           st_shortstring:
+             begin
+                pushusedregisters(pushed,$ff);
+                stringdispose(p^.location.reference.symbol);
+                gettempofsizereference(p^.resulttype^.size,p^.location.reference);
+                case p^.left^.location.loc of
+                   LOC_REGISTER,LOC_CREGISTER:
+                     begin
+                        exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
+                        ungetregister32(p^.left^.location.register);
+                     end;
+                   LOC_REFERENCE,LOC_MEM:
+                     begin
+                        emit_push_mem(p^.left^.location.reference);
+                        del_reference(p^.left^.location.reference);
+                     end;
+                end;
+                emitpushreferenceaddr(exprasmlist,p^.location.reference);
+                emitcall('FPC_PCHAR_TO_STR',true);
+                maybe_loadesi;
+                popusedregisters(pushed);
+             end;
+           st_ansistring:
+             begin
+                stringdispose(p^.location.reference.symbol);
+                gettempofsizereference(p^.resulttype^.size,p^.location.reference);
+                case p^.left^.location.loc of
+                   LOC_REGISTER,LOC_CREGISTER:
+                     begin
+                        ungetregister32(p^.left^.location.register);
+                        pushusedregisters(pushed,$ff);
+                        exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
+                     end;
+                   LOC_REFERENCE,LOC_MEM:
+                     begin
+                        del_reference(p^.left^.location.reference);
+                        pushusedregisters(pushed,$ff);
+                        emit_push_mem(p^.left^.location.reference);
+                     end;
+                end;
+                emitpushreferenceaddr(exprasmlist,p^.location.reference);
+                emitcall('FPC_PCHAR_TO_ANSISTRING',true);
+                maybe_loadesi;
+                popusedregisters(pushed);
+             end;
          else
           begin
             p^.location.loc:=LOC_REGISTER;
@@ -1282,7 +1306,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.23  1998-09-23 12:03:51  peter
+  Revision 1.24  1998-09-27 10:16:22  florian
+    * type casts pchar<->ansistring fixed
+    * ansistring[..] calls does now an unique call
+
+  Revision 1.23  1998/09/23 12:03:51  peter
     * overloading fix for array of const
 
   Revision 1.22  1998/09/22 15:34:09  peter

compiler/cg386mem.pas

@@ -324,7 +324,7 @@ implementation
 
     procedure secondvecn(var p : ptree);
       var
-        pushed : boolean;
+        is_pushed : boolean;
         ind,hr : tregister;
         _p : ptree;
 
@@ -358,6 +358,7 @@ implementation
          t   : ptree;
          hp  : preference;
          tai : Pai386;
+         pushed : tpushed;
 
       begin
          secondpass(p^.left);
@@ -370,11 +371,34 @@ implementation
            begin
               reset_reference(p^.location.reference);
               p^.location.loc:=LOC_REFERENCE;
+              if is_ansistring(p^.left^.resulttype) then
+                begin
+                   if p^.callunique then
+                     begin
+                        pushusedregisters(pushed,$ff);
+                        emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                        emitcall('FPC_UNIQUE_ANSISTRING',true);
+                        maybe_loadesi;
+                        popusedregisters(pushed);
+                     end;
+                end
+              else
+                begin
+                   if p^.callunique then
+                     begin
+                        pushusedregisters(pushed,$ff);
+                        emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                        emitcall('FPC_UNIQUE_WIDESTRING',true);
+                        maybe_loadesi;
+                        popusedregisters(pushed);
+                     end;
+                end;
               del_reference(p^.left^.location.reference);
               p^.location.reference.base:=getregister32;
               exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
                 newreference(p^.left^.location.reference),
                 p^.location.reference.base)));
+
               if is_ansistring(p^.left^.resulttype) then
                 begin
                    { in ansistrings S[1] is pchar(S)[0] !! }
@@ -480,9 +504,9 @@ implementation
               if (p^.location.loc<>LOC_REFERENCE) and
                  (p^.location.loc<>LOC_MEM) then
                 CGMessage(cg_e_illegal_expression);
-              pushed:=maybe_push(p^.right^.registers32,p);
+              is_pushed:=maybe_push(p^.right^.registers32,p);
               secondpass(p^.right);
-              if pushed then restore(p);
+              if is_pushed then restore(p);
               case p^.right^.location.loc of
                  LOC_REGISTER:
                    begin
@@ -649,7 +673,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.12  1998-09-23 15:46:36  florian
+  Revision 1.13  1998-09-27 10:16:23  florian
+    * type casts pchar<->ansistring fixed
+    * ansistring[..] calls does now an unique call
+
+  Revision 1.12  1998/09/23 15:46:36  florian
     * problem with with and classes fixed
 
   Revision 1.11  1998/09/17 09:42:18  peter

compiler/tccal.pas

@@ -182,7 +182,10 @@ implementation
               { is this usefull here ? }
               { this was missing in formal parameter list   }
               if defcoll^.paratyp=vs_var then
-                make_not_regable(p^.left);
+                begin
+                   set_unique(p^.left);
+                   make_not_regable(p^.left);
+                end;
 
               p^.resulttype:=defcoll^.data;
            end;
@@ -907,7 +910,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.3  1998-09-24 14:27:40  peter
+  Revision 1.4  1998-09-27 10:16:24  florian
+    * type casts pchar<->ansistring fixed
+    * ansistring[..] calls does now an unique call
+
+  Revision 1.3  1998/09/24 14:27:40  peter
     * some better support for openarray
 
   Revision 1.2  1998/09/24 09:02:16  peter

compiler/tccnv.pas

@@ -279,6 +279,7 @@ implementation
          if p^.left^.treetype=ordconstn then
            begin
               hp:=genstringconstnode(chr(p^.left^.value));
+              hp^.stringtype:=pstringdef(p^.resulttype)^.string_typ;
               firstpass(hp);
               disposetree(p);
               p:=hp;
@@ -488,14 +489,11 @@ implementation
       end;
 
 
-    procedure first_pchar_to_ansistring(var p : ptree);
+    procedure first_pchar_to_string(var p : ptree);
       begin
-         p^.location.loc:=LOC_REGISTER;
-         if p^.registers32<1 then
-           p^.registers32:=1;
+         p^.location.loc:=LOC_MEM;
       end;
 
-
     procedure first_ansistring_to_pchar(var p : ptree);
       begin
          p^.location.loc:=LOC_REGISTER;
@@ -550,12 +548,12 @@ implementation
                            first_cchar_charpointer,
                            first_load_smallset,
                            first_ansistring_to_pchar,
-                           first_pchar_to_ansistring,
+                           first_pchar_to_string,
                            first_arrayconstructor_to_set);
 
      begin
        aprocdef:=nil;
-       { if explicite type conversation, then run firstpass }
+       { if explicite type cast, then run firstpass }
        if p^.explizit then
          firstpass(p^.left);
 
@@ -720,6 +718,13 @@ implementation
                           firstconvert[p^.convtyp](p);
                           exit;
                        end;
+                     if is_pchar(p^.resulttype) and
+                       is_ansistring(p^.left^.resulttype) then
+                       begin
+                          p^.convtyp:=tc_ansistring_2_pchar;
+                          firstconvert[p^.convtyp](p);
+                          exit;
+                       end;
                      { normal tc_equal-Konvertierung durchf�hren }
                      p^.convtyp:=tc_equal;
                      { wenn Aufz„hltyp nach Ordinal konvertiert werden soll }
@@ -738,7 +743,7 @@ implementation
                           else
                             begin
                                if not isconvertable(s32bitdef,p^.resulttype,p^.convtyp,
-                               ordconstn { nur Dummy},false ) then
+                               ordconstn { only Dummy},false ) then
                                  CGMessage(cg_e_illegal_type_conversion);
                             end;
 
@@ -898,7 +903,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  1998-09-24 23:49:22  peter
+  Revision 1.3  1998-09-27 10:16:26  florian
+    * type casts pchar<->ansistring fixed
+    * ansistring[..] calls does now an unique call
+
+  Revision 1.2  1998/09/24 23:49:22  peter
     + aktmodeswitches
 
   Revision 1.1  1998/09/23 20:42:24  peter

compiler/tcld.pas

@@ -174,6 +174,9 @@ implementation
          store_valid:=must_be_valid;
          must_be_valid:=false;
 
+         { must be made unique }
+         set_unique(p^.left);
+
          firstpass(p^.left);
          if codegenerror then
            exit;
@@ -396,7 +399,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  1998-09-24 15:13:48  peter
+  Revision 1.3  1998-09-27 10:16:27  florian
+    * type casts pchar<->ansistring fixed
+    * ansistring[..] calls does now an unique call
+
+  Revision 1.2  1998/09/24 15:13:48  peter
     * fixed type node which was always set to void :(
 
   Revision 1.1  1998/09/23 20:42:24  peter

compiler/tree.pas

@@ -214,7 +214,7 @@ unit tree;
              fixconstn : (value_fix: longint);
              funcretn : (funcretprocinfo : pointer;retdef : pdef);
              subscriptn : (vs : pvarsym);
-             vecn : (memindex,memseg:boolean);
+             vecn : (memindex,memseg:boolean;callunique : boolean);
 {$ifdef UseAnsiString}
              stringconstn : (value_str : pchar;length : longint; lab_str : plabel;stringtype : tstringtype);
 {$else UseAnsiString}
@@ -286,6 +286,10 @@ unit tree;
        maxfirstpasscount : longint = 0;
 {$endif extdebug}
 
+    { sets the callunique flag, if the node is a vecn, }
+    { takes care of type casts etc.                    }
+    procedure set_unique(p : ptree);
+
     { gibt den ordinalen Werten der Node zurueck oder falls sie }
     { keinen ordinalen Wert hat, wird ein Fehler erzeugt        }
     function get_ordinal_value(p : ptree) : longint;
@@ -1493,6 +1497,20 @@ unit tree;
           equal_trees:=false;
      end;
 
+    procedure set_unique(p : ptree);
+
+      begin
+         if assigned(p) then
+           begin
+              case p^.treetype of
+                 vecn:
+                    p^.callunique:=true;
+                 typeconvn:
+                    set_unique(p^.left);
+              end;
+           end;
+      end;
+
     {This is needed if you want to be able to delete the string with the nodes !!}
     procedure set_location(var destloc,sourceloc : tlocation);
 
@@ -1570,7 +1588,11 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.42  1998-09-23 12:03:59  peter
+  Revision 1.43  1998-09-27 10:16:28  florian
+    * type casts pchar<->ansistring fixed
+    * ansistring[..] calls does now an unique call
+
+  Revision 1.42  1998/09/23 12:03:59  peter
     * overloading fix for array of const
 
   Revision 1.41  1998/09/23 09:58:55  peter