| |
|
| included |
included |
| |
|
| |
\ Create additional parameters 19jan95py |
| |
|
| |
T |
| |
cell Constant tcell |
| |
cell<< Constant tcell<< |
| |
cell>bit Constant tcell>bit |
| |
bits/byte Constant tbits/byte |
| |
float Constant tfloat |
| |
1 bits/byte lshift Constant maxbyte |
| |
H |
| |
|
| >TARGET |
>TARGET |
| |
|
| \ Byte ordering and cell size 06oct92py |
\ Byte ordering and cell size 06oct92py |
| |
|
| : cell+ cell + ; |
: cell+ tcell + ; |
| : cells cell<< lshift ; |
: cells tcell<< lshift ; |
| : chars ; |
: chars ; |
| : floats float * ; |
: floats tfloat * ; |
| |
|
| >CROSS |
>CROSS |
| : cell/ cell<< rshift ; |
: cell/ tcell<< rshift ; |
| >TARGET |
>TARGET |
| 20 CONSTANT bl |
20 CONSTANT bl |
| -1 Constant NIL |
-1 Constant NIL |
| >CROSS |
>CROSS |
| |
|
| bigendian 0 pad ! -1 pad c! pad @ 0< |
bigendian 0 pad ! -1 pad c! pad @ 0< |
| = [IF] : bswap ; immediate |
= [IF] |
| [ELSE] : bswap ( big / little -- little / big ) 0 |
\ : bswap ; immediate |
| cell 1- FOR bits/byte lshift over |
: T! ( n addr -- ) >r s>d r> tcell bounds swap 1- |
| [ 1 bits/byte lshift 1- ] Literal and or |
DO maxbyte ud/mod rot I c! -1 +LOOP 2drop ; |
| swap bits/byte rshift swap NEXT nip ; |
: T@ ( addr -- n ) >r 0 0 r> tcell bounds |
| |
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap LOOP d>s ; |
| |
|
| |
[ELSE] |
| |
: T! ( n addr -- ) >r s>d r> tcell bounds |
| |
DO maxbyte ud/mod rot I c! LOOP 2drop ; |
| |
: T@ ( addr -- n ) >r 0 0 r> tcell bounds swap 1- |
| |
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap -1 +LOOP d>s ; |
| |
|
| |
\ : bswap ( big / little -- little / big ) 0 |
| |
\ cell 1- FOR bits/byte lshift over |
| |
\ [ 1 bits/byte lshift 1- ] Literal and or |
| |
\ swap bits/byte rshift swap NEXT nip ; |
| [THEN] |
[THEN] |
| |
|
| \ Memory initialisation 05dec92py |
\ Memory initialisation 05dec92py |
| >CROSS |
>CROSS |
| : >image ( taddr -- absaddr ) image @ + ; |
: >image ( taddr -- absaddr ) image @ + ; |
| >TARGET |
>TARGET |
| : @ ( taddr -- w ) >image @ bswap ; |
: @ ( taddr -- w ) >image t@ ; |
| : ! ( w taddr -- ) >r bswap r> >image ! ; |
: ! ( w taddr -- ) >image t! ; |
| : 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@ ( taddr -- x1 x2 ) T dup cell+ @ swap @ H ; |
| Variable tudp 0 tudp ! |
Variable tudp 0 tudp ! |
| : u, ( n -- udp ) |
: u, ( n -- udp ) |
| tup @ tudp @ + T ! H |
tup @ tudp @ + T ! H |
| tudp @ dup cell+ tudp ! ; |
tudp @ dup T cell+ H tudp ! ; |
| : au, ( n -- udp ) |
: au, ( n -- udp ) |
| tup @ tudp @ + T A! H |
tup @ tudp @ + T A! H |
| tudp @ dup cell+ tudp ! ; |
tudp @ dup T cell+ H tudp ! ; |
| >TARGET |
>TARGET |
| |
|
| Build: T 0 u, , H ; |
Build: T 0 u, , H ; |
| : * * ; : / / ; |
: * * ; : / / ; |
| : dup dup ; : over over ; |
: dup dup ; : over over ; |
| : swap swap ; : rot rot ; |
: swap swap ; : rot rot ; |
| : drop drop ; |
: drop drop ; : = = ; |
| : lshift lshift ; : 2/ 2/ ; |
: lshift lshift ; : 2/ 2/ ; |
| |
: . . ; |
| cell constant cell |
cell constant cell |
| |
|
| \ include bug5.fs |
\ include bug5.fs |