version 1.4, 1994/05/18 17:29:50
|
version 1.8, 1994/07/13 19:20:59
|
Line 23
|
Line 23
|
|
|
include other.fs \ ansforth extentions for cross |
include other.fs \ ansforth extentions for cross |
|
|
|
: comment? ( c-addr u -- c-addr u ) |
|
2dup s" (" compare 0= |
|
IF postpone ( |
|
ELSE 2dup s" \" compare 0= IF postpone \ THEN |
|
THEN ; |
|
|
decimal |
decimal |
|
|
\ number? 11may93jaw |
\ number? 11may93jaw |
Line 128 include machine.fs
|
Line 134 include machine.fs
|
: cell+ cell + ; |
: cell+ cell + ; |
: cells cell<< lshift ; |
: cells cell<< lshift ; |
: chars ; |
: chars ; |
|
: floats float * ; |
|
|
>CROSS |
>CROSS |
: cell/ cell<< rshift ; |
: cell/ cell<< rshift ; |
>TARGET |
>TARGET |
Line 155 endian 0 pad ! -1 pad c! pad @ 0<
|
Line 162 endian 0 pad ! -1 pad c! pad @ 0<
|
\ Fixed bug in else part 11may93jaw |
\ Fixed bug in else part 11may93jaw |
|
|
[IFDEF] Memory \ Memory is a bigFORTH feature |
[IFDEF] Memory \ Memory is a bigFORTH feature |
Memory |
also Memory |
: initmem ( var len -- ) |
: initmem ( var len -- ) |
2dup swap handle! >r @ r> erase ; |
2dup swap handle! >r @ r> erase ; |
Target |
toss |
[ELSE] |
[ELSE] |
: initmem ( var len -- ) |
: initmem ( var len -- ) |
tuck allocate abort" CROSS: No memory for target" |
tuck allocate abort" CROSS: No memory for target" |
Line 201 CREATE Bittable 80 c, 40 c, 20 c, 10 c,
|
Line 208 CREATE Bittable 80 c, 40 c, 20 c, 10 c,
|
: ! ( w taddr -- ) >r bswap r> >image ! ; |
: ! ( w taddr -- ) >r bswap r> >image ! ; |
: c@ ( taddr -- char ) >image c@ ; |
: c@ ( taddr -- char ) >image c@ ; |
: c! ( char taddr -- ) >image c! ; |
: c! ( char taddr -- ) >image c! ; |
|
: 2@ ( taddr -- x1 x2 ) T dup cell+ @ swap @ H ; |
|
: 2! ( x1 x2 taddr -- ) T swap over ! cell+ ! H ; |
|
|
\ Target compilation primitives 06oct92py |
\ Target compilation primitives 06oct92py |
\ included A! 16may93jaw |
\ included A! 16may93jaw |
Line 263 Variable atonce atonce off
|
Line 272 Variable atonce atonce off
|
: gfind ( string -- ghost true/1 / string false ) |
: gfind ( string -- ghost true/1 / string false ) |
\ searches for string in word-list ghosts |
\ searches for string in word-list ghosts |
\ !! wouldn't it be simpler to just use search-wordlist ? ae |
\ !! wouldn't it be simpler to just use search-wordlist ? ae |
>r get-order 0 set-order also ghosts r> find >r >r |
dup count [ ' ghosts >body ] ALiteral search-wordlist |
set-order r> r@ IF >body THEN r> ; |
\ >r get-order 0 set-order also ghosts r> find >r >r |
|
>r r@ IF >body nip THEN r> ; |
|
\ set-order r> r@ IF >body THEN r> ; |
|
|
VARIABLE Already |
VARIABLE Already |
|
|
Line 339 VARIABLE ^imm
|
Line 350 VARIABLE ^imm
|
^imm @ @ dup <imm> = ?EXIT |
^imm @ @ dup <imm> = ?EXIT |
<res> <> ABORT" CROSS: Cannot immediate a unresolved word" |
<res> <> ABORT" CROSS: Cannot immediate a unresolved word" |
<imm> ^imm @ ! ; |
<imm> ^imm @ ! ; |
: restrict ; |
: restrict 40 flag! ; |
>CROSS |
>CROSS |
|
|
\ ALIAS2 ansforth conform alias 9may93jaw |
\ ALIAS2 ansforth conform alias 9may93jaw |
Line 480 Cond: [Char] ( "<char>" -- ) restrict
|
Line 491 Cond: [Char] ( "<char>" -- ) restrict
|
|
|
Cond: EXIT ( -- ) restrict? compile ;S ;Cond |
Cond: EXIT ( -- ) restrict? compile ;S ;Cond |
|
|
|
Cond: ?EXIT ( -- ) 1 abort" CROSS: using ?exit" ;Cond |
|
|
Cond: ; ( -- ) restrict? |
Cond: ; ( -- ) restrict? |
depth ?dup IF 1- <> ABORT" CROSS: Stack changed" |
depth ?dup IF 1- <> ABORT" CROSS: Stack changed" |
ELSE true ABORT" CROSS: Stack empty" THEN |
ELSE true ABORT" CROSS: Stack empty" THEN |