version 1.50, 2000/11/12 14:09:45
|
version 1.51, 2000/11/12 18:14:09
|
Line 103 end-struct stack%
|
Line 103 end-struct stack%
|
|
|
s" sp" save-mem s" (Cell)" make-stack data-stack |
s" sp" save-mem s" (Cell)" make-stack data-stack |
s" fp" save-mem s" " make-stack fp-stack |
s" fp" save-mem s" " make-stack fp-stack |
|
s" rp" save-mem s" (Cell)" make-stack return-stack |
\ !! initialize stack-in and stack-out |
\ !! initialize stack-in and stack-out |
|
|
\ stack items |
\ stack items |
Line 245 eof-char singleton charclass eof
|
Line 246 eof-char singleton charclass eof
|
|
|
|
|
(( letter (( letter || digit )) ** |
(( letter (( letter || digit )) ** |
)) <- c-name ( -- ) |
)) <- c-ident ( -- ) |
|
|
|
(( ` # ?? (( letter || digit || ` : )) ** |
|
)) <- stack-ident ( -- ) |
|
|
(( nowhitebq nowhite ** )) |
(( nowhitebq nowhite ** )) |
<- name ( -- ) |
<- forth-ident ( -- ) |
|
|
Variable forth-flag |
Variable forth-flag |
Variable c-flag |
Variable c-flag |
Line 283 Variable c-flag
|
Line 287 Variable c-flag
|
|
|
(( ` \ comment-body nl )) <- comment ( -- ) |
(( ` \ comment-body nl )) <- comment ( -- ) |
|
|
(( {{ effect-in }} (( {{ start }} c-name {{ end 2 pick init-item item% %size + }} white ** )) ** {{ effect-in-end ! }} |
(( {{ start }} stack-ident {{ end 2 pick init-item item% %size + }} white ** )) ** |
|
<- stack-items |
|
|
|
(( {{ effect-in }} stack-items {{ effect-in-end ! }} |
` - ` - white ** |
` - ` - white ** |
{{ effect-out }} (( {{ start }} c-name {{ end 2 pick init-item item% %size + }} white ** )) ** {{ effect-out-end ! }} |
{{ effect-out }} stack-items {{ effect-out-end ! }} |
)) <- stack-effect ( -- ) |
)) <- stack-effect ( -- ) |
|
|
(( {{ s" " doc 2! s" " forth-code 2! }} |
(( {{ s" " doc 2! s" " forth-code 2! }} |
(( {{ line @ name-line ! filename 2@ name-filename 2! }} |
(( {{ line @ name-line ! filename 2@ name-filename 2! }} |
{{ start }} name {{ end 2dup forth-name 2! c-name 2! }} white ++ |
{{ start }} forth-ident {{ end 2dup forth-name 2! c-name 2! }} white ++ |
` ( white ** {{ start }} stack-effect {{ end stack-string 2! }} ` ) white ** |
` ( white ** {{ start }} stack-effect {{ end stack-string 2! }} ` ) white ** |
{{ start }} name {{ end wordset 2! }} white ** |
{{ start }} forth-ident {{ end wordset 2! }} white ** |
(( {{ start }} c-name {{ end c-name 2! }} )) ?? nl |
(( {{ start }} c-ident {{ end c-name 2! }} )) ?? nl |
)) |
)) |
(( ` " ` " {{ start }} (( noquote ++ ` " )) ++ {{ end 1- doc 2! }} ` " nl )) ?? |
(( ` " ` " {{ start }} (( noquote ++ ` " )) ++ {{ end 1- doc 2! }} ` " nl )) ?? |
{{ skipsynclines off line @ c-line ! filename 2@ c-filename 2! start }} (( nocolonnl nonl ** nl )) ** {{ end c-code 2! skipsynclines on }} |
{{ skipsynclines off line @ c-line ! filename 2@ c-filename 2! start }} (( nocolonnl nonl ** nl )) ** {{ end c-code 2! skipsynclines on }} |
Line 485 does> ( item -- )
|
Line 492 does> ( item -- )
|
: declaration ( item -- ) |
: declaration ( item -- ) |
dup item-name 2@ execute-prefix ; |
dup item-name 2@ execute-prefix ; |
|
|
|
: stack-prefix ( stack "prefix" -- ) |
|
name tuck nextname create ( stack length ) 2, |
|
does> ( item -- ) |
|
2@ { item stack prefix-length } |
|
item item-name 2@ prefix-length /string item item-name 2! |
|
stack item item-stack ! |
|
item declaration ; |
|
|
: declaration-list ( addr1 addr2 -- ) |
: declaration-list ( addr1 addr2 -- ) |
swap ?do |
swap ?do |
i declaration |
i declaration |
Line 515 s" Xt" single-type type-prefix xt
|
Line 530 s" Xt" single-type type-prefix xt
|
s" WID" single-type type-prefix wid |
s" WID" single-type type-prefix wid |
s" struct F83Name *" single-type type-prefix f83name |
s" struct F83Name *" single-type type-prefix f83name |
|
|
|
return-stack stack-prefix R: |
|
|
set-current |
set-current |
|
|
\ offset computation |
\ offset computation |
Line 538 set-current
|
Line 555 set-current
|
|
|
|
|
: compute-offsets ( -- ) |
: compute-offsets ( -- ) |
data-stack clear-stack fp-stack clear-stack |
data-stack clear-stack fp-stack clear-stack return-stack clear-stack |
effect-in effect-in-end @ ['] stack-in compute-list |
effect-in effect-in-end @ ['] stack-in compute-list |
effect-out effect-out-end @ ['] stack-out compute-list ; |
effect-out effect-out-end @ ['] stack-out compute-list ; |
|
|
Line 550 set-current
|
Line 567 set-current
|
endif ; |
endif ; |
|
|
: flush-tos ( -- ) |
: flush-tos ( -- ) |
data-stack flush-a-tos |
data-stack flush-a-tos |
fp-stack flush-a-tos ; |
fp-stack flush-a-tos |
|
return-stack flush-a-tos ; |
|
|
: fill-a-tos { stack -- } |
: fill-a-tos { stack -- } |
stack stack-out @ 0= stack stack-in @ 0<> and |
stack stack-out @ 0= stack stack-in @ 0<> and |
Line 561 set-current
|
Line 579 set-current
|
endif ; |
endif ; |
|
|
: fill-tos ( -- ) |
: fill-tos ( -- ) |
fp-stack fill-a-tos |
fp-stack fill-a-tos |
data-stack fill-a-tos ; |
data-stack fill-a-tos |
|
return-stack fill-a-tos ; |
|
|
: fetch ( addr -- ) |
: fetch ( addr -- ) |
dup item-type @ type-fetch @ execute ; |
dup item-type @ type-fetch @ execute ; |
Line 580 set-current
|
Line 599 set-current
|
endif ; |
endif ; |
|
|
: stack-pointer-updates ( -- ) |
: stack-pointer-updates ( -- ) |
data-stack stack-pointer-update |
data-stack stack-pointer-update |
fp-stack stack-pointer-update ; |
fp-stack stack-pointer-update |
|
return-stack stack-pointer-update ; |
|
|
: store ( item -- ) |
: store ( item -- ) |
\ f is true if the item should be stored |
\ f is true if the item should be stored |
Line 639 set-current
|
Line 659 set-current
|
." {" cr |
." {" cr |
declarations |
declarations |
compute-offsets \ for everything else |
compute-offsets \ for everything else |
data-stack stack-used? IF ." Cell *sp=SP;" cr THEN |
data-stack stack-used? IF ." Cell *sp=SP;" cr THEN |
fp-stack stack-used? IF ." Cell *fp=*FP;" cr THEN |
fp-stack stack-used? IF ." Cell *fp=*FP;" cr THEN |
|
return-stack stack-used? IF ." Cell *rp=*RP;" cr THEN |
flush-tos |
flush-tos |
fetches |
fetches |
stack-pointer-updates |
stack-pointer-updates |