Browse Source

+ pchar -> string conversion

peter 27 years ago
parent
commit
bfc89b2587
3 changed files with 58 additions and 17 deletions
  1. 38 7
      compiler/cg386cnv.pas
  2. 15 8
      compiler/pass_1.pas
  3. 5 2
      compiler/tree.pas

+ 38 - 7
compiler/cg386cnv.pas

@@ -456,10 +456,10 @@ implementation
                       push_int(p^.resulttype^.size-1);
                       gettempofsizereference(p^.resulttype^.size,p^.location.reference);
                       emitpushreferenceaddr(exprasmlist,p^.location.reference);
-                      case p^.right^.location.loc of
+                      case p^.left^.location.loc of
                          LOC_REGISTER,LOC_CREGISTER:
                            begin
-                              exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.right^.location.register)));
+                              exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
                               ungetregister32(p^.left^.location.register);
                            end;
                          LOC_REFERENCE,LOC_MEM:
@@ -1078,11 +1078,39 @@ implementation
          emitl(A_LABEL,l2);
       end;
 
-    procedure second_pchar_to_ansistring(p,hp : ptree;convtyp : tconverttype);
 
+    procedure second_pchar_to_string(p,hp : ptree;convtyp : tconverttype);
+      var
+        pushed : tpushed;
       begin
-         p^.location.loc:=LOC_REGISTER;
-         internalerror(12121);
+         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;
+         else
+          begin
+            p^.location.loc:=LOC_REGISTER;
+            internalerror(12121);
+          end;
+         end;
       end;
 
     procedure second_nothing(p,hp : ptree;convtyp : tconverttype);
@@ -1123,7 +1151,7 @@ implementation
            second_nothing,
            second_load_smallset,
            second_ansistring_to_pchar,
-           second_pchar_to_ansistring);
+           second_pchar_to_string);
 
       begin
          { this isn't good coding, I think tc_bool_2_int, shouldn't be }
@@ -1253,7 +1281,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.21  1998-09-20 17:46:47  florian
+  Revision 1.22  1998-09-22 15:34:09  peter
+    + pchar -> string conversion
+
+  Revision 1.21  1998/09/20 17:46:47  florian
     * some things regarding ansistrings fixed
 
   Revision 1.20  1998/09/17 09:42:12  peter

+ 15 - 8
compiler/pass_1.pas

@@ -527,14 +527,18 @@ unit pass_1;
              end
          else
            }
-           { pchar can be assigned to ansistrings }
-           if ((def_from^.deftype=pointerdef) and
-             (ppointerdef(def_from)^.definition^.deftype=orddef) and
-             (porddef(ppointerdef(def_from)^.definition)^.typ=uchar)) and
-             is_ansistring(def_to) then
+
+           { pchar can be assigned to short/ansistrings }
+           if (def_to^.deftype=stringdef) and
+              ((def_from^.deftype=pointerdef) and
+              (ppointerdef(def_from)^.definition^.deftype=orddef) and
+              (porddef(ppointerdef(def_from)^.definition)^.typ=uchar)) then
              begin
-                doconv:=tc_pchar_2_ansistring;
-                b:=true;
+                if (pstringdef(def_to)^.string_typ in [st_shortstring,st_ansistring]) then
+                 begin
+                   doconv:=tc_pchar_2_string;
+                   b:=true;
+                 end;
              end
          else
 
@@ -5512,7 +5516,10 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.88  1998-09-21 08:45:14  pierre
+  Revision 1.89  1998-09-22 15:34:10  peter
+    + pchar -> string conversion
+
+  Revision 1.88  1998/09/21 08:45:14  pierre
     + added vmt_offset in tobjectdef.write for fututre use
       (first steps to have objects without vmt if no virtual !!)
     + added fpu_used field for tabstractprocdef  :

+ 5 - 2
compiler/tree.pas

@@ -147,7 +147,7 @@ unit tree;
                       tc_fix_2_real,tc_int_2_fix,tc_real_2_real,
                       tc_chararray_2_string,
                       tc_proc2procvar,tc_cchar_charpointer,tc_load_smallset,
-                      tc_ansistring_2_pchar,tc_pchar_2_ansistring);
+                      tc_ansistring_2_pchar,tc_pchar_2_string);
 
        { allows to determine which elementes are to be replaced }
        tdisposetyp = (dt_nothing,dt_leftright,dt_left,
@@ -1567,7 +1567,10 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.39  1998-09-21 08:45:27  pierre
+  Revision 1.40  1998-09-22 15:34:07  peter
+    + pchar -> string conversion
+
+  Revision 1.39  1998/09/21 08:45:27  pierre
     + added vmt_offset in tobjectdef.write for fututre use
       (first steps to have objects without vmt if no virtual !!)
     + added fpu_used field for tabstractprocdef  :