version 1.73, 2001/01/23 17:05:40
|
version 1.74, 2001/01/24 10:32:01
|
Line 125 variable output-combined \ xt ( -- ) of
|
Line 125 variable output-combined \ xt ( -- ) of
|
struct% |
struct% |
cell% field stack-number \ the number of this stack |
cell% field stack-number \ the number of this stack |
cell% 2* field stack-pointer \ stackpointer name |
cell% 2* field stack-pointer \ stackpointer name |
cell% 2* field stack-typename \ name for default type of stack items |
cell% field stack-type \ name for default type of stack items |
cell% 2* field stack-cast \ cast string for assignments to stack elements |
cell% 2* field stack-cast \ cast string for assignments to stack elements |
cell% field stack-in-index-xt \ ( in-size item -- in-index ) |
cell% field stack-in-index-xt \ ( in-size item -- in-index ) |
end-struct stack% |
end-struct stack% |
Line 155 create stacks max-stacks cells allot \ a
|
Line 155 create stacks max-stacks cells allot \ a
|
: inst-in-index ( in-size item -- in-index ) |
: inst-in-index ( in-size item -- in-index ) |
nip dup item-offset @ swap item-type @ type-size @ + 1- ; |
nip dup item-offset @ swap item-type @ type-size @ + 1- ; |
|
|
: make-stack ( addr-ptr u1 addr-stack u2 addr-cast u3 "stack-name" -- ) |
: make-stack ( addr-ptr u1 type addr-cast u2 "stack-name" -- ) |
create stack% %allot >r |
create stack% %allot >r |
r@ stacks next-stack-number @ th ! |
r@ stacks next-stack-number @ th ! |
next-stack-number @ r@ stack-number ! 1 next-stack-number +! |
next-stack-number @ r@ stack-number ! 1 next-stack-number +! |
save-mem r@ stack-cast 2! |
save-mem r@ stack-cast 2! |
save-mem r@ stack-typename 2! |
r@ stack-type ! |
save-mem r@ stack-pointer 2! |
save-mem r@ stack-pointer 2! |
['] stack-in-index r> stack-in-index-xt ! ; |
['] stack-in-index r> stack-in-index-xt ! ; |
|
|
Line 230 Variable function-number 0 function-numb
|
Line 230 Variable function-number 0 function-numb
|
\ 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 |
\ wordlist for every word and store it in the variable items |
\ wordlist for every word and store it in the variable items |
variable items |
variable itemsqq |
|
|
\ a few more set ops |
\ a few more set ops |
|
|
Line 280 variable items
|
Line 280 variable items
|
: 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-name 2@ items @ search-wordlist 0= |
r@ item-first @ if |
abort" bug" |
rdrop false exit |
|
endif |
|
r@ item-name 2@ itemsqq @ search-wordlist 0= abort" bug" |
execute @ |
execute @ |
dup r@ = |
dup r@ = |
if \ item first appeared in output |
if \ item first appeared in output |
Line 368 does> ( item -- )
|
Line 370 does> ( item -- )
|
{ item typ } |
{ item typ } |
typ item item-type ! |
typ item item-type ! |
typ type-stack @ item item-stack !default |
typ type-stack @ item item-stack !default |
item item-name 2@ items @ search-wordlist 0= if \ new name |
item item-name 2@ itemsqq @ search-wordlist 0= if \ new name |
item item-name 2@ nextname item declare |
item item-name 2@ nextname item declare |
item item-first on |
item item-first on |
\ typ type-c-name 2@ type space type ." ;" cr |
\ typ type-c-name 2@ type space type ." ;" cr |
Line 397 does> ( item -- )
|
Line 399 does> ( item -- )
|
['] declaration map-items ; |
['] declaration map-items ; |
|
|
: declarations ( -- ) |
: declarations ( -- ) |
wordlist dup items ! set-current |
wordlist dup itemsqq ! set-current |
prim prim-effect-in prim prim-effect-in-end @ declaration-list |
prim prim-effect-in prim prim-effect-in-end @ declaration-list |
prim prim-effect-out prim prim-effect-out-end @ declaration-list ; |
prim prim-effect-out prim prim-effect-out-end @ declaration-list ; |
|
|
Line 419 does> ( item -- )
|
Line 421 does> ( item -- )
|
stack item item-stack ! |
stack item item-stack ! |
item declaration ; |
item declaration ; |
|
|
s" sp" save-mem s" Cell" save-mem s" (Cell)" make-stack data-stack |
\ types pointed to by stacks for use in combined prims |
s" fp" save-mem s" Float" save-mem s" " make-stack fp-stack |
s" Cell" single 0 create-type cell-type |
s" rp" save-mem s" Cell" save-mem s" (Cell)" make-stack return-stack |
s" Float" single 0 create-type float-type |
s" IP" save-mem s" Cell" save-mem s" error don't use # on results" make-stack inst-stream |
|
|
s" sp" save-mem cell-type s" (Cell)" make-stack data-stack |
|
s" fp" save-mem cell-type s" " make-stack fp-stack |
|
s" rp" save-mem float-type s" (Cell)" make-stack return-stack |
|
s" IP" save-mem cell-type s" error don't use # on results" make-stack inst-stream |
' inst-in-index inst-stream stack-in-index-xt ! |
' inst-in-index inst-stream stack-in-index-xt ! |
\ !! initialize stack-in and stack-out |
\ !! initialize stack-in and stack-out |
|
|
Line 820 create min-depth max-stacks cells al
|
Line 826 create min-depth max-stacks cells al
|
i 0 <# #s stack stack-pointer 2@ holds [char] _ hold #> save-mem |
i 0 <# #s stack stack-pointer 2@ holds [char] _ hold #> save-mem |
item item-name 2! |
item item-name 2! |
stack item item-stack ! |
stack item item-stack ! |
0 item item-type ! |
stack stack-type @ item item-type ! |
i item item-offset ! |
i item item-offset ! |
item item-first on |
item item-first on |
item% %size effect-endp +! |
item% %size effect-endp +! |
Line 842 create min-depth max-stacks cells al
|
Line 848 create min-depth max-stacks cells al
|
|
|
: print-item { n stack -- } |
: print-item { n stack -- } |
\ print nth stack item name |
\ print nth stack item name |
." _" stack stack-typename 2@ type space |
." _" stack stack-type @ type-c-name 2@ type space |
stack stack-pointer 2@ type n 0 .r ; |
stack stack-pointer 2@ type n 0 .r ; |
|
|
: print-declarations-combined ( -- ) |
: print-declarations-combined ( -- ) |
Line 852 create min-depth max-stacks cells al
|
Line 858 create min-depth max-stacks cells al
|
loop |
loop |
loop ; |
loop ; |
|
|
|
: output-parts ( -- ) |
|
prim >r |
|
num-combined @ 0 +do |
|
combined-prims i th @ to prim |
|
output-c |
|
loop |
|
r> to prim ; |
|
|
: output-c-combined ( -- ) |
: output-c-combined ( -- ) |
print-entry cr |
print-entry cr |
\ debugging messages just in constituents |
\ debugging messages just in parts |
." {" cr |
." {" cr |
." DEF_CA" cr |
." DEF_CA" cr |
print-declarations-combined |
print-declarations-combined |
." NEXT_P0;" cr |
." NEXT_P0;" cr |
flush-tos |
flush-tos |
fetches |
fetches |
; |
\ print-debug-args |
|
stack-pointer-updates |
|
output-parts |
|
output-c-tail |
|
." }" cr |
|
cr ; |
|
|
: output-forth-combined ( -- ) |
: output-forth-combined ( -- ) |
; |
; |