version 1.14, 1994/10/24 19:15:53
|
version 1.18, 1994/12/15 12:35:12
|
Line 1
|
Line 1
|
\ CROSS.FS The Cross-Compiler 06oct92py |
\ CROSS.FS The Cross-Compiler 06oct92py |
\ $Id$ |
\ $Id$ |
\ Idea and implementation: Bernd Paysan (py) |
\ Idea and implementation: Bernd Paysan (py) |
\ Copyright 1992 by the ANSI figForth Development Group |
\ Copyright 1992-94 by the GNU Forth Development Group |
|
|
\ Log: |
\ Log: |
\ changed in ; [ to state off 12may93jaw |
\ changed in ; [ to state off 12may93jaw |
Line 256 VARIABLE Already
|
Line 256 VARIABLE Already
|
BEGIN @ dup |
BEGIN @ dup |
WHILE 2dup cell+ @ = |
WHILE 2dup cell+ @ = |
UNTIL |
UNTIL |
nip 2 cells + count cr ." CROSS: Exists: " type 4 spaces |
2 cells + count cr ." CROSS: Exists: " type 4 spaces drop |
swap cell+ ! |
swap cell+ ! |
ELSE true ABORT" CROSS: Ghostnames inconsistent" |
ELSE true ABORT" CROSS: Ghostnames inconsistent" |
THEN ; |
THEN ; |
Line 312 VARIABLE ^imm
|
Line 312 VARIABLE ^imm
|
|
|
>TARGET |
>TARGET |
: immediate 20 flag! |
: immediate 20 flag! |
^imm @ @ dup <imm> = ?EXIT |
^imm @ @ dup <imm> = IF drop EXIT THEN |
<res> <> ABORT" CROSS: Cannot immediate a unresolved word" |
<res> <> ABORT" CROSS: Cannot immediate a unresolved word" |
<imm> ^imm @ ! ; |
<imm> ^imm @ ! ; |
: restrict 40 flag! ; |
: restrict 40 flag! ; |
Line 322 VARIABLE ^imm
|
Line 322 VARIABLE ^imm
|
|
|
: ALIAS2 create here 0 , DOES> @ execute ; |
: ALIAS2 create here 0 , DOES> @ execute ; |
\ usage: |
\ usage: |
\ ' alias2 bla ! |
\ ' <name> alias2 bla ! |
|
|
\ Target Header Creation 01nov92py |
\ Target Header Creation 01nov92py |
|
|
Line 337 VARIABLE CreateFlag CreateFlag off
|
Line 337 VARIABLE CreateFlag CreateFlag off
|
tlast @ dup 0> IF T 1 cells - THEN A, H there tlast ! |
tlast @ dup 0> IF T 1 cells - THEN A, H there tlast ! |
>in @ name, >in ! T here H tlastcfa ! |
>in @ name, >in ! T here H tlastcfa ! |
CreateFlag @ IF |
CreateFlag @ IF |
>in @ alias2 swap >in ! \ create alias in target |
>in @ alias2 swap >in ! \ create alias in target |
>in @ ghost swap >in ! |
>in @ ghost swap >in ! |
swap also ghosts ' previous swap ! \ tick ghost and store in alias |
swap also ghosts ' previous swap ! \ tick ghost and store in alias |
CreateFlag off |
CreateFlag off |
ELSE ghost THEN |
ELSE ghost THEN |
dup >magic ^imm ! \ a pointer for immediate |
dup >magic ^imm ! \ a pointer for immediate |
Already @ IF dup >end tdoes ! |
Already @ IF dup >end tdoes ! |
Line 738 bigendian Constant bigendian
|
Line 738 bigendian Constant bigendian
|
: save-cross ( "name" -- ) |
: save-cross ( "name" -- ) |
bl parse ." Saving to " 2dup type |
bl parse ." Saving to " 2dup type |
w/o bin create-file throw >r |
w/o bin create-file throw >r |
image @ there r@ write-file throw |
s" gforth00" r@ write-file throw \ write magic |
bit$ @ there 1- cell>bit rshift 1+ r@ write-file throw |
image @ there r@ write-file throw \ write image |
|
bit$ @ there 1- cell>bit rshift 1+ |
|
r@ write-file throw \ write tags |
r> close-file throw ; |
r> close-file throw ; |
|
|
\ words that should be in minimal |
\ words that should be in minimal |