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

git-svn-id: trunk@26958 -

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

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;

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}

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;

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}

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}