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

Added support for 8-bit CPU's in RTL. Mostly for missing implementations of int<->string conversion and console/text output.

Browse Source 
git-svn-id: trunk@26958 -
This commit is contained in:
Jeppe Johansen 2014-03-04 20:00:03 +00:00
parent 98517b9ac9
commit 9b79f2f68d
6 changed files with 373 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
rtl/inc/astrings.inc
View File

@ -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);

39
rtl/inc/compproc.inc
View File

@ -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;

147
rtl/inc/sstrings.inc
View File

@ -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}

2
rtl/inc/system.inc
View File

@ -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;

54
rtl/inc/text.inc
View File

@ -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}

48
rtl/inc/ustrings.inc
View File

@ -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}