version 1.70, 1999/02/22 17:40:18
|
version 1.73, 1999/05/05 12:07:55
|
Line 315 false DefaultValue header
|
Line 315 false DefaultValue header
|
true DefaultValue interpreter |
true DefaultValue interpreter |
true DefaultValue ITC |
true DefaultValue ITC |
false DefaultValue rom |
false DefaultValue rom |
|
true DefaultValue standardthreading |
|
|
>TARGET |
>TARGET |
s" relocate" T environment? H |
s" relocate" T environment? H |
Line 326 s" relocate" T environment? H
|
Line 327 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 353 Variable bit$
|
Line 378 Variable bit$
|
Variable headers-named 0 headers-named ! |
Variable headers-named 0 headers-named ! |
Variable user-vars 0 user-vars ! |
Variable user-vars 0 user-vars ! |
|
|
\ Memory initialisation 05dec92py |
|
|
|
[IFDEF] Memory \ Memory is a bigFORTH feature |
|
also Memory |
|
: initmem ( var len -- ) |
|
2dup swap handle! >r @ r> erase ; |
|
toss |
|
[ELSE] |
|
: initmem ( var len -- ) |
|
tuck allocate abort" CROSS: No memory for target" |
|
( len var adr ) dup rot ! |
|
( len adr ) swap erase ; |
|
[THEN] |
|
|
|
\ MakeKernal 12dec92py |
|
|
|
: makekernel ( targetsize -- targetsize ) |
|
bit$ over 1- tcell>bit rshift 1+ initmem |
|
image over initmem ; |
|
|
|
>MINIMAL |
|
: makekernel makekernel ; |
|
>CROSS |
|
|
|
: target>bitmask-size ( u1 -- u2 ) |
: target>bitmask-size ( u1 -- u2 ) |
1- tcell>bit rshift 1+ ; |
1- tcell>bit rshift 1+ ; |
|
|
Line 384 Variable user-vars 0 user-vars !
|
Line 385 Variable user-vars 0 user-vars !
|
dup allocate ABORT" CROSS: No memory for target" |
dup allocate ABORT" CROSS: No memory for target" |
swap over swap erase ; |
swap over swap erase ; |
|
|
|
|
|
|
\ \ memregion.fs |
\ \ memregion.fs |
|
|
|
|
Line 491 T has? rom H
|
Line 490 T has? rom H
|
: setup-target ( -- ) \G initialize targets memory space |
: setup-target ( -- ) \G initialize targets memory space |
s" rom" T $has? H |
s" rom" T $has? H |
IF \ check for ram and rom... |
IF \ check for ram and rom... |
address-space area nip 0<> |
\ address-space area nip 0<> |
ram-dictionary area nip 0<> |
ram-dictionary area nip 0<> |
rom-dictionary area nip 0<> |
rom-dictionary area nip 0<> |
and and 0= |
and 0= |
ABORT" CROSS: define address-space, rom- , ram-dictionary, with rom-support!" |
ABORT" CROSS: define address-space, rom- , ram-dictionary, with rom-support!" |
THEN |
THEN |
address-space area nip |
address-space area nip |
Line 519 T has? rom H
|
Line 518 T has? rom H
|
r@ >rmem ! |
r@ >rmem ! |
|
|
target>bitmask-size allocatetarget |
target>bitmask-size allocatetarget |
dup |
dup bit$ ! |
bit$ ! |
|
r> >rbm ! |
r> >rbm ! |
|
|
ELSE r> drop THEN |
ELSE r> drop THEN |
REPEAT ; |
REPEAT drop ; |
|
|
|
\ MakeKernal 22feb99jaw |
|
|
|
: makekernel ( targetsize -- targetsize ) |
|
dup dictionary >rlen ! setup-target ; |
|
|
|
>MINIMAL |
|
: makekernel makekernel ; |
|
>CROSS |
|
|
\ \ switched tdp for rom support 03jun97jaw |
\ \ switched tdp for rom support 03jun97jaw |
|
|
Line 603 variable constflag constflag off
|
Line 610 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 733 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 ; |
|
|