mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-17 16:29:24 +02:00
* reading of 64 bit type implemented
This commit is contained in:
parent
587a967353
commit
0a05c8d0e0
@ -256,7 +256,7 @@
|
|||||||
if value<0 then
|
if value<0 then
|
||||||
begin
|
begin
|
||||||
q:=qword(-value);
|
q:=qword(-value);
|
||||||
int_str(q,hs);
|
qword_str(q,hs);
|
||||||
s:='-'+hs;
|
s:='-'+hs;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
@ -299,10 +299,103 @@
|
|||||||
s:=ss;
|
s:=ss;
|
||||||
end;
|
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$
|
$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
|
* copyright 2000
|
||||||
|
|
||||||
Revision 1.13 1999/07/05 20:04:23 peter
|
Revision 1.13 1999/07/05 20:04:23 peter
|
||||||
|
@ -978,15 +978,61 @@ end;
|
|||||||
|
|
||||||
|
|
||||||
{$ifdef INT64}
|
{$ifdef INT64}
|
||||||
procedure read_qword(len : longint;var t : textrec;q : qword);[public,alias:'FPC_READ_TEXT_QWORD'];
|
function Read_QWord(var f : textrec) : qword;[public,alias:'FPC_READ_TEXT_QWORD'];
|
||||||
begin
|
var
|
||||||
{ !!!!!!!!!!!!! }
|
hs : String;
|
||||||
end;
|
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'];
|
function Read_Int64(var f : textrec) : int64;[public,alias:'FPC_READ_TEXT_INT64'];
|
||||||
begin
|
var
|
||||||
{ !!!!!!!!!!!!! }
|
hs : String;
|
||||||
end;
|
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}
|
{$endif INT64}
|
||||||
|
|
||||||
|
|
||||||
@ -1016,7 +1062,10 @@ end;
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* writing of int64/qword fixed
|
||||||
|
|
||||||
Revision 1.64 2000/01/08 17:08:36 jonas
|
Revision 1.64 2000/01/08 17:08:36 jonas
|
||||||
|
Loading…
Reference in New Issue
Block a user