| \ CROSS.FS The Cross-Compiler 06oct92py |
\ CROSS.FS The Cross-Compiler 06oct92py |
| \ Idea and implementation: Bernd Paysan (py) |
\ Idea and implementation: Bernd Paysan (py) |
| |
|
| \ Copyright (C) 1995,1996,1997,1998,1999,2000,2003 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1996,1997,1998,1999,2000,2003,2004 Free Software Foundation, Inc. |
| |
|
| \ This file is part of Gforth. |
\ This file is part of Gforth. |
| |
|
| \G Make a complete new Forth search path; the path separator is |. |
\G Make a complete new Forth search path; the path separator is |. |
| fpath path= ; |
fpath path= ; |
| |
|
| : path>counted cell+ dup cell+ swap @ ; |
: path>string cell+ dup cell+ swap @ ; |
| |
|
| : next-path ( adr len -- adr2 len2 ) |
: next-path ( adr len -- adr2 len2 ) |
| 2dup 0 scan |
2dup 0 scan |
| r> - ; |
r> - ; |
| |
|
| : previous-path ( path^ -- ) |
: previous-path ( path^ -- ) |
| dup path>counted |
dup path>string |
| BEGIN tuck dup WHILE repeat ; |
BEGIN tuck dup WHILE repeat ; |
| |
|
| : .path ( path-addr -- ) \ gforth |
: .path ( path-addr -- ) \ gforth |
| \G Display the contents of the search path @var{path-addr}. |
\G Display the contents of the search path @var{path-addr}. |
| path>counted |
path>string |
| BEGIN next-path dup WHILE type space REPEAT 2drop 2drop ; |
BEGIN next-path dup WHILE type space REPEAT 2drop 2drop ; |
| |
|
| : .fpath ( -- ) \ gforth |
: .fpath ( -- ) \ gforth |
| IF rdrop |
IF rdrop |
| ofile place open-ofile |
ofile place open-ofile |
| dup 0= IF >r ofile count r> THEN EXIT |
dup 0= IF >r ofile count r> THEN EXIT |
| ELSE r> path>counted |
ELSE r> path>string |
| BEGIN next-path dup |
BEGIN next-path dup |
| WHILE 5 pick 5 pick check-path |
WHILE 5 pick 5 pick check-path |
| 0= IF >r 2drop 2drop r> ofile count 0 EXIT ELSE drop THEN |
0= IF >r 2drop 2drop r> ofile count 0 EXIT ELSE drop THEN |
| Ghost (for) drop |
Ghost (for) drop |
| Ghost (loop) Ghost (+loop) 2drop |
Ghost (loop) Ghost (+loop) 2drop |
| Ghost (next) drop |
Ghost (next) drop |
| Ghost (does>) Ghost compile, 2drop |
Ghost (does>) Ghost (does>1) Ghost (does>2) 2drop drop |
| |
Ghost compile, drop |
| Ghost (.") Ghost (S") Ghost (ABORT") 2drop drop |
Ghost (.") Ghost (S") Ghost (ABORT") 2drop drop |
| Ghost (C") Ghost c(abort") Ghost type 2drop drop |
Ghost (C") Ghost c(abort") Ghost type 2drop drop |
| Ghost ' drop |
Ghost ' drop |
| |
|
| : count dup X c@ swap X char+ swap ; |
: count dup X c@ swap X char+ swap ; |
| |
|
| : on -1 -1 rot TD! ; |
: on >r -1 -1 r> TD! ; |
| : off T 0 swap ! H ; |
: off T 0 swap ! H ; |
| |
|
| : tcmove ( source dest len -- ) |
: tcmove ( source dest len -- ) |
| ENDCASE |
ENDCASE |
| LOOP ; |
LOOP ; |
| |
|
| Defer setup-execution-semantics |
Defer setup-execution-semantics ' noop IS setup-execution-semantics |
| 0 Value lastghost |
0 Value lastghost |
| |
|
| : (THeader ( "name" -- ghost ) |
: (THeader ( "name" -- ghost ) |
| r@ created >do:ghost ! r@ swap resolve |
r@ created >do:ghost ! r@ swap resolve |
| r> tlastcfa @ >tempdp dodoes, tempdp> ; |
r> tlastcfa @ >tempdp dodoes, tempdp> ; |
| |
|
| Defer instant-interpret-does>-hook |
Defer instant-interpret-does>-hook ' noop IS instant-interpret-does>-hook |
| |
|
| T has? peephole H [IF] |
T has? peephole H [IF] |
| : does-resolved ( ghost -- ) |
: does-resolved ( ghost -- ) |
| |
|
| >TARGET |
>TARGET |
| Cond: DOES> |
Cond: DOES> |
| compile (does>) doeshandler, |
T here 5 cells H + alit, compile (does>2) compile ;s |
| resolve-does>-part |
doeshandler, resolve-does>-part |
| ;Cond |
;Cond |
| |
|
| : DOES> |
: DOES> |
