Browse Source

* released useansistring
* removed -Sv, its now available in fpc modes

peter 27 years ago
parent
commit
3037445491

+ 36 - 76
compiler/cg386cnv.pas

@@ -391,14 +391,9 @@ implementation
        end;
        end;
 
 
     procedure second_string_string(p,hp : ptree;convtyp : tconverttype);
     procedure second_string_string(p,hp : ptree;convtyp : tconverttype);
-
-{$ifdef UseAnsiString}
       var
       var
          pushed : tpushed;
          pushed : tpushed;
-{$endif UseAnsiString}
-
       begin
       begin
-{$ifdef UseAnsiString}
          { does anybody know a better solution than this big case statement ? }
          { does anybody know a better solution than this big case statement ? }
          { ok, a proc table would do the job                                  }
          { ok, a proc table would do the job                                  }
          case pstringdef(p^.resulttype)^.string_typ of
          case pstringdef(p^.resulttype)^.string_typ of
@@ -508,43 +503,10 @@ implementation
                    end;
                    end;
               end;
               end;
          end;
          end;
-{$ifdef dummy}
-         if is_ansistring(p^.resulttype) and not is_ansistring(p^.left^.resulttype) then
-           begin
-              { call shortstring to ansistring conversion }
-              { result is in register }
-              del_reference(p^.left^.location.reference);
-              {!!!!
-              copyshortstringtoansistring(p^.location,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
-              }
-              ungetiftemp(p^.left^.location.reference);
-           end
-         else if not is_ansistring(p^.resulttype) and is_ansistring(p^.left^.resulttype) then
-           begin
-              { call ansistring to shortstring conversion }
-              { result is in mem }
-              stringdispose(p^.location.reference.symbol);
-              gettempofsizereference(p^.resulttype^.size,p^.location.reference);
-              if p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE] then
-                del_reference(p^.left^.location.reference);
-              copyansistringtoshortstring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
-              ungetiftemp(p^.left^.location.reference);
-           end
-         else
-{$endif dummy}
-{$else UseAnsiString}
-           begin
-              stringdispose(p^.location.reference.symbol);
-              gettempofsizereference(p^.resulttype^.size,p^.location.reference);
-              del_reference(p^.left^.location.reference);
-              copystring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
-              ungetiftemp(p^.left^.location.reference);
-           end;
-{$endif UseAnsiString}
       end;
       end;
 
 
-    procedure second_cstring_charpointer(p,hp : ptree;convtyp : tconverttype);
 
 
+    procedure second_cstring_charpointer(p,hp : ptree;convtyp : tconverttype);
       begin
       begin
          clear_location(p^.location);
          clear_location(p^.location);
          p^.location.loc:=LOC_REGISTER;
          p^.location.loc:=LOC_REGISTER;
@@ -554,14 +516,14 @@ implementation
              p^.location.register)));
              p^.location.register)));
       end;
       end;
 
 
-    procedure second_string_chararray(p,hp : ptree;convtyp : tconverttype);
 
 
+    procedure second_string_chararray(p,hp : ptree;convtyp : tconverttype);
       begin
       begin
          inc(p^.location.reference.offset);
          inc(p^.location.reference.offset);
       end;
       end;
 
 
-    procedure second_array_to_pointer(p,hp : ptree;convtyp : tconverttype);
 
 
+    procedure second_array_to_pointer(p,hp : ptree;convtyp : tconverttype);
       begin
       begin
          del_reference(p^.left^.location.reference);
          del_reference(p^.left^.location.reference);
          clear_location(p^.location);
          clear_location(p^.location);
@@ -571,8 +533,8 @@ implementation
            p^.location.register)));
            p^.location.register)));
       end;
       end;
 
 
-    procedure second_pointer_to_array(p,hp : ptree;convtyp : tconverttype);
 
 
+    procedure second_pointer_to_array(p,hp : ptree;convtyp : tconverttype);
       begin
       begin
          clear_location(p^.location);
          clear_location(p^.location);
          p^.location.loc:=LOC_REFERENCE;
          p^.location.loc:=LOC_REFERENCE;
@@ -597,13 +559,12 @@ implementation
            end;
            end;
       end;
       end;
 
 
+
     { generates the code for the type conversion from an array of char }
     { generates the code for the type conversion from an array of char }
     { to a string                                                        }
     { to a string                                                        }
     procedure second_chararray_to_string(p,hp : ptree;convtyp : tconverttype);
     procedure second_chararray_to_string(p,hp : ptree;convtyp : tconverttype);
-
       var
       var
          l : longint;
          l : longint;
-
       begin
       begin
          { this is a type conversion which copies the data, so we can't }
          { this is a type conversion which copies the data, so we can't }
          { return a reference                                             }
          { return a reference                                             }
@@ -634,8 +595,8 @@ implementation
          dec(p^.location.reference.offset);
          dec(p^.location.reference.offset);
       end;
       end;
 
 
-    procedure second_char_to_string(p,hp : ptree;convtyp : tconverttype);
 
 
+    procedure second_char_to_string(p,hp : ptree;convtyp : tconverttype);
       begin
       begin
          clear_location(p^.location);
          clear_location(p^.location);
          p^.location.loc:=LOC_MEM;
          p^.location.loc:=LOC_MEM;
@@ -650,12 +611,11 @@ implementation
          p^.right:=nil;
          p^.right:=nil;
       end;
       end;
 
 
-    procedure second_int_real(p,hp : ptree;convtyp : tconverttype);
 
 
+    procedure second_int_real(p,hp : ptree;convtyp : tconverttype);
       var
       var
          r : preference;
          r : preference;
          hregister : tregister;
          hregister : tregister;
-
       begin
       begin
          { for u32bit a solution is to push $0 and to load a comp }
          { for u32bit a solution is to push $0 and to load a comp }
          { does this first, it destroys maybe EDI }
          { does this first, it destroys maybe EDI }
@@ -705,13 +665,11 @@ implementation
          p^.location.loc:=LOC_FPU;
          p^.location.loc:=LOC_FPU;
       end;
       end;
 
 
-    procedure second_real_fix(p,hp : ptree;convtyp : tconverttype);
 
 
+    procedure second_real_fix(p,hp : ptree;convtyp : tconverttype);
       var
       var
-         {hs : string;}
          rreg : tregister;
          rreg : tregister;
          ref : treference;
          ref : treference;
-
       begin
       begin
          { real must be on fpu stack }
          { real must be on fpu stack }
          if (p^.left^.location.loc<>LOC_FPU) then
          if (p^.left^.location.loc<>LOC_FPU) then
@@ -745,8 +703,8 @@ implementation
          p^.location.register:=rreg;
          p^.location.register:=rreg;
       end;
       end;
 
 
-    procedure second_float_float(p,hp : ptree;convtyp : tconverttype);
 
 
+    procedure second_float_float(p,hp : ptree;convtyp : tconverttype);
       begin
       begin
          case p^.left^.location.loc of
          case p^.left^.location.loc of
             LOC_FPU : ;
             LOC_FPU : ;
@@ -763,13 +721,13 @@ implementation
          p^.location.loc:=LOC_FPU;
          p^.location.loc:=LOC_FPU;
       end;
       end;
 
 
-    procedure second_fix_real(p,hp : ptree;convtyp : tconverttype);
 
 
-    var popeax,popebx,popecx,popedx : boolean;
+    procedure second_fix_real(p,hp : ptree;convtyp : tconverttype);
+      var
+        popeax,popebx,popecx,popedx : boolean;
         startreg : tregister;
         startreg : tregister;
         hl : plabel;
         hl : plabel;
         r : treference;
         r : treference;
-
       begin
       begin
          if (p^.left^.location.loc=LOC_REGISTER) or
          if (p^.left^.location.loc=LOC_REGISTER) or
             (p^.left^.location.loc=LOC_CREGISTER) then
             (p^.left^.location.loc=LOC_CREGISTER) then
@@ -841,12 +799,10 @@ implementation
          p^.location.loc:=LOC_FPU;
          p^.location.loc:=LOC_FPU;
       end;
       end;
 
 
-    procedure second_int_fix(p,hp : ptree;convtyp : tconverttype);
 
 
+    procedure second_int_fix(p,hp : ptree;convtyp : tconverttype);
       var
       var
-         {hs : string;}
          hregister : tregister;
          hregister : tregister;
-
       begin
       begin
          if (p^.left^.location.loc=LOC_REGISTER) then
          if (p^.left^.location.loc=LOC_REGISTER) then
            hregister:=p^.left^.location.register
            hregister:=p^.left^.location.register
@@ -878,26 +834,25 @@ implementation
       end;
       end;
 
 
 
 
-     procedure second_proc_to_procvar(p,hp : ptree;convtyp : tconverttype);
-
-       begin
-          clear_location(p^.location);
-          p^.location.loc:=LOC_REGISTER;
-          del_reference(hp^.location.reference);
-          p^.location.register:=getregister32;
-          exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
+    procedure second_proc_to_procvar(p,hp : ptree;convtyp : tconverttype);
+      begin
+        clear_location(p^.location);
+        p^.location.loc:=LOC_REGISTER;
+        del_reference(hp^.location.reference);
+        p^.location.register:=getregister32;
+        exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
            newreference(hp^.location.reference),p^.location.register)));
            newreference(hp^.location.reference),p^.location.register)));
-     end;
+      end;
 
 
-     procedure second_bool_to_int(p,hp : ptree;convtyp : tconverttype);
 
 
+    procedure second_bool_to_int(p,hp : ptree;convtyp : tconverttype);
       var
       var
          oldtruelabel,oldfalselabel,hlabel : plabel;
          oldtruelabel,oldfalselabel,hlabel : plabel;
          hregister : tregister;
          hregister : tregister;
          newsize,
          newsize,
          opsize : topsize;
          opsize : topsize;
          op     : tasmop;
          op     : tasmop;
-     begin
+      begin
          oldtruelabel:=truelabel;
          oldtruelabel:=truelabel;
          oldfalselabel:=falselabel;
          oldfalselabel:=falselabel;
          getlabel(truelabel);
          getlabel(truelabel);
@@ -1001,13 +956,13 @@ implementation
          freelabel(falselabel);
          freelabel(falselabel);
          truelabel:=oldtruelabel;
          truelabel:=oldtruelabel;
          falselabel:=oldfalselabel;
          falselabel:=oldfalselabel;
-     end;
+      end;
 
 
 
 
-     procedure second_int_to_bool(p,hp : ptree;convtyp : tconverttype);
-     var
+    procedure second_int_to_bool(p,hp : ptree;convtyp : tconverttype);
+      var
         hregister : tregister;
         hregister : tregister;
-     begin
+      begin
          clear_location(p^.location);
          clear_location(p^.location);
          p^.location.loc:=LOC_REGISTER;
          p^.location.loc:=LOC_REGISTER;
          del_reference(hp^.location.reference);
          del_reference(hp^.location.reference);
@@ -1041,7 +996,7 @@ implementation
          else
          else
           internalerror(10064);
           internalerror(10064);
          end;
          end;
-     end;
+      end;
 
 
 
 
     procedure second_load_smallset(p,hp : ptree;convtyp : tconverttype);
     procedure second_load_smallset(p,hp : ptree;convtyp : tconverttype);
@@ -1062,12 +1017,11 @@ implementation
         p^.location.reference:=href;
         p^.location.reference:=href;
       end;
       end;
 
 
