Forth 2012 adds more convenient syntax for numbers and characters.
* csrc/pf_words.c (ffWord): Don't upcase input. Without this
change we can't support the '<char>' syntax.
(ffNumberQ): Recgonize new syntax.
* fth/numerio.fth (>number-with-base): New helper.
(((NUMBER?))): Recognize new syntax.
* fth/t_corex.fth: Add test for number prefixes, from Gerry Jackson's
Forth2012 test suite.
/* Convert a string to the corresponding number using BASE. */
cell_t ffNumberQ( const char *FWord, cell_t *Num )
{
- cell_t Len, i, Accum=0, n, Sign=1;
+ cell_t Len, i, Accum=0, n, Sign=1, Base=gVarBase;
const char *s;
/* get count */
Len = *FWord++;
s = FWord;
+ switch (*s) {
+ case '#': Base = 10; s++; Len--; break;
+ case '$': Base = 16; s++; Len--; break;
+ case '%': Base = 2; s++; Len--; break;
+ case '\'':
+ if( Len == 3 && s[2] == '\'' )
+ {
+ *Num = s[1];
+ return NUM_TYPE_SINGLE;
+ }
+ }
+
/* process initial minus sign */
if( *s == '-' )
{
for( i=0; i<Len; i++)
{
n = HexDigitToNumber( *s++ );
- if( (n < 0) || (n >= gVarBase) )
+ if( (n < 0) || (n >= Base) )
{
return NUM_TYPE_BAD;
}
- Accum = (Accum * gVarBase) + n;
+ Accum = (Accum * Base) + n;
}
*Num = Accum * Sign;
return NUM_TYPE_SINGLE;
gScratch[0] = (char) nc;
for( i=0; i<nc; i++ )
{
- gScratch[i+1] = pfCharToUpper( s2[i] );
+ gScratch[i+1] = s2[i];
}
}
else
1 constant NUM_TYPE_SINGLE
2 constant NUM_TYPE_DOUBLE
+\ Like >number, but temporarily switch BASE.
+: (>number-with-base) ( ud c-addr u base -- ud' c-addr' u' )
+ base @ >r base ! >number r> base !
+;
+
\ This is similar to the F83 NUMBER? except that it returns a number type
\ and then either a single or double precision number.
: ((NUMBER?)) ( c-addr u -- 0 | n 1 | d 2 , convert string to number )
dup 0= IF 2drop NUM_TYPE_BAD exit THEN \ any chars?
-\ prepare for >number
- 0 0 2swap ( 0 0 c-addr cnt )
+ base @ -rot ( base c-addr u )
+
+ \ Regonize prefixes and change base if needed
+ over c@ >r ( base c-addr u ) ( r: char )
+ r@ [char] # = if rot drop 10 -rot 1 /string then
+ r@ [char] $ = if rot drop 16 -rot 1 /string then
+ r@ [char] % = if rot drop 2 -rot 1 /string then
+ r@ [char] ' = if
+ \ Recognize '<char>'
+ dup 3 = if
+ over 2 chars + c@ [char] ' = if
+ drop nip rdrop
+ char+ c@ NUM_TYPE_SINGLE exit
+ then
+ then
+ then
+ r> drop
\ check for '-' at beginning, skip if present
over c@ ascii - = \ is it a '-'
dup >r \ save flag
- IF 1- >r 1+ r> ( -- 0 0 c-addr+1 cnt-1 , skip past minus sign )
+ IF 1 /string ( -- base c-addr+1 cnt-1 , skip past minus sign )
THEN
-\
- >number dup 0= \ convert as much as we can
+
+ ( base c-addr cnt ) ( r: minus-flag )
+ rot >r 0 0 2swap r>
+ (>number-with-base) dup 0= \ convert as much as we can
IF
2drop \ drop addr cnt
drop \ drop hi part of num
T{ 0 MIN-INT 1+ 1 MIN-INT GD8 }T{ 2 }T
T{ 0 MIN-INT 1+ DUP MIN-INT GD8 }T{ 1 }T
+\ ----------------------------------------------------------------------------
+\ .( TESTING number prefixes # $ % and 'c' character input )
+\ Adapted from the Forth 200X Draft 14.5 document
+
+VARIABLE OLD-BASE
+DECIMAL BASE @ OLD-BASE !
+T{ #1289 }T{ 1289 }T
+T{ #-1289 }T{ -1289 }T
+T{ $12eF }T{ 4847 }T
+T{ $-12eF }T{ -4847 }T
+T{ %10010110 }T{ 150 }T
+T{ %-10010110 }T{ -150 }T
+T{ 'z' }T{ 122 }T
+T{ 'Z' }T{ 90 }T
+\ Check BASE is unchanged
+T{ BASE @ OLD-BASE @ = }T{ TRUE }T
+
+\ Repeat in Hex mode
+16 OLD-BASE ! 16 BASE !
+T{ #1289 }T{ 509 }T
+T{ #-1289 }T{ -509 }T
+T{ $12eF }T{ 12EF }T
+T{ $-12eF }T{ -12EF }T
+T{ %10010110 }T{ 96 }T
+T{ %-10010110 }T{ -96 }T
+T{ 'z' }T{ 7a }T
+T{ 'Z' }T{ 5a }T
+\ Check BASE is unchanged
+T{ BASE @ OLD-BASE @ = }T{ TRUE }T \ 2
+
+DECIMAL
+\ Check number prefixes in compile mode
+T{ : nmp #8327 $-2cbe %011010111 ''' ; nmp }T{ 8327 -11454 215 39 }T
}TEST