version 1.70, 1999/02/22 17:40:18
|
version 1.71, 1999/02/22 18:27:22
|
Line 326 s" relocate" T environment? H
|
Line 326 s" relocate" T environment? H
|
|
|
\ \ Create additional parameters 19jan95py |
\ \ Create additional parameters 19jan95py |
|
|
1 8 lshift Constant maxbyte |
\ currently cross only works for host machines with address-unit-bits |
|
\ eual to 8 because of s! and sc! |
|
\ but I start to query the environment just to modularize a little bit |
|
|
|
: check-address-unit-bits ( -- ) |
|
\ s" ADDRESS-UNIT-BITS" environment? |
|
\ IF 8 <> ELSE true THEN |
|
\ ABORT" ADDRESS-UNIT-BITS unknown or not equal to 8!" |
|
|
|
\ shit, this doesn't work because environment? is only defined for |
|
\ gforth.fi and not kernl???.fi |
|
; |
|
|
|
check-address-unit-bits |
|
8 Constant bits/byte \ we define: byte is address-unit |
|
|
|
1 bits/byte lshift Constant maxbyte |
\ this sets byte size for the target machine, an (probably right guess) jaw |
\ this sets byte size for the target machine, an (probably right guess) jaw |
|
|
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/char Constant tbits/char |
bits/char Constant tbits/char |
bits/char 8 / Constant tchar |
bits/char H bits/byte T / |
float Constant tfloat |
Constant tchar |
1 bits/char lshift Constant tmaxchar |
float Constant tfloat |
|
1 bits/char lshift Constant tmaxchar |
|
[IFUNDEF] bits/byte |
|
8 Constant tbits/byte |
|
[ELSE] |
|
bits/byte Constant tbits/byte |
|
[THEN] |
H |
H |
|
tbits/byte bits/byte / Constant tbyte |
|
|
|
|
\ Variables 06oct92py |
\ Variables 06oct92py |
|
|
Line 603 variable constflag constflag off
|
Line 627 variable constflag constflag off
|
|
|
: cell+ tcell + ; |
: cell+ tcell + ; |
: cells tcell<< lshift ; |
: cells tcell<< lshift ; |
: chars ; |
: chars tchar * ; |
: char+ 1 + ; |
: char+ tchar + ; |
: floats tfloat * ; |
: floats tfloat * ; |
|
|
>CROSS |
>CROSS |
Line 726 T has? relocate H
|
Line 750 T has? relocate H
|
: cfalign ( -- ) |
: cfalign ( -- ) |
T here H cfalign+ 0 ?DO bl T c, tchar H +LOOP ; |
T here H cfalign+ 0 ?DO bl T c, tchar H +LOOP ; |
|
|
: >address dup 0>= IF tchar / THEN ; \ ?? jaw |
: >address dup 0>= IF tbyte / THEN ; \ ?? jaw |
: A! swap >address swap dup relon T ! H ; |
: A! swap >address swap dup relon T ! H ; |
: A, ( w -- ) >address T here H relon T , H ; |
: A, ( w -- ) >address T here H relon T , H ; |
|
|