version 1.67, 1999/02/19 18:25:28
|
version 1.71, 1999/02/22 18:27:22
|
Line 1
|
Line 1
|
\ CROSS.FS The Cross-Compiler 06oct92py |
\ CROSS.FS The Cross-Compiler 06oct92py |
\ Idea and implementation: Bernd Paysan (py) |
\ Idea and implementation: Bernd Paysan (py) |
|
|
\ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 52 Warnings off
|
Line 52 Warnings off
|
\G Same behaviour as "Value" if the <name> is not defined |
\G Same behaviour as "Value" if the <name> is not defined |
\G Same behaviour as "to" if <name> is defined |
\G Same behaviour as "to" if <name> is defined |
\G SetValue searches in the current vocabulary |
\G SetValue searches in the current vocabulary |
save-input bl word >r restore-input throw r> count |
save-input bl word >r restore-input throw r> count |
get-current search-wordlist |
get-current search-wordlist |
IF ['] to execute ELSE Value THEN ; |
IF drop >r |
|
\ we have to set current to be topmost context wordlist |
|
get-order get-order get-current swap 1+ set-order |
|
r> ['] to execute |
|
set-order order |
|
ELSE Value THEN ; |
|
|
: DefaultValue ( n -- <name> ) |
: DefaultValue ( n -- <name> ) |
\G Same behaviour as "Value" if the <name> is not defined |
\G Same behaviour as "Value" if the <name> is not defined |
Line 321 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/byte Constant tbits/byte |
bits/char Constant tbits/char |
bits/byte 8 / Constant tchar |
bits/char H bits/byte T / |
float Constant tfloat |
Constant tchar |
1 bits/byte lshift Constant tmaxbyte |
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 425 Variable mirrored-link \ linked
|
Line 454 Variable mirrored-link \ linked
|
|
|
: mirrored \G mark a region as mirrored |
: mirrored \G mark a region as mirrored |
mirrored-link |
mirrored-link |
linked last-defined-region @ , ; |
align linked last-defined-region @ , ; |
|
|
: .addr ( u -- ) |
: .addr ( u -- ) |
\G prints a 16 or 32 Bit nice hex value |
\G prints a 16 or 32 Bit nice hex value |
Line 598 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 684 T has? relocate H
|
Line 713 T has? relocate H
|
[ELSE] |
[ELSE] |
' drop IS relon |
' drop IS relon |
' drop IS reloff |
' drop IS reloff |
' (correcter) IS >image |
' (>regionimage) IS >image |
[THEN] |
[THEN] |
|
|
\ Target memory access 06oct92py |
\ Target memory access 06oct92py |
Line 721 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 ; |
|
|