paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-28 15:20:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* ansistring fixes

Browse Source
This commit is contained in:
peter 1998-11-04 10:20:48 +00:00
parent 7469443729
commit 5727090134
5 changed files with 221 additions and 175 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
rtl/inc/astrings.pp
View File

@ -172,16 +172,15 @@ Procedure AssignAnsiString (Var S1 : Pointer;S2 : Pointer);
{ {
Assigns S2 to S1 (S1:=S2), taking in account reference counts. Assigns S2 to S1 (S1:=S2), taking in account reference counts.
} }
begin begin
If S2<>nil then If S2<>nil then
If PAnsiRec(S2-FirstOff)^.Ref>0 then If PAnsiRec(S2-FirstOff)^.Ref>0 then
Inc(PAnsiRec(S2-FirstOff)^.ref); Inc(PAnsiRec(S2-FirstOff)^.ref);
Temp:=S2; { Temp:=S2;
end; end;
end end
else else
temp:=S2; temp:=S2; }
{ Decrease the reference count on the old S1 } { Decrease the reference count on the old S1 }
Decr_Ansi_Ref (S1); Decr_Ansi_Ref (S1);
{ And finally, have S1 pointing to S2 (or its copy) } { And finally, have S1 pointing to S2 (or its copy) }
@ -702,7 +701,10 @@ end;
{ {
$Log$ $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 + Fix for assign of null string
Revision 1.25 1998/10/30 21:42:48 michael Revision 1.25 1998/10/30 21:42:48 michael

177
rtl/inc/sstrings.inc
View File

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

135
rtl/inc/systemh.inc
View File

@ -67,7 +67,9 @@ Type
{ some type aliases } { some type aliases }
dword = cardinal; dword = cardinal;
longword = cardinal; longword = cardinal;
ShortString = String[255]; {$ifndef useansistrings}
shortstring = string;
{$endif}
{ Zero - terminated strings } { Zero - terminated strings }
PChar = ^Char; PChar = ^Char;
@ -182,80 +184,88 @@ Function Sseg:Word;
PChar and String Handling PChar and String Handling
****************************************************************************} ****************************************************************************}
function strpas(p:pchar):string; function strpas(p:pchar):shortstring;
function strlen(p:pchar):longint; function strlen(p:pchar):longint;
Function Copy(const s:string;index:StrLenInt;count:StrLenInt):string; { Shortstring functions }
Procedure Delete(Var s:string;index:StrLenInt;count:StrLenInt); Function Copy(const s:shortstring;index:StrLenInt;count:StrLenInt):shortstring;
Procedure Insert(const source:string;Var s:string;index:StrLenInt); Procedure Delete(Var s:shortstring;index:StrLenInt;count:StrLenInt);
Function Pos(const substr:string;const s:string):byte; Procedure Insert(const source:shortstring;Var s:shortstring;index:StrLenInt);
Function Pos(C:Char;const s:string):byte; 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(c:Char):Char;
Function upCase(const s:string):string;
{$ifndef RTLLITE} {$ifndef RTLLITE}
Function lowerCase(c:Char):Char; Function lowerCase(c:Char):Char;
Function lowerCase(const s:string):string; Function lowerCase(const s:shortstring):shortstring;
Function hexStr(Val:Longint;cnt:byte):string; Function hexStr(Val:Longint;cnt:byte):shortstring;
Function binStr(Val:Longint;cnt:byte):string; Function binStr(Val:Longint;cnt:byte):shortstring;
{$endif RTLLITE} {$endif RTLLITE}
Function Space(b:byte):string; Function Space(b:byte):shortstring;
Procedure Val(const s:string;Var l:Longint;Var code:Word); Procedure Val(const s:shortstring;Var l:Longint;Var code:Word);
Procedure Val(const s:string;Var l:Longint;Var code:Integer); Procedure Val(const s:shortstring;Var l:Longint;Var code:Integer);
Procedure Val(const s:string;Var l:Longint;Var code:Longint); Procedure Val(const s:shortstring;Var l:Longint;Var code:Longint);
Procedure Val(const s:string;Var l:Longint); Procedure Val(const s:shortstring;Var l:Longint);
Procedure Val(const s:string;Var b:byte;Var code:Word); Procedure Val(const s:shortstring;Var b:byte;Var code:Word);
Procedure Val(const s:string;Var b:byte;Var code:Integer); Procedure Val(const s:shortstring;Var b:byte;Var code:Integer);
Procedure Val(const s:string;Var b:byte;Var code:Longint); Procedure Val(const s:shortstring;Var b:byte;Var code:Longint);
Procedure Val(const s:string;Var b:byte); Procedure Val(const s:shortstring;Var b:byte);
Procedure Val(const s:string;Var b:shortint;Var code:Word); Procedure Val(const s:shortstring;Var b:shortint;Var code:Word);
Procedure Val(const s:string;Var b:shortint;Var code:Integer); Procedure Val(const s:shortstring;Var b:shortint;Var code:Integer);
Procedure Val(const s:string;Var b:shortint;Var code:Longint); Procedure Val(const s:shortstring;Var b:shortint;Var code:Longint);
Procedure Val(const s:string;Var b:shortint); Procedure Val(const s:shortstring;Var b:shortint);
Procedure Val(const s:string;Var b:Word;Var code:Word); Procedure Val(const s:shortstring;Var b:Word;Var code:Word);
Procedure Val(const s:string;Var b:Word;Var code:Integer); Procedure Val(const s:shortstring;Var b:Word;Var code:Integer);
Procedure Val(const s:string;Var b:Word;Var code:Longint); Procedure Val(const s:shortstring;Var b:Word;Var code:Longint);
Procedure Val(const s:string;Var b:Word); Procedure Val(const s:shortstring;Var b:Word);
Procedure Val(const s:string;Var b:Integer;Var code:Word); Procedure Val(const s:shortstring;Var b:Integer;Var code:Word);
Procedure Val(const s:string;Var b:Integer;Var code:Integer); Procedure Val(const s:shortstring;Var b:Integer;Var code:Integer);
Procedure Val(const s:string;Var b:Integer;Var code:Longint); Procedure Val(const s:shortstring;Var b:Integer;Var code:Longint);
Procedure Val(const s:string;Var b:Integer); Procedure Val(const s:shortstring;Var b:Integer);
Procedure Val(const s:string;Var v:cardinal;Var code:Word); Procedure Val(const s:shortstring;Var v:cardinal;Var code:Word);
Procedure Val(const s:string;Var v:cardinal;Var code:Integer); Procedure Val(const s:shortstring;Var v:cardinal;Var code:Integer);
Procedure Val(const s:string;Var v:cardinal;Var code:Longint); Procedure Val(const s:shortstring;Var v:cardinal;Var code:Longint);
Procedure Val(const s:string;Var v:cardinal); Procedure Val(const s:shortstring;Var v:cardinal);
Procedure Val(const s:string;Var d:ValReal;Var code:Word); Procedure Val(const s:shortstring;Var d:ValReal;Var code:Word);
Procedure Val(const s:string;Var d:ValReal;Var code:Integer); Procedure Val(const s:shortstring;Var d:ValReal;Var code:Integer);
Procedure Val(const s:string;Var d:ValReal;Var code:Longint); Procedure Val(const s:shortstring;Var d:ValReal;Var code:Longint);
Procedure Val(const s:string;Var d:ValReal); Procedure Val(const s:shortstring;Var d:ValReal);
{$ifdef SUPPORT_SINGLE} {$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);
Procedure Val(const s:string;Var d:single;Var code:Integer); Procedure Val(const s:shortstring;Var d:single;Var code:Integer);
Procedure Val(const s:string;Var d:single;Var code:Longint); Procedure Val(const s:shortstring;Var d:single;Var code:Longint);
Procedure Val(const s:string;Var d:single); Procedure Val(const s:shortstring;Var d:single);
{$endif SUPPORT_SINGLE} {$endif SUPPORT_SINGLE}
{$ifdef SUPPORT_COMP} {$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);
Procedure Val(const s:string;Var d:comp;Var code:Integer); Procedure Val(const s:shortstring;Var d:comp;Var code:Integer);
Procedure Val(const s:string;Var d:comp;Var code:Longint); Procedure Val(const s:shortstring;Var d:comp;Var code:Longint);
Procedure Val(const s:string;Var d:comp); Procedure Val(const s:shortstring;Var d:comp);
{$endif SUPPORT_COMP} {$endif SUPPORT_COMP}
{$ifdef SUPPORT_FIXED} {$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);
Procedure Val(const s:string;Var d:fixed;Var code:Integer); Procedure Val(const s:shortstring;Var d:fixed;Var code:Integer);
Procedure Val(const s:string;Var d:fixed;Var code:Longint); Procedure Val(const s:shortstring;Var d:fixed;Var code:Longint);
Procedure Val(const s:string;Var d:fixed); Procedure Val(const s:shortstring;Var d:fixed);
{$endif SUPPORT_FIXED} {$endif SUPPORT_FIXED}
{$ifdef DEFAULT_EXTENDED} {$ifdef DEFAULT_EXTENDED}
Procedure Val(const s:string;Var d:Real;Var code:Word); Procedure Val(const s:shortstring;Var d:Real;Var code:Word);
Procedure Val(const s:string;Var d:Real;Var code:Integer); Procedure Val(const s:shortstring;Var d:Real;Var code:Integer);
Procedure Val(const s:string;Var d:Real;Var code:Longint); Procedure Val(const s:shortstring;Var d:Real;Var code:Longint);
Procedure Val(const s:string;Var d:Real); Procedure Val(const s:shortstring;Var d:Real);
{$else DEFAULT_EXTENDED} {$else DEFAULT_EXTENDED}
{$ifdef SUPPORT_EXTENDED} {$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);
Procedure Val(const s:string;Var d:Extended;Var code:Integer); Procedure Val(const s:shortstring;Var d:Extended;Var code:Integer);
Procedure Val(const s:string;Var d:Extended;Var code:Longint); Procedure Val(const s:shortstring;Var d:Extended;Var code:Longint);
Procedure Val(const s:string;Var d:Extended); Procedure Val(const s:shortstring;Var d:Extended);
{$endif} {$endif}
{$endif DEFAULT_EXTENDED} {$endif DEFAULT_EXTENDED}
@ -422,7 +432,10 @@ const
{ {
$Log$ $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 + read single,fixed
+ val with code:longint + val with code:longint
+ val for fixed + val for fixed

22
rtl/objpas/sysstr.inc
View File

@ -716,18 +716,6 @@ end;
{ extra functions } { 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 } { LeftStr returns Count left-most characters from S }
function LeftStr(const S: string; Count: integer): string; function LeftStr(const S: string; Count: integer): string;
@ -906,7 +894,10 @@ end ;
{ {
$Log$ $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 Format error now causes exception
Revision 1.7 1998/10/02 12:17:17 michael Revision 1.7 1998/10/02 12:17:17 michael
@ -929,7 +920,10 @@ end ;
Update from gertjan Schouten, plus small fix for linux Update from gertjan Schouten, plus small fix for linux
$Log$ $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 Format error now causes exception
Revision 1.7 1998/10/02 12:17:17 michael Revision 1.7 1998/10/02 12:17:17 michael

6
rtl/objpas/sysstrh.inc
View File

@ -77,14 +77,16 @@ Function Format (Const Fmt : String; const Args : Array of const) : String;
{ extra functions } { 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 LeftStr(const S: string; Count: integer): string;
function RightStr(const S: string; Count: integer): string; function RightStr(const S: string; Count: integer): string;
function BCDToInt(Value: integer): integer; function BCDToInt(Value: integer): integer;
{ {
$Log$ $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 + Added format function
Revision 1.2 1998/09/16 08:28:43 michael Revision 1.2 1998/09/16 08:28:43 michael