Browse Source

* ansistring fixes

peter 27 years ago
parent
commit
5727090134
5 changed files with 221 additions and 175 deletions
  1. 10 8
      rtl/inc/astrings.pp
  2. 106 71
      rtl/inc/sstrings.inc
  3. 74 61
      rtl/inc/systemh.inc
  4. 27 33
      rtl/objpas/sysstr.inc
  5. 4 2
      rtl/objpas/sysstrh.inc

+ 10 - 8
rtl/inc/astrings.pp

@@ -172,16 +172,15 @@ Procedure AssignAnsiString (Var S1 : Pointer;S2 : Pointer);
 {
  Assigns S2 to S1 (S1:=S2), taking in account reference counts.
 }
-
 begin
   If S2<>nil then
     If PAnsiRec(S2-FirstOff)^.Ref>0 then
       Inc(PAnsiRec(S2-FirstOff)^.ref);
-      Temp:=S2;
+{      Temp:=S2;
       end;
     end
   else
-    temp:=S2;
+    temp:=S2; }
   { Decrease the reference count on the old S1 }
   Decr_Ansi_Ref (S1);
   { And finally, have S1 pointing to S2 (or its copy) }
@@ -391,7 +390,7 @@ Procedure SetLength (Var S : AnsiString; l : Longint);
  Makes sure S is unique, and contains enough room.
 }
 Var Temp : Pointer;
-     
+
 begin
    If (Pointer(S)=Nil) and (l>0) then
     begin
@@ -406,7 +405,7 @@ begin
     If (PAnsiRec(Pointer(S)-FirstOff)^.Maxlen < L) or
        (PAnsiRec(Pointer(S)-FirstOff)^.Ref <> 1) then
       begin
-      { Reallocation is needed... }   
+      { Reallocation is needed... }
       Temp:=Pointer(NewAnsiString(L));
       if Length(S)>0 then
         Move (Pointer(S)^,Temp^,Length(S)+1);
@@ -681,7 +680,7 @@ end;
 Procedure Insert (Const Source : AnsiString; Var S : AnsiString; Index : Longint);
 
 var s3,s4,s5 : Pointer;
-    
+
 begin
   If Length(Source)=0 then exit;
   if index <= 0 then index := 1;
@@ -702,7 +701,10 @@ end;
 
 {
   $Log$
-  Revision 1.26  1998-11-02 09:46:12  michael
+  Revision 1.27  1998-11-04 10:20:48  peter
+    * ansistring fixes
+
+  Revision 1.26  1998/11/02 09:46:12  michael
   + Fix for assign of null string
 
   Revision 1.25  1998/10/30 21:42:48  michael
@@ -787,4 +789,4 @@ end;
     * removed logs
     * removed $ifdef ver_above
 
-}
+}

+ 106 - 71
rtl/inc/sstrings.inc

@@ -18,7 +18,7 @@
 
 {$I real2str.inc}
 
-function copy(const s : string;index : StrLenInt;count : StrLenInt): string;
+function copy(const s : shortstring;index : StrLenInt;count : StrLenInt): shortstring;
 begin
   if count<0 then
    count:=0;
@@ -36,7 +36,7 @@ begin
 end;
 
 
-procedure delete(var s : string;index : StrLenInt;count : StrLenInt);
+procedure delete(var s : shortstring;index : StrLenInt;count : StrLenInt);
 begin
   if index<=0 then
    begin
@@ -54,7 +54,7 @@ begin
 end;
 
 
-procedure insert(const source : string;var s : string;index : StrLenInt);
+procedure insert(const source : shortstring;var s : shortstring;index : StrLenInt);
 begin
   if index>1 then
    dec(index)
@@ -64,9 +64,9 @@ begin
 end;
 
 
-function pos(const substr : string;const s : string): byte;
+function pos(const substr : shortstring;const s : shortstring):StrLenInt;
 var
-  i,j : longint;
+  i,j : StrLenInt;
   e   : boolean;
 begin
   i := 0;
@@ -86,9 +86,9 @@ end;
 
 
 {Faster when looking for a single char...}
-function pos(c:char;const s:string):byte;
+function pos(c:char;const s:shortstring):StrLenInt;
 var
-  i : longint;
+  i : StrLenInt;
 begin
   for i:=1 to length(s) do
    if s[i]=c then
@@ -100,10 +100,42 @@ begin
 end;
 
 
+procedure SetLength(var s:shortstring;len:StrLenInt);
+begin
+  if Len>255 then
+   Len:=255;
+  s[0]:=chr(len);
+end;
+
+
+function copy(c:char;index : StrLenInt;count : StrLenInt): shortstring;
+begin
+  if (index=1) and (Count>0) then
+   Copy:=c
+  else
+   Copy:='';
+end;
+
+
+function pos(const substr : shortstring;c:char): StrLenInt;
+begin
+  if (length(substr)=1) and (substr[1]=c) then
+   Pos:=1
+  else
+   Pos:=0;
+end;
+
+
+function length(c:char):StrLenInt;
+begin
+  Length:=1;
+end;
+
+
 {$ifdef IBM_CHAR_SET}
 const
-  UpCaseTbl : string[7]=#154#142#153#144#128#143#165;
-  LoCaseTbl : string[7]=#129#132#148#130#135#134#164;
+  UpCaseTbl : shortstring[7]=#154#142#153#144#128#143#165;
+  LoCaseTbl : shortstring[7]=#129#132#148#130#135#134#164;
 {$endif}
 
 function upcase(c : char) : char;
@@ -129,7 +161,7 @@ begin
 end;
 
 
-function upcase(const s : string) : string;
+function upcase(const s : shortstring) : shortstring;
 var
   i : longint;
 begin
@@ -164,7 +196,7 @@ begin
 end;
 
 
-function lowercase(const s : string) : string;
+function lowercase(const s : shortstring) : shortstring;
 var
   i : longint;
 begin
@@ -174,7 +206,7 @@ begin
 end;
 
 
-function hexstr(val : longint;cnt : byte) : string;
+function hexstr(val : longint;cnt : byte) : shortstring;
 const
   HexTbl : array[0..15] of char='0123456789ABCDEF';
 var
@@ -189,7 +221,7 @@ begin
 end;
 
 
-function binstr(val : longint;cnt : byte) : string;
+function binstr(val : longint;cnt : byte) : shortstring;
 var
   i : longint;
 begin
@@ -204,7 +236,7 @@ end;
 {$endif RTLLITE}
 
 
-function space (b : byte): string;
+function space (b : byte): shortstring;
 begin
   space[0] := chr(b);
   FillChar (Space[1],b,' ');
@@ -215,7 +247,7 @@ end;
                               Str() Helpers
 *****************************************************************************}
 
-procedure int_str_real(d : real;len,fr : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_REAL'{$else}'STR_REAL'{$endif}];
+procedure int_str_real(d : real;len,fr : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_REAL'{$else}'STR_REAL'{$endif}];
 begin
 {$ifdef i386}
    str_real(len,fr,d,rt_s64real,s);
@@ -226,7 +258,7 @@ end;
 
 
 {$ifdef SUPPORT_SINGLE}
-procedure int_str_single(d : single;len,fr : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_SINGLE'{$else}'STR_SINGLE'{$endif}];
+procedure int_str_single(d : single;len,fr : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_SINGLE'{$else}'STR_SINGLE'{$endif}];
 begin
    str_real(len,fr,d,rt_s32real,s);
 end;
@@ -234,7 +266,7 @@ end;
 
 
 {$ifdef SUPPORT_EXTENDED}
-procedure int_str_extended(d : extended;len,fr : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_EXTENDED'{$else}'STR_EXTENDED'{$endif}];
+procedure int_str_extended(d : extended;len,fr : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_EXTENDED'{$else}'STR_EXTENDED'{$endif}];
 begin
    str_real(len,fr,d,rt_s80real,s);
 end;
@@ -242,7 +274,7 @@ end;
 
 
 {$ifdef SUPPORT_COMP}
-procedure int_str_comp(d : comp;len,fr : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_COMP'{$else}'STR_COMP'{$endif}];
+procedure int_str_comp(d : comp;len,fr : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_COMP'{$else}'STR_COMP'{$endif}];
 begin
    str_real(len,fr,d,rt_s64bit,s);
 end;
@@ -250,14 +282,14 @@ end;
 
 
 {$ifdef SUPPORT_FIXED}
-procedure int_str_fixed(d : fixed;len,fr : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_FIXED'{$else}'STR_FIXED'{$endif}];
+procedure int_str_fixed(d : fixed;len,fr : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_FIXED'{$else}'STR_FIXED'{$endif}];
 begin
    str_real(len,fr,d,rt_f32bit,s);
 end;
 {$endif SUPPORT_FIXED}
 
 
-procedure int_str_longint(v : longint;len : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_LONGINT'{$else}'STR_LONGINT'{$endif}];
+procedure int_str_longint(v : longint;len : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_LONGINT'{$else}'STR_LONGINT'{$endif}];
 begin
    int_str(v,s);
    if length(s)<len then
@@ -265,7 +297,7 @@ begin
 end;
 
 
-procedure int_str_cardinal(v : cardinal;len : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_CARDINAL'{$else}'STR_CARDINAL'{$endif}];
+procedure int_str_cardinal(v : cardinal;len : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_CARDINAL'{$else}'STR_CARDINAL'{$endif}];
 begin
   int_str(v,s);
   if length(s)<len then
@@ -277,7 +309,7 @@ end;
                            Val() Functions
 *****************************************************************************}
 
-Function InitVal(const s:string;var negativ:boolean;var base:byte):Word;
+Function InitVal(const s:shortstring;var negativ:boolean;var base:byte):Word;
 var
   Code : Longint;
 begin
@@ -317,7 +349,7 @@ begin
 end;
 
 
-procedure val(const s : string;var l : longint;var code : word);
+procedure val(const s : shortstring;var l : longint;var code : word);
 var
   base,u  : byte;
   negativ : boolean;
@@ -357,13 +389,13 @@ begin
 end;
 
 
-procedure val(const s : string;var l : longint;var code : integer);
+procedure val(const s : shortstring;var l : longint;var code : integer);
 begin
   val(s,l,word(code));
 end;
 
 
-procedure val(const s : string;var l : longint;var code : longint);
+procedure val(const s : shortstring;var l : longint;var code : longint);
 var
   cw : word;
 begin
@@ -372,7 +404,7 @@ begin
 end;
 
 
-procedure val(const s : string;var l : longint);
+procedure val(const s : shortstring;var l : longint);
 var
   code : word;
 begin
@@ -380,7 +412,7 @@ begin
 end;
 
 
-procedure val(const s : string;var b : byte);
+procedure val(const s : shortstring;var b : byte);
 var
   l : longint;
 begin
@@ -389,7 +421,7 @@ begin
 end;
 
 
-procedure val(const s : string;var b : byte;var code : word);
+procedure val(const s : shortstring;var b : byte;var code : word);
 var
   l : longint;
 begin
@@ -398,13 +430,13 @@ begin
 end;
 
 
-procedure val(const s : string;var b : byte;var code : Integer);
+procedure val(const s : shortstring;var b : byte;var code : Integer);
 begin
   val(s,b,word(code));
 end;
 
 
-procedure val(const s : string;var b : byte;var code : longint);
+procedure val(const s : shortstring;var b : byte;var code : longint);
 var
   l : longint;
 begin
@@ -413,7 +445,7 @@ begin
 end;
 
 
-procedure val(const s : string;var b : shortint);
+procedure val(const s : shortstring;var b : shortint);
 var
   l : longint;
 begin
@@ -422,7 +454,7 @@ begin
 end;
 
 
-procedure val(const s : string;var b : shortint;var code : word);
+procedure val(const s : shortstring;var b : shortint;var code : word);
 var
   l : longint;
 begin
@@ -431,13 +463,13 @@ begin
 end;
 
 
-procedure val(const s : string;var b : shortint;var code : Integer);
+procedure val(const s : shortstring;var b : shortint;var code : Integer);
 begin
   val(s,b,word(code));
 end;
 
 
-procedure val(const s : string;var b : shortint;var code : longint);
+procedure val(const s : shortstring;var b : shortint;var code : longint);
 var
   l : longint;
 begin
@@ -446,7 +478,7 @@ begin
 end;
 
 
-procedure val(const s : string;var b : word);
+procedure val(const s : shortstring;var b : word);
 var
   l : longint;
 begin
@@ -455,7 +487,7 @@ begin
 end;
 
 
-procedure val(const s : string;var b : word;var code : word);
+procedure val(const s : shortstring;var b : word;var code : word);
 var
   l : longint;
 begin
@@ -464,13 +496,13 @@ begin
 end;
 
 
-procedure val(const s : string;var b : word;var code : Integer);
+procedure val(const s : shortstring;var b : word;var code : Integer);
 begin
   val(s,b,word(code));
 end;
 
 
-procedure val(const s : string;var b : word;var code : longint);
+procedure val(const s : shortstring;var b : word;var code : longint);
 var
   l : longint;
 begin
@@ -479,7 +511,7 @@ begin
 end;
 
 
-procedure val(const s : string;var b : integer);
+procedure val(const s : shortstring;var b : integer);
 var
   l : longint;
 begin
@@ -488,7 +520,7 @@ begin
 end;
 
 
-procedure val(const s : string;var b : integer;var code : word);
+procedure val(const s : shortstring;var b : integer;var code : word);
 var
   l : longint;
 begin
@@ -497,13 +529,13 @@ begin
 end;
 
 
-procedure val(const s : string;var b : integer;var code : Integer);
+procedure val(const s : shortstring;var b : integer;var code : Integer);
 begin
   val(s,b,word(code));
 end;
 
 
-procedure val(const s : string;var b : integer;var code : longint);
+procedure val(const s : shortstring;var b : integer;var code : longint);
 var
   l : longint;
 begin
@@ -512,7 +544,7 @@ begin
 end;
 
 
-procedure val(const s : string;var v : cardinal;var code : word);
+procedure val(const s : shortstring;var v : cardinal;var code : word);
 var
   negativ : boolean;
   base,u  : byte;
@@ -544,7 +576,7 @@ begin
 end;
 
 
-procedure val(const s : string;var v : cardinal);
+procedure val(const s : shortstring;var v : cardinal);
 var
   code : word;
 begin
@@ -552,13 +584,13 @@ begin
 end;
 
 
-procedure val(const s : string;var v : cardinal;var code : integer);
+procedure val(const s : shortstring;var v : cardinal;var code : integer);
 begin
   val(s,v,word(code));
 end;
 
 
-procedure val(const s : string;var v : cardinal;var code : longint);
+procedure val(const s : shortstring;var v : cardinal;var code : longint);
 var
   cw : word;
 begin
@@ -567,7 +599,7 @@ begin
 end;
 
 
-procedure val(const s : string;var d : valreal;var code : word);
+procedure val(const s : shortstring;var d : valreal;var code : word);
 var
   hd,
   esign,sign : valreal;
@@ -667,13 +699,13 @@ begin
 end;
 
 
-procedure val(const s : string;var d : valreal;var code : integer);
+procedure val(const s : shortstring;var d : valreal;var code : integer);
 begin
   val(s,d,word(code));
 end;
 
 
-procedure val(const s : string;var d : valreal;var code : longint);
+procedure val(const s : shortstring;var d : valreal;var code : longint);
 var
   cw : word;
 begin
@@ -682,7 +714,7 @@ begin
 end;
 
 
-procedure val(const s : string;var d : valreal);
+procedure val(const s : shortstring;var d : valreal);
 var
   code : word;
 begin
@@ -691,7 +723,7 @@ end;
 
 
 {$ifdef SUPPORT_SINGLE}
-procedure val(const s : string;var d : single;var code : word);
+procedure val(const s : shortstring;var d : single;var code : word);
 var
   e : valreal;
 begin
@@ -700,7 +732,7 @@ begin
 end;
 
 
-procedure val(const s : string;var d : single;var code : integer);
+procedure val(const s : shortstring;var d : single;var code : integer);
 var
   e : valreal;
 begin
@@ -709,7 +741,7 @@ begin
 end;
 
 
-procedure val(const s : string;var d : single;var code : longint);
+procedure val(const s : shortstring;var d : single;var code : longint);
 var
   cw : word;
   e  : valreal;
@@ -720,7 +752,7 @@ begin
 end;
 
 
-procedure val(const s : string;var d : single);
+procedure val(const s : shortstring;var d : single);
 var
   code : word;
   e    : valreal;
@@ -736,7 +768,7 @@ end;
   { with extended as default the valreal is extended so for real there need
     to be a new val }
 
-  procedure val(const s : string;var d : real;var code : word);
+  procedure val(const s : shortstring;var d : real;var code : word);
   var
     e : valreal;
   begin
@@ -745,7 +777,7 @@ end;
   end;
 
 
-  procedure val(const s : string;var d : real;var code : integer);
+  procedure val(const s : shortstring;var d : real;var code : integer);
   var
     e : valreal;
   begin
@@ -754,7 +786,7 @@ end;
   end;
 
 
-  procedure val(const s : string;var d : real;var code : longint);
+  procedure val(const s : shortstring;var d : real;var code : longint);
   var
     cw : word;
     e  : valreal;
@@ -765,7 +797,7 @@ end;
   end;
 
 
-  procedure val(const s : string;var d : real);
+  procedure val(const s : shortstring;var d : real);
   var
     code : word;
     e    : valreal;
@@ -780,7 +812,7 @@ end;
 
   {$ifdef SUPPORT_EXTENDED}
 
-  procedure val(const s : string;var d : extended;var code : word);
+  procedure val(const s : shortstring;var d : extended;var code : word);
   var
     e : valreal;
   begin
@@ -788,7 +820,7 @@ end;
     d:=e;
   end;
 
-  procedure val(const s : string;var d : extended;var code : integer);
+  procedure val(const s : shortstring;var d : extended;var code : integer);
   var
     e : valreal;
   begin
@@ -796,7 +828,7 @@ end;
     d:=e;
   end;
 
-  procedure val(const s : string;var d : extended;var code : longint);
+  procedure val(const s : shortstring;var d : extended;var code : longint);
   var
     cw : word;
     e  : valreal;
@@ -806,7 +838,7 @@ end;
     code:=cw;
   end;
 
-  procedure val(const s : string;var d : extended);
+  procedure val(const s : shortstring;var d : extended);
   var
     code : word;
     e    : valreal;
@@ -821,7 +853,7 @@ end;
 
 
 {$ifdef SUPPORT_COMP}
-procedure val(const s : string;var d : comp;var code : word);
+procedure val(const s : shortstring;var d : comp;var code : word);
 var
   e : valreal;
 begin
@@ -830,7 +862,7 @@ begin
 end;
 
 
-procedure val(const s : string;var d : comp;var code : integer);
+procedure val(const s : shortstring;var d : comp;var code : integer);
 var
   e : valreal;
 begin
@@ -839,7 +871,7 @@ begin
 end;
 
 
-procedure val(const s : string;var d : comp;var code : longint);
+procedure val(const s : shortstring;var d : comp;var code : longint);
 var
   cw : word;
   e  : valreal;
@@ -850,7 +882,7 @@ begin
 end;
 
 
-procedure val(const s : string;var d : comp);
+procedure val(const s : shortstring;var d : comp);
 var
   code : word;
   e    : valreal;
@@ -862,7 +894,7 @@ end;
 
 
 {$ifdef SUPPORT_FIXED}
-procedure val(const s : string;var d : fixed;var code : word);
+procedure val(const s : shortstring;var d : fixed;var code : word);
 var
   e : valreal;
 begin
@@ -871,7 +903,7 @@ begin
 end;
 
 
-procedure val(const s : string;var d : fixed;var code : integer);
+procedure val(const s : shortstring;var d : fixed;var code : integer);
 var
   e : valreal;
 begin
@@ -880,7 +912,7 @@ begin
 end;
 
 
-procedure val(const s : string;var d : fixed;var code : longint);
+procedure val(const s : shortstring;var d : fixed;var code : longint);
 var
   cw : word;
   e  : valreal;
@@ -891,7 +923,7 @@ begin
 end;
 
 
-procedure val(const s : string;var d : fixed);
+procedure val(const s : shortstring;var d : fixed);
 var
   code : word;
   e    : valreal;
@@ -904,7 +936,10 @@ end;
 
 {
   $Log$
-  Revision 1.14  1998-10-11 14:30:19  peter
+  Revision 1.15  1998-11-04 10:20:50  peter
+    * ansistring fixes
+
+  Revision 1.14  1998/10/11 14:30:19  peter
     * small typo :(
 
   Revision 1.13  1998/10/10 15:28:46  peter

+ 74 - 61
rtl/inc/systemh.inc

@@ -67,7 +67,9 @@ Type
 { some type aliases }
   dword       = cardinal;
   longword    = cardinal;
-  ShortString = String[255];
+{$ifndef useansistrings}
+  shortstring = string;
+{$endif}
 
 { Zero - terminated strings }
   PChar       = ^Char;
@@ -182,80 +184,88 @@ Function  Sseg:Word;
                       PChar and String Handling
 ****************************************************************************}
 
-function strpas(p:pchar):string;
+function strpas(p:pchar):shortstring;
 function strlen(p:pchar):longint;
 
-Function  Copy(const s:string;index:StrLenInt;count:StrLenInt):string;
-Procedure Delete(Var s:string;index:StrLenInt;count:StrLenInt);
-Procedure Insert(const source:string;Var s:string;index:StrLenInt);
-Function  Pos(const substr:string;const s:string):byte;
-Function  Pos(C:Char;const s:string):byte;
+{ Shortstring functions }
+Function  Copy(const s:shortstring;index:StrLenInt;count:StrLenInt):shortstring;
+Procedure Delete(Var s:shortstring;index:StrLenInt;count:StrLenInt);
+Procedure Insert(const source:shortstring;Var s:shortstring;index:StrLenInt);
+Function  Pos(const substr:shortstring;const s:shortstring):StrLenInt;
+Function  Pos(C:Char;const s:shortstring):StrLenInt;
+Procedure SetLength(var s:shortstring;len:StrLenInt);
+
+{ Char functions to overcome overloading problem with ansistrings }
+function  copy(c:char;index : StrLenInt;count : StrLenInt): shortstring;
+function  pos(const substr : shortstring;c:char): StrLenInt;
+function  length(c:char):StrLenInt;
+
+Function  upCase(const s:shortstring):shortstring;
 Function  upCase(c:Char):Char;
-Function  upCase(const s:string):string;
 {$ifndef RTLLITE}
 Function  lowerCase(c:Char):Char;
-Function  lowerCase(const s:string):string;
-Function  hexStr(Val:Longint;cnt:byte):string;
-Function  binStr(Val:Longint;cnt:byte):string;
+Function  lowerCase(const s:shortstring):shortstring;
+Function  hexStr(Val:Longint;cnt:byte):shortstring;
+Function  binStr(Val:Longint;cnt:byte):shortstring;
 {$endif RTLLITE}
-Function  Space(b:byte):string;
-Procedure Val(const s:string;Var l:Longint;Var code:Word);
-Procedure Val(const s:string;Var l:Longint;Var code:Integer);
-Procedure Val(const s:string;Var l:Longint;Var code:Longint);
-Procedure Val(const s:string;Var l:Longint);
-Procedure Val(const s:string;Var b:byte;Var code:Word);
-Procedure Val(const s:string;Var b:byte;Var code:Integer);
-Procedure Val(const s:string;Var b:byte;Var code:Longint);
-Procedure Val(const s:string;Var b:byte);
-Procedure Val(const s:string;Var b:shortint;Var code:Word);
-Procedure Val(const s:string;Var b:shortint;Var code:Integer);
-Procedure Val(const s:string;Var b:shortint;Var code:Longint);
-Procedure Val(const s:string;Var b:shortint);
-Procedure Val(const s:string;Var b:Word;Var code:Word);
-Procedure Val(const s:string;Var b:Word;Var code:Integer);
-Procedure Val(const s:string;Var b:Word;Var code:Longint);
-Procedure Val(const s:string;Var b:Word);
-Procedure Val(const s:string;Var b:Integer;Var code:Word);
-Procedure Val(const s:string;Var b:Integer;Var code:Integer);
-Procedure Val(const s:string;Var b:Integer;Var code:Longint);
-Procedure Val(const s:string;Var b:Integer);
-Procedure Val(const s:string;Var v:cardinal;Var code:Word);
-Procedure Val(const s:string;Var v:cardinal;Var code:Integer);
-Procedure Val(const s:string;Var v:cardinal;Var code:Longint);
-Procedure Val(const s:string;Var v:cardinal);
-Procedure Val(const s:string;Var d:ValReal;Var code:Word);
-Procedure Val(const s:string;Var d:ValReal;Var code:Integer);
-Procedure Val(const s:string;Var d:ValReal;Var code:Longint);
-Procedure Val(const s:string;Var d:ValReal);
+Function  Space(b:byte):shortstring;
+Procedure Val(const s:shortstring;Var l:Longint;Var code:Word);
+Procedure Val(const s:shortstring;Var l:Longint;Var code:Integer);
+Procedure Val(const s:shortstring;Var l:Longint;Var code:Longint);
+Procedure Val(const s:shortstring;Var l:Longint);
+Procedure Val(const s:shortstring;Var b:byte;Var code:Word);
+Procedure Val(const s:shortstring;Var b:byte;Var code:Integer);
+Procedure Val(const s:shortstring;Var b:byte;Var code:Longint);
+Procedure Val(const s:shortstring;Var b:byte);
+Procedure Val(const s:shortstring;Var b:shortint;Var code:Word);
+Procedure Val(const s:shortstring;Var b:shortint;Var code:Integer);
+Procedure Val(const s:shortstring;Var b:shortint;Var code:Longint);
+Procedure Val(const s:shortstring;Var b:shortint);
+Procedure Val(const s:shortstring;Var b:Word;Var code:Word);
+Procedure Val(const s:shortstring;Var b:Word;Var code:Integer);
+Procedure Val(const s:shortstring;Var b:Word;Var code:Longint);
+Procedure Val(const s:shortstring;Var b:Word);
+Procedure Val(const s:shortstring;Var b:Integer;Var code:Word);
+Procedure Val(const s:shortstring;Var b:Integer;Var code:Integer);
+Procedure Val(const s:shortstring;Var b:Integer;Var code:Longint);
+Procedure Val(const s:shortstring;Var b:Integer);
+Procedure Val(const s:shortstring;Var v:cardinal;Var code:Word);
+Procedure Val(const s:shortstring;Var v:cardinal;Var code:Integer);
+Procedure Val(const s:shortstring;Var v:cardinal;Var code:Longint);
+Procedure Val(const s:shortstring;Var v:cardinal);
+Procedure Val(const s:shortstring;Var d:ValReal;Var code:Word);
+Procedure Val(const s:shortstring;Var d:ValReal;Var code:Integer);
+Procedure Val(const s:shortstring;Var d:ValReal;Var code:Longint);
+Procedure Val(const s:shortstring;Var d:ValReal);
 {$ifdef SUPPORT_SINGLE}
-  Procedure Val(const s:string;Var d:single;Var code:Word);
-  Procedure Val(const s:string;Var d:single;Var code:Integer);
-  Procedure Val(const s:string;Var d:single;Var code:Longint);
-  Procedure Val(const s:string;Var d:single);
+  Procedure Val(const s:shortstring;Var d:single;Var code:Word);
+  Procedure Val(const s:shortstring;Var d:single;Var code:Integer);
+  Procedure Val(const s:shortstring;Var d:single;Var code:Longint);
+  Procedure Val(const s:shortstring;Var d:single);
 {$endif SUPPORT_SINGLE}
 {$ifdef SUPPORT_COMP}
-  Procedure Val(const s:string;Var d:comp;Var code:Word);
-  Procedure Val(const s:string;Var d:comp;Var code:Integer);
-  Procedure Val(const s:string;Var d:comp;Var code:Longint);
-  Procedure Val(const s:string;Var d:comp);
+  Procedure Val(const s:shortstring;Var d:comp;Var code:Word);
+  Procedure Val(const s:shortstring;Var d:comp;Var code:Integer);
+  Procedure Val(const s:shortstring;Var d:comp;Var code:Longint);
+  Procedure Val(const s:shortstring;Var d:comp);
 {$endif SUPPORT_COMP}
 {$ifdef SUPPORT_FIXED}
-  Procedure Val(const s:string;Var d:fixed;Var code:Word);
-  Procedure Val(const s:string;Var d:fixed;Var code:Integer);
-  Procedure Val(const s:string;Var d:fixed;Var code:Longint);
-  Procedure Val(const s:string;Var d:fixed);
+  Procedure Val(const s:shortstring;Var d:fixed;Var code:Word);
+  Procedure Val(const s:shortstring;Var d:fixed;Var code:Integer);
+  Procedure Val(const s:shortstring;Var d:fixed;Var code:Longint);
+  Procedure Val(const s:shortstring;Var d:fixed);
 {$endif SUPPORT_FIXED}
 {$ifdef DEFAULT_EXTENDED}
-  Procedure Val(const s:string;Var d:Real;Var code:Word);
-  Procedure Val(const s:string;Var d:Real;Var code:Integer);
-  Procedure Val(const s:string;Var d:Real;Var code:Longint);
-  Procedure Val(const s:string;Var d:Real);
+  Procedure Val(const s:shortstring;Var d:Real;Var code:Word);
+  Procedure Val(const s:shortstring;Var d:Real;Var code:Integer);
+  Procedure Val(const s:shortstring;Var d:Real;Var code:Longint);
+  Procedure Val(const s:shortstring;Var d:Real);
 {$else DEFAULT_EXTENDED}
   {$ifdef SUPPORT_EXTENDED}
-    Procedure Val(const s:string;Var d:Extended;Var code:Word);
-    Procedure Val(const s:string;Var d:Extended;Var code:Integer);
-    Procedure Val(const s:string;Var d:Extended;Var code:Longint);
-    Procedure Val(const s:string;Var d:Extended);
+    Procedure Val(const s:shortstring;Var d:Extended;Var code:Word);
+    Procedure Val(const s:shortstring;Var d:Extended;Var code:Integer);
+    Procedure Val(const s:shortstring;Var d:Extended;Var code:Longint);
+    Procedure Val(const s:shortstring;Var d:Extended);
   {$endif}
 {$endif DEFAULT_EXTENDED}
 
@@ -422,7 +432,10 @@ const
 
 {
   $Log$
-  Revision 1.37  1998-10-10 15:28:47  peter
+  Revision 1.38  1998-11-04 10:20:51  peter
+    * ansistring fixes
+
+  Revision 1.37  1998/10/10 15:28:47  peter
     + read single,fixed
     + val with code:longint
     + val for fixed

+ 27 - 33
rtl/objpas/sysstr.inc

@@ -453,7 +453,7 @@ begin
  Writeln (S);
  {$endif}
 end;
-   
+
 Procedure DoFormatError (ErrCode : Longint);
 
 Var S : String;
@@ -484,28 +484,28 @@ Var ChPos,OldPos,ArgPos,DoArg,Len : Longint;
 
   {
     ReadFormat reads the format string. It returns the type character in
-    uppercase, and sets index, Width, Prec to their correct values, 
-    or -1 if not set. It sets Left to true if left alignment was requested. 
+    uppercase, and sets index, Width, Prec to their correct values,
+    or -1 if not set. It sets Left to true if left alignment was requested.
     In case of an error, DoFormatError is called.
   }
-      
+
   Function ReadFormat : Char;
 
   Var Value : longint;
 
-    Procedure ReadInteger;	
+    Procedure ReadInteger;
 
     Var Code : Word;
 
     begin
       If Value<>-1 then exit; // Was already read.
       OldPos:=chPos;
-      While (Chpos<Len) and 
+      While (Chpos<Len) and
             (Pos(Fmt[chpos],'1234567890')<>0) do inc(chpos);
       If Chpos=len then DoFormatError(feInvalidFormat);
-      If Fmt[Chpos]='*' then 
+      If Fmt[Chpos]='*' then
         begin
-        If (Chpos>OldPos) or (ArgPos>High(Args)) 
+        If (Chpos>OldPos) or (ArgPos>High(Args))
            or (Args[ArgPos].Vtype<>vtInteger) then
           DoFormatError(feInvalidFormat);
         Value:=Args[ArgPos].VInteger;
@@ -542,7 +542,7 @@ Var ChPos,OldPos,ArgPos,DoArg,Len : Longint;
     Procedure ReadLeft;
 
     begin
-      If Fmt[chpos]='-' then 
+      If Fmt[chpos]='-' then
         begin
         left:=True;
         Inc(chpos);
@@ -559,7 +559,7 @@ Var ChPos,OldPos,ArgPos,DoArg,Len : Longint;
       If Value<>-1 then
         begin
         Width:=Value;
-        Value:=-1;	
+        Value:=-1;
         end;
       Log ('Read width');
     end;
@@ -611,7 +611,7 @@ Procedure Checkarg (AT : Longint);
   DoArg is set to the argument that must be used.
 }
 begin
-  If Index=-1 then 
+  If Index=-1 then
     begin
     DoArg:=Argpos;
     inc(ArgPos);
@@ -623,7 +623,7 @@ begin
 end;
 
 Const Zero = '000000000000000000000000000000000000000000000000000000000000000';
-    
+
 begin
   Result:='';
   Len:=Length(Fmt)+1;
@@ -634,7 +634,7 @@ begin
     begin
     // uses shortcut evaluation !!
     While (ChPos<=Len) and (Fmt[chpos]<>'%') do inc(chpos);
-    If ChPos>OldPos Then 
+    If ChPos>OldPos Then
       Result:=Result+Copy(Fmt,OldPos,Chpos-Oldpos);
     If ChPos<Len then
       begin
@@ -661,7 +661,7 @@ begin
               Prec:=Prec+5;   // correct dot, eXXX
               If ExtVal<0 then Inc(Prec); // Corect for minus sign
               If Abs(Extval)<1 then Inc(Prec); // correct for - in E
-              Writeln('STRING ',prec); 
+              Writeln('STRING ',prec);
               Str(Args[doarg].VExtended^:prec,ToAdd);
               WRITELN('DID');
               end;
@@ -682,15 +682,15 @@ begin
               end;
         'X' : begin
               Checkarg(vtinteger);
-              If Prec>32 then 
+              If Prec>32 then
                 ToAdd:=HexStr(Args[Doarg].VInteger,Prec)
               else
                 begin
                 // determine minimum needed number of hex digits.
                 Index:=1;
-                While (1 shl (Index*4))<Args[DoArg].VInteger do 
+                While (1 shl (Index*4))<Args[DoArg].VInteger do
                   inc(Index);
-                If Index>Prec then 
+                If Index>Prec then
                   Prec:=Index;
                 ToAdd:=HexStr(Args[DoArg].VInteger,Prec);
                 end;
@@ -700,11 +700,11 @@ begin
       end;
       If Width<>-1 then
         If Length(ToAdd)<Width then
-          If not Left then 
+          If not Left then
             ToAdd:=Space(Width-Length(ToAdd))+ToAdd
           else
             ToAdd:=ToAdd+space(Width-Length(ToAdd));
-      Result:=Result+ToAdd; 
+      Result:=Result+ToAdd;
       end;
     inc(chpos);
     Oldpos:=chpos;
@@ -716,18 +716,6 @@ end;
 {   extra functions                                                            }
 {==============================================================================}
 
-{   SetLength sets the length of S to NewLength   }
-//  SetLength should be in the system unit
-//  which lacks the ShortString version of SetLength
-
-function SetLength(var S: string; NewLength: integer): integer;
-begin
-if (NewLength > 255) then
-   NewLength := 255;
-S[0] := char(NewLength);
-Result := Ord(S[0]);
-end ;
-
 {   LeftStr returns Count left-most characters from S   }
 
 function LeftStr(const S: string; Count: integer): string;
@@ -906,7 +894,10 @@ end ;
 
 {
   $Log$
-  Revision 1.8  1998-10-02 13:57:38  michael
+  Revision 1.9  1998-11-04 10:20:52  peter
+    * ansistring fixes
+
+  Revision 1.8  1998/10/02 13:57:38  michael
   Format error now causes exception
 
   Revision 1.7  1998/10/02 12:17:17  michael
@@ -929,7 +920,10 @@ end ;
   Update from gertjan Schouten, plus small fix for linux
 
   $Log$
-  Revision 1.8  1998-10-02 13:57:38  michael
+  Revision 1.9  1998-11-04 10:20:52  peter
+    * ansistring fixes
+
+  Revision 1.8  1998/10/02 13:57:38  michael
   Format error now causes exception
 
   Revision 1.7  1998/10/02 12:17:17  michael

+ 4 - 2
rtl/objpas/sysstrh.inc

@@ -77,14 +77,16 @@ Function Format (Const Fmt : String; const Args : Array of const) : String;
 {   extra functions                                                            }
 {==============================================================================}
 
-function SetLength(var S: string; NewLength: integer): integer; // should be in the system unit
 function LeftStr(const S: string; Count: integer): string;
 function RightStr(const S: string; Count: integer): string;
 function BCDToInt(Value: integer): integer;
 
 {
   $Log$
-  Revision 1.3  1998-11-02 12:53:53  michael
+  Revision 1.4  1998-11-04 10:20:53  peter
+    * ansistring fixes
+
+  Revision 1.3  1998/11/02 12:53:53  michael
   + Added format function
 
   Revision 1.2  1998/09/16 08:28:43  michael