| \ targets 09jun93jaw |
\ targets 09jun93jaw |
| \ added: 2user and value 11jun93jaw |
\ added: 2user and value 11jun93jaw |
| |
|
| include other.fs \ ansforth extentions for cross |
\ include other.fs \ ansforth extentions for cross |
| |
|
| : comment? ( c-addr u -- c-addr u ) |
: comment? ( c-addr u -- c-addr u ) |
| 2dup s" (" compare 0= |
2dup s" (" compare 0= |
| |
|
| decimal |
decimal |
| |
|
| \ number? 11may93jaw |
|
| |
|
| \ checks for +, -, $, & ... |
|
| : leading? ( c-addr u -- c-addr u doubleflag negflag base ) |
|
| 2dup 1- chars + c@ [char] . = \ process double |
|
| IF dup 1 chars = IF over 1 swap c! false ELSE 1 chars - true THEN |
|
| \ only if more than only . ( may be number output! ) |
|
| \ if only . => store garbage |
|
| ELSE false THEN >r \ numbers |
|
| false -rot base @ -rot |
|
| BEGIN over c@ |
|
| dup [char] - = |
|
| IF drop >r >r >r |
|
| drop true r> r> r> 0 THEN |
|
| dup [char] + = |
|
| IF drop 0 THEN |
|
| dup [char] $ = |
|
| IF drop >r >r drop 16 r> r> 0 THEN |
|
| dup [char] & = |
|
| IF drop >r >r drop 10 r> r> 0 THEN |
|
| 0= IF 1 chars - swap char+ swap false ELSE true THEN |
|
| over 0= or |
|
| UNTIL |
|
| rot >r rot r> r> -rot ; |
|
| |
|
| : number? ( c-addr -- n/d flag ) |
|
| \ return -1 if cell 1 if double 0 if garbage |
|
| 0 swap 0 swap \ create double number |
|
| count leading? |
|
| base @ >r base ! |
|
| >r >r |
|
| >number IF 2drop false r> r> 2drop |
|
| r> base ! EXIT THEN |
|
| drop r> r> |
|
| IF IF dnegate 1 |
|
| ELSE drop negate -1 THEN |
|
| ELSE IF 1 ELSE drop -1 THEN |
|
| THEN r> base ! ; |
|
| |
|
| |
|
| |
|
| \ Begin CROSS COMPILER: |
\ Begin CROSS COMPILER: |
| |
|
| \ GhostNames 9may93jaw |
\ GhostNames 9may93jaw |
| ghost lit ghost (compile) ghost ! 2drop drop |
ghost lit ghost (compile) ghost ! 2drop drop |
| ghost (;code) ghost noop 2drop |
ghost (;code) ghost noop 2drop |
| ghost (.") ghost (S") ghost (ABORT") 2drop drop |
ghost (.") ghost (S") ghost (ABORT") 2drop drop |
| |
ghost ' |
| |
|
| \ compile 10may93jaw |
\ compile 10may93jaw |
| |
|
| |
|
| Cond: IS T ' >body H compile ALiteral compile ! ;Cond |
Cond: IS T ' >body H compile ALiteral compile ! ;Cond |
| : IS T ' >body ! H ; |
: IS T ' >body ! H ; |
| |
Cond: TO T ' >body H compile ALiteral compile ! ;Cond |
| |
: TO T ' >body ! H ; |
| |
|
| \ LINKED ERR" ENV" 2ENV" 18may93jaw |
\ LINKED ERR" ENV" 2ENV" 18may93jaw |
| |
|