-    procedure second_ansistring_to_pchar(p,hp : ptree;convtyp : tconverttype);
 
 
+    procedure second_ansistring_to_pchar(p,hp : ptree;convtyp : tconverttype);
       var
       var
          l1,l2 : plabel;
          l1,l2 : plabel;
          hr : preference;
          hr : preference;
-
       begin
       begin
          clear_location(p^.location);
          clear_location(p^.location);
          p^.location.loc:=LOC_REGISTER;
          p^.location.loc:=LOC_REGISTER;
@@ -1160,10 +1114,12 @@ implementation
          end;
          end;
       end;
       end;
 
 
+
     procedure second_nothing(p,hp : ptree;convtyp : tconverttype);
     procedure second_nothing(p,hp : ptree;convtyp : tconverttype);
       begin
       begin
       end;
       end;
 
 
+
 {****************************************************************************
 {****************************************************************************
                              SecondTypeConv
                              SecondTypeConv
 ****************************************************************************}
 ****************************************************************************}
@@ -1330,7 +1286,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.30  1998-10-27 11:12:45  peter
+  Revision 1.31  1998-11-05 12:02:30  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.30  1998/10/27 11:12:45  peter
     * fixed char_to_string which did not set the .loc
     * fixed char_to_string which did not set the .loc
 
 
   Revision 1.29  1998/10/26 15:18:41  peter
   Revision 1.29  1998/10/26 15:18:41  peter

+ 5 - 21
compiler/cg386con.pas

@@ -137,9 +137,7 @@ implementation
     procedure secondstringconst(var p : ptree);
     procedure secondstringconst(var p : ptree);
       var
       var
          hp1 : pai;
          hp1 : pai;
-{$ifdef UseAnsiString}
          l1,
          l1,
-{$endif}
          lastlabel   : plabel;
          lastlabel   : plabel;
          pc          : pchar;
          pc          : pchar;
          same_string : boolean;
          same_string : boolean;
@@ -163,22 +161,12 @@ implementation
                         { currently, this is no problem, because   }
                         { currently, this is no problem, because   }
                         { typed consts have no leading length or   }
                         { typed consts have no leading length or   }
                         { they have no trailing zero               }
                         { they have no trailing zero               }
-{$ifdef UseAnsiString}
                         if (hp1^.typ=ait_string) and (lastlabel<>nil) and
                         if (hp1^.typ=ait_string) and (lastlabel<>nil) and
                           (pai_string(hp1)^.len=p^.length+2) then
                           (pai_string(hp1)^.len=p^.length+2) then
-{$else UseAnsiString}
-                        if (hp1^.typ=ait_string) and (lastlabel<>nil) and
-                          (pai_string(hp1)^.len=length(p^.value_str^)+2) then
-{$endif UseAnsiString}
                           begin
                           begin
                              same_string:=true;
                              same_string:=true;
-{$ifndef UseAnsiString}
-                             for i:=0 to length(p^.value_str^) do
-                               if pai_string(hp1)^.str[i]<>p^.value_str^[i] then
-{$else}
                              for i:=0 to p^.length do
                              for i:=0 to p^.length do
                                if pai_string(hp1)^.str[i]<>p^.value_str[i] then
                                if pai_string(hp1)^.str[i]<>p^.value_str[i] then
-{$endif}
                                  begin
                                  begin
                                     same_string:=false;
                                     same_string:=false;
                                     break;
                                     break;
@@ -202,13 +190,6 @@ implementation
                    if (cs_smartlink in aktmoduleswitches) then
                    if (cs_smartlink in aktmoduleswitches) then
                     consts^.concat(new(pai_cut,init));
                     consts^.concat(new(pai_cut,init));
                    consts^.concat(new(pai_label,init(lastlabel)));
                    consts^.concat(new(pai_label,init(lastlabel)));
-{$ifndef UseAnsiString}
-                   getmem(pc,length(p^.value_str^)+3);
-                   move(p^.value_str^,pc^,length(p^.value_str^)+1);
-                   pc[length(p^.value_str^)+1]:=#0;
-                   { we still will have a problem if there is a #0 inside the pchar }
-                   consts^.concat(new(pai_string,init_length_pchar(pc,length(p^.value_str^)+2)));
-{$else UseAnsiString}
                    { generate an ansi string ? }
                    { generate an ansi string ? }
                    case p^.stringtype of
                    case p^.stringtype of
                       st_ansistring:
                       st_ansistring:
@@ -249,7 +230,6 @@ implementation
                             end;
                             end;
                         end;
                         end;
                    end;
                    end;
-{$endif UseAnsiString}
                 end;
                 end;
            end;
            end;
          clear_reference(p^.location.reference);
          clear_reference(p^.location.reference);
@@ -325,7 +305,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.16  1998-11-04 21:07:43  michael
+  Revision 1.17  1998-11-05 12:02:32  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.16  1998/11/04 21:07:43  michael
   * undid peters change. Constant ansistrings should end on null too cd ..
   * undid peters change. Constant ansistrings should end on null too cd ..
 
 
   Revision 1.15  1998/11/04 10:11:36  peter
   Revision 1.15  1998/11/04 10:11:36  peter

+ 6 - 4
compiler/cg386inl.pas

@@ -498,7 +498,7 @@ implementation
              ,false,0
              ,false,0
              );
              );
            disposetree(hp);
            disposetree(hp);
-             
+
            if codegenerror then
            if codegenerror then
              exit;
              exit;
 
 
@@ -687,10 +687,8 @@ implementation
                  secondpass(p^.left);
                  secondpass(p^.left);
                  set_location(p^.location,p^.left^.location);
                  set_location(p^.location,p^.left^.location);
                  { length in ansi strings is at offset -8 }
                  { length in ansi strings is at offset -8 }
-{$ifdef UseAnsiString}
                  if is_ansistring(p^.left^.resulttype) then
                  if is_ansistring(p^.left^.resulttype) then
                    dec(p^.location.reference.offset,8);
                    dec(p^.location.reference.offset,8);
-{$endif UseAnsiString}
               end;
               end;
             in_pred_x,
             in_pred_x,
             in_succ_x:
             in_succ_x:
@@ -964,7 +962,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.16  1998-10-22 17:11:13  pierre
+  Revision 1.17  1998-11-05 12:02:33  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.16  1998/10/22 17:11:13  pierre
     + terminated the include exclude implementation for i386
     + terminated the include exclude implementation for i386
     * enums inside records fixed
     * enums inside records fixed
 
 

+ 5 - 6
compiler/cg386ld.pas

@@ -339,7 +339,6 @@ implementation
 {$endif test_dest_loc}
 {$endif test_dest_loc}
          if p^.left^.resulttype^.deftype=stringdef then
          if p^.left^.resulttype^.deftype=stringdef then
            begin
            begin
-{$ifdef UseAnsiString}
               if is_ansistring(p^.left^.resulttype) then
               if is_ansistring(p^.left^.resulttype) then
                 begin
                 begin
                   { the source and destinations are released
                   { the source and destinations are released
@@ -349,16 +348,12 @@ implementation
                   loadansistring(p);
                   loadansistring(p);
                 end
                 end
               else
               else
-{$endif UseAnsiString}
               if is_shortstring(p^.left^.resulttype) and
               if is_shortstring(p^.left^.resulttype) and
                 not (p^.concat_string) then
                 not (p^.concat_string) then
                 begin
                 begin
-{$ifdef UseAnsiString}
                   if is_ansistring(p^.right^.resulttype) then
                   if is_ansistring(p^.right^.resulttype) then
                     loadansi2short(p^.right,p^.left)
                     loadansi2short(p^.right,p^.left)
                   else
                   else
-{$endif UseAnsiString}
-
                     begin
                     begin
                        { we do not need destination anymore }
                        { we do not need destination anymore }
                        del_reference(p^.left^.location.reference);
                        del_reference(p^.left^.location.reference);
@@ -733,7 +728,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.24  1998-10-14 08:47:14  pierre
+  Revision 1.25  1998-11-05 12:02:35  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.24  1998/10/14 08:47:14  pierre
     * bugs in secondfuncret for result in subprocedures removed
     * bugs in secondfuncret for result in subprocedures removed
 
 
   Revision 1.23  1998/10/06 17:16:44  pierre
   Revision 1.23  1998/10/06 17:16:44  pierre

+ 5 - 37
compiler/cg68kcnv.pas

@@ -446,13 +446,10 @@ implementation
 
 
     procedure second_string_string(p,hp : ptree;convtyp : tconverttype);
     procedure second_string_string(p,hp : ptree;convtyp : tconverttype);
 
 
-{$ifdef UseAnsiString}
       var
       var
          pushed : tpushed;
          pushed : tpushed;
-{$endif UseAnsiString}
 
 
       begin
       begin
-{$ifdef UseAnsiString}
          { does anybody know a better solution than this big case statement ? }
          { does anybody know a better solution than this big case statement ? }
          { ok, a proc table would do the job                                  }
          { ok, a proc table would do the job                                  }
          case pstringdef(p)^.string_typ of
          case pstringdef(p)^.string_typ of
@@ -563,39 +560,6 @@ implementation
                    end;
                    end;
               end;
               end;
          end;
          end;
-{$ifdef dummy}
-         if is_ansistring(p^.resulttype) and not is_ansistring(p^.left^.resulttype) then
-           begin
-              { call shortstring to ansistring conversion }
-              { result is in register }
-              del_reference(p^.left^.location.reference);
-              {!!!!
-              copyshortstringtoansistring(p^.location,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
-              }
-              ungetiftemp(p^.left^.location.reference);
-           end
-         else if not is_ansistring(p^.resulttype) and is_ansistring(p^.left^.resulttype) then
-           begin
-              { call ansistring to shortstring conversion }
-              { result is in mem }
-              stringdispose(p^.location.reference.symbol);
-              gettempofsizereference(p^.resulttype^.size,p^.location.reference);
-              if p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE] then
-                del_reference(p^.left^.location.reference);
-              copyansistringtoshortstring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
-              ungetiftemp(p^.left^.location.reference);
-           end
-         else
-{$endif dummy}
-{$else UseAnsiString}
-           begin
-              stringdispose(p^.location.reference.symbol);
-              gettempofsizereference(p^.resulttype^.size,p^.location.reference);
-              del_reference(p^.left^.location.reference);
-              copystring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
-              ungetiftemp(p^.left^.location.reference);
-           end;
-{$endif UseAnsiString}
       end;
       end;
 
 
     procedure second_cstring_charpointer(p,hp : ptree;convtyp : tconverttype);
     procedure second_cstring_charpointer(p,hp : ptree;convtyp : tconverttype);
@@ -1398,7 +1362,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.10  1998-10-15 12:41:17  pierre
+  Revision 1.11  1998-11-05 12:02:36  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.10  1998/10/15 12:41:17  pierre
     * last memory leaks found when compiler
     * last memory leaks found when compiler
       a native atari compiler fixed
       a native atari compiler fixed
 
 

+ 19 - 27
compiler/cg68kcon.pas

@@ -137,9 +137,7 @@ implementation
     procedure secondstringconst(var p : ptree);
     procedure secondstringconst(var p : ptree);
       var
       var
          hp1 : pai;
          hp1 : pai;
-{$ifdef UseAnsiString}
          l1,
          l1,
-{$endif}
          lastlabel   : plabel;
          lastlabel   : plabel;
          pc          : pchar;
          pc          : pchar;
          same_string : boolean;
          same_string : boolean;
@@ -163,22 +161,12 @@ implementation
                         { currently, this is no problem, because   }
                         { currently, this is no problem, because   }
                         { typed consts have no leading length or   }
                         { typed consts have no leading length or   }
                         { they have no trailing zero               }
                         { they have no trailing zero               }
-{$ifdef UseAnsiString}
                         if (hp1^.typ=ait_string) and (lastlabel<>nil) and
                         if (hp1^.typ=ait_string) and (lastlabel<>nil) and
                           (pai_string(hp1)^.len=p^.length+2) then
                           (pai_string(hp1)^.len=p^.length+2) then
-{$else UseAnsiString}
-                        if (hp1^.typ=ait_string) and (lastlabel<>nil) and
-                          (pai_string(hp1)^.len=length(p^.value_str^)+2) then
-{$endif UseAnsiString}
                           begin
                           begin
                              same_string:=true;
                              same_string:=true;
-{$ifndef UseAnsiString}
-                             for i:=0 to length(p^.value_str^) do
-                               if pai_string(hp1)^.str[i]<>p^.value_str^[i] then
-{$else}
                              for i:=0 to p^.length do
                              for i:=0 to p^.length do
                                if pai_string(hp1)^.str[i]<>p^.value_str[i] then
                                if pai_string(hp1)^.str[i]<>p^.value_str[i] then
-{$endif}
                                  begin
                                  begin
                                     same_string:=false;
                                     same_string:=false;
                                     break;
                                     break;
@@ -202,13 +190,6 @@ implementation
                    if (cs_smartlink in aktmoduleswitches) then
                    if (cs_smartlink in aktmoduleswitches) then
                     consts^.concat(new(pai_cut,init));
                     consts^.concat(new(pai_cut,init));
                    consts^.concat(new(pai_label,init(lastlabel)));
                    consts^.concat(new(pai_label,init(lastlabel)));
-{$ifndef UseAnsiString}
-                   getmem(pc,length(p^.value_str^)+3);
-                   move(p^.value_str^,pc^,length(p^.value_str^)+1);
-                   pc[length(p^.value_str^)+1]:=#0;
-                   { we still will have a problem if there is a #0 inside the pchar }
-                   consts^.concat(new(pai_string,init_length_pchar(pc,length(p^.value_str^)+2)));
-{$else UseAnsiString}
                    { generate an ansi string ? }
                    { generate an ansi string ? }
                    case p^.stringtype of
                    case p^.stringtype of
                       st_ansistring:
                       st_ansistring:
@@ -226,6 +207,7 @@ implementation
                                 consts^.concat(new(pai_label,init(l1)));
                                 consts^.concat(new(pai_label,init(l1)));
                                 getmem(pc,p^.length+1);
                                 getmem(pc,p^.length+1);
                                 move(p^.value_str^,pc^,p^.length+1);
                                 move(p^.value_str^,pc^,p^.length+1);
+                                pc[p^.length]:=#0;
                                 { to overcome this problem we set the length explicitly }
                                 { to overcome this problem we set the length explicitly }
                                 { with the ending null char }
                                 { with the ending null char }
                                 consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+1)));
                                 consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+1)));
@@ -233,15 +215,21 @@ implementation
                         end;
                         end;
                       st_shortstring:
                       st_shortstring:
                         begin
                         begin
-                           getmem(pc,p^.length+3);
-                           move(p^.value_str^,pc[1],p^.length+1);
-                           pc[0]:=chr(p^.length);
-                           { to overcome this problem we set the length explicitly }
-                           { with the ending null char }
-                           consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+2)));
+                           { empty strings }
+                           if p^.length=0 then
+                            consts^.concat(new(pai_const,init_16bit(0)))
+                           else
+                            begin
+                              { also length and terminating zero }
+                              getmem(pc,p^.length+2);
+                              move(p^.value_str^,pc[1],p^.length+1);
+                              pc[0]:=chr(p^.length);
+                              { to overcome this problem we set the length explicitly }
+                              { with the ending null char }
+                              consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+1)));
+                            end;
                         end;
                         end;
                    end;
                    end;
-{$endif UseAnsiString}
                 end;
                 end;
            end;
            end;
          clear_reference(p^.location.reference);
          clear_reference(p^.location.reference);
@@ -317,7 +305,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.2  1998-09-07 18:45:56  peter
+  Revision 1.3  1998-11-05 12:02:37  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.2  1998/09/07 18:45:56  peter
     * update smartlinking, uses getdatalabel
     * update smartlinking, uses getdatalabel
     * renamed ptree.value vars to value_str,value_real,value_set
     * renamed ptree.value vars to value_str,value_real,value_set
 
 

+ 6 - 4
compiler/cg68kinl.pas

@@ -449,7 +449,7 @@ implementation
            dummycoll.paratyp:=vs_const;
            dummycoll.paratyp:=vs_const;
            disposetree(hp);
            disposetree(hp);
            p^.left:=nil;
            p^.left:=nil;
-           
+
            { second arg }
            { second arg }
            hp:=node;
            hp:=node;
            node:=node^.right;
            node:=node^.right;
@@ -660,10 +660,8 @@ implementation
                  secondpass(p^.left);
                  secondpass(p^.left);
                  set_location(p^.location,p^.left^.location);
                  set_location(p^.location,p^.left^.location);
                  { length in ansi strings is at offset -8 }
                  { length in ansi strings is at offset -8 }
-{$ifdef UseAnsiString}
                  if is_ansistring(p^.left^.resulttype) then
                  if is_ansistring(p^.left^.resulttype) then
                    dec(p^.location.reference.offset,8);
                    dec(p^.location.reference.offset,8);
-{$endif UseAnsiString}
               end;
               end;
             in_pred_x,
             in_pred_x,
             in_succ_x:
             in_succ_x:
@@ -900,7 +898,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.13  1998-10-22 17:11:14  pierre
+  Revision 1.14  1998-11-05 12:02:38  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.13  1998/10/22 17:11:14  pierre
     + terminated the include exclude implementation for i386
     + terminated the include exclude implementation for i386
     * enums inside records fixed
     * enums inside records fixed
 
 

+ 1 - 1
compiler/msgidx.inc

@@ -475,6 +475,7 @@ type tmsgconst=(
   option_too_less_endif,
   option_too_less_endif,
   option_no_debug_support,
   option_no_debug_support,
   option_no_debug_support_recompile_fpc,
   option_no_debug_support_recompile_fpc,
+  option_obsolete_switch,
   option_logo_start,
   option_logo_start,
   option_logo_end,
   option_logo_end,
   option_info_start,
   option_info_start,
@@ -544,7 +545,6 @@ type tmsgconst=(
   ol053,
   ol053,
   ol054,
   ol054,
   ol055,
   ol055,
-  ol056,
   ol057,
   ol057,
   ol058,
   ol058,
   ol059,
   ol059,

+ 36 - 35
compiler/msgtxt.inc

@@ -490,123 +490,124 @@ const msgtxt : array[0..00094,1..240] of char=(
   'F_open conditional at the end of the file'#000+
   'F_open conditional at the end of the file'#000+
   'W_Debug information generation is not supported by this executable'#000+
   'W_Debug information generation is not supported by this executable'#000+
   'H_Try recompiling with -dGDB'#000+
   'H_Try recompiling with -dGDB'#000+
-  'Free Pascal Compiler version $','FPCVER [$FPCDATE] for $FPCTARGET'#000+
+  'W_You are using the obsolete s','witch $1'#000+
+  'Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#000+
   'Copyright (c) 1993-98 by Florian Klaempfl'#000+
   'Copyright (c) 1993-98 by Florian Klaempfl'#000+
   'Free Pascal Compiler version $FPCVER'#000+
   'Free Pascal Compiler version $FPCVER'#000+
   #000+
   #000+
   'Compiler Date  : $FPCDATE'#000+
   'Compiler Date  : $FPCDATE'#000+
   'Compiler Target: $FPCTARGET'#000+
   'Compiler Target: $FPCTARGET'#000+
   #000+
   #000+
-  'This program comes under the GNU General Public Licence'#000+
-  'For more informa','tion read COPYING.FPC'#000+
+  'This program comes under the GNU ','General Public Licence'#000+
+  'For more information read COPYING.FPC'#000+
   #000+
   #000+
   'Report bugs,suggestions etc to:'#000+
   'Report bugs,suggestions etc to:'#000+
   '                [email protected]'#000+
   '                [email protected]'#000+
-  '**0*_+ switch option on, - off'#000+
-  '**1a_the compiler doesn'#039't delete the generated assembler file'#000+
-  '**2al_list sourcecode lines in assembler fi','le'#000+
+  '**0*_put + after a boolean switch option to enable it, - to disable it'+
+  #000+
+  '**1a_the compiler doesn'#039't ','delete the generated assembler file'#000+
+  '**2al_list sourcecode lines in assembler file'#000+
   '*t1b_use EMS'#000+
   '*t1b_use EMS'#000+
   '**1B_build all modules'#000+
   '**1B_build all modules'#000+
   '**1C_code generation options'#000+
   '**1C_code generation options'#000+
   '3*2CD_create dynamic library'#000+
   '3*2CD_create dynamic library'#000+
   '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#000+
   '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#000+
-  '**2Ci_IO-checking'#000+
+  '**2Ci_IO-che','cking'#000+
   '**2Cn_omit linking stage'#000+
   '**2Cn_omit linking stage'#000+
   '**2Co_check overflow of integer operations'#000+
   '**2Co_check overflow of integer operations'#000+
-  '**2Cr','_range checking'#000+
+  '**2Cr_range checking'#000+
   '**2Cs<n>_set stack size to <n>'#000+
   '**2Cs<n>_set stack size to <n>'#000+
   '**2Ct_stack checking'#000+
   '**2Ct_stack checking'#000+
   '3*2CS_create static library'#000+
   '3*2CS_create static library'#000+
   '3*2Cx_use smartlinking'#000+
   '3*2Cx_use smartlinking'#000+
   '**1d<x>_defines the symbol <x>'#000+
   '**1d<x>_defines the symbol <x>'#000+
-  '*O1D_generate a DEF file'#000+
+  '*O1D_genera','te a DEF file'#000+
   '*O2Dd<x>_set description to <x>'#000+
   '*O2Dd<x>_set description to <x>'#000+
   '*O2Dw_PM application'#000+
   '*O2Dw_PM application'#000+
-  '**1e<x>_set ','path to executable'#000+
+  '**1e<x>_set path to executable'#000+
   '**1E_same as -Cn'#000+
   '**1E_same as -Cn'#000+
   '**1F_set file names and paths'#000+
   '**1F_set file names and paths'#000+
   '**2FD<x>_sets the directory where to search for compiler utilities'#000+
   '**2FD<x>_sets the directory where to search for compiler utilities'#000+
-  '**2Fe<x>_redirect error output to <x>'#000+
+  '**2Fe<x>_redirect error outp','ut to <x>'#000+
   '**2FE<x>_set exe/unit output path to <x>'#000+
   '**2FE<x>_set exe/unit output path to <x>'#000+
   '*L2Fg<x>_same as -Fl'#000+
   '*L2Fg<x>_same as -Fl'#000+
-  '**2Fi<x','>_adds <x> to include path'#000+
+  '**2Fi<x>_adds <x> to include path'#000+
   '**2Fl<x>_adds <x> to library path'#000+
   '**2Fl<x>_adds <x> to library path'#000+
   '*L2FL<x>_uses <x> as dynamic linker'#000+
   '*L2FL<x>_uses <x> as dynamic linker'#000+
   '**2Fo<x>_adds <x> to object path'#000+
   '**2Fo<x>_adds <x> to object path'#000+
-  '**2Fr<x>_load error message file <x>'#000+
+  '**2Fr<x>_load error message fil','e <x>'#000+
   '**2Fu<x>_adds <x> to unit path'#000+
   '**2Fu<x>_adds <x> to unit path'#000+
-  '**2FU<x>_set unit output path to <x>, over','rides -FE'#000+
+  '**2FU<x>_set unit output path to <x>, overrides -FE'#000+
   '*g1g_generate debugger information'#000+
   '*g1g_generate debugger information'#000+
   '*g2gg_use gsym'#000+
   '*g2gg_use gsym'#000+
   '*g2gd_use dbx'#000+
   '*g2gd_use dbx'#000+
   '**1i_information'#000+
   '**1i_information'#000+
   '**1I<x>_adds <x> to include path'#000+
   '**1I<x>_adds <x> to include path'#000+
   '**1k<x>_Pass <x> to the linker'#000+
   '**1k<x>_Pass <x> to the linker'#000+
-  '**1l_write logo'#000+
+  '**1l_w','rite logo'#000+
   '**1n_don'#039't read the default config file'#000+
   '**1n_don'#039't read the default config file'#000+
-  '**1o<x>_change the name of th','e executable produced to <x>'#000+
+  '**1o<x>_change the name of the executable produced to <x>'#000+
   '**1pg_generate profile code for gprof'#000+
   '**1pg_generate profile code for gprof'#000+
   '*L1P_use pipes instead of creating temporary assembler files'#000+
   '*L1P_use pipes instead of creating temporary assembler files'#000+
   '**1S_syntax options'#000+
   '**1S_syntax options'#000+
-  '**2S2_switch some Delphi 2 extensions on'#000+
+  '**2S2_switch ','some Delphi 2 extensions on'#000+
   '**2Sc_supports operators like C (*=,+=,/= and -=)'#000+
   '**2Sc_supports operators like C (*=,+=,/= and -=)'#000+
-  '*','*2Sd_tries to be Delphi compatible'#000+
+  '**2Sd_tries to be Delphi compatible'#000+
   '**2Se_compiler stops after the first error'#000+
   '**2Se_compiler stops after the first error'#000+
   '**2Sg_allow LABEL and GOTO'#000+
   '**2Sg_allow LABEL and GOTO'#000+
   '**2Si_support C++ stlyed INLINE'#000+
   '**2Si_support C++ stlyed INLINE'#000+
-  '**2Sm_support macros like C (global)'#000+
+  '**2Sm_support macros lik','e C (global)'#000+
   '**2So_tries to be TP/BP 7.0 compatible'#000+
   '**2So_tries to be TP/BP 7.0 compatible'#000+
-  '**2Sp_tries to be gpc compa','tible'#000+
+  '**2Sp_tries to be gpc compatible'#000+
   '**2Ss_constructor name must be init (destructor must be done)'#000+
   '**2Ss_constructor name must be init (destructor must be done)'#000+
   '**2St_allow static keyword in objects'#000+
   '**2St_allow static keyword in objects'#000+
-  '**2Sv_allow variable directives (cvar,external,public,export)'#000+
   '**1s_don'#039't call assembler and linker (only with -a)'#000+
   '**1s_don'#039't call assembler and linker (only with -a)'#000+
-  '**1u<x>_undefines th','e symbol <x>'#000+
+  '**1','u<x>_undefines the symbol <x>'#000+
   '**1U_unit options'#000+
   '**1U_unit options'#000+
   '**2Un_don'#039't check the unit name'#000+
   '**2Un_don'#039't check the unit name'#000+
   '**2Up<x>_same as -Fu<x>'#000+
   '**2Up<x>_same as -Fu<x>'#000+
   '**2Us_compile a system unit'#000+
   '**2Us_compile a system unit'#000+
   '**1v<x>_Be verbose. <x> is a combination of the following letters :'#000+
   '**1v<x>_Be verbose. <x> is a combination of the following letters :'#000+
-  '**2*_e : Show errors (default)       d : Show debug info'#000,+
+  '**2*_e : Show errors (default)       d :',' Show debug info'#000+
   '**2*_w : Show warnings               u : Show unit info'#000+
   '**2*_w : Show warnings               u : Show unit info'#000+
   '**2*_n : Show notes                  t : Show tried/used files'#000+
   '**2*_n : Show notes                  t : Show tried/used files'#000+
   '**2*_h : Show hints                  m : Show defined macros'#000+
   '**2*_h : Show hints                  m : Show defined macros'#000+
-  '**2*_i : Show general info           p : Show compiled proce','dures'#000+
+  '**2*_i : Show general info           p : Sh','ow compiled procedures'#000+
   '**2*_l : Show linenumbers            c : Show conditionals'#000+
   '**2*_l : Show linenumbers            c : Show conditionals'#000+
   '**2*_a : Show everything             0 : Show nothing (except errors)'#000+
   '**2*_a : Show everything             0 : Show nothing (except errors)'#000+
   '**2*_b : Show all procedure          r : Rhide/GCC compatibility mode'#000+
   '**2*_b : Show all procedure          r : Rhide/GCC compatibility mode'#000+
-  '**2*_    declarations if an error  ','  x : Executable info (Win32 only'+
+  '**2*_    declarati','ons if an error    x : Executable info (Win32 only'+
   ')'#000+
   ')'#000+
   '**2*_    occurs'#000+
   '**2*_    occurs'#000+
   '**1X_executable options'#000+
   '**1X_executable options'#000+
   '*L2Xc_link with the c library'#000+
   '*L2Xc_link with the c library'#000+
   '**2XD_link with dynamic libraries (defines FPC_LINK_DYNAMIC)'#000+
   '**2XD_link with dynamic libraries (defines FPC_LINK_DYNAMIC)'#000+
   '**2Xs_strip all symbols from executable'#000+
   '**2Xs_strip all symbols from executable'#000+
-  '**2XS_link with static libraries (','defines FPC_LINK_STATIC)'#000+
+  '**2XS_link with s','tatic libraries (defines FPC_LINK_STATIC)'#000+
   '**0*_Processor specific options:'#000+
   '**0*_Processor specific options:'#000+
   '3*1A<x>_output format'#000+
   '3*1A<x>_output format'#000+
   '3*2Ao_coff file using GNU AS'#000+
   '3*2Ao_coff file using GNU AS'#000+
   '3*2Anasmcoff_coff file using Nasm'#000+
   '3*2Anasmcoff_coff file using Nasm'#000+
   '3*2Anasmelf_elf32 (linux) file using Nasm'#000+
   '3*2Anasmelf_elf32 (linux) file using Nasm'#000+
   '3*2Anasmobj_obj file using Nasm'#000+
   '3*2Anasmobj_obj file using Nasm'#000+
-  '3*2Amasm_obj using Masm',' (Mircosoft)'#000+
+  '3*2Ama','sm_obj using Masm (Mircosoft)'#000+
   '3*2Atasm_obj using Tasm (Borland)'#000+
   '3*2Atasm_obj using Tasm (Borland)'#000+
   '3*1R<x>_assembler reading style'#000+
   '3*1R<x>_assembler reading style'#000+
   '3*2Ratt_read AT&T style assembler'#000+
   '3*2Ratt_read AT&T style assembler'#000+
   '3*2Rintel_read Intel style assembler'#000+
   '3*2Rintel_read Intel style assembler'#000+
   '3*2Rdirect_copy assembler text directly to assembler file'#000+
   '3*2Rdirect_copy assembler text directly to assembler file'#000+
-  '3*1O<x>_optimizations'#000+
-  '3*2Og_gene','rate smaller code'#000+
+  '3*1O<x>_optimiz','ations'#000+
+  '3*2Og_generate smaller code'#000+
   '3*2OG_generate faster code (default)'#000+
   '3*2OG_generate faster code (default)'#000+
   '3*2Or_keep certain variables in registers (still BUGGY!!!)'#000+
   '3*2Or_keep certain variables in registers (still BUGGY!!!)'#000+
   '3*2Ou_enable uncertain optimizations (see docs)'#000+
   '3*2Ou_enable uncertain optimizations (see docs)'#000+
   '3*2O1_level 1 optimizations (quick optimizations)'#000+
   '3*2O1_level 1 optimizations (quick optimizations)'#000+
-  '3*2O2_level 2 optimizations ','(-O1 + slower optimizations)'#000+
+  '3*2O2_level',' 2 optimizations (-O1 + slower optimizations)'#000+
   '3*2O3_level 3 optimizations (same as -O2u)'#000+
   '3*2O3_level 3 optimizations (same as -O2u)'#000+
   '3*2Op_target processor'#000+
   '3*2Op_target processor'#000+
   '3*3Op1_set target processor to 386/486'#000+
   '3*3Op1_set target processor to 386/486'#000+
   '3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#000+
   '3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#000+
-  '3*3Op3_set target processor to PPro/PII/c6x86/K6 (t','m)'#000+
+  '3*3Op3_set target processor to PPr','o/PII/c6x86/K6 (tm)'#000+
   '3*1T<x>_Target operating system'#000+
   '3*1T<x>_Target operating system'#000+
   '3*2TGO32V1_version 1 of DJ Delorie DOS extender'#000+
   '3*2TGO32V1_version 1 of DJ Delorie DOS extender'#000+
   '3*2TGO32V2_version 2 of DJ Delorie DOS extender'#000+
   '3*2TGO32V2_version 2 of DJ Delorie DOS extender'#000+
@@ -614,7 +615,7 @@ const msgtxt : array[0..00094,1..240] of char=(
   '3*2TOS2_OS/2 2.x'#000+
   '3*2TOS2_OS/2 2.x'#000+
   '3*2TWin32_Windows 32 Bit'#000+
   '3*2TWin32_Windows 32 Bit'#000+
   '6*1A<x>_output format'#000+
   '6*1A<x>_output format'#000+
-  '6*2Ao_Unix o-file using GNU A','S'#000+
+  '6*2Ao_Unix o','-file using GNU AS'#000+
   '6*2Agas_GNU Motorola assembler'#000+
   '6*2Agas_GNU Motorola assembler'#000+
   '6*2Amit_MIT Syntax (old GAS)'#000+
   '6*2Amit_MIT Syntax (old GAS)'#000+
   '6*2Amot_Standard Motorola assembler'#000+
   '6*2Amot_Standard Motorola assembler'#000+
@@ -622,15 +623,15 @@ const msgtxt : array[0..00094,1..240] of char=(
   '6*2Oa_turn on the optimizer'#000+
   '6*2Oa_turn on the optimizer'#000+
   '6*2Og_generate smaller code'#000+
   '6*2Og_generate smaller code'#000+
   '6*2OG_generate faster code (default)'#000+
   '6*2OG_generate faster code (default)'#000+
-  '6*2Ox_optimize maximum (still ','BUGGY!!!)'#000+
+  '6*2Ox_optimiz','e maximum (still BUGGY!!!)'#000+
   '6*2O2_set target processor to a MC68020+'#000+
   '6*2O2_set target processor to a MC68020+'#000+
   '6*1R<x>_assembler reading style'#000+
   '6*1R<x>_assembler reading style'#000+
   '6*2RMOT_read motorola style assembler'#000+
   '6*2RMOT_read motorola style assembler'#000+
   '6*1T<x>_Target operating system'#000+
   '6*1T<x>_Target operating system'#000+
   '6*2TAMIGA_Commodore Amiga'#000+
   '6*2TAMIGA_Commodore Amiga'#000+
   '6*2TATARI_Atari ST/STe/TT'#000+
   '6*2TATARI_Atari ST/STe/TT'#000+
-  '6*2TMACOS_Macintosh m68k'#000+
-  '6*2TLINUX_','Linux-68k'#000+
+  '6*2TMACOS_Macintos','h m68k'#000+
+  '6*2TLINUX_Linux-68k'#000+
   '**1*_'#000+
   '**1*_'#000+
   '**1?_shows this help'#000+
   '**1?_shows this help'#000+
   '**1h_shows this help without waiting'#000
   '**1h_shows this help without waiting'#000

+ 26 - 24
compiler/pdecl.pas

@@ -117,9 +117,7 @@ unit pdecl;
          old_block_type : tblock_type;
          old_block_type : tblock_type;
          ps : pconstset;
          ps : pconstset;
          pd : pbestreal;
          pd : pbestreal;
-{$ifdef USEANSISTRING}
          sp : pstring;
          sp : pstring;
-{$endif USEANSISTRING}
       begin
       begin
          consume(_CONST);
          consume(_CONST);
          old_block_type:=block_type;
          old_block_type:=block_type;
@@ -152,27 +150,27 @@ unit pdecl;
                            else internalerror(111);
                            else internalerror(111);
                         end;
                         end;
                       stringconstn:
                       stringconstn:
-                        {value_str is disposed with p so I need a copy !}
-{$ifdef USEANSISTRING}  begin
+                        begin
+                           { value_str is disposed with p so I need a copy }
                            getmem(sp,p^.length+1);
                            getmem(sp,p^.length+1);
                            move(p^.value_str^,sp^[1],p^.length);
                            move(p^.value_str^,sp^[1],p^.length);
                            sp^[0]:=chr(p^.length);
                            sp^[0]:=chr(p^.length);
                            symtablestack^.insert(new(pconstsym,init(name,conststring,longint(sp),nil)));
                            symtablestack^.insert(new(pconstsym,init(name,conststring,longint(sp),nil)));
                         end;
                         end;
-{$else USEANSISTRING}
-                        symtablestack^.insert(new(pconstsym,init(name,conststring,longint(stringdup(p^.value_str^)),nil)));
-{$endif USEANSISTRING}
-                      realconstn : begin
-                                      new(pd);
-                                      pd^:=p^.value_real;
-                                      symtablestack^.insert(new(pconstsym,init(name,constreal,longint(pd),nil)));
-                                   end;
-                       setconstn : begin
-                                      new(ps);
-                                      ps^:=p^.value_set^;
-                                      symtablestack^.insert(new(pconstsym,init(name,constset,longint(ps),p^.resulttype)));
-                                   end;
-                      else Message(cg_e_illegal_expression);
+                      realconstn :
+                        begin
+                           new(pd);
+                           pd^:=p^.value_real;
+                           symtablestack^.insert(new(pconstsym,init(name,constreal,longint(pd),nil)));
+                        end;
+                      setconstn :
+                        begin
+                          new(ps);
+                          ps^:=p^.value_set^;
+                          symtablestack^.insert(new(pconstsym,init(name,constset,longint(ps),p^.resulttype)));
+                        end;
+                      else
+                        Message(cg_e_illegal_expression);
                    end;
                    end;
                    tokenpos:=storetokenpos;
                    tokenpos:=storetokenpos;
                    consume(SEMICOLON);
                    consume(SEMICOLON);
@@ -392,7 +390,7 @@ unit pdecl;
              if not symdone and (token=ID) then
              if not symdone and (token=ID) then
               begin
               begin
                 { Check for C Variable declarations }
                 { Check for C Variable declarations }
-                if (cs_support_c_var in aktmoduleswitches) and
+                if (m_cvar_support in aktmodeswitches) and
                    not(is_record or is_object) and
                    not(is_record or is_object) and
                    (idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) then
                    (idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) then
                  begin
                  begin
@@ -558,9 +556,9 @@ unit pdecl;
               if p^.value>255 then
               if p^.value>255 then
                 d:=new(pstringdef,longinit(p^.value))
                 d:=new(pstringdef,longinit(p^.value))
               else if p^.value<>255 then
               else if p^.value<>255 then
-                d:=new(pstringdef,init(p^.value))
+                d:=new(pstringdef,shortinit(p^.value))
 {$ifndef GDB}
 {$ifndef GDB}
-                 else d:=new(pstringdef,init(255));
+                 else d:=new(pstringdef,shortinit(255));
 {$else GDB}
 {$else GDB}
                  else d:=globaldef('STRING');
                  else d:=globaldef('STRING');
 {$endif GDB}
 {$endif GDB}
@@ -574,7 +572,7 @@ unit pdecl;
                  d:=new(pstringdef,ansiinit(0))
                  d:=new(pstringdef,ansiinit(0))
                else
                else
 {$ifndef GDB}
 {$ifndef GDB}
-                 d:=new(pstringdef,init(255));
+                 d:=new(pstringdef,shortinit(255));
 {$else GDB}
 {$else GDB}
                  d:=globaldef('STRING');
                  d:=globaldef('STRING');
 {$endif GDB}
 {$endif GDB}
@@ -1128,7 +1126,7 @@ unit pdecl;
                    { all classes must have a vmt !!  at offset zero }
                    { all classes must have a vmt !!  at offset zero }
                    if (aktclass^.options and oo_hasvmt)=0 then
                    if (aktclass^.options and oo_hasvmt)=0 then
                      aktclass^.insertvmt;
                      aktclass^.insertvmt;
-                   
+
                    object_dec:=aktclass;
                    object_dec:=aktclass;
                    exit;
                    exit;
                 end;
                 end;
@@ -2088,7 +2086,11 @@ unit pdecl;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.78  1998-10-27 13:45:33  pierre
+  Revision 1.79  1998-11-05 12:02:51  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.78  1998/10/27 13:45:33  pierre
     * classes get a vmt allways
     * classes get a vmt allways
     * better error info (tried to remove
     * better error info (tried to remove
       several error strings introduced by the tpexcept handling)
       several error strings introduced by the tpexcept handling)

+ 6 - 6
compiler/pexpr.pas

@@ -357,7 +357,7 @@ unit pexpr;
                   break;
                   break;
                end;
                end;
               consume(RKLAMMER);
               consume(RKLAMMER);
-              pd:=cstringdef;
+              pd:=cshortstringdef;
               statement_syssym:=p2;
               statement_syssym:=p2;
             end;
             end;
 
 
@@ -1896,18 +1896,18 @@ unit pexpr;
             Message(cg_e_illegal_expression);
             Message(cg_e_illegal_expression);
         end
         end
       else
       else
-{$ifdef UseAnsiString}
         get_stringconst:=strpas(p^.value_str);
         get_stringconst:=strpas(p^.value_str);
-{$else UseAnsiString}
-        get_stringconst:=p^.value_str^;
-{$endif UseAnsiString}
       disposetree(p);
       disposetree(p);
     end;
     end;
 
 
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.72  1998-11-04 10:11:41  peter
+  Revision 1.73  1998-11-05 12:02:52  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.72  1998/11/04 10:11:41  peter
     * ansistring fixes
     * ansistring fixes
 
 
   Revision 1.71  1998/10/22 23:57:29  peter
   Revision 1.71  1998/10/22 23:57:29  peter

+ 9 - 5
compiler/pp.pas

@@ -249,10 +249,10 @@ end;
 begin
 begin
   oldexit:=exitproc;
   oldexit:=exitproc;
   exitproc:=@myexit;
   exitproc:=@myexit;
-{$ifndef TP}
-{$ifndef UseAnsiString}
-  heapblocks:=true;
-{$endif not UseAnsiString}
+{$ifdef fpc}
+  {$ifndef autoobjpas}
+    heapblocks:=true;
+  {$endif}
 {$endif}
 {$endif}
 {$ifdef UseOverlay}
 {$ifdef UseOverlay}
   InitOverlay;
   InitOverlay;
@@ -263,7 +263,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.34  1998-10-14 11:28:24  florian
+  Revision 1.35  1998-11-05 12:02:53  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.34  1998/10/14 11:28:24  florian
     * emitpushreferenceaddress gets now the asmlist as parameter
     * emitpushreferenceaddress gets now the asmlist as parameter
     * m68k version compiles with -duseansistrings
     * m68k version compiles with -duseansistrings
 
 

+ 11 - 11
compiler/psystem.pas

@@ -89,10 +89,8 @@ begin
   p^.insert(new(ptypesym,init('s80real',s80floatdef)));
   p^.insert(new(ptypesym,init('s80real',s80floatdef)));
   p^.insert(new(ptypesym,init('cs32fixed',s32fixeddef)));
   p^.insert(new(ptypesym,init('cs32fixed',s32fixeddef)));
   p^.insert(new(ptypesym,init('byte',u8bitdef)));
   p^.insert(new(ptypesym,init('byte',u8bitdef)));
-  p^.insert(new(ptypesym,init('string',cstringdef)));
-{$ifdef useansistring}
-  p^.insert(new(ptypesym,init('shortstring',cstringdef)));
-{$endif}
+  p^.insert(new(ptypesym,init('string',cshortstringdef)));
+  p^.insert(new(ptypesym,init('shortstring',cshortstringdef)));
   p^.insert(new(ptypesym,init('longstring',clongstringdef)));
   p^.insert(new(ptypesym,init('longstring',clongstringdef)));
   p^.insert(new(ptypesym,init('ansistring',cansistringdef)));
   p^.insert(new(ptypesym,init('ansistring',cansistringdef)));
   p^.insert(new(ptypesym,init('widestring',cwidestringdef)));
   p^.insert(new(ptypesym,init('widestring',cwidestringdef)));
@@ -122,10 +120,8 @@ begin
 {$endif}
 {$endif}
   p^.insert(new(ptypesym,init('SINGLE',new(pfloatdef,init(s32real)))));
   p^.insert(new(ptypesym,init('SINGLE',new(pfloatdef,init(s32real)))));
   p^.insert(new(ptypesym,init('POINTER',new(ppointerdef,init(voiddef)))));
   p^.insert(new(ptypesym,init('POINTER',new(ppointerdef,init(voiddef)))));
-  p^.insert(new(ptypesym,init('STRING',cstringdef)));
-{$ifdef useansistring}
-  p^.insert(new(ptypesym,init('SHORTSTRING',cstringdef)));
-{$endif}
+  p^.insert(new(ptypesym,init('STRING',cshortstringdef)));
+  p^.insert(new(ptypesym,init('SHORTSTRING',cshortstringdef)));
   p^.insert(new(ptypesym,init('LONGSTRING',clongstringdef)));
   p^.insert(new(ptypesym,init('LONGSTRING',clongstringdef)));
   p^.insert(new(ptypesym,init('ANSISTRING',cansistringdef)));
   p^.insert(new(ptypesym,init('ANSISTRING',cansistringdef)));
   p^.insert(new(ptypesym,init('WIDESTRING',cwidestringdef)));
   p^.insert(new(ptypesym,init('WIDESTRING',cwidestringdef)));
@@ -175,7 +171,7 @@ procedure readconstdefs;
 begin
 begin
   s32bitdef:=porddef(globaldef('longint'));
   s32bitdef:=porddef(globaldef('longint'));
   u32bitdef:=porddef(globaldef('ulong'));
   u32bitdef:=porddef(globaldef('ulong'));
-  cstringdef:=pstringdef(globaldef('string'));
+  cshortstringdef:=pstringdef(globaldef('shortstring'));
   clongstringdef:=pstringdef(globaldef('longstring'));
   clongstringdef:=pstringdef(globaldef('longstring'));
   cansistringdef:=pstringdef(globaldef('ansistring'));
   cansistringdef:=pstringdef(globaldef('ansistring'));
   cwidestringdef:=pstringdef(globaldef('widestring'));
   cwidestringdef:=pstringdef(globaldef('widestring'));
@@ -214,7 +210,7 @@ begin
   s32bitdef:=new(porddef,init(s32bit,$80000000,$7fffffff));
   s32bitdef:=new(porddef,init(s32bit,$80000000,$7fffffff));
   booldef:=new(porddef,init(bool8bit,0,1));
   booldef:=new(porddef,init(bool8bit,0,1));
   cchardef:=new(porddef,init(uchar,0,255));
   cchardef:=new(porddef,init(uchar,0,255));
-  cstringdef:=new(pstringdef,init(255));
+  cshortstringdef:=new(pstringdef,shortinit(255));
   { should we give a length to the default long and ansi string definition ?? }
   { should we give a length to the default long and ansi string definition ?? }
   clongstringdef:=new(pstringdef,longinit(-1));
   clongstringdef:=new(pstringdef,longinit(-1));
   cansistringdef:=new(pstringdef,ansiinit(-1));
   cansistringdef:=new(pstringdef,ansiinit(-1));
@@ -241,7 +237,11 @@ end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.8  1998-11-04 10:11:44  peter
+  Revision 1.9  1998-11-05 12:02:54  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.8  1998/11/04 10:11:44  peter
     * ansistring fixes
     * ansistring fixes
 
 
   Revision 1.7  1998/10/05 12:32:48  peter
   Revision 1.7  1998/10/05 12:32:48  peter

+ 5 - 26
compiler/ptconst.pas

@@ -54,9 +54,7 @@ unit ptconst;
 {$ifdef m68k}
 {$ifdef m68k}
          j : longint;
          j : longint;
 {$endif m68k}
 {$endif m68k}
-{$ifdef useansistring}
          len       : longint;
          len       : longint;
-{$endif}
          p,hp      : ptree;
          p,hp      : ptree;
          i,l,offset,
          i,l,offset,
          strlength : longint;
          strlength : longint;
@@ -313,7 +311,6 @@ unit ptconst;
                    begin
                    begin
                       if p^.treetype=stringconstn then
                       if p^.treetype=stringconstn then
                         begin
                         begin
-{$ifdef UseAnsiString}
                            if p^.length>=def^.size then
                            if p^.length>=def^.size then
                              strlength:=def^.size-1
                              strlength:=def^.size-1
                            else
                            else
@@ -324,18 +321,6 @@ unit ptconst;
                            move(p^.value_str^,ca^,strlength);
                            move(p^.value_str^,ca^,strlength);
                            ca[strlength]:=#0;
                            ca[strlength]:=#0;
                            generate_pascii(datasegment,ca,strlength);
                            generate_pascii(datasegment,ca,strlength);
-{$else UseAnsiString}
-                           if length(p^.value_str^)>=def^.size then
-                             begin
-                               strlength:=def^.size-1;
-                               generate_ascii(datasegment,char(strlength)+copy(p^.value_str^,1,strlength));
-                             end
-                           else
-                             begin
-                               strlength:=length(p^.value_str^);
-                               generate_ascii(datasegment,char(strlength)+p^.value_str^);
-                             end;
-{$endif UseAnsiString}
                         end
                         end
                       else if is_constcharnode(p) then
                       else if is_constcharnode(p) then
                         begin
                         begin
@@ -351,12 +336,8 @@ unit ptconst;
                            { we have to subtract one                           }
                            { we have to subtract one                           }
                            fillchar(ca[0],def^.size-strlength-1,' ');
                            fillchar(ca[0],def^.size-strlength-1,' ');
                            ca[def^.size-strlength-1]:=#0;
                            ca[def^.size-strlength-1]:=#0;
-{$ifdef UseAnsiString}
                            { this can also handle longer strings }
                            { this can also handle longer strings }
                            generate_pascii(datasegment,ca,def^.size-strlength-1);
                            generate_pascii(datasegment,ca,def^.size-strlength-1);
-{$else UseAnsiString}
-                           datasegment^.concat(new(pai_string,init_pchar(ca)));
-{$endif UseAnsiString}
                         end;
                         end;
                     end;
                     end;
 {$ifdef UseLongString}
 {$ifdef UseLongString}
@@ -385,7 +366,6 @@ unit ptconst;
                      datasegment^.concat(new(pai_const,init_8bit(0)));
                      datasegment^.concat(new(pai_const,init_8bit(0)));
                    end;
                    end;
 {$endif UseLongString}
 {$endif UseLongString}
-{$ifdef UseAnsiString}
                  st_ansistring:
                  st_ansistring:
                    begin
                    begin
                       { an empty ansi string is nil! }
                       { an empty ansi string is nil! }
@@ -426,7 +406,6 @@ unit ptconst;
                            consts^.concat(new(pai_const,init_8bit(0)));
                            consts^.concat(new(pai_const,init_8bit(0)));
                         end;
                         end;
                     end;
                     end;
-{$endif UseAnsiString}
               end;
               end;
               disposetree(p);
               disposetree(p);
            end;
            end;
@@ -449,16 +428,12 @@ unit ptconst;
                    do_firstpass(p);
                    do_firstpass(p);
                    if p^.treetype=stringconstn then
                    if p^.treetype=stringconstn then
                     begin
                     begin
-{$ifdef useansistring}
                       if p^.length>255 then
                       if p^.length>255 then
                        len:=255
                        len:=255
                       else
                       else
                        len:=p^.length;
                        len:=p^.length;
                       s[0]:=chr(len);
                       s[0]:=chr(len);
                       move(p^.value_str^,s[1],len);
                       move(p^.value_str^,s[1],len);
-{$else}
-                     s:=p^.value_str^
-{$endif}
                     end
                     end
                    else
                    else
                      if is_constcharnode(p) then
                      if is_constcharnode(p) then
@@ -649,7 +624,11 @@ unit ptconst;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.23  1998-11-04 10:11:45  peter
+  Revision 1.24  1998-11-05 12:02:55  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.23  1998/11/04 10:11:45  peter
     * ansistring fixes
     * ansistring fixes
 
 
   Revision 1.22  1998/10/20 08:06:56  pierre
   Revision 1.22  1998/10/20 08:06:56  pierre

+ 8 - 4
compiler/symdef.inc

@@ -167,7 +167,7 @@
               st^.registerdef(@self);
               st^.registerdef(@self);
            end;
            end;
       end;
       end;
-      
+
 
 
     procedure tdef.write;
     procedure tdef.write;
       begin
       begin
@@ -416,7 +416,7 @@
                                TSTRINGDEF
                                TSTRINGDEF
 ****************************************************************************}
 ****************************************************************************}
 
 
-    constructor tstringdef.init(l : byte);
+    constructor tstringdef.shortinit(l : byte);
       begin
       begin
          tdef.init;
          tdef.init;
          string_typ:=st_shortstring;
          string_typ:=st_shortstring;
@@ -426,7 +426,7 @@
       end;
       end;
 
 
 
 
-    constructor tstringdef.load;
+    constructor tstringdef.shortload;
       begin
       begin
          tdef.load;
          tdef.load;
          string_typ:=st_shortstring;
          string_typ:=st_shortstring;
@@ -3200,7 +3200,11 @@
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.66  1998-10-26 22:58:22  florian
+  Revision 1.67  1998-11-05 12:02:56  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.66  1998/10/26 22:58:22  florian
     * new introduded problem with classes fix, the parent class wasn't set
     * new introduded problem with classes fix, the parent class wasn't set
       correct, if the class was defined forward before
       correct, if the class was defined forward before
 
 

+ 7 - 3
compiler/symdefh.inc

@@ -414,8 +414,8 @@
        tstringdef = object(tdef)
        tstringdef = object(tdef)
           string_typ : tstringtype;
           string_typ : tstringtype;
           len : longint;
           len : longint;
-          constructor init(l : byte);
-          constructor load;
+          constructor shortinit(l : byte);
+          constructor shortload;
           constructor longinit(l : longint);
           constructor longinit(l : longint);
           constructor longload;
           constructor longload;
           constructor ansiinit(l : longint);
           constructor ansiinit(l : longint);
@@ -483,7 +483,11 @@
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.6  1998-10-22 17:11:23  pierre
+  Revision 1.7  1998-11-05 12:02:59  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.6  1998/10/22 17:11:23  pierre
     + terminated the include exclude implementation for i386
     + terminated the include exclude implementation for i386
     * enums inside records fixed
     * enums inside records fixed
 
 

+ 25 - 69
compiler/tcadd.pas

@@ -82,12 +82,8 @@ implementation
          i : longint;
          i : longint;
          b : boolean;
          b : boolean;
          convdone : boolean;
          convdone : boolean;
-{$ifndef UseAnsiString}
-         s1,s2:^string;
-{$else UseAnsiString}
          s1,s2 : pchar;
          s1,s2 : pchar;
          l1,l2 : longint;
          l1,l2 : longint;
-{$endif UseAnsiString}
 
 
          { this totally forgets to set the pi_do_call flag !! }
          { this totally forgets to set the pi_do_call flag !! }
       label
       label
@@ -262,66 +258,41 @@ implementation
 
 
        { concating strings ? }
        { concating strings ? }
          concatstrings:=false;
          concatstrings:=false;
-{$ifdef UseAnsiString}
          s1:=nil;
          s1:=nil;
          s2:=nil;
          s2:=nil;
-{$else UseAnsiString}
-         new(s1);
-         new(s2);
-{$endif UseAnsiString}
          if (lt=ordconstn) and (rt=ordconstn) and
          if (lt=ordconstn) and (rt=ordconstn) and
             is_char(ld) and is_char(rd) then
             is_char(ld) and is_char(rd) then
            begin
            begin
-{$ifdef UseAnsiString}
               s1:=strpnew(char(byte(p^.left^.value)));
               s1:=strpnew(char(byte(p^.left^.value)));
               s2:=strpnew(char(byte(p^.right^.value)));
               s2:=strpnew(char(byte(p^.right^.value)));
               l1:=1;
               l1:=1;
               l2:=1;
               l2:=1;
-{$else UseAnsiString}
-              s1^:=char(byte(p^.left^.value));
-              s2^:=char(byte(p^.right^.value));
-{$endif UseAnsiString}
               concatstrings:=true;
               concatstrings:=true;
            end
            end
          else
          else
            if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then
            if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then
            begin
            begin
-{$ifdef UseAnsiString}
               s1:=getpcharcopy(p^.left);
               s1:=getpcharcopy(p^.left);
               l1:=p^.left^.length;
               l1:=p^.left^.length;
               s2:=strpnew(char(byte(p^.right^.value)));
               s2:=strpnew(char(byte(p^.right^.value)));
               l2:=1;
               l2:=1;
-{$else UseAnsiString}
-              s1^:=p^.left^.value_str^;
-              s2^:=char(byte(p^.right^.value));
-{$endif UseAnsiString}
               concatstrings:=true;
               concatstrings:=true;
            end
            end
          else
          else
            if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then
            if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then
            begin
            begin
-{$ifdef UseAnsiString}
               s1:=strpnew(char(byte(p^.left^.value)));
               s1:=strpnew(char(byte(p^.left^.value)));
               l1:=1;
               l1:=1;
               s2:=getpcharcopy(p^.right);
               s2:=getpcharcopy(p^.right);
               l2:=p^.right^.length;
               l2:=p^.right^.length;
-{$else UseAnsiString}
-              s1^:=char(byte(p^.left^.value));
-              s2^:=p^.right^.value_str^;
-{$endif UseAnsiString}
               concatstrings:=true;
               concatstrings:=true;
            end
            end
          else if (lt=stringconstn) and (rt=stringconstn) then
          else if (lt=stringconstn) and (rt=stringconstn) then
            begin
            begin
-{$ifdef UseAnsiString}
               s1:=getpcharcopy(p^.left);
               s1:=getpcharcopy(p^.left);
               l1:=p^.left^.length;
               l1:=p^.left^.length;
               s2:=getpcharcopy(p^.right);
               s2:=getpcharcopy(p^.right);
               l2:=p^.right^.length;
               l2:=p^.right^.length;
-{$else UseAnsiString}
-              s1^:=p^.left^.value_str^;
-              s2^:=p^.right^.value_str^;
-{$endif UseAnsiString}
               concatstrings:=true;
               concatstrings:=true;
            end;
            end;
 
 
@@ -329,47 +300,28 @@ implementation
          if concatstrings then
          if concatstrings then
            begin
            begin
               case p^.treetype of
               case p^.treetype of
-{$ifndef UseAnsiString}
-                 addn : t:=genstringconstnode(s1^+s2^);
-                 ltn : t:=genordinalconstnode(byte(s1^<s2^),booldef);
-                 lten : t:=genordinalconstnode(byte(s1^<=s2^),booldef);
-                 gtn : t:=genordinalconstnode(byte(s1^>s2^),booldef);
-                 gten : t:=genordinalconstnode(byte(s1^>=s2^),booldef);
-                 equaln : t:=genordinalconstnode(byte(s1^=s2^),booldef);
-                 unequaln : t:=genordinalconstnode(byte(s1^<>s2^),booldef);
-{$else UseAnsiString}
-                 addn : t:=genpcharconstnode(
-                             concatansistrings(s1,s2,l1,l2),l1+l2);
-                 ltn : t:=genordinalconstnode(
-                           byte(compareansistrings(s1,s2,l1,l2)<0),booldef);
-                 lten : t:=genordinalconstnode(
-                            byte(compareansistrings(s1,s2,l1,l2)<=0),booldef);
-                 gtn : t:=genordinalconstnode(
-                            byte(compareansistrings(s1,s2,l1,l2)>0),booldef);
-                 gten : t:=genordinalconstnode(
-                             byte(compareansistrings(s1,s2,l1,l2)>=0),booldef);
-                 equaln : t:=genordinalconstnode(
-                               byte(compareansistrings(s1,s2,l1,l2)=0),booldef);
-                 unequaln : t:=genordinalconstnode(
-                                 byte(compareansistrings(s1,s2,l1,l2)<>0),booldef);
-{$endif UseAnsiString}
+                 addn :
+                   t:=genpcharconstnode(concatansistrings(s1,s2,l1,l2),l1+l2);
+                 ltn :
+                   t:=genordinalconstnode(byte(compareansistrings(s1,s2,l1,l2)<0),booldef);
+                 lten :
+                   t:=genordinalconstnode(byte(compareansistrings(s1,s2,l1,l2)<=0),booldef);
+                 gtn :
+                   t:=genordinalconstnode(byte(compareansistrings(s1,s2,l1,l2)>0),booldef);
+                 gten :
+                   t:=genordinalconstnode(byte(compareansistrings(s1,s2,l1,l2)>=0),booldef);
+                 equaln :
+                   t:=genordinalconstnode(byte(compareansistrings(s1,s2,l1,l2)=0),booldef);
+                 unequaln :
+                   t:=genordinalconstnode(byte(compareansistrings(s1,s2,l1,l2)<>0),booldef);
               end;
               end;
-{$ifdef UseAnsiString}
               ansistringdispose(s1,l1);
               ansistringdispose(s1,l1);
               ansistringdispose(s2,l2);
               ansistringdispose(s2,l2);
-{$else UseAnsiString}
-              dispose(s1);
-              dispose(s2);
-{$endif UseAnsiString}
               disposetree(p);
               disposetree(p);
               firstpass(t);
               firstpass(t);
               p:=t;
               p:=t;
               exit;
               exit;
            end;
            end;
-{$ifndef UseAnsiString}
-         dispose(s1);
-         dispose(s2);
-{$endif UseAnsiString}
 
 
        { if both are orddefs then check sub types }
        { if both are orddefs then check sub types }
          if (ld^.deftype=orddef) and (rd^.deftype=orddef) then
          if (ld^.deftype=orddef) and (rd^.deftype=orddef) then
@@ -424,9 +376,9 @@ implementation
                begin
                begin
                  if p^.treetype=addn then
                  if p^.treetype=addn then
                    begin
                    begin
-                      p^.left:=gentypeconvnode(p^.left,cstringdef);
+                      p^.left:=gentypeconvnode(p^.left,cshortstringdef);
                       firstpass(p^.left);
                       firstpass(p^.left);
-                      p^.right:=gentypeconvnode(p^.right,cstringdef);
+                      p^.right:=gentypeconvnode(p^.right,cshortstringdef);
                       firstpass(p^.right);
                       firstpass(p^.right);
                       { here we call STRCOPY }
                       { here we call STRCOPY }
                       procinfo.flags:=procinfo.flags or pi_do_call;
                       procinfo.flags:=procinfo.flags or pi_do_call;
@@ -502,10 +454,10 @@ implementation
               else
               else
                 begin
                 begin
                    if not(is_shortstring(rd)) then
                    if not(is_shortstring(rd)) then
-                     p^.right:=gentypeconvnode(p^.right,cstringdef);
+                     p^.right:=gentypeconvnode(p^.right,cshortstringdef);
                    if not(is_shortstring(ld)) then
                    if not(is_shortstring(ld)) then
-                     p^.left:=gentypeconvnode(p^.left,cstringdef);
-                   p^.resulttype:=cstringdef;
+                     p^.left:=gentypeconvnode(p^.left,cshortstringdef);
+                   p^.resulttype:=cshortstringdef;
                    { this is only for add, the comparisaion is handled later }
                    { this is only for add, the comparisaion is handled later }
                    p^.location.loc:=LOC_MEM;
                    p^.location.loc:=LOC_MEM;
                 end;
                 end;
@@ -950,7 +902,7 @@ implementation
                     (p^.right^.resulttype^.deftype=stringdef) then
                     (p^.right^.resulttype^.deftype=stringdef) then
                    begin
                    begin
                       if not assigned(p^.resulttype) then
                       if not assigned(p^.resulttype) then
-                        p^.resulttype:=cstringdef
+                        p^.resulttype:=cshortstringdef
                       { the rest is done before }
                       { the rest is done before }
                    end
                    end
                  else
                  else
@@ -966,7 +918,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.10  1998-11-04 10:11:46  peter
+  Revision 1.11  1998-11-05 12:03:02  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.10  1998/11/04 10:11:46  peter
     * ansistring fixes
     * ansistring fixes
 
 
   Revision 1.9  1998/10/25 23:32:04  peter
   Revision 1.9  1998/10/25 23:32:04  peter

+ 6 - 2
compiler/tccnv.pas

@@ -428,7 +428,7 @@ implementation
 
 
     procedure first_cchar_charpointer(var p : ptree);
     procedure first_cchar_charpointer(var p : ptree);
       begin
       begin
-         p^.left:=gentypeconvnode(p^.left,cstringdef);
+         p^.left:=gentypeconvnode(p^.left,cshortstringdef);
          { convert constant char to constant string }
          { convert constant char to constant string }
          firstpass(p^.left);
          firstpass(p^.left);
          { evalute tree }
          { evalute tree }
@@ -913,7 +913,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.7  1998-10-23 11:58:27  florian
+  Revision 1.8  1998-11-05 12:03:03  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.7  1998/10/23 11:58:27  florian
     * better code generation for s:=s+[b] if b is in the range of
     * better code generation for s:=s+[b] if b is in the range of
       a small set and s is also a small set
       a small set and s is also a small set
 
 

+ 6 - 2
compiler/tccon.pas

@@ -87,7 +87,7 @@ implementation
         if cs_ansistrings in aktlocalswitches then
         if cs_ansistrings in aktlocalswitches then
           p^.resulttype:=cansistringdef
           p^.resulttype:=cansistringdef
         else
         else
-          p^.resulttype:=cstringdef;
+          p^.resulttype:=cshortstringdef;
         p^.location.loc:=LOC_MEM;
         p^.location.loc:=LOC_MEM;
       end;
       end;
 
 
@@ -116,7 +116,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.1  1998-09-23 20:42:24  peter
+  Revision 1.2  1998-11-05 12:03:04  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.1  1998/09/23 20:42:24  peter
     * splitted pass_1
     * splitted pass_1
 
 
 }
 }

+ 7 - 9
compiler/tcinl.pas

@@ -358,11 +358,9 @@ implementation
                end;
                end;
              in_length_string:
              in_length_string:
                begin
                begin
-{$ifdef UseAnsiString}
                   if is_ansistring(p^.left^.resulttype) then
                   if is_ansistring(p^.left^.resulttype) then
                     p^.resulttype:=s32bitdef
                     p^.resulttype:=s32bitdef
                   else
                   else
-{$endif UseAnsiString}
                     p^.resulttype:=u8bitdef;
                     p^.resulttype:=u8bitdef;
                   { wer don't need string conversations here }
                   { wer don't need string conversations here }
                   if (p^.left^.treetype=typeconvn) and
                   if (p^.left^.treetype=typeconvn) and
@@ -376,11 +374,7 @@ implementation
                   { evaluates length of constant strings direct }
                   { evaluates length of constant strings direct }
                   if (p^.left^.treetype=stringconstn) then
                   if (p^.left^.treetype=stringconstn) then
                     begin
                     begin
-{$ifdef UseAnsiString}
                        hp:=genordinalconstnode(p^.left^.length,s32bitdef);
                        hp:=genordinalconstnode(p^.left^.length,s32bitdef);
-{$else UseAnsiString}
-                       hp:=genordinalconstnode(length(p^.left^.value_str^),s32bitdef);
-{$endif UseAnsiString}
                        disposetree(p);
                        disposetree(p);
                        firstpass(hp);
                        firstpass(hp);
                        p:=hp;
                        p:=hp;
@@ -561,7 +555,7 @@ implementation
                                                         (parraydef(hp^.left^.resulttype)^.lowrange<>0) and
                                                         (parraydef(hp^.left^.resulttype)^.lowrange<>0) and
                                                         (parraydef(hp^.left^.resulttype)^.definition^.deftype=orddef) and
                                                         (parraydef(hp^.left^.resulttype)^.definition^.deftype=orddef) and
                                                         (porddef(parraydef(hp^.left^.resulttype)^.definition)^.typ=uchar) then
                                                         (porddef(parraydef(hp^.left^.resulttype)^.definition)^.typ=uchar) then
-                                                       hp^.left:=gentypeconvnode(hp^.left,cstringdef)
+                                                       hp^.left:=gentypeconvnode(hp^.left,cshortstringdef)
                                                      else
                                                      else
                                                        CGMessage(type_e_cant_read_write_type);
                                                        CGMessage(type_e_cant_read_write_type);
                                                    end;
                                                    end;
@@ -838,7 +832,7 @@ implementation
                       if is_boolean(p^.left^.resulttype) then
                       if is_boolean(p^.left^.resulttype) then
                         begin
                         begin
                            { must always be a string }
                            { must always be a string }
-                           p^.left^.right^.left:=gentypeconvnode(p^.left^.right^.left,cstringdef);
+                           p^.left^.right^.left:=gentypeconvnode(p^.left^.right^.left,cshortstringdef);
                            firstpass(p^.left^.right^.left);
                            firstpass(p^.left^.right^.left);
                         end
                         end
                       else
                       else
@@ -860,7 +854,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.5  1998-10-20 11:16:47  pierre
+  Revision 1.6  1998-11-05 12:03:05  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.5  1998/10/20 11:16:47  pierre
    + length(c) where C is a char is allways 1
    + length(c) where C is a char is allways 1
 
 
   Revision 1.4  1998/10/06 20:49:11  peter
   Revision 1.4  1998/10/06 20:49:11  peter

+ 20 - 58
compiler/tree.pas

@@ -215,11 +215,7 @@ unit tree;
              funcretn : (funcretprocinfo : pointer;retdef : pdef);
              funcretn : (funcretprocinfo : pointer;retdef : pdef);
              subscriptn : (vs : pvarsym);
              subscriptn : (vs : pvarsym);
              vecn : (memindex,memseg:boolean;callunique : boolean);
              vecn : (memindex,memseg:boolean;callunique : boolean);
-{$ifdef UseAnsiString}
              stringconstn : (value_str : pchar;length : longint; lab_str : plabel;stringtype : tstringtype);
              stringconstn : (value_str : pchar;length : longint; lab_str : plabel;stringtype : tstringtype);
-{$else UseAnsiString}
-             stringconstn : (value_str : pstring; lab_str:plabel;stringtype : tstringtype);
-{$endif UseAnsiString}
              typeconvn : (convtyp : tconverttype;explizit : boolean);
              typeconvn : (convtyp : tconverttype;explizit : boolean);
              typen : (typenodetype : pdef);
              typen : (typenodetype : pdef);
              inlinen : (inlinenumber : longint;inlineconst:boolean);
              inlinen : (inlinenumber : longint;inlineconst:boolean);
@@ -251,12 +247,10 @@ unit tree;
 
 
     { allow pchar or string for defining a pchar node }
     { allow pchar or string for defining a pchar node }
     function genstringconstnode(const s : string) : ptree;
     function genstringconstnode(const s : string) : ptree;
-{$ifdef UseAnsiString}
     { length is required for ansistrings }
     { length is required for ansistrings }
     function genpcharconstnode(s : pchar;length : longint) : ptree;
     function genpcharconstnode(s : pchar;length : longint) : ptree;
     { helper routine for conststring node }
     { helper routine for conststring node }
     function getpcharcopy(p : ptree) : pchar;
     function getpcharcopy(p : ptree) : pchar;
-{$endif UseAnsiString}
 
 
     function genzeronode(t : ttreetyp) : ptree;
     function genzeronode(t : ttreetyp) : ptree;
     function geninlinenode(number : longint;is_const:boolean;l : ptree) : ptree;
     function geninlinenode(number : longint;is_const:boolean;l : ptree) : ptree;
@@ -338,11 +332,7 @@ unit tree;
           asmn : if assigned(p^.p_asm) then
           asmn : if assigned(p^.p_asm) then
                   dispose(p^.p_asm,done);
                   dispose(p^.p_asm,done);
   stringconstn : begin
   stringconstn : begin
-{$ifndef UseAnsiString}
-                   stringdispose(p^.value_str);
-{$else UseAnsiString}
                    ansistringdispose(p^.value_str,p^.length);
                    ansistringdispose(p^.value_str,p^.length);
-{$endif UseAnsiString}
                  end;
                  end;
      setconstn : begin
      setconstn : begin
                    if assigned(p^.value_set) then
                    if assigned(p^.value_set) then
@@ -411,12 +401,8 @@ unit tree;
        { now check treetype }
        { now check treetype }
          case p^.treetype of
          case p^.treetype of
   stringconstn : begin
   stringconstn : begin
-{$ifdef UseAnsiString}
                    hp^.value_str:=getpcharcopy(p);
                    hp^.value_str:=getpcharcopy(p);
                    hp^.length:=p^.length;
                    hp^.length:=p^.length;
-{$else UseAnsiString}
-                   hp^.value_str:=stringdup(p^.value_str^);
-{$endif UseAnsiString}
                  end;
                  end;
      setconstn : begin
      setconstn : begin
                    new(hp^.value_set);
                    new(hp^.value_set);
@@ -455,7 +441,7 @@ unit tree;
       var
       var
          symt : psymtable;
          symt : psymtable;
          i : longint;
          i : longint;
-         
+
       begin
       begin
          if not(assigned(p)) then
          if not(assigned(p)) then
            exit;
            exit;
@@ -770,9 +756,7 @@ unit tree;
 
 
       var
       var
          p : ptree;
          p : ptree;
-{$ifdef UseAnsiString}
          l : longint;
          l : longint;
-{$endif UseAnsiString}
       begin
       begin
          p:=getnode;
          p:=getnode;
          p^.disposetyp:=dt_nothing;
          p^.disposetyp:=dt_nothing;
@@ -784,43 +768,43 @@ unit tree;
 {$ifdef SUPPORT_MMX}
 {$ifdef SUPPORT_MMX}
          p^.registersmmx:=0;
          p^.registersmmx:=0;
 {$endif SUPPORT_MMX}
 {$endif SUPPORT_MMX}
-         p^.resulttype:=cstringdef;
-{$ifdef UseAnsiString}
          l:=length(s);
          l:=length(s);
          p^.length:=l;
          p^.length:=l;
          { stringdup write even past a #0 }
          { stringdup write even past a #0 }
          getmem(p^.value_str,l+1);
          getmem(p^.value_str,l+1);
          move(s[1],p^.value_str^,l);
          move(s[1],p^.value_str^,l);
          p^.value_str[l]:=#0;
          p^.value_str[l]:=#0;
-{$else UseAnsiString}
-         p^.value_str:=stringdup(s);
-{$endif UseAnsiString}
          p^.lab_str:=nil;
          p^.lab_str:=nil;
-         p^.stringtype:=st_shortstring;
+         if cs_ansistrings in aktlocalswitches then
+          begin
+            p^.stringtype:=st_ansistring;
+            p^.resulttype:=cansistringdef;
+          end
+         else
+          begin
+            p^.stringtype:=st_shortstring;
+            p^.resulttype:=cshortstringdef;
+          end;
+
          genstringconstnode:=p;
          genstringconstnode:=p;
       end;
       end;
 
 
-{$ifdef UseAnsiString}
     function getpcharcopy(p : ptree) : pchar;
     function getpcharcopy(p : ptree) : pchar;
-
       var
       var
          pc : pchar;
          pc : pchar;
-
       begin
       begin
          pc:=nil;
          pc:=nil;
          getmem(pc,p^.length+1);
          getmem(pc,p^.length+1);
-         { Peter can you change that ? }
          if pc=nil then
          if pc=nil then
            Message(general_f_no_memory_left);
            Message(general_f_no_memory_left);
          move(p^.value_str^,pc^,p^.length+1);
          move(p^.value_str^,pc^,p^.length+1);
          getpcharcopy:=pc;
          getpcharcopy:=pc;
       end;
       end;
 
 
-    function genpcharconstnode(s : pchar;length : longint) : ptree;
 
 
+    function genpcharconstnode(s : pchar;length : longint) : ptree;
       var
       var
          p : ptree;
          p : ptree;
-
       begin
       begin
          p:=getnode;
          p:=getnode;
          p^.disposetyp:=dt_nothing;
          p^.disposetyp:=dt_nothing;
@@ -832,13 +816,13 @@ unit tree;
 {$ifdef SUPPORT_MMX}
 {$ifdef SUPPORT_MMX}
          p^.registersmmx:=0;
          p^.registersmmx:=0;
 {$endif SUPPORT_MMX}
 {$endif SUPPORT_MMX}
-         p^.resulttype:=cstringdef;
+         p^.resulttype:=cshortstringdef;
          p^.length:=length;
          p^.length:=length;
          p^.value_str:=s;
          p^.value_str:=s;
          p^.lab_str:=nil;
          p^.lab_str:=nil;
          genpcharconstnode:=p;
          genpcharconstnode:=p;
       end;
       end;
-{$endif UseAnsiString}
+
 
 
     function gensinglenode(t : ttreetyp;l : ptree) : ptree;
     function gensinglenode(t : ttreetyp;l : ptree) : ptree;
 
 
@@ -1440,28 +1424,6 @@ unit tree;
                      error_found:=true;
                      error_found:=true;
                   end;
                   end;
                end;
                end;
-             (*realconstn : (valued : bestreal;labnumber : longint;realtyp : tait);
-             fixconstn : (valuef: longint);
-             funcretn : (funcretprocinfo : pointer;retdef : pdef);
-             subscriptn : (vs : pvarsym);
-             vecn : (memindex,memseg:boolean);
-             { stringconstn : (length : longint; value_str : pstring;labstrnumber : longint); }
-             { string const can be longer then 255 with ansistring !! }
-{$ifdef UseAnsiString}
-             stringconstn : (value_str : pchar;length : longint; labstrnumber : longint);
-{$else UseAnsiString}
-             stringconstn : (value_str : pstring; labstrnumber : longint);
-{$endif UseAnsiString}
-             typeconvn : (convtyp : tconverttype;explizit : boolean);
-             inlinen : (inlinenumber : longint);
-             procinlinen : (inlineprocdef : pprocdef);
-             setconstrn : (constset : pconstset);
-             loopn : (t1,t2 : ptree;backward : boolean);
-             asmn : (p_asm : paasmoutput);
-             casen : (nodes : pcaserecord;elseblock : ptree);
-             labeln,goton : (labelnr : plabel);
-             withn : (withsymtable : psymtable;tablecount : longint);
-           end; *)
            end;
            end;
          if not error_found then
          if not error_found then
            comment(v_warning,'did not find difference in trees');
            comment(v_warning,'did not find difference in trees');
@@ -1632,18 +1594,18 @@ unit tree;
     function str_length(p : ptree) : longint;
     function str_length(p : ptree) : longint;
 
 
       begin
       begin
-{$ifdef UseAnsiString}
          str_length:=p^.length;
          str_length:=p^.length;
-{$else UseAnsiString}
-         str_length:=length(p^.value_str^);
-{$endif UseAnsiString}
       end;
       end;
 
 
 
 
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.48  1998-10-21 15:12:59  pierre
+  Revision 1.49  1998-11-05 12:03:07  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.48  1998/10/21 15:12:59  pierre
     * bug fix for IOCHECK inside a procedure with iocheck modifier
     * bug fix for IOCHECK inside a procedure with iocheck modifier
     * removed the GPF for unexistant overloading
     * removed the GPF for unexistant overloading
       (firstcall was called with procedinition=nil !)
       (firstcall was called with procedinition=nil !)