| |
|
| [THEN] |
[THEN] |
| |
|
| |
\ this provides assert( and struct stuff |
| |
\GFORTH [IFUNDEF] assert1( |
| |
\GFORTH also forth definitions require assert.fs previous |
| |
\GFORTH [THEN] |
| |
|
| |
>CROSS |
| |
|
| hex \ the defualt base for the cross-compiler is hex !! |
hex \ the defualt base for the cross-compiler is hex !! |
| \ Warnings off |
\ Warnings off |
| |
|
| |
|
| \ ' >ghostname ALIAS @name |
\ ' >ghostname ALIAS @name |
| |
|
| |
: findghost ( "ghostname" -- ghost ) |
| |
bl word gfind 0= ABORT" CROSS: Ghost don't exists" ; |
| |
|
| : [G'] ( -- ghost : name ) |
: [G'] ( -- ghost : name ) |
| \G ticks a ghost and returns its address |
\G ticks a ghost and returns its address |
| \ bl word gfind 0= ABORT" CROSS: Ghost don't exists" |
findghost |
| ghost state @ IF postpone literal THEN ; immediate |
state @ IF postpone literal THEN ; immediate |
| |
|
| : g>xt ( ghost -- xt ) |
: g>xt ( ghost -- xt ) |
| \G Returns the xt (cfa) of a ghost. Issues a warning if undefined. |
\G Returns the xt (cfa) of a ghost. Issues a warning if undefined. |
| Ghost over Ghost = Ghost drop 2drop drop |
Ghost over Ghost = Ghost drop 2drop drop |
| Ghost 2drop drop |
Ghost 2drop drop |
| Ghost 2dup drop |
Ghost 2dup drop |
| |
Ghost state drop |
| |
Ghost call drop |
| |
Ghost @ drop |
| |
Ghost useraddr drop |
| |
Ghost execute drop |
| |
Ghost + drop |
| |
Ghost (C") drop |
| |
Ghost decimal drop |
| |
Ghost hex drop |
| |
|
| \ \ Parameter for target systems 06oct92py |
\ \ Parameter for target systems 06oct92py |
| |
|
| \ compile 10may93jaw |
\ compile 10may93jaw |
| |
|
| : compile ( "name" -- ) \ name |
: compile ( "name" -- ) \ name |
| \ bl word gfind 0= ABORT" CROSS: Can't compile " |
findghost |
| ghost |
|
| dup >exec-compile @ ?dup |
dup >exec-compile @ ?dup |
| IF nip compile, |
IF nip compile, |
| ELSE postpone literal postpone gexecute THEN ; immediate restrict |
ELSE postpone literal postpone gexecute THEN ; immediate restrict |
| |
|
| : [T'] |
: [T'] |
| \ returns the target-cfa of a ghost, or compiles it as literal |
\ returns the target-cfa of a ghost, or compiles it as literal |
| postpone [G'] state @ IF postpone g>xt ELSE g>xt THEN ; immediate |
postpone [G'] |
| |
state @ IF postpone g>xt ELSE g>xt THEN ; immediate |
| |
|
| \ \ threading modell 13dec92py |
\ \ threading modell 13dec92py |
| \ modularized 14jun97jaw |
\ modularized 14jun97jaw |
| ;Cond |
;Cond |
| |
|
| >CROSS |
>CROSS |
| |
|
| \ Target compiling loop 12dec92py |
\ Target compiling loop 12dec92py |
| \ ">tib trick thrown out 10may93jaw |
\ ">tib trick thrown out 10may93jaw |
| \ number? defined at the top 11may93jaw |
\ number? defined at the top 11may93jaw |
| IF 0> IF swap lit, THEN lit, discard |
IF 0> IF swap lit, THEN lit, discard |
| ELSE 2drop restore-input throw Ghost gexecute THEN ; |
ELSE 2drop restore-input throw Ghost gexecute THEN ; |
| |
|
| >TARGET |
|
| \ : ; DOES> 13dec92py |
\ : ; DOES> 13dec92py |
| \ ] 9may93py/jaw |
\ ] 9may93py/jaw |
| |
|
| |
>CROSS |
| |
|
| : compiling-state ( -- ) |
: compiling-state ( -- ) |
| \G set states to compililng |
\G set states to compililng |
| Compiling comp-state ! |
Compiling comp-state ! |
| IF >ghost-xt @ execute X off ELSE drop THEN |
IF >ghost-xt @ execute X off ELSE drop THEN |
| Interpreting comp-state ! ; |
Interpreting comp-state ! ; |
| |
|
| |
>TARGET |
| |
|
| : ] |
: ] |
| compiling-state |
compiling-state |
| BEGIN |
BEGIN |