version 1.157, 2005/07/28 14:12:33
|
version 1.158, 2005/07/28 19:15:00
|
Line 351 wordlist constant primitives
|
Line 351 wordlist constant primitives
|
\ address of number of stack items in effect out |
\ address of number of stack items in effect out |
stack-number @ cells prim prim-stacks-out + ; |
stack-number @ cells prim prim-stacks-out + ; |
|
|
|
: stack-prim-stacks-sync ( stack -- addr ) |
|
prim prim-stacks-sync swap stack-number @ th ; |
|
|
\ global vars |
\ global vars |
variable c-line |
variable c-line |
2variable c-filename |
2variable c-filename |
Line 504 defer inst-stream-f ( -- stack )
|
Line 507 defer inst-stream-f ( -- stack )
|
rdrop ; |
rdrop ; |
|
|
: same-as-in? ( item -- f ) |
: same-as-in? ( item -- f ) |
\ f is true iff the offset and stack of item is the same as on input |
\ f is true iff the offset and stack of item is the same as on input |
>r |
>r |
r@ item-first @ if |
r@ item-stack @ stack-prim-stacks-sync @ if |
rdrop false exit |
rdrop false exit |
endif |
endif |
r@ item-name 2@ prim prim-items-wordlist @ search-wordlist 0= abort" bug" |
r@ item-first @ if |
execute @ |
rdrop false exit |
dup r@ = |
endif |
if \ item first appeared in output |
r@ item-name 2@ prim prim-items-wordlist @ search-wordlist 0= abort" bug" |
drop false |
execute @ |
else |
dup r@ = |
dup item-stack @ r@ item-stack @ = |
if \ item first appeared in output |
swap item-offset @ r@ item-offset @ = and |
drop false |
endif |
else |
rdrop ; |
dup item-stack @ r@ item-stack @ = |
|
swap item-offset @ r@ item-offset @ = and |
|
endif |
|
rdrop ; |
|
|
: item-out-index ( item -- n ) |
: item-out-index ( item -- n ) |
\ n is the index of item (in the out-effect) |
\ n is the index of item (in the out-effect) |
Line 616 does> ( item -- )
|
Line 622 does> ( item -- )
|
UNLOOP EXIT |
UNLOOP EXIT |
endif |
endif |
-1 s+loop |
-1 s+loop |
\ we did not find a type, abort |
\ we did not find a type, abort |
|
abort |
false s" unknown prefix" ?print-error ; |
false s" unknown prefix" ?print-error ; |
|
|
: declaration ( item -- ) |
: declaration ( item -- ) |
Line 650 does> ( item -- )
|
Line 657 does> ( item -- )
|
stack item item-stack ! |
stack item item-stack ! |
item declaration ; |
item declaration ; |
|
|
: stack-prim-stacks-sync ( stack -- addr ) |
|
prim prim-stacks-sync swap stack-number @ th ; |
|
|
|
: set-prim-stacks-sync ( stack -- ) |
: set-prim-stacks-sync ( stack -- ) |
stack-prim-stacks-sync on ; |
stack-prim-stacks-sync on ; |
|
|
Line 667 get-current prefixes set-current
|
Line 671 get-current prefixes set-current
|
item-stack @ dup if |
item-stack @ dup if |
set-prim-stacks-sync |
set-prim-stacks-sync |
else \ prefixless "..." syncs all stacks |
else \ prefixless "..." syncs all stacks |
['] set-prim-stacks-sync map-stacks1 |
drop ['] set-prim-stacks-sync map-stacks1 |
endif ; |
endif ; |
set-current |
set-current |
|
|
Line 1800 nl-char singleton eof-char over add-memb
|
Line 1804 nl-char singleton eof-char over add-memb
|
(( letter (( letter || digit )) ** |
(( letter (( letter || digit )) ** |
)) <- c-ident ( -- ) |
)) <- c-ident ( -- ) |
|
|
(( ` # ?? (( letter || digit || ` : )) ++ (( ` . ` . ` . )) ?? |
(( ` . ` . ` . |
|
)) <- sync-stack ( -- ) |
|
|
|
(( ` # ?? (( letter || digit || ` : )) ++ sync-stack ?? |
|
|| sync-stack |
)) <- stack-ident ( -- ) |
)) <- stack-ident ( -- ) |
|
|
(( nowhitebq nowhite ** )) |
(( nowhitebq nowhite ** )) |