version 1.11, 1994/09/02 15:23:33
|
version 1.15, 1994/11/15 15:55:34
|
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 40 VARIABLE GhostNames
|
Line 40 VARIABLE GhostNames
|
0 GhostNames ! |
0 GhostNames ! |
: GhostName ( -- addr ) |
: GhostName ( -- addr ) |
here GhostNames @ , GhostNames ! here 0 , |
here GhostNames @ , GhostNames ! here 0 , |
name count |
bl word count |
\ 2dup type space |
\ 2dup type space |
dup c, here over chars allot swap move align ; |
dup c, here over chars allot swap move align ; |
|
|
Line 84 Variable tdp
|
Line 84 Variable tdp
|
|
|
\ Parameter for target systems 06oct92py |
\ Parameter for target systems 06oct92py |
|
|
include-file |
included |
|
|
>TARGET |
>TARGET |
|
|
Line 110 include-file
|
Line 110 include-file
|
|
|
>CROSS |
>CROSS |
|
|
endian 0 pad ! -1 pad c! pad @ 0< |
bigendian 0 pad ! -1 pad c! pad @ 0< |
= [IF] : bswap ; immediate |
= [IF] : bswap ; immediate |
[ELSE] : bswap ( big / little -- little / big ) 0 |
[ELSE] : bswap ( big / little -- little / big ) 0 |
cell 1- FOR bits/byte lshift over |
cell 1- FOR bits/byte lshift over |
Line 234 Variable last-ghost
|
Line 234 Variable last-ghost
|
\ searches for string in word-list ghosts |
\ searches for string in word-list ghosts |
\ !! wouldn't it be simpler to just use search-wordlist ? ae |
\ !! wouldn't it be simpler to just use search-wordlist ? ae |
dup count [ ' ghosts >body ] ALiteral search-wordlist |
dup count [ ' ghosts >body ] ALiteral search-wordlist |
\ >r get-order 0 set-order also ghosts r> find >r >r |
dup IF >r >body nip r> THEN ; |
>r r@ IF >body nip THEN r> ; |
|
\ set-order r> r@ IF >body THEN r> ; |
|
|
|
VARIABLE Already |
VARIABLE Already |
|
|
: ghost ( "name" -- ghost ) |
: ghost ( "name" -- ghost ) |
Already off |
Already off |
>in @ name gfind IF Already on nip EXIT THEN |
>in @ bl word gfind IF Already on nip EXIT THEN |
drop >in ! Make-Ghost ; |
drop >in ! Make-Ghost ; |
|
|
\ resolve 14oct92py |
\ resolve 14oct92py |
Line 330 VARIABLE ^imm
|
Line 328 VARIABLE ^imm
|
|
|
: string, ( addr count -- ) |
: string, ( addr count -- ) |
dup T c, H bounds DO I c@ T c, H LOOP ; |
dup T c, H bounds DO I c@ T c, H LOOP ; |
: name, ( "name" -- ) name count string, T align H ; |
: name, ( "name" -- ) bl word count string, T align H ; |
: view, ( -- ) ( dummy ) ; |
: view, ( -- ) ( dummy ) ; |
|
|
VARIABLE CreateFlag CreateFlag off |
VARIABLE CreateFlag CreateFlag off |
Line 398 ghost '
|
Line 396 ghost '
|
|
|
: compile ( -- ) \ name |
: compile ( -- ) \ name |
restrict? |
restrict? |
name gfind dup 0= ABORT" CROSS: Can't compile " |
bl word gfind dup 0= ABORT" CROSS: Can't compile " |
0> ( immediate? ) |
0> ( immediate? ) |
IF >exec @ compile, |
IF >exec @ compile, |
ELSE postpone literal postpone gexecute THEN ; |
ELSE postpone literal postpone gexecute THEN ; |
immediate |
immediate |
|
|
>TARGET |
>TARGET |
: ' ( -- cfa ) name gfind 0= ABORT" CROSS: undefined " |
: ' ( -- cfa ) bl word gfind 0= ABORT" CROSS: undefined " |
dup >magic @ <fwd> = ABORT" CROSS: forward " >link @ ; |
dup >magic @ <fwd> = ABORT" CROSS: forward " >link @ ; |
|
|
Cond: ['] compile lit ghost gexecute ;Cond |
Cond: ['] compile lit ghost gexecute ;Cond |
|
|
|
Cond: chars ;Cond |
|
|
>CROSS |
>CROSS |
\ tLiteral 12dec92py |
\ tLiteral 12dec92py |
|
|
Line 442 Cond: [Char] ( "<char>" -- ) restrict
|
Line 442 Cond: [Char] ( "<char>" -- ) restrict
|
|
|
: ] state on |
: ] state on |
BEGIN |
BEGIN |
BEGIN >in @ name |
BEGIN >in @ bl word |
dup c@ 0= WHILE 2drop refill 0= |
dup c@ 0= WHILE 2drop refill 0= |
ABORT" CROSS: End of file while target compiling" |
ABORT" CROSS: End of file while target compiling" |
REPEAT |
REPEAT |
Line 672 Cond: TO T ' >body H compile ALit
|
Line 672 Cond: TO T ' >body H compile ALit
|
\ compile must be last 22feb93py |
\ compile must be last 22feb93py |
|
|
Cond: compile ( -- ) restrict? \ name |
Cond: compile ( -- ) restrict? \ name |
name gfind dup 0= ABORT" CROSS: Can't compile" |
bl word gfind dup 0= ABORT" CROSS: Can't compile" |
0> IF gexecute |
0> IF gexecute |
ELSE dup >magic @ <imm> = |
ELSE dup >magic @ <imm> = |
IF gexecute |
IF gexecute |
ELSE compile (compile) gexecute THEN THEN ;Cond |
ELSE compile (compile) gexecute THEN THEN ;Cond |
|
|
Cond: postpone ( -- ) restrict? \ name |
Cond: postpone ( -- ) restrict? \ name |
name gfind dup 0= ABORT" CROSS: Can't compile" |
bl word gfind dup 0= ABORT" CROSS: Can't compile" |
0> IF gexecute |
0> IF gexecute |
ELSE dup >magic @ <imm> = |
ELSE dup >magic @ <imm> = |
IF gexecute |
IF gexecute |
Line 693 also minimal
|
Line 693 also minimal
|
|
|
\ define new [IFDEF] and [IFUNDEF] 20may93jaw |
\ define new [IFDEF] and [IFUNDEF] 20may93jaw |
|
|
: there? name gfind IF >magic @ <fwd> <> ELSE drop false THEN ; |
: there? bl word gfind IF >magic @ <fwd> <> ELSE drop false THEN ; |
|
|
: [IFDEF] there? postpone [IF] ; |
: [IFDEF] there? postpone [IF] ; |
: [IFUNDEF] there? 0= postpone [IF] ; |
: [IFUNDEF] there? 0= postpone [IF] ; |
Line 733 Cond: [ELSE] [ELSE] ;Cond
|
Line 733 Cond: [ELSE] [ELSE] ;Cond
|
\ [THEN] |
\ [THEN] |
\ included throw after create-file 11may93jaw |
\ included throw after create-file 11may93jaw |
|
|
endian Constant endian |
bigendian Constant bigendian |
|
|
: save-cross ( "name" -- ) |
: save-cross ( "name" -- ) |
bl parse ." Saving to " 2dup type |
bl parse ." Saving to " 2dup type |
Line 749 endian Constant endian
|
Line 749 endian Constant endian
|
: * * ; : / / ; |
: * * ; : / / ; |
: dup dup ; : over over ; |
: dup dup ; : over over ; |
: swap swap ; : rot rot ; |
: swap swap ; : rot rot ; |
|
: drop drop ; |
|
: lshift lshift ; : 2/ 2/ ; |
|
cell constant cell |
|
|
\ include bug5.fs |
\ include bug5.fs |
\ only forth also minimal definitions |
\ only forth also minimal definitions |