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

+ Added comp support for val and read(ln)

Browse Source
This commit is contained in:
michael 1998-03-26 14:41:22 +00:00
parent 5f20356336
commit f6b5cc3358
3 changed files with 130 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
rtl/inc/sstrings.inc
View File

@ -459,7 +459,6 @@ procedure val(const s : string;var d : single);
d:=e;
end;
{$ENDIF ieee_support}
{ Again, not fast, but solid and understandable. }
{$endif ver_above0_9_2}
{$ifdef ver_above0_9_7}
{$ifdef ieee_support}
@ -490,6 +489,35 @@ begin
d:=e;
end;
{$endif ieee_support}
{$ifdef comp_support}
procedure val(const s : string;var d : comp;var code : word);
var e : double;
begin
val(s,e,code);
d:=e;
end;
procedure val(const s : string;var d : comp;var code : integer);
var e : double;
begin
val(s,e,word(code));
d:=e;
end;
procedure val(const s : string;var d : comp);
var code : word;
e : double;
begin
val(s,e,code);
d:=e;
end;
{$endif comp_support}
{$endif ver_above0_9_7}
@ -734,8 +762,11 @@ end;
{
$Log$
Revision 1.1 1998-03-25 11:18:43 root
Initial revision
Revision 1.2 1998-03-26 14:41:22 michael
+ Added comp support for val and read(ln)
Revision 1.1.1.1 1998/03/25 11:18:43 root
* Restored version
Revision 1.8 1998/03/18 15:04:36 pierre
* bug in val : a was accepted as 10 in base 10 !!

10
rtl/inc/systemh.inc
View File

@ -285,6 +285,11 @@ Procedure Val(const s:string;Var d:Real);
Procedure Val(const s:string;Var d:Extended;Var code:Integer);
Procedure Val(const s:string;Var d:Extended);
{$ENDIF ieee_support}
{$IFDEF comp_support}
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);
{$ENDIF comp_support}
{$ENDIF VER_ABOVE0_9_7}
{$IFDEF VER_ABOVE0_9_8}
Procedure Val(const s:string;Var v:cardinal;Var code:Word);
@ -387,7 +392,10 @@ Procedure AddExitProc(Proc:TProcedure);
{
$Log$
Revision 1.2 1998-03-25 23:39:17 florian
Revision 1.3 1998-03-26 14:41:22 michael
+ Added comp support for val and read(ln)
Revision 1.2 1998/03/25 23:39:17 florian
* complete Object Pascal support moved to objpas unit
Revision 1.1.1.1 1998/03/25 11:18:43 root

90
rtl/inc/text.inc
View File

@ -458,8 +458,12 @@ End;
Procedure w(fixkomma,Len : Longint;var t : TextRec;r : comp);[Public,Alias: 'WRITE_TEXT_COMP'];
var
s : String;
e : extended;
L : longint;
Begin
Str_real(Len,fixkomma,r,rt_s64bit,s);
e:=r;
Str_real(Len,fixkomma,e,rt_s80real,s);
w(Len,t,s);
End;
{$endif comp_support}
@ -820,10 +824,90 @@ Begin
If code<>0 Then
RunError(106);
End;
{$ifdef ieee_support}
Procedure r(var f : TextRec;var d : extended);[Public,Alias: 'READ_TEXT_EXTENDED'];
var
hs : String;
code : Word;
Begin
d:=0.0;
hs:='';
if not OpenInput(f) then
exit;
if IgnoreSpaces(f) and ReadSign(f,hs) and ReadNumeric(f,hs,10) then
begin
{ First check for a . }
if (f.Bufptr^[f.BufPos]='.') and (f.BufPos<f.BufEnd) Then
begin
hs:=hs+'.';
Inc(f.BufPos);
If f.BufPos>=f.BufEnd Then
FileFunc(f.InOutFunc)(f);
ReadNumeric(f,hs,10);
end;
{ Also when a point is found check for a E }
if (f.Bufptr^[f.BufPos] in ['e','E']) and (f.BufPos<f.BufEnd) Then
begin
hs:=hs+'E';
Inc(f.BufPos);
If f.BufPos>=f.BufEnd Then
FileFunc(f.InOutFunc)(f);
if ReadSign(f,hs) then
ReadNumeric(f,hs,10);
end;
end;
val(hs,d,code);
If code<>0 Then
RunError(106);
End;
{$endif ieee_support}
{$ifdef comp_support}
Procedure r(var f : TextRec;var d : comp);[Public,Alias: 'READ_TEXT_COMP'];
var
hs : String;
code : Word;
Begin
d:=0.0;
hs:='';
if not OpenInput(f) then
exit;
if IgnoreSpaces(f) and ReadSign(f,hs) and ReadNumeric(f,hs,10) then
begin
{ First check for a . }
if (f.Bufptr^[f.BufPos]='.') and (f.BufPos<f.BufEnd) Then
begin
hs:=hs+'.';
Inc(f.BufPos);
If f.BufPos>=f.BufEnd Then
FileFunc(f.InOutFunc)(f);
ReadNumeric(f,hs,10);
end;
{ Also when a point is found check for a E }
if (f.Bufptr^[f.BufPos] in ['e','E']) and (f.BufPos<f.BufEnd) Then
begin
hs:=hs+'E';
Inc(f.BufPos);
If f.BufPos>=f.BufEnd Then
FileFunc(f.InOutFunc)(f);
if ReadSign(f,hs) then
ReadNumeric(f,hs,10);
end;
end;
val(hs,d,code);
If code<>0 Then
RunError(106);
End;
{$endif}
{
$Log$
Revision 1.1 1998-03-25 11:18:43 root
Initial revision
Revision 1.2 1998-03-26 14:41:22 michael
+ Added comp support for val and read(ln)
Revision 1.1.1.1 1998/03/25 11:18:43 root
* Restored version
Revision 1.13 1998/03/19 12:00:42 pierre
* missing write for comp fixed