r1018 - forth/lib

Author: wmb
Date: 2008-12-04 10:18:10 +0100 (Thu, 04 Dec 2008)
New Revision: 1018

Added:
   forth/lib/printf.fth
Modified:
   forth/lib/loadcomm.fth
Log:
All platforms - added simple "printf" and "sprintf" functions.

Modified: forth/lib/loadcomm.fth
===================================================================
--- forth/lib/loadcomm.fth	2008-12-04 09:18:06 UTC (rev 1017)
+++ forth/lib/loadcomm.fth	2008-12-04 09:18:10 UTC (rev 1018)
@@ -70,6 +70,7 @@
 fload ${BP}/forth/lib/linklist.fth		\ Linked list routines

fload ${BP}/forth/lib/lex.fth
+fload ${BP}/forth/lib/printf.fth

fload ${BP}/forth/lib/autold.fth		\ Autoload mechanism

Added: forth/lib/printf.fth
===================================================================
--- forth/lib/printf.fth	                        (rev 0)
+++ forth/lib/printf.fth	2008-12-04 09:18:10 UTC (rev 1018)
@@ -0,0 +1,88 @@
+purpose: printf and sprintf
+\ See license at end of file
+
+d# 1024 buffer: spbuf
+0 value splen
+: +spbuf  ( adr len -- )
+   dup splen + d# 1024 >  abort" sprintf buffer overflow"
+   tuck  spbuf splen +  swap  move   ( len )
+   splen + is splen
+;
+: +spchar  ( char -- )
+   splen d# 1023 >  abort" sprintf buffer overflow"
+   spbuf splen +  c!
+   splen 1+ is splen
+;
+
+: 1/string  ( adr len -- adr' len' char )
+   dup  if                      ( adr len )
+      over c@ >r  1 /string  r>  ( adr' len' char )
+   else                          ( adr len )
+      -1                         ( adr len -1 )
+   then
+;
+
+: handle%  ( ... tail$ -- ... tail$' )  \ Handle % escapes
+   1/string              ( ... tail$ char )
+   case
+      [char] d  of   push-decimal rot <# u#s u#> +spbuf  pop-base  endof
+      [char] x  of   push-hex     rot <# u#s u#> +spbuf  pop-base  endof
+      [char] s  of   2swap +spbuf  endof
+      [char] o  of   push-octal   rot <# u#s u#> +spbuf  pop-base  endof
+      -1        of   endof
+      ( default )  dup +spchar
+   endcase
+;
+
+: handle\  ( ... tail$ -- ... tail$' )   \ Handle backslash escapes
+   1/string              ( ... tail$ char )
+   case
+      [char] n  of  newline   +spchar  then
+      [char] r  of  carret    +spchar  then
+      [char] t  of  control i +spchar  then
+      [char] f  of  control l +spchar  then
+      [char] l  of  linefeed  +spchar  then
+      [char] b  of  control h +spchar  then
+      [char] !  of  bell      +spchar  then
+      ( default ) +spchar
+   endcase
+;
+
+: sprintf  ( ... adr len -- adr' len' )
+   0 is splen
+
+   begin  dup  while              ( ... adr len )
+      " %" lex  if               ( ... tail$ head$ delim )
+         -rot +spbuf              ( ... tail$ delim )
+         [char] %  =  if  handle%  else  handle\  then  ( ... tail$ )
+      else                        ( ... tail$ )
+         +spbuf 0 0               ( ... 0 0 )
+      then                        ( ... tail$ )
+   repeat                         ( tail$ )
+   2drop   spbuf splen
+;
+: printf  ( ... adr len -- )  sprintf type  ;
+
+\ LICENSE_BEGIN
+\ Copyright (c) 2008 FirmWorks
+\ 
+\ Permission is hereby granted, free of charge, to any person obtaining
+\ a copy of this software and associated documentation files (the
+\ "Software"), to deal in the Software without restriction, including
+\ without limitation the rights to use, copy, modify, merge, publish,
+\ distribute, sublicense, and/or sell copies of the Software, and to
+\ permit persons to whom the Software is furnished to do so, subject to
+\ the following conditions:
+\ 
+\ The above copyright notice and this permission notice shall be
+\ included in all copies or substantial portions of the Software.
+\ 
+\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+\
+\ LICENSE_END