version 1.163, 2007/03/31 21:43:18
|
version 1.169, 2010/04/05 22:17:56
|
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 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 1244 bits/byte Constant tbits/byte
|
Line 1245 bits/byte Constant tbits/byte
|
H |
H |
tbits/char bits/byte / Constant tbyte |
tbits/char bits/byte / Constant tbyte |
|
|
|
: >signed ( u -- n ) |
|
1 tbits/char tcell * 1- lshift 2dup and |
|
IF negate or ELSE drop THEN ; |
|
|
\ Variables 06oct92py |
\ Variables 06oct92py |
|
|
Line 2316 Variable prim#
|
Line 2320 Variable prim#
|
prim# @ (THeader ( S xt ghost ) |
prim# @ (THeader ( S xt ghost ) |
['] prim-resolved over >comp ! |
['] prim-resolved over >comp ! |
dup >ghost-flags <primitive> set-flag |
dup >ghost-flags <primitive> set-flag |
over resolve-noforwards T A, H |
|
s" EC" T $has? H 0= |
s" EC" T $has? H 0= |
IF |
IF |
|
over resolve-noforwards T A, H |
alias-mask flag! |
alias-mask flag! |
|
ELSE |
|
T here H resolve-noforwards T A, H |
THEN |
THEN |
-1 prim# +! ; |
-1 prim# +! ; |
>CROSS |
>CROSS |
Line 2531 Cond: MAXI
|
Line 2537 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 2943 by (Field)
|
Line 2949 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 |
|
|
\ Input-Methods 01py |
\ Input-Methods 01py |
|
|
Builder input-method |
Builder input-method |
Line 2975 T has? primcentric H [IF]
|
Line 2986 T has? primcentric H [IF]
|
: (callcm) T here 0 a, 0 a, H ; ' (callcm) plugin-of colonmark, |
: (callcm) T here 0 a, 0 a, H ; ' (callcm) plugin-of colonmark, |
: (call-res) >tempdp resolved gexecute tempdp> drop ; |
: (call-res) >tempdp resolved gexecute tempdp> drop ; |
' (call-res) plugin-of colon-resolve |
' (call-res) plugin-of colon-resolve |
|
T has? ec H [IF] |
|
: (pprim) T @ H >signed dup 0< IF $4000 - ELSE |
|
cr ." wrong usage of (prim) " |
|
dup gdiscover IF .ghost ELSE . THEN cr -1 throw THEN |
|
T a, H ; ' (pprim) plugin-of prim, |
|
[ELSE] |
: (pprim) dup 0< IF $4000 - ELSE |
: (pprim) dup 0< IF $4000 - ELSE |
cr ." wrong usage of (prim) " |
cr ." wrong usage of (prim) " |
dup gdiscover IF .ghost ELSE . THEN cr -1 throw THEN |
dup gdiscover IF .ghost ELSE . THEN cr -1 throw THEN |
T a, H ; ' (pprim) plugin-of prim, |
T a, H ; ' (pprim) plugin-of prim, |
|
[THEN] |
|
|
\ if we want this, we have to spilt aconstant |
\ if we want this, we have to spilt aconstant |
\ and constant!! |
\ and constant!! |
Line 3002 Builder Defer
|
Line 3020 Builder Defer
|
compile: g>body compile lit-perform T A, H ;compile |
compile: g>body compile lit-perform T A, H ;compile |
|
|
Builder (Field) |
Builder (Field) |
compile: g>body T @ H compile lit+ T , H ;compile |
compile: g>body T @ H compile lit+ T here H reloff T , H ;compile |
|
|
Builder interpret/compile: |
Builder interpret/compile: |
compile: does-resolved ;compile |
compile: does-resolved ;compile |