| hex |
hex |
| const Create bases 10 , 2 , A , 100 , |
const Create bases 10 , 2 , A , 100 , |
| \ 16 2 10 character |
\ 16 2 10 character |
| \ !! this saving and restoring base is an abomination! - anton |
|
| |
|
| |
\ !! protect BASE saving wrapper against exceptions |
| : getbase ( addr u -- addr' u' ) |
: getbase ( addr u -- addr' u' ) |
| over c@ [char] $ - dup 4 u< |
over c@ [char] $ - dup 4 u< |
| IF |
IF |
| drop |
drop |
| THEN ; |
THEN ; |
| |
|
| : s>number ( addr len -- d ) |
\ ouch, this is complicated; there must be a simpler way - anton |
| |
: s>number? ( addr len -- d f ) |
| |
\ converts string addr len into d, flag indicates success |
| base @ >r dpl on |
base @ >r dpl on |
| over c@ '- = dup >r |
over c@ '- = dup >r |
| IF |
IF |
| 1 /string |
1 /string |
| THEN |
THEN |
| getbase dpl on 0 0 2swap |
getbase dpl on 0. 2swap |
| BEGIN |
BEGIN ( d addr len ) |
| dup >r >number dup |
dup >r >number dup |
| WHILE |
WHILE \ there are characters left |
| dup r> - |
dup r> - |
| WHILE |
WHILE \ the last >number parsed something |
| dup dpl ! over c@ [char] . = |
dup 1- dpl ! over c@ [char] . = |
| WHILE |
WHILE \ the current char is '.' |
| 1 /string |
1 /string |
| REPEAT THEN |
REPEAT THEN \ there are unparseable characters left |
| 2drop rdrop dpl off |
2drop rdrop false |
| ELSE |
ELSE \ no characters left, all ok |
| 2drop rdrop r> |
2drop rdrop r> |
| IF |
IF |
| dnegate |
dnegate |
| THEN |
THEN |
| |
true |
| THEN |
THEN |
| r> base ! ; |
r> base ! ; |
| |
|
| |
: s>number ( addr len -- d ) |
| |
\ don't use this, there is no way to tell success |
| |
s>number? drop ; |
| |
|
| : snumber? ( c-addr u -- 0 / n -1 / d 0> ) |
: snumber? ( c-addr u -- 0 / n -1 / d 0> ) |
| s>number dpl @ 0= |
s>number? 0= |
| IF |
IF |
| 2drop false EXIT |
2drop false EXIT |
| THEN |
THEN |
| dpl @ dup 0> 0= IF |
dpl @ dup 0< IF |
| nip |
nip |
| |
ELSE |
| |
1+ |
| THEN ; |
THEN ; |
| |
|
| : number? ( string -- string 0 / n -1 / d 0> ) |
: number? ( string -- string 0 / n -1 / d 0> ) |
