From cac6ac38d043f9402cc81e61d2fb2cfec3be8e47 Mon Sep 17 00:00:00 2001 From: nickysn Date: Fri, 29 Mar 2013 01:19:14 +0000 Subject: [PATCH] + added RTL helpers for Val() for longint/dword on 16/8-bit CPUs git-svn-id: branches/i8086@24048 - --- rtl/inc/astrings.inc | 32 ++++++++++++++ rtl/inc/compproc.inc | 18 ++++++++ rtl/inc/sstrings.inc | 101 +++++++++++++++++++++++++++++++++++++++++++ rtl/inc/ustrings.inc | 32 ++++++++++++++ 4 files changed, 183 insertions(+) diff --git a/rtl/inc/astrings.inc b/rtl/inc/astrings.inc index 7ef49249f5..844096d1ff 100644 --- a/rtl/inc/astrings.inc +++ b/rtl/inc/astrings.inc @@ -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 diff --git a/rtl/inc/compproc.inc b/rtl/inc/compproc.inc index 50f1e3882d..862a049e31 100644 --- a/rtl/inc/compproc.inc +++ b/rtl/inc/compproc.inc @@ -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; diff --git a/rtl/inc/sstrings.inc b/rtl/inc/sstrings.inc index 9b8e0707b0..e472f8cea0 100644 --- a/rtl/inc/sstrings.inc +++ b/rtl/inc/sstrings.inc @@ -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))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