version 1.2, 1994/05/03 15:24:11
|
version 1.4, 1994/05/18 17:29:50
|
Line 117 Variable bit$
|
Line 117 Variable bit$
|
Variable tdp |
Variable tdp |
: there tdp @ ; |
: there tdp @ ; |
|
|
\ Constants 06apr93py |
|
|
|
-2 Constant :docol |
|
-3 Constant :docon |
|
-4 Constant :dovar |
|
-5 Constant :dodoes |
|
|
|
\ Parameter for target systems 06oct92py |
\ Parameter for target systems 06oct92py |
|
|
include machine.fs |
include machine.fs |
Line 144 include machine.fs
|
Line 137 include machine.fs
|
-2 Constant :docol |
-2 Constant :docol |
-3 Constant :docon |
-3 Constant :docon |
-4 Constant :dovar |
-4 Constant :dovar |
-5 Constant :dodoes |
-5 Constant :douser |
|
-6 Constant :dodoes |
|
-7 Constant :doesjump |
|
|
>CROSS |
>CROSS |
|
|
Line 186 CREATE Bittable 80 c, 40 c, 20 c, 10 c,
|
Line 181 CREATE Bittable 80 c, 40 c, 20 c, 10 c,
|
|
|
: >bit ( addr n -- c-addr mask ) 8 /mod rot + swap bits ; |
: >bit ( addr n -- c-addr mask ) 8 /mod rot + swap bits ; |
: +bit ( addr n -- ) >bit over c@ or swap c! ; |
: +bit ( addr n -- ) >bit over c@ or swap c! ; |
|
: -bit ( addr n -- ) >bit invert over c@ and swap c! ; |
: relon ( taddr -- ) bit$ @ swap cell/ +bit ; |
: relon ( taddr -- ) bit$ @ swap cell/ +bit ; |
|
: reloff ( taddr -- ) bit$ @ swap cell/ -bit ; |
|
|
\ Target memory access 06oct92py |
\ Target memory access 06oct92py |
|
|
Line 228 CREATE Bittable 80 c, 40 c, 20 c, 10 c,
|
Line 225 CREATE Bittable 80 c, 40 c, 20 c, 10 c,
|
: >body ( cfa -- pfa ) T cell+ cell+ H ; |
: >body ( cfa -- pfa ) T cell+ cell+ H ; |
>CROSS |
>CROSS |
|
|
: dodoes, ( -- ) T 0 , 0 , H ; |
: dodoes, ( -- ) T :doesjump A, 0 , H ; |
|
|
\ Ghost Builder 06oct92py |
\ Ghost Builder 06oct92py |
|
|
Line 515 Cond: DOES> restrict?
|
Line 512 Cond: DOES> restrict?
|
|
|
: gdoes, ( ghost -- ) >end @ dup >magic @ <fwd> <> |
: gdoes, ( ghost -- ) >end @ dup >magic @ <fwd> <> |
IF dup >link @ dup 0< IF T A, 0 , H drop EXIT THEN drop THEN |
IF dup >link @ dup 0< IF T A, 0 , H drop EXIT THEN drop THEN |
:dodoes T A, H gexecute ; |
:dodoes T A, H gexecute T here H cell - reloff ; |
|
|
: TCreate ( ghost -- ) |
: TCreate ( ghost -- ) |
CreateFlag on |
CreateFlag on |
Line 562 Build: T 0 A, H ;
|
Line 559 Build: T 0 A, H ;
|
by Create |
by Create |
Builder AVariable |
Builder AVariable |
|
|
Build: T 0 , H ; |
\ User variables 04may94py |
by Create |
|
|
>CROSS |
|
Variable tup 0 tup ! |
|
Variable tudp 0 tudp ! |
|
: u, ( n -- udp ) |
|
tup @ tudp @ + T ! H |
|
tudp @ dup cell+ tudp ! ; |
|
: au, ( n -- udp ) |
|
tup @ tudp @ + T A! H |
|
tudp @ dup cell+ tudp ! ; |
|
>TARGET |
|
|
|
Build: T 0 u, , H ; |
|
DO: ( ghost -- up-addr ) T @ H tup @ + ;DO |
Builder User |
Builder User |
|
by User :douser resolve |
|
|
Build: T 0 , 0 , H ; |
Build: T 0 u, , 0 u, drop H ; |
by Create |
by User |
Builder 2User |
Builder 2User |
|
|
Build: T 0 A, H ; |
Build: T 0 au, , H ; |
by Create |
by User |
Builder AUser |
Builder AUser |
|
|
Build: ( n -- ) T , H ; |
Build: ( n -- ) T , H ; |
Line 771 only forth also minimal definitions
|
Line 782 only forth also minimal definitions
|
: decimal decimal ; |
: decimal decimal ; |
: hex hex ; |
: hex hex ; |
|
|
|
: tudp T tudp H ; |
|
: tup T tup H ; minimal |
|
|
\ for debugging... |
\ for debugging... |
: order order ; |
: order order ; |