version 1.29, 1997/12/14 01:15:20
|
version 1.31, 1998/05/31 19:29:23
|
Line 129 variable name-line
|
Line 129 variable name-line
|
2variable last-name-filename |
2variable last-name-filename |
|
|
variable primitive-number -10 primitive-number ! |
variable primitive-number -10 primitive-number ! |
|
Variable function-number 0 function-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 352 constant type-description
|
Line 353 constant type-description
|
\ true if item has the same offset as the input TOS |
\ true if item has the same offset as the input TOS |
item-d-offset @ 1+ effect-in-size 2@ drop = ; |
item-d-offset @ 1+ effect-in-size 2@ drop = ; |
|
|
|
: is-out-tos? ( item -- f ) |
|
\ true if item has the same offset as the input TOS |
|
item-d-offset @ 1+ effect-out-size 2@ drop = ; |
|
|
: really-store-single ( item -- ) |
: really-store-single ( item -- ) |
>r |
>r |
r@ item-d-offset @ effect-out-size 2@ data-stack-access ." = (Cell)" |
r@ item-d-offset @ effect-out-size 2@ data-stack-access ." = (Cell)" |
Line 362 constant type-description
|
Line 367 constant type-description
|
>r |
>r |
r@ d-same-as-in? |
r@ d-same-as-in? |
if |
if |
r@ is-in-tos? |
r@ is-in-tos? r@ is-out-tos? xor |
if |
if |
." IF_TOS(" r@ really-store-single ." );" cr |
." IF_TOS(" r@ really-store-single ." );" cr |
endif |
endif |
Line 605 set-current
|
Line 610 set-current
|
cr |
cr |
; |
; |
|
|
|
: output-funclabel ( -- ) |
|
1 function-number +! |
|
." &I_" c-name 2@ type ." ," cr ; |
|
|
|
: output-forthname ( -- ) |
|
1 function-number +! |
|
'" emit forth-name 2@ type '" emit ." ," cr ; |
|
|
|
: output-c-func ( -- ) |
|
1 function-number +! |
|
." void I_" c-name 2@ type ." () /* " forth-name 2@ type |
|
." ( " stack-string 2@ type ." ) */" cr |
|
." /* " doc 2@ type ." */" cr |
|
." NAME(" [char] " emit forth-name 2@ type [char] " emit ." )" cr |
|
\ debugging |
|
." {" cr |
|
." DEF_CA" cr |
|
declarations |
|
compute-offsets \ for everything else |
|
." NEXT_P0;" cr |
|
flush-tos |
|
fetches |
|
stack-pointer-updates |
|
." {" cr |
|
." #line " c-line @ . [char] " emit c-filename 2@ type [char] " emit cr |
|
c-code 2@ type |
|
." }" cr |
|
." NEXT_P1;" cr |
|
stores |
|
fill-tos |
|
." NEXT_P2;" cr |
|
." }" cr |
|
cr ; |
|
|
: output-label ( -- ) |
: output-label ( -- ) |
." &&I_" c-name 2@ type ." ," cr ; |
." &&I_" c-name 2@ type ." ," cr ; |
|
|
: output-alias ( -- ) flush-comment on |
: output-alias ( -- ) flush-comment on |
?flush-comment |
?flush-comment |
Line 614 set-current
|
Line 653 set-current
|
-1 primitive-number +! ; |
-1 primitive-number +! ; |
|
|
: output-forth ( -- ) flush-comment on |
: output-forth ( -- ) flush-comment on |
?flush-comment |
?flush-comment |
forth-code @ 0= |
forth-code @ 0= |
IF \ output-alias |
IF \ output-alias |
\ this is bad for ec: an alias is compiled if tho word does not exist! |
\ this is bad for ec: an alias is compiled if tho word does not exist! |
\ JAW |
\ JAW |
ELSE ." : " forth-name 2@ type ." ( " |
ELSE ." : " forth-name 2@ type ." ( " |
effect-in effect-in-end @ .stack-list ." -- " |
effect-in effect-in-end @ .stack-list ." -- " |
effect-out effect-out-end @ .stack-list ." )" cr |
effect-out effect-out-end @ .stack-list ." )" cr |
forth-code 2@ type cr |
forth-code 2@ type cr |
-1 primitive-number +! |
-1 primitive-number +! |
THEN ; |
THEN ; |
|
|
: output-tag-file ( -- ) |
: output-tag-file ( -- ) |
name-filename 2@ last-name-filename 2@ compare if |
name-filename 2@ last-name-filename 2@ compare if |
Line 658 set-current
|
Line 697 set-current
|
: process-file ( addr u xt -- ) |
: process-file ( addr u xt -- ) |
>r |
>r |
2dup filename 2! |
2dup filename 2! |
|
0 function-number ! |
r/o open-file abort" cannot open file" |
r/o open-file abort" cannot open file" |
warnings @ if |
warnings @ if |
." ------------ CUT HERE -------------" cr endif |
." ------------ CUT HERE -------------" cr endif |
r> primfilter ; |
r> primfilter ; |
|
|
|
: process ( xt -- ) |
|
bl word count rot |
|
process-file ; |
|
|