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

* reading of 64 bit type implemented

Browse Source
This commit is contained in:
florian 2000-01-23 12:22:37 +00:00
parent 587a967353
commit 0a05c8d0e0
2 changed files with 155 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
rtl/inc/int64.inc
View File

@ -256,7 +256,7 @@
if value<0 then
begin
q:=qword(-value);
int_str(q,hs);
qword_str(q,hs);
s:='-'+hs;
end
else
@ -299,10 +299,103 @@
s:=ss;
end;
Function ValInt64(DestSize: longint; Const S: ShortString; var Code: ValSInt): Int64; [public, alias:'FPC_VAL_INT64_SHORTSTR'];
var
u, temp, prev : Int64;
base : byte;
negative : boolean;
begin
ValInt64 := 0;
Temp:=0;
Code:=InitVal(s,negative,base);
if Code>length(s) then
exit;
if negative and (s='-9223372036854775808') then
begin
Code:=0;
ValInt64:=Int64($80000000) shl 32;
exit;
end;
while Code<=Length(s) do
begin
case s[Code] of
'0'..'9' : u:=Ord(S[Code])-Ord('0');
'A'..'F' : u:=Ord(S[Code])-(Ord('A')-10);
'a'..'f' : u:=Ord(S[Code])-(Ord('a')-10);
else
u:=16;
end;
Prev:=Temp;
Temp:=Temp*Int64(base);
if (Temp<prev) Then
Begin
ValInt64:=0;
Exit
End;
prev:=temp;
Temp:=Temp+u;
if prev>temp then
begin
ValInt64:=0;
exit;
end;
inc(code);
end;
code:=0;
ValInt64:=Temp;
If Negative Then
ValInt64:=-ValInt64;
end;
Function ValQWord(Const S: ShortString; var Code: ValSInt): QWord; [public, alias:'FPC_VAL_QWORD_SHORTSTR'];
var
u, prev: QWord;
base : byte;
negative : boolean;
begin
ValQWord:=0;
Code:=InitVal(s,negative,base);
If Negative or (Code>length(s)) Then
Exit;
while Code<=Length(s) do
begin
case s[Code] of
'0'..'9' : u:=Ord(S[Code])-Ord('0');
'A'..'F' : u:=Ord(S[Code])-(Ord('A')-10);
'a'..'f' : u:=Ord(S[Code])-(Ord('a')-10);
else
u:=16;
end;
prev := ValQWord;
ValQWord:=ValQWord*QWord(base);
If (prev>ValQWord) or (u>base) Then
Begin
ValQWord := 0;
Exit
End;
prev:=ValQWord;
ValQWord:=ValQWord+u;
if prev>ValQWord then
begin
ValQWord:=0;
exit;
end;
inc(code);
end;
code := 0;
end;
{
$Log$
Revision 1.14 2000-01-07 16:41:34 daniel
Revision 1.15 2000-01-23 12:22:37 florian
* reading of 64 bit type implemented
Revision 1.14 2000/01/07 16:41:34 daniel
* copyright 2000
Revision 1.13 1999/07/05 20:04:23 peter
@ -347,4 +440,4 @@
Revision 1.1 1998/12/12 12:15:41 florian
+ first implementation
}
}

69
rtl/inc/text.inc
View File

@ -978,15 +978,61 @@ end;
{$ifdef INT64}
procedure read_qword(len : longint;var t : textrec;q : qword);[public,alias:'FPC_READ_TEXT_QWORD'];
begin
{ !!!!!!!!!!!!! }
end;
function Read_QWord(var f : textrec) : qword;[public,alias:'FPC_READ_TEXT_QWORD'];
var
hs : String;
code : longint;
base : longint;
Begin
Read_QWord:=0;
{ Leave if error or not open file, else check for empty buf }
If (InOutRes<>0) then
exit;
if (f.mode<>fmInput) Then
begin
if TextRec(f).mode=fmClosed then
InOutRes:=103
else
InOutRes:=104;
exit;
end;
If f.BufPos>=f.BufEnd Then
FileFunc(f.InOutFunc)(f);
hs:='';
if IgnoreSpaces(f) and ReadSign(f,hs) and ReadBase(f,hs,Base) then
ReadNumeric(f,hs,Base);
val(hs,Read_QWord,code);
If code<>0 Then
InOutRes:=106;
End;
procedure read_int64(len : longint;var t : textrec;q : int64);[public,alias:'FPC_READ_TEXT_INT64'];
begin
{ !!!!!!!!!!!!! }
end;
function Read_Int64(var f : textrec) : int64;[public,alias:'FPC_READ_TEXT_INT64'];
var
hs : String;
code : Longint;
base : longint;
Begin
Read_Int64:=0;
{ Leave if error or not open file, else check for empty buf }
If (InOutRes<>0) then
exit;
if (f.mode<>fmInput) Then
begin
if TextRec(f).mode=fmClosed then
InOutRes:=103
else
InOutRes:=104;
exit;
end;
If f.BufPos>=f.BufEnd Then
FileFunc(f.InOutFunc)(f);
hs:='';
if IgnoreSpaces(f) and ReadSign(f,hs) and ReadBase(f,hs,Base) then
ReadNumeric(f,hs,Base);
Val(hs,Read_Int64,code);
If code<>0 Then
InOutRes:=106;
End;
{$endif INT64}
@ -1016,7 +1062,10 @@ end;
{
$Log$
Revision 1.65 2000-01-20 20:19:37 florian
Revision 1.66 2000-01-23 12:22:37 florian
* reading of 64 bit type implemented
Revision 1.65 2000/01/20 20:19:37 florian
* writing of int64/qword fixed
Revision 1.64 2000/01/08 17:08:36 jonas
@ -1099,4 +1148,4 @@ end;
* use external names
* removed all direct assembler modes
}
}