version 1.12, 1995/02/02 18:13:10
|
version 1.16, 1995/11/07 18:06:57
|
Line 1
|
Line 1
|
|
\ converts primitives to, e.g., C code |
|
|
|
\ Copyright (C) 1995 Free Software Foundation, Inc. |
|
|
|
\ This file is part of Gforth. |
|
|
|
\ Gforth is free software; you can redistribute it and/or |
|
\ modify it under the terms of the GNU General Public License |
|
\ as published by the Free Software Foundation; either version 2 |
|
\ of the License, or (at your option) any later version. |
|
|
|
\ This program is distributed in the hope that it will be useful, |
|
\ but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
\ GNU General Public License for more details. |
|
|
|
\ You should have received a copy of the GNU General Public License |
|
\ along with this program; if not, write to the Free Software |
|
\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
|
|
|
|
\ This is not very nice (hard limits, no checking, assumes 1 chars = 1) |
\ This is not very nice (hard limits, no checking, assumes 1 chars = 1) |
|
|
\ Optimizations: |
\ Optimizations: |
Line 90 variable effect-out-end ( pointer )
|
Line 111 variable effect-out-end ( pointer )
|
2variable effect-in-size |
2variable effect-in-size |
2variable effect-out-size |
2variable effect-out-size |
|
|
variable primitive-number -9 primitive-number ! |
variable primitive-number -10 primitive-number ! |
|
|
\ for several reasons stack items of a word are stored in a wordlist |
\ for several reasons stack items of a word are stored in a wordlist |
\ since neither forget nor marker are implemented yet, we make a new |
\ since neither forget nor marker are implemented yet, we make a new |
Line 463 set-current
|
Line 484 set-current
|
|
|
: flush-tos ( -- ) |
: flush-tos ( -- ) |
effect-in-size 2@ effect-out-size 2@ |
effect-in-size 2@ effect-out-size 2@ |
rot - swap rot - ( -f-diff -d-diff ) >r >r |
|
effect-in-size 2@ effect-out-size 2@ |
|
0<> rot 0= and |
0<> rot 0= and |
if |
if |
." IF_FTOS(fp[" r@ 0 .r ." ] = FTOS);" cr |
." IF_FTOS(fp[0] = FTOS);" cr |
endif rdrop |
endif |
0<> swap 0= and |
0<> swap 0= and |
if |
if |
." IF_TOS(sp[" r@ 0 .r ." ] = TOS);" cr |
." IF_TOS(sp[0] = TOS);" cr |
endif rdrop ; |
endif ; |
|
|
: fill-tos ( -- ) |
: fill-tos ( -- ) |
effect-in-size 2@ effect-out-size 2@ |
effect-in-size 2@ effect-out-size 2@ |
Line 517 set-current
|
Line 536 set-current
|
: output-c ( -- ) |
: output-c ( -- ) |
." I_" c-name 2@ type ." : /* " forth-name 2@ type ." ( " stack-string 2@ type ." ) */" cr |
." I_" c-name 2@ type ." : /* " forth-name 2@ type ." ( " stack-string 2@ type ." ) */" cr |
." /* " doc 2@ type ." */" cr |
." /* " doc 2@ type ." */" cr |
|
." NAME(" [char] " emit forth-name 2@ type [char] " emit ." )" cr \ debugging |
." {" cr |
." {" cr |
." DEF_CA" cr |
." DEF_CA" cr |
declarations |
declarations |
compute-offsets \ for everything else |
compute-offsets \ for everything else |
|
." NEXT_P0;" cr |
|
flush-tos |
fetches |
fetches |
stack-pointer-updates cr |
stack-pointer-updates |
." NAME(" [char] " emit forth-name 2@ type [char] " emit ." )" cr \ debugging |
|
." {" cr |
." {" cr |
c-code 2@ type |
c-code 2@ type |
." }" cr |
." }" cr |
." NEXT_P1;" cr |
." NEXT_P1;" cr |
flush-tos |
|
stores |
stores |
fill-tos |
fill-tos |
." NEXT_P2;" cr |
." NEXT_P2;" cr |
Line 558 set-current
|
Line 578 set-current
|
get-current documentation set-current |
get-current documentation set-current |
forth-name 2@ nextname create |
forth-name 2@ nextname create |
forth-name 2@ 2, |
forth-name 2@ 2, |
stack-string 2@ 2, |
stack-string 2@ condition-stack-effect 2, |
wordset 2@ 2, |
wordset 2@ 2, |
c-name 2@ 2, |
c-name 2@ condition-pronounciation 2, |
doc 2@ 2, |
doc 2@ 2, |
set-current ; |
set-current ; |
[THEN] |
[THEN] |