paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-06 17:35:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ added RTL helpers for Val() for longint/dword on 16/8-bit CPUs

Browse Source 
git-svn-id: branches/i8086@24048 -
This commit is contained in:
nickysn 2013-03-29 01:19:14 +00:00
parent 8b6b832677
commit cac6ac38d0
4 changed files with 183 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
rtl/inc/astrings.inc
View File

@ -1077,6 +1077,38 @@ end;
{$endif CPU64}
{$if defined(CPU16) or defined(CPU8)}
Function fpc_Val_longword_AnsiStr (Const S : RawByteString; out Code : ValSInt): longword; [public, alias:'FPC_VAL_LONGWORD_ANSISTR']; compilerproc;
Var
SS : ShortString;
begin
fpc_Val_longword_AnsiStr:=0;
if length(S)>255 then
code:=256
else
begin
SS := S;
Val(SS,fpc_Val_longword_AnsiStr,Code);
end;
end;
Function fpc_Val_longint_AnsiStr (Const S : RawByteString; out Code : ValSInt): LongInt; [public, alias:'FPC_VAL_LONGINT_ANSISTR']; compilerproc;
Var
SS : ShortString;
begin
fpc_Val_longint_AnsiStr:=0;
if length(S)>255 then
code:=256
else
begin
SS := s;
Val(SS,fpc_Val_longint_AnsiStr,Code);
end;
end;
{$endif CPU16 or CPU8}
{$ifndef FPUNONE}
procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING});[public,alias:'FPC_ANSISTR_FLOAT']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
var

18
rtl/inc/compproc.inc
View File

@ -230,6 +230,24 @@ Function fpc_Val_int64_UnicodeStr (Const S : UnicodeString; out Code : ValSInt):
{$endif CPU64}
{$if defined(CPU16) or defined(CPU8)}
Function fpc_val_longint_shortstr(Const S: ShortString; out Code: ValSInt): LongInt; compilerproc;
Function fpc_val_longword_shortstr(Const S: ShortString; out Code: ValSInt): LongWord; compilerproc;
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Function fpc_Val_longword_AnsiStr (Const S : RawByteString; out Code : ValSInt): LongWord;compilerproc;
Function fpc_Val_longint_AnsiStr (Const S : RawByteString; out Code : ValSInt): LongInt; compilerproc;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
Function fpc_Val_longword_WideStr (Const S : WideString; out Code : ValSInt): LongWord; compilerproc;
Function fpc_Val_longint_WideStr (Const S : WideString; out Code : ValSInt): LongInt; compilerproc;
{$endif ndef FPC_WIDESTRING_EQUAL_UNICODESTRING}
Function fpc_Val_longword_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): LongWord; compilerproc;
Function fpc_Val_longint_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): LongInt; compilerproc;
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
{$endif CPU16 or CPU8}
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Procedure fpc_ansistr_decr_ref (Var S : Pointer); compilerproc;
Procedure fpc_ansistr_incr_ref (S : Pointer); compilerproc;

101
rtl/inc/sstrings.inc
View File

@ -1253,6 +1253,107 @@ end;
{$endif CPU64}
{$if defined(CPU16) or defined(CPU8)}
Function fpc_val_longint_shortstr(Const S: ShortString; out Code: ValSInt): LongInt; [public, alias:'FPC_VAL_LONGINT_SHORTSTR']; compilerproc;
var u, temp, prev, maxprevvalue, maxnewvalue : longword;
base : byte;
negative : boolean;
const maxlongint=longword($7fffffff);
maxlongword=longword($ffffffff);
begin
fpc_val_longint_shortstr := 0;
Temp:=0;
Code:=InitVal(s,negative,base);
if Code>length(s) then
exit;
if (s[Code]=#0) then
begin
if (Code>1) and (s[Code-1]='0') then
Code:=0;
exit;
end;
maxprevvalue := maxlongword div base;
if (base = 10) then
maxnewvalue := maxlongint + ord(negative)
else
maxnewvalue := maxlongword;
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);
#0 : break;
else
u:=16;
end;
Prev:=Temp;
Temp:=Temp*longword(base);
If (u >= base) or
(longword(maxnewvalue-u) < temp) or
(prev > maxprevvalue) Then
Begin
fpc_val_longint_shortstr := 0;
Exit
End;
Temp:=Temp+u;
inc(code);
end;
code:=0;
fpc_val_longint_shortstr:=longint(Temp);
If Negative Then
fpc_val_longint_shortstr:=-fpc_val_longint_shortstr;
end;
Function fpc_val_longword_shortstr(Const S: ShortString; out Code: ValSInt): LongWord; [public, alias:'FPC_VAL_LONGWORD_SHORTSTR']; compilerproc;
var u, prev: LongWord;
base : byte;
negative : boolean;
const maxlongword=longword($ffffffff);
begin
fpc_val_longword_shortstr:=0;
Code:=InitVal(s,negative,base);
If Negative or (Code>length(s)) Then
Exit;
if (s[Code]=#0) then
begin
if (Code>1) and (s[Code-1]='0') then
Code:=0;
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);
#0 : break;
else
u:=16;
end;
prev := fpc_val_longword_shortstr;
If (u>=base) or
((LongWord(maxlongword-u) div LongWord(base))<prev) then
Begin
fpc_val_longword_shortstr := 0;
Exit
End;
fpc_val_longword_shortstr:=fpc_val_longword_shortstr*LongWord(base) + u;
inc(code);
end;
code := 0;
end;
{$endif CPU16 or CPU8}
{$ifndef FPUNONE}
const
{$ifdef FPC_HAS_TYPE_EXTENDED}

32
rtl/inc/ustrings.inc
View File

@ -1478,6 +1478,38 @@ end;
{$endif CPU64}
{$if defined(CPU16) or defined(CPU8)}
Function fpc_Val_longword_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): longword; [public, alias:'FPC_VAL_LONGWORD_UNICODESTR']; compilerproc;
Var
SS: ShortString;
begin
fpc_Val_longword_UnicodeStr:=0;
if length(S)>255 then
code:=256
else
begin
SS:=ShortString(S);
Val(SS,fpc_Val_longword_UnicodeStr,Code);
end;
end;
Function fpc_Val_longint_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): LongInt; [public, alias:'FPC_VAL_LONGINT_UNICODESTR']; compilerproc;
Var
SS: ShortString;
begin
fpc_Val_longint_UnicodeStr:=0;
if length(S)>255 then
code:=256
else
begin
SS:=ShortString(S);
Val(SS,fpc_Val_longint_UnicodeStr,Code);
end;
end;
{$endif CPU16 or CPU8}
{$ifndef FPUNONE}
procedure fpc_UnicodeStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : UnicodeString);compilerproc;
var