diff --git a/rtl/inc/astrings.inc b/rtl/inc/astrings.inc index f141501751..5ec3c9910f 100644 --- a/rtl/inc/astrings.inc +++ b/rtl/inc/astrings.inc @@ -1125,9 +1125,71 @@ begin Val(SS,fpc_Val_longint_AnsiStr,Code); end; end; + + +Function fpc_Val_word_AnsiStr (Const S : RawByteString; out Code : ValSInt): word; [public, alias:'FPC_VAL_WORD_ANSISTR']; compilerproc; +Var + SS : ShortString; +begin + fpc_Val_word_AnsiStr:=0; + if length(S)>255 then + code:=256 + else + begin + SS := S; + Val(SS,fpc_Val_word_AnsiStr,Code); + end; +end; + + +Function fpc_Val_smallint_AnsiStr (Const S : RawByteString; out Code : ValSInt): smallint; [public, alias:'FPC_VAL_SMALLINT_ANSISTR']; compilerproc; +Var + SS : ShortString; +begin + fpc_Val_smallint_AnsiStr:=0; + if length(S)>255 then + code:=256 + else + begin + SS := s; + Val(SS,fpc_Val_smallint_AnsiStr,Code); + end; +end; {$endif CPU16 or CPU8} +{$if defined(CPU8)} +Function fpc_Val_word_AnsiStr (Const S : RawByteString; out Code : ValSInt): longword; [public, alias:'FPC_VAL_WORD_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_smallint_AnsiStr (Const S : RawByteString; out Code : ValSInt): LongInt; [public, alias:'FPC_VAL_SMALLINT_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 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; inline; var @@ -1263,6 +1325,28 @@ begin SetCodePage(s,cp,false); {$endif FPC_HAS_CPSTRING} end; + +Procedure fpc_AnsiStr_Word(v : Word;Len : SizeInt; out S : RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING});[Public,Alias : 'FPC_ANSISTR_WORD']; compilerproc; inline; +Var + SS : ShortString; +begin + str(v:Len,SS); + S:=SS; + {$ifdef FPC_HAS_CPSTRING} + SetCodePage(s,cp,false); + {$endif FPC_HAS_CPSTRING} +end; + +Procedure fpc_AnsiStr_SmallInt(v : SmallInt; Len : SizeInt; out S : RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING});[Public,Alias : 'FPC_ANSISTR_SMALLINT']; compilerproc; inline; +Var + SS : ShortString; +begin + str (v:Len,SS); + S:=SS; + {$ifdef FPC_HAS_CPSTRING} + SetCodePage(s,cp,false); + {$endif FPC_HAS_CPSTRING} +end; {$endif CPU16 or CPU8} Procedure Delete(Var S : RawByteString; Index,Size: SizeInt); diff --git a/rtl/inc/compproc.inc b/rtl/inc/compproc.inc index 85848eddc0..a2b09b03de 100644 --- a/rtl/inc/compproc.inc +++ b/rtl/inc/compproc.inc @@ -144,6 +144,24 @@ procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : RawByteStri procedure fpc_UnicodeStr_longword(v : longword;len : SizeInt;out s : UnicodeString); compilerproc; procedure fpc_UnicodeStr_longint(v : longint;len : SizeInt;out s : UnicodeString); compilerproc; {$endif FPC_HAS_FEATURE_WIDESTRINGS} + + procedure fpc_shortstr_word(v : word;len : SizeInt;out s : shortstring); compilerproc; + procedure fpc_shortstr_smallint(v : smallint;len : SizeInt;out s : shortstring); compilerproc; + procedure fpc_chararray_word(v : word;len : SizeInt;out a : array of char); compilerproc; + procedure fpc_chararray_smallint(v : smallint;len : SizeInt;out a : array of char); compilerproc; + {$ifdef FPC_HAS_FEATURE_ANSISTRINGS} + procedure fpc_ansistr_word(v : word;len : SizeInt;out s : RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}); compilerproc; + procedure fpc_ansistr_smallint(v : smallint;len : SizeInt;out s : RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}); compilerproc; + {$endif FPC_HAS_FEATURE_ANSISTRINGS} + + {$ifdef FPC_HAS_FEATURE_WIDESTRINGS} + {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING} + procedure fpc_widestr_word(v : word;len : SizeInt;out s : widestring); compilerproc; + procedure fpc_widestr_smallint(v : smallint;len : SizeInt;out s : widestring); compilerproc; + {$endif ndef FPC_WIDESTRING_EQUAL_UNICODESTRING} + procedure fpc_UnicodeStr_word(v : word;len : SizeInt;out s : UnicodeString); compilerproc; + procedure fpc_UnicodeStr_smallint(v : smallint;len : SizeInt;out s : UnicodeString); compilerproc; + {$endif FPC_HAS_FEATURE_WIDESTRINGS} {$endif CPU16 or CPU8} {$ifdef FPC_HAS_FEATURE_WIDESTRINGS} {$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING} @@ -247,6 +265,22 @@ Function fpc_Val_longint_WideStr (Const S : WideString; out Code : ValSInt): Lon 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} + +Function fpc_val_smallint_shortstr(Const S: ShortString; out Code: ValSInt): SmallInt; compilerproc; +Function fpc_val_word_shortstr(Const S: ShortString; out Code: ValSInt): Word; compilerproc; +{$ifdef FPC_HAS_FEATURE_ANSISTRINGS} +Function fpc_Val_word_AnsiStr (Const S : RawByteString; out Code : ValSInt): Word;compilerproc; +Function fpc_Val_smallint_AnsiStr (Const S : RawByteString; out Code : ValSInt): SmallInt; compilerproc; +{$endif FPC_HAS_FEATURE_ANSISTRINGS} + +{$ifdef FPC_HAS_FEATURE_WIDESTRINGS} +{$ifndef FPC_WIDESTRING_EQUAL_UNICODESTRING} +Function fpc_Val_word_WideStr (Const S : WideString; out Code : ValSInt): Word; compilerproc; +Function fpc_Val_smallint_WideStr (Const S : WideString; out Code : ValSInt): SmallInt; compilerproc; +{$endif ndef FPC_WIDESTRING_EQUAL_UNICODESTRING} +Function fpc_Val_word_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): Word; compilerproc; +Function fpc_Val_smallint_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): SmallInt; compilerproc; +{$endif FPC_HAS_FEATURE_WIDESTRINGS} {$endif CPU16 or CPU8} {$ifdef FPC_HAS_FEATURE_ANSISTRINGS} @@ -407,6 +441,11 @@ procedure fpc_write_text_longword(len : longint;var t : text;q : longword); comp procedure fpc_write_text_longint(len : longint;var t : text;i : longint); compilerproc; procedure fpc_write_text_longword_iso(len : longint;var t : text;q : longword); compilerproc; procedure fpc_write_text_longint_iso(len : longint;var t : text;i : longint); compilerproc; + +procedure fpc_write_text_word(len : longint;var t : text;q : word); compilerproc; +procedure fpc_write_text_smallint(len : longint;var t : text;i : smallint); compilerproc; +procedure fpc_write_text_word_iso(len : longint;var t : text;q : word); compilerproc; +procedure fpc_write_text_smallint_iso(len : longint;var t : text;i : smallint); compilerproc; {$endif CPU16 or CPU8} {$ifndef FPUNONE} Procedure fpc_Write_Text_Float(rt,fixkomma,Len : Longint;var t : Text;r : ValReal); compilerproc; diff --git a/rtl/inc/sstrings.inc b/rtl/inc/sstrings.inc index 443c127653..14edd56fc9 100644 --- a/rtl/inc/sstrings.inc +++ b/rtl/inc/sstrings.inc @@ -463,6 +463,22 @@ begin if length(s)<len then s:=space(len-length(s))+s; end; + + +procedure fpc_shortstr_word(v : word;len : SizeInt;out s : shortstring);[public,alias:'FPC_SHORTSTR_WORD']; compilerproc; +begin + int_str_unsigned(v,s); + if length(s)<len then + s:=space(len-length(s))+s; +end; + + +procedure fpc_shortstr_smallint(v : smallint;len : SizeInt;out s : shortstring);[public,alias:'FPC_SHORTSTR_SMALLINT']; compilerproc; +begin + int_str(v,s); + if length(s)<len then + s:=space(len-length(s))+s; +end; {$endif CPU16 or CPU8} @@ -923,6 +939,38 @@ begin fpc_shortstr_chararray_intern_charmove(ss,a,maxlen); end; + +procedure fpc_chararray_word(v : word;len : SizeInt;out a : array of char);compilerproc; +var + ss : shortstring; + maxlen : SizeInt; +begin + int_str_unsigned(v,ss); + if length(ss)<len then + ss:=space(len-length(ss))+ss; + if length(ss)<high(a)+1 then + maxlen:=length(ss) + else + maxlen:=high(a)+1; + fpc_shortstr_chararray_intern_charmove(ss,a,maxlen); +end; + + +procedure fpc_chararray_smallint(v : smallint;len : SizeInt;out a : array of char);compilerproc; +var + ss : shortstring; + maxlen : SizeInt; +begin + int_str(v,ss); + if length(ss)<len then + ss:=space(len-length(ss))+ss; + if length(ss)<high(a)+1 then + maxlen:=length(ss) + else + maxlen:=high(a)+1; + fpc_shortstr_chararray_intern_charmove(ss,a,maxlen); +end; + {$endif CPU16 or CPU8} @@ -1353,6 +1401,105 @@ end; end; code := 0; end; + + + Function fpc_val_smallint_shortstr(Const S: ShortString; out Code: ValSInt): SmallInt; [public, alias:'FPC_VAL_SMALLINT_SHORTSTR']; compilerproc; + + var u, temp, prev, maxprevvalue, maxnewvalue : word; + base : byte; + negative : boolean; + + const maxlongint=longword($7fffffff); + maxlongword=longword($ffffffff); + + begin + fpc_val_smallint_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_smallint_shortstr := 0; + Exit + End; + Temp:=Temp+u; + inc(code); + end; + code:=0; + fpc_val_smallint_shortstr:=longint(Temp); + If Negative Then + fpc_val_smallint_shortstr:=-fpc_val_smallint_shortstr; + end; + + + Function fpc_val_word_shortstr(Const S: ShortString; out Code: ValSInt): Word; [public, alias:'FPC_VAL_WORD_SHORTSTR']; compilerproc; + + var u, prev: word; + base : byte; + negative : boolean; + + const maxlongword=longword($ffffffff); + + begin + fpc_val_word_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_word_shortstr; + If (u>=base) or + ((LongWord(maxlongword-u) div LongWord(base))<prev) then + Begin + fpc_val_word_shortstr := 0; + Exit + End; + fpc_val_word_shortstr:=fpc_val_word_shortstr*LongWord(base) + u; + inc(code); + end; + code := 0; + end; {$endif CPU16 or CPU8} {$ifdef FLOAT_ASCII_FALLBACK} diff --git a/rtl/inc/system.inc b/rtl/inc/system.inc index beace1addb..10edeb65bb 100644 --- a/rtl/inc/system.inc +++ b/rtl/inc/system.inc @@ -644,7 +644,7 @@ end; ****************************************************************************} {$ifndef FPC_SYSTEM_HAS_PTR} -Function Ptr(sel,off : Longint) : farpointer;{$ifdef SYSTEMINLINE}inline;{$endif} +Function Ptr(sel,off : {$ifdef CPU16}Word{$else}Longint{$endif}) : farpointer;{$ifdef SYSTEMINLINE}inline;{$endif} Begin ptr:=farpointer((sel shl 4)+off); End; diff --git a/rtl/inc/text.inc b/rtl/inc/text.inc index ebef4ef1c0..e2afb77874 100644 --- a/rtl/inc/text.inc +++ b/rtl/inc/text.inc @@ -1099,6 +1099,60 @@ begin len:=length(s); write_str_iso(len,t,s); end; + + +procedure fpc_write_text_word(len : longint;var t : text;q : word); iocheck; compilerproc; +var + s : string; +begin + if (InOutRes<>0) then + exit; + str(q,s); + write_str(len,t,s); +end; + + +procedure fpc_write_text_smallint(len : longint;var t : text;i : smallint); iocheck; compilerproc; +var + s : string; +begin + if (InOutRes<>0) then + exit; + str(i,s); + write_str(len,t,s); +end; + + +procedure fpc_write_text_word_iso(len : longint;var t : text;q : word); iocheck; compilerproc; +var + s : string; +begin + if (InOutRes<>0) then + exit; + str(q,s); + { default value? } + if len=-1 then + len:=11 + else if len<length(s) then + len:=length(s); + write_str_iso(len,t,s); +end; + + +procedure fpc_write_text_smallint_iso(len : longint;var t : text;i : smallint); iocheck; compilerproc; +var + s : string; +begin + if (InOutRes<>0) then + exit; + str(i,s); + { default value? } + if len=-1 then + len:=11 + else if len<length(s) then + len:=length(s); + write_str_iso(len,t,s); +end; {$endif CPU16 or CPU8} {$ifndef FPUNONE} diff --git a/rtl/inc/ustrings.inc b/rtl/inc/ustrings.inc index f98e796adf..85503bdd74 100644 --- a/rtl/inc/ustrings.inc +++ b/rtl/inc/ustrings.inc @@ -1515,6 +1515,36 @@ begin Val(SS,fpc_Val_longint_UnicodeStr,Code); end; end; + + +Function fpc_Val_word_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): word; [public, alias:'FPC_VAL_WORD_UNICODESTR']; compilerproc; +Var + SS: ShortString; +begin + fpc_Val_word_UnicodeStr:=0; + if length(S)>255 then + code:=256 + else + begin + SS:=ShortString(S); + Val(SS,fpc_Val_word_UnicodeStr,Code); + end; +end; + + +Function fpc_Val_smallint_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): SmallInt; [public, alias:'FPC_VAL_SMALLINT_UNICODESTR']; compilerproc; +Var + SS: ShortString; +begin + fpc_Val_smallint_UnicodeStr:=0; + if length(S)>255 then + code:=256 + else + begin + SS:=ShortString(S); + Val(SS,fpc_Val_smallint_UnicodeStr,Code); + end; +end; {$endif CPU16 or CPU8} @@ -1616,6 +1646,24 @@ begin S:=UnicodeString(SS); end; + +Procedure fpc_UnicodeStr_SmallInt(v : SmallInt; Len : SizeInt; out S : UnicodeString);compilerproc; +Var + SS: ShortString; +begin + Str (v:Len,SS); + S:=UnicodeString(SS); +end; + + +Procedure fpc_UnicodeStr_Word(v : Word;Len : SizeInt; out S : UnicodeString);compilerproc; +Var + SS: ShortString; +begin + str(v:Len,SS); + S:=UnicodeString(SS); +end; + {$endif CPU16 or CPU8}