version 1.56, 1998/07/05 20:49:59
|
version 1.57, 1998/10/25 23:15:46
|
Line 334 s" relocate" T environment? H
|
Line 334 s" relocate" T environment? H
|
|
|
\ \ Create additional parameters 19jan95py |
\ \ Create additional parameters 19jan95py |
|
|
|
1 8 lshift Constant maxbyte |
T |
T |
NIL Constant TNIL |
NIL Constant TNIL |
cell Constant tcell |
cell Constant tcell |
cell<< Constant tcell<< |
cell<< Constant tcell<< |
cell>bit Constant tcell>bit |
cell>bit Constant tcell>bit |
bits/byte Constant tbits/byte |
bits/byte Constant tbits/byte |
|
bits/byte 8 / Constant tchar |
float Constant tfloat |
float Constant tfloat |
1 bits/byte lshift Constant maxbyte |
1 bits/byte lshift Constant tmaxbyte |
H |
H |
|
|
\ Variables 06oct92py |
\ Variables 06oct92py |
Line 589 bigendian
|
Line 591 bigendian
|
DO maxbyte ud/mod rot I c! -1 +LOOP 2drop ; |
DO maxbyte ud/mod rot I c! -1 +LOOP 2drop ; |
: S@ ( addr -- n ) >r 0 0 r> tcell bounds |
: S@ ( addr -- n ) >r 0 0 r> tcell bounds |
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap LOOP d>s ; |
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap LOOP d>s ; |
|
: Sc! ( n addr -- ) >r s>d r> tchar bounds swap 1- |
|
DO maxbyte ud/mod rot I c! -1 +LOOP 2drop ; |
|
: Sc@ ( addr -- n ) >r 0 0 r> tchar bounds |
|
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap LOOP d>s ; |
[ELSE] |
[ELSE] |
: S! ( n addr -- ) >r s>d r> tcell bounds |
: S! ( n addr -- ) >r s>d r> tcell bounds |
DO maxbyte ud/mod rot I c! LOOP 2drop ; |
DO maxbyte ud/mod rot I c! LOOP 2drop ; |
: S@ ( addr -- n ) >r 0 0 r> tcell bounds swap 1- |
: S@ ( addr -- n ) >r 0 0 r> tcell bounds swap 1- |
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap -1 +LOOP d>s ; |
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap -1 +LOOP d>s ; |
|
: Sc! ( n addr -- ) >r s>d r> tchar bounds |
|
DO maxbyte ud/mod rot I c! LOOP 2drop ; |
|
: Sc@ ( addr -- n ) >r 0 0 r> tchar bounds swap 1- |
|
DO maxbyte * swap maxbyte um* rot + swap I c@ + swap -1 +LOOP d>s ; |
[THEN] |
[THEN] |
|
|
>CROSS |
>CROSS |
Line 629 CREATE Bittable 80 c, 40 c, 20 c, 10 c,
|
Line 639 CREATE Bittable 80 c, 40 c, 20 c, 10 c,
|
>TARGET |
>TARGET |
: @ ( taddr -- w ) >image S@ ; |
: @ ( taddr -- w ) >image S@ ; |
: ! ( w taddr -- ) >image S! ; |
: ! ( w taddr -- ) >image S! ; |
: c@ ( taddr -- char ) >image c@ ; |
: c@ ( taddr -- char ) >image Sc@ ; |
: c! ( char taddr -- ) >image c! ; |
: c! ( char taddr -- ) >image Sc! ; |
: 2@ ( taddr -- x1 x2 ) T dup cell+ @ swap @ H ; |
: 2@ ( taddr -- x1 x2 ) T dup cell+ @ swap @ H ; |
: 2! ( x1 x2 taddr -- ) T swap over ! cell+ ! H ; |
: 2! ( x1 x2 taddr -- ) T swap over ! cell+ ! H ; |
|
|
Line 640 CREATE Bittable 80 c, 40 c, 20 c, 10 c,
|
Line 650 CREATE Bittable 80 c, 40 c, 20 c, 10 c,
|
: here ( -- there ) there ; |
: here ( -- there ) there ; |
: allot ( n -- ) tdp +! ; |
: allot ( n -- ) tdp +! ; |
: , ( w -- ) T here H tcell T allot ! H T here drop H ; |
: , ( w -- ) T here H tcell T allot ! H T here drop H ; |
: c, ( char -- ) T here 1 allot c! H ; |
: c, ( char -- ) T here tchar allot c! H ; |
: align ( -- ) T here H align+ 0 ?DO bl T c, H LOOP ; |
: align ( -- ) T here H align+ 0 ?DO bl T c, H LOOP ; |
: cfalign ( -- ) |
: cfalign ( -- ) |
T here H cfalign+ 0 ?DO bl T c, H LOOP ; |
T here H cfalign+ 0 ?DO bl T c, H LOOP ; |
Line 652 CREATE Bittable 80 c, 40 c, 20 c, 10 c,
|
Line 662 CREATE Bittable 80 c, 40 c, 20 c, 10 c,
|
|
|
: tcmove ( source dest len -- ) |
: tcmove ( source dest len -- ) |
\G cmove in target memory |
\G cmove in target memory |
bounds |
tchar * bounds |
?DO dup T c@ H I T c! H 1+ |
?DO dup T c@ H I T c! H 1+ |
LOOP drop ; |
tchar +LOOP drop ; |
|
|
>TARGET |
>TARGET |
H also Forth definitions \ ." asm: " order |
H also Forth definitions \ ." asm: " order |
Line 1263 Defer (end-code)
|
Line 1273 Defer (end-code)
|
ELSE true ABORT" CROSS: Stack empty" THEN |
ELSE true ABORT" CROSS: Stack empty" THEN |
; |
; |
|
|
Cond: chars ;Cond |
( Cond ) : chars tchar * ; ( Cond ) |
|
|
>CROSS |
>CROSS |
|
|