version 1.164, 2007/04/01 21:30:26
|
version 1.176, 2011/10/06 20:04:35
|
Line 1
|
Line 1
|
\ 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,2004,2005,2006 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1996,1997,1998,1999,2000,2003,2004,2005,2006,2007,2009,2010 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
\ Gforth is free software; you can redistribute it and/or |
\ Gforth is free software; you can redistribute it and/or |
\ modify it under the terms of the GNU General Public License |
\ modify it under the terms of the GNU General Public License |
\ as published by the Free Software Foundation; either version 2 |
\ as published by the Free Software Foundation, either version 3 |
\ of the License, or (at your option) any later version. |
\ of the License, or (at your option) any later version. |
|
|
\ This program is distributed in the hope that it will be useful, |
\ This program is distributed in the hope that it will be useful, |
Line 16
|
Line 16
|
\ GNU General Public License for more details. |
\ GNU General Public License for more details. |
|
|
\ You should have received a copy of the GNU General Public License |
\ You should have received a copy of the GNU General Public License |
\ along with this program; if not, write to the Free Software |
\ along with this program. If not, see http://www.gnu.org/licenses/. |
\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. |
|
|
|
0 |
0 |
[IF] |
[IF] |
Line 192 Create bases 10 , 2 , A , 100 ,
|
Line 191 Create bases 10 , 2 , A , 100 ,
|
1+ |
1+ |
THEN ; |
THEN ; |
|
|
: number? ( string -- string 0 / n -1 / d 0> ) |
: (number?) ( string -- string 0 / n -1 / d 0> ) |
dup >r count snumber? dup if |
dup >r count snumber? dup if |
rdrop |
rdrop |
else |
else |
Line 200 Create bases 10 , 2 , A , 100 ,
|
Line 199 Create bases 10 , 2 , A , 100 ,
|
then ; |
then ; |
|
|
: number ( string -- d ) |
: number ( string -- d ) |
number? ?dup 0= abort" ?" 0< |
(number?) ?dup 0= abort" ?" 0< |
IF |
IF |
s>d |
s>d |
THEN ; |
THEN ; |
|
|
[THEN] |
[THEN] |
|
|
|
[IFUNDEF] (number?) : (number?) number? ; [THEN] |
|
|
\ this provides assert( and struct stuff |
\ this provides assert( and struct stuff |
\GFORTH [IFUNDEF] assert1( |
\GFORTH [IFUNDEF] assert1( |
\GFORTH also forth definitions require assert.fs previous |
\GFORTH also forth definitions require assert.fs previous |
Line 764 Plugin ?do, ( -- ?do-token )
|
Line 765 Plugin ?do, ( -- ?do-token )
|
Plugin for, ( -- for-token ) |
Plugin for, ( -- for-token ) |
Plugin loop, ( do-token / ?do-token -- ) |
Plugin loop, ( do-token / ?do-token -- ) |
Plugin +loop, ( do-token / ?do-token -- ) |
Plugin +loop, ( do-token / ?do-token -- ) |
|
Plugin -loop, ( do-token / ?do-token -- ) |
Plugin next, ( for-token ) |
Plugin next, ( for-token ) |
Plugin leave, ( -- ) |
Plugin leave, ( -- ) |
Plugin ?leave, ( -- ) |
Plugin ?leave, ( -- ) |
Line 1725 T has? relocate H
|
Line 1727 T has? relocate H
|
|
|
Ghost (do) Ghost (?do) 2drop |
Ghost (do) Ghost (?do) 2drop |
Ghost (for) drop |
Ghost (for) drop |
Ghost (loop) Ghost (+loop) 2drop |
Ghost (loop) Ghost (+loop) Ghost (-loop) 2drop drop |
Ghost (next) drop |
Ghost (next) drop |
Ghost (does>) Ghost (does>1) Ghost (does>2) 2drop drop |
Ghost !does drop |
Ghost compile, 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 |
Line 2411 T 2 cells H Value xt>body
|
Line 2413 T 2 cells H Value xt>body
|
there xt>body + ca>native T a, H 1 fillcfa ; ' (doprim,) plugin-of doprim, |
there xt>body + ca>native T a, H 1 fillcfa ; ' (doprim,) plugin-of doprim, |
|
|
: (doeshandler,) ( -- ) |
: (doeshandler,) ( -- ) |
T cfalign H [G'] :doesjump addr, T 0 , H ; ' (doeshandler,) plugin-of doeshandler, |
T H ; ' (doeshandler,) plugin-of doeshandler, |
|
|
: (dodoes,) ( does-action-ghost -- ) |
: (dodoes,) ( does-action-ghost -- ) |
]comp [G'] :dodoes addr, comp[ |
]comp [G'] :dodoes addr, comp[ |
addr, |
addr, |
\ the relocator in the c engine, does not like the |
|
\ does-address to marked for relocation |
|
[ T e? ec H 0= [IF] ] T here H tcell - reloff [ [THEN] ] |
|
2 fillcfa ; ' (dodoes,) plugin-of dodoes, |
2 fillcfa ; ' (dodoes,) plugin-of dodoes, |
|
|
: (dlit,) ( n -- ) compile lit td, ; ' (dlit,) plugin-of dlit, |
: (dlit,) ( n -- ) compile lit td, ; ' (dlit,) plugin-of dlit, |
Line 2536 Cond: MAXI
|
Line 2535 Cond: MAXI
|
IF nip execute-exec-compile ELSE gexecute THEN |
IF nip execute-exec-compile ELSE gexecute THEN |
EXIT |
EXIT |
THEN |
THEN |
number? dup |
(number?) dup |
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 ; |
|
|
Line 2651 T has? primcentric H [IF]
|
Line 2650 T has? primcentric H [IF]
|
>TARGET |
>TARGET |
Cond: DOES> |
Cond: DOES> |
T here H [ T has? primcentric H [IF] ] 5 [ [ELSE] ] 4 [ [THEN] ] T cells |
T here H [ T has? primcentric H [IF] ] 5 [ [ELSE] ] 4 [ [THEN] ] T cells |
H + alit, compile (does>2) compile ;s |
H + alit, compile !does compile ;s |
doeshandler, resolve-does>-part |
doeshandler, resolve-does>-part |
;Cond |
;Cond |
|
|
Line 2948 by (Field)
|
Line 2947 by (Field)
|
T 1 cells H dup ; |
T 1 cells H dup ; |
>CROSS |
>CROSS |
|
|
|
\ ABI-CODE support |
|
Builder (ABI-CODE) |
|
Build: ;Build |
|
by: :doabicode noop ;DO |
|
|
|
BUILDER (;abi-code) |
|
Build: ;Build |
|
by: :do;abicode noop ;DO |
|
|
\ Input-Methods 01py |
\ Input-Methods 01py |
|
|
Builder input-method |
Builder input-method |
Line 3226 Cond: ENDCASE endcase, ;Cond
|
Line 3234 Cond: ENDCASE endcase, ;Cond
|
1to compile (+loop) loop] |
1to compile (+loop) loop] |
compile unloop skiploop] ; ' (+loop,) plugin-of +loop, |
compile unloop skiploop] ; ' (+loop,) plugin-of +loop, |
|
|
|
: (-loop,) ( target-addr -- ) |
|
1to compile (-loop) loop] |
|
compile unloop skiploop] ; ' (-loop,) plugin-of -loop, |
|
|
: (next,) |
: (next,) |
compile (next) loop] compile unloop ; ' (next,) plugin-of next, |
compile (next) loop] compile unloop ; ' (next,) plugin-of next, |
|
|
Line 3235 Cond: FOR for, ;Cond
|
Line 3247 Cond: FOR for, ;Cond
|
|
|
Cond: LOOP 1 ncontrols? loop, ;Cond |
Cond: LOOP 1 ncontrols? loop, ;Cond |
Cond: +LOOP 1 ncontrols? +loop, ;Cond |
Cond: +LOOP 1 ncontrols? +loop, ;Cond |
|
Cond: -LOOP 1 ncontrols? -loop, ;Cond |
Cond: NEXT 1 ncontrols? next, ;Cond |
Cond: NEXT 1 ncontrols? next, ;Cond |
|
|
\ String words 23feb93py |
\ String words 23feb93py |
Line 3309 Cond: postpone ( -- ) \ name
|
Line 3322 Cond: postpone ( -- ) \ name
|
hex |
hex |
|
|
>CROSS |
>CROSS |
Create magic s" Gforth3x" here over allot swap move |
Create magic s" Gforth4x" here over allot swap move |
|
|
bigendian 1+ \ strangely, in magic big=0, little=1 |
bigendian 1+ \ strangely, in magic big=0, little=1 |
tcell 1 = 0 and or |
tcell 1 = 0 and or |