version 1.47, 1997/04/10 21:32:08
|
version 1.48, 1997/05/21 20:39:21
|
Line 37
|
Line 37
|
\ targets 09jun93jaw |
\ targets 09jun93jaw |
\ added: 2user and value 11jun93jaw |
\ added: 2user and value 11jun93jaw |
|
|
|
\ needed? works better now!!! 01mar97jaw |
|
\ mach file is only loaded into target |
|
\ cell corrected |
|
|
|
|
\ include other.fs \ ansforth extentions for cross |
\ include other.fs \ ansforth extentions for cross |
|
|
: string, ( c-addr u -- ) |
: string, ( c-addr u -- ) |
Line 93 H
|
Line 98 H
|
|
|
\ Parameter for target systems 06oct92py |
\ Parameter for target systems 06oct92py |
|
|
|
>TARGET |
mach-file count included |
mach-file count included |
|
|
|
[IFUNDEF] has-interpreter true CONSTANT has-interpreter [THEN] |
|
|
also Forth definitions |
also Forth definitions |
|
|
[IFDEF] asm-include asm-include [THEN] |
[IFDEF] asm-include asm-include [THEN] |
Line 104 hex
|
Line 112 hex
|
|
|
>CROSS |
>CROSS |
|
|
\ Variables 06oct92py |
|
|
|
Variable image |
|
Variable tlast NIL tlast ! \ Last name field |
|
Variable tlastcfa \ Last code field |
|
Variable tdoes \ Resolve does> calls |
|
Variable bit$ |
|
Variable tdp |
|
: there tdp @ ; |
|
|
|
\ Create additional parameters 19jan95py |
\ Create additional parameters 19jan95py |
|
|
T |
T |
|
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 |
Line 125 float Constant tfloat
|
Line 124 float Constant tfloat
|
1 bits/byte lshift Constant maxbyte |
1 bits/byte lshift Constant maxbyte |
H |
H |
|
|
|
\ Variables 06oct92py |
|
|
|
Variable image |
|
Variable tlast TNIL tlast ! \ Last name field |
|
Variable tlastcfa \ Last code field |
|
Variable tdoes \ Resolve does> calls |
|
Variable bit$ |
|
Variable tdp |
|
: there tdp @ ; |
|
|
|
|
>TARGET |
>TARGET |
|
|
\ Byte ordering and cell size 06oct92py |
\ Byte ordering and cell size 06oct92py |
Line 132 H
|
Line 142 H
|
: cell+ tcell + ; |
: cell+ tcell + ; |
: cells tcell<< lshift ; |
: cells tcell<< lshift ; |
: chars ; |
: chars ; |
|
: char+ 1 + ; |
: floats tfloat * ; |
: floats tfloat * ; |
|
|
>CROSS |
>CROSS |
: cell/ tcell<< rshift ; |
: cell/ tcell<< rshift ; |
>TARGET |
>TARGET |
20 CONSTANT bl |
20 CONSTANT bl |
-1 Constant NIL |
TNIL Constant NIL |
|
|
>CROSS |
>CROSS |
|
|
Line 174 bigendian
|
Line 185 bigendian
|
|
|
>MINIMAL |
>MINIMAL |
: makekernel ( targetsize -- targetsize ) |
: makekernel ( targetsize -- targetsize ) |
bit$ over 1- cell>bit rshift 1+ initmem |
bit$ over 1- tcell>bit rshift 1+ initmem |
image over initmem tdp off ; |
image over initmem tdp off ; |
|
|
>CROSS |
>CROSS |
Line 192 CREATE Bittable 80 c, 40 c, 20 c, 10 c,
|
Line 203 CREATE Bittable 80 c, 40 c, 20 c, 10 c,
|
\ Target memory access 06oct92py |
\ Target memory access 06oct92py |
|
|
: align+ ( taddr -- rest ) |
: align+ ( taddr -- rest ) |
cell tuck 1- and - [ cell 1- ] Literal and ; |
tcell tuck 1- and - [ tcell 1- ] Literal and ; |
: cfalign+ ( taddr -- rest ) |
: cfalign+ ( taddr -- rest ) |
\ see kernel.fs:cfaligned |
\ see kernel.fs:cfaligned |
/maxalign tuck 1- and - [ /maxalign 1- ] Literal and ; |
/maxalign tuck 1- and - [ /maxalign 1- ] Literal and ; |
Line 220 CREATE Bittable 80 c, 40 c, 20 c, 10 c,
|
Line 231 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 cell T allot ! H ; |
: , ( w -- ) T here H tcell T allot ! H ; |
: c, ( char -- ) T here 1 allot c! H ; |
: c, ( char -- ) T here 1 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 ( -- ) |
Line 271 Variable last-ghost
|
Line 282 Variable last-ghost
|
here tuck swap ! ghostheader T> |
here tuck swap ! ghostheader T> |
DOES> dup last-ghost ! >exec @ execute ; |
DOES> dup last-ghost ! >exec @ execute ; |
|
|
|
variable cfalist 0 cfalist ! |
|
|
|
: markcfa |
|
cfalist here over @ , swap ! , ; |
|
|
\ ghost words 14oct92py |
\ ghost words 14oct92py |
\ changed: 10may93py/jaw |
\ changed: 10may93py/jaw |
|
|
Line 340 variable ResolveFlag
|
Line 356 variable ResolveFlag
|
WHILE dup ?resolved |
WHILE dup ?resolved |
REPEAT drop ResolveFlag @ |
REPEAT drop ResolveFlag @ |
IF |
IF |
abort" Unresolved words!" |
-1 abort" Unresolved words!" |
ELSE |
ELSE |
." Nothing!" |
." Nothing!" |
THEN |
THEN |
Line 376 VARIABLE ^imm
|
Line 392 VARIABLE ^imm
|
|
|
\ Target Document Creation (goes to crossdoc.fd) 05jul95py |
\ Target Document Creation (goes to crossdoc.fd) 05jul95py |
|
|
s" crossdoc.fd" r/w create-file throw value doc-file-id |
s" doc/crossdoc.fd" r/w create-file throw value doc-file-id |
\ contains the file-id of the documentation file |
\ contains the file-id of the documentation file |
|
|
: T-\G ( -- ) |
: T-\G ( -- ) |
Line 443 Defer skip? ' false IS skip?
|
Line 459 Defer skip? ' false IS skip?
|
ghost >magic @ <fwd> <> ; |
ghost >magic @ <fwd> <> ; |
|
|
: needed? ( -- flag ) \ name |
: needed? ( -- flag ) \ name |
ghost dup >magic @ <fwd> = |
\G returns a false flag when |
IF >link @ 0<> ELSE drop false THEN ; |
\G a word is not defined |
|
\G a forward reference exists |
|
\G so the definition is not skipped! |
|
bl word gfind |
|
IF dup >magic @ <fwd> = |
|
\ swap >link @ 0<> and |
|
nip |
|
0= |
|
ELSE drop true THEN ; |
|
|
: doer? ( -- flag ) \ name |
: doer? ( -- flag ) \ name |
ghost >magic @ <do:> = ; |
ghost >magic @ <do:> = ; |
Line 552 Defer (code)
|
Line 576 Defer (code)
|
Defer (end-code) |
Defer (end-code) |
[THEN] |
[THEN] |
|
|
|
[IFUNDEF] ca>native |
|
defer ca>native |
|
[THEN] |
|
|
>TARGET |
>TARGET |
: Code |
: Code |
(THeader there resolve |
(THeader there resolve |
[ has-prims 0= [IF] ITC [ELSE] true [THEN] ] [IF] |
[ has-prims 0= [IF] ITC [ELSE] true [THEN] ] [IF] |
there 2 T cells H + T a, 0 , H |
there 2 T cells H + ca>native T a, 0 , H |
[THEN] |
[THEN] |
depth (code) ; |
depth (code) ; |
|
|
: Code: |
: Code: |
ghost dup there resolve <do:> swap >magic ! |
ghost dup there ca>native resolve <do:> swap >magic ! |
depth (code) ; |
depth (code) ; |
|
|
: end-code |
: end-code |
Line 673 Cond: [ restrict? state off ;Cond
|
Line 701 Cond: [ restrict? state off ;Cond
|
|
|
>TARGET |
>TARGET |
Cond: DOES> restrict? |
Cond: DOES> restrict? |
compile (does>) dodoes, tdoes @ ?dup IF @ T here H resolve THEN |
compile (does>) dodoes, tdoes @ ?dup IF @ T here H resolve THEN |
;Cond |
;Cond |
: DOES> dodoes, T here H !does depth T ] H ; |
: DOES> dodoes, T here H !does depth T ] H ; |
|
|
Line 878 Cond: ENDCASE restrict? compile drop 0
|
Line 906 Cond: ENDCASE restrict? compile drop 0
|
\ Structural Conditionals 12dec92py |
\ Structural Conditionals 12dec92py |
|
|
Cond: DO restrict? compile (do) T here H ;Cond |
Cond: DO restrict? compile (do) T here H ;Cond |
Cond: ?DO restrict? compile (?do) (leave T here H ;Cond |
Cond: ?DO restrict? compile (?do) T (leave here H ;Cond |
Cond: FOR restrict? compile (for) T here H ;Cond |
Cond: FOR restrict? compile (for) T here H ;Cond |
|
|
>CROSS |
>CROSS |
: loop] dup <resolve cell - compile DONE compile unloop ; |
: loop] dup <resolve tcell - compile DONE compile unloop ; |
>TARGET |
>TARGET |
|
|
Cond: LOOP restrict? sys? compile (loop) loop] ;Cond |
Cond: LOOP restrict? sys? compile (loop) loop] ;Cond |
Line 962 also minimal
|
Line 990 also minimal
|
|
|
also minimal |
also minimal |
|
|
|
\G interprets the line if word is not defined |
: \- defined? IF postpone \ THEN ; |
: \- defined? IF postpone \ THEN ; |
|
|
|
\G interprets the line if word is defined |
: \+ defined? 0= IF postpone \ THEN ; |
: \+ defined? 0= IF postpone \ THEN ; |
|
|
|
Cond: \- \- ;Cond |
|
Cond: \+ \+ ;Cond |
|
|
|
: ?? bl word find IF execute ELSE drop 0 THEN ; |
|
|
|
: needed: |
|
\G defines ghost for words that we want to be compiled |
|
BEGIN >in @ bl word c@ WHILE >in ! ghost drop REPEAT drop ; |
|
|
: [IF] postpone [IF] ; |
: [IF] postpone [IF] ; |
: [THEN] postpone [THEN] ; |
: [THEN] postpone [THEN] ; |
: [ELSE] postpone [ELSE] ; |
: [ELSE] postpone [ELSE] ; |
Line 975 Cond: [IFUNDEF] [IFUNDEF] ;Cond
|
Line 1015 Cond: [IFUNDEF] [IFUNDEF] ;Cond
|
Cond: [THEN] [THEN] ;Cond |
Cond: [THEN] [THEN] ;Cond |
Cond: [ELSE] [ELSE] ;Cond |
Cond: [ELSE] [ELSE] ;Cond |
|
|
\ save-cross 17mar93py |
previous |
|
|
\ i'm not interested in bigforth features this time 10may93jaw |
|
\ [IFDEF] file |
|
\ also file |
|
\ [THEN] |
|
\ included throw after create-file 11may93jaw |
|
|
|
bigendian Constant bigendian |
\ save-cross 17mar93py |
|
|
|
>CROSS |
Create magic s" Gforth10" here over allot swap move |
Create magic s" Gforth10" here over allot swap move |
|
|
char 1 bigendian + cell + magic 7 + c! |
char 1 bigendian + tcell + magic 7 + c! |
|
|
: save-cross ( "image-name" "binary-name" -- ) |
: save-cross ( "image-name" "binary-name" -- ) |
bl parse ." Saving to " 2dup type cr |
bl parse ." Saving to " 2dup type cr |
w/o bin create-file throw >r |
w/o bin create-file throw >r |
NIL IF |
TNIL IF |
s" #! " r@ write-file throw |
s" #! " r@ write-file throw |
bl parse r@ write-file throw |
bl parse r@ write-file throw |
s" -i" r@ write-file throw |
s" -i" r@ write-file throw |
Line 1007 char 1 bigendian + cell + magic 7 + c!
|
Line 1042 char 1 bigendian + cell + magic 7 + c!
|
bl parse 2drop |
bl parse 2drop |
THEN |
THEN |
image @ there r@ write-file throw \ write image |
image @ there r@ write-file throw \ write image |
NIL IF |
TNIL IF |
bit$ @ there 1- cell>bit rshift 1+ |
bit$ @ there 1- tcell>bit rshift 1+ |
r@ write-file throw \ write tags |
r@ write-file throw \ write tags |
THEN |
THEN |
r> close-file throw ; |
r> close-file throw ; |
|
|
\ words that should be in minimal |
\ words that should be in minimal |
|
>MINIMAL |
|
also minimal |
|
|
|
bigendian Constant bigendian |
|
: save-cross save-cross ; |
: here there ; |
: here there ; |
also forth [IFDEF] Label : Label Label ; [THEN] previous |
also forth |
|
[IFDEF] Label : Label Label ; [THEN] |
|
[IFDEF] start-macros : start-macros start-macros ; [THEN] |
|
previous |
|
|
: + + ; |
: + + ; |
: or or ; |
: or or ; |
: 1- 1- ; |
: 1- 1- ; |
Line 1035 also forth [IFDEF] Label : Label Label ;
|
Line 1078 also forth [IFDEF] Label : Label Label ;
|
: 2/ 2/ ; |
: 2/ 2/ ; |
: . . ; |
: . . ; |
|
|
mach-file count included |
\ mach-file count included |
|
|
: all-words ['] false IS skip? ; |
: all-words ['] false IS skip? ; |
: needed-words ['] needed? IS skip? ; |
: needed-words ['] needed? IS skip? ; |