version 1.107, 2002/08/07 10:11:18
|
version 1.110, 2002/08/20 07:59:01
|
Line 60 include startup.fs
|
Line 60 include startup.fs
|
: struct% struct ; \ struct is redefined in gray |
: struct% struct ; \ struct is redefined in gray |
|
|
warnings off |
warnings off |
|
\ warnings on |
|
|
include ./gray.fs |
include ./gray.fs |
|
|
32 constant max-effect \ number of things on one side of a stack effect |
32 constant max-effect \ number of things on one side of a stack effect |
4 constant max-stacks \ the max. number of stacks (including inst-stream). |
4 constant max-stacks \ the max. number of stacks (including inst-stream). |
255 constant maxchar |
255 constant maxchar |
Line 625 stack inst-stream IP Cell
|
Line 625 stack inst-stream IP Cell
|
endif |
endif |
2drop ; |
2drop ; |
|
|
: output-c-tail ( -- ) |
: output-c-tail1 ( -- ) |
\ the final part of the generated C code |
\ the final part of the generated C code except LABEL2 and NEXT_P2 |
output-super-end |
output-super-end |
print-debug-results |
print-debug-results |
." NEXT_P1;" cr |
." NEXT_P1;" cr |
stores |
stores |
fill-tos |
fill-tos ; |
|
|
|
: output-c-tail ( -- ) |
|
\ the final part of the generated C code, without LABEL2 |
|
output-c-tail1 |
." NEXT_P2;" ; |
." NEXT_P2;" ; |
|
|
|
: output-c-tail2 ( -- ) |
|
\ the final part of the generated C code, including LABEL2 |
|
output-c-tail1 |
|
." LABEL2(" prim prim-c-name 2@ type ." )" cr |
|
." NEXT_P2;" cr ; |
|
|
: type-c-code ( c-addr u xt -- ) |
: type-c-code ( c-addr u xt -- ) |
\ like TYPE, but replaces "TAIL;" with tail code produced by xt |
\ like TYPE, but replaces "INST_TAIL;" with tail code produced by xt |
{ xt } |
{ xt } |
begin ( c-addr1 u1 ) |
begin ( c-addr1 u1 ) |
2dup s" TAIL;" search |
2dup s" INST_TAIL;" search |
while ( c-addr1 u1 c-addr3 u3 ) |
while ( c-addr1 u1 c-addr3 u3 ) |
2dup 2>r drop nip over - type |
2dup 2>r drop nip over - type |
xt execute |
xt execute |
2r> 5 /string |
2r> 10 /string |
\ !! resync #line missing |
\ !! resync #line missing |
repeat |
repeat |
2drop type ; |
2drop type ; |
|
|
: print-entry ( -- ) |
: print-entry ( -- ) |
." LABEL(" prim prim-c-name 2@ type ." ):" ; |
." LABEL(" prim prim-c-name 2@ type ." )" ; |
|
|
: output-c ( -- ) |
: output-c ( -- ) |
print-entry ." /* " prim prim-name 2@ type ." ( " prim prim-stack-string 2@ type ." ) */" cr |
print-entry ." /* " prim prim-name 2@ type ." ( " prim prim-stack-string 2@ type ." ) */" cr |
Line 666 stack inst-stream IP Cell
|
Line 676 stack inst-stream IP Cell
|
." #line " c-line @ . quote c-filename 2@ type quote cr |
." #line " c-line @ . quote c-filename 2@ type quote cr |
prim prim-c-code 2@ ['] output-c-tail type-c-code |
prim prim-c-code 2@ ['] output-c-tail type-c-code |
." }" cr |
." }" cr |
output-c-tail |
output-c-tail2 |
." }" cr |
." }" cr |
cr |
cr |
; |
; |
Line 899 stack inst-stream IP Cell
|
Line 909 stack inst-stream IP Cell
|
\ #line 516 "./prim" |
\ #line 516 "./prim" |
\ n = n1+n2; |
\ n = n1+n2; |
\ } |
\ } |
\ NEXT_P1; |
|
\ _x_sp0 = (Cell)n; |
\ _x_sp0 = (Cell)n; |
\ NEXT_P2; |
|
\ } |
\ } |
\ NEXT_P1; |
\ NEXT_P1; |
\ spTOS = (Cell)_x_sp0; |
\ spTOS = (Cell)_x_sp0; |
Line 1046 stack inst-stream IP Cell
|
Line 1054 stack inst-stream IP Cell
|
\ print-debug-args |
\ print-debug-args |
stack-pointer-updates |
stack-pointer-updates |
output-parts |
output-parts |
output-c-tail |
output-c-tail2 |
." }" cr |
." }" cr |
cr ; |
cr ; |
|
|
Line 1157 bl singleton tab-char over add-member
|
Line 1165 bl singleton tab-char over add-member
|
nl-char singleton eof-char over add-member complement charclass nonl |
nl-char singleton eof-char over add-member complement charclass nonl |
nl-char singleton eof-char over add-member |
nl-char singleton eof-char over add-member |
char : over add-member complement charclass nocolonnl |
char : over add-member complement charclass nocolonnl |
|
nl-char singleton eof-char over add-member |
|
char } over add-member complement charclass nobracenl |
bl 1+ maxchar .. char \ singleton complement intersection |
bl 1+ maxchar .. char \ singleton complement intersection |
charclass nowhitebq |
charclass nowhitebq |
bl 1+ maxchar .. charclass nowhite |
bl 1+ maxchar .. charclass nowhite |
Line 1168 nl-char singleton eof-char over add-memb
|
Line 1178 nl-char singleton eof-char over add-memb
|
(( letter (( letter || digit )) ** |
(( letter (( letter || digit )) ** |
)) <- c-ident ( -- ) |
)) <- c-ident ( -- ) |
|
|
(( ` # ?? (( letter || digit || ` : )) ** |
(( ` # ?? (( letter || digit || ` : )) ++ |
)) <- stack-ident ( -- ) |
)) <- stack-ident ( -- ) |
|
|
(( nowhitebq nowhite ** )) |
(( nowhitebq nowhite ** )) |
Line 1231 Variable c-flag
|
Line 1241 Variable c-flag
|
(( {{ start }} c-ident {{ end prim prim-c-name 2! }} )) ?? |
(( {{ start }} c-ident {{ end prim prim-c-name 2! }} )) ?? |
)) ?? nleof |
)) ?? nleof |
(( ` " ` " {{ start }} (( noquote ++ ` " )) ++ {{ end 1- prim prim-doc 2! }} ` " white ** nleof )) ?? |
(( ` " ` " {{ start }} (( noquote ++ ` " )) ++ {{ end 1- prim prim-doc 2! }} ` " white ** nleof )) ?? |
{{ skipsynclines off line @ c-line ! filename 2@ c-filename 2! start }} (( nocolonnl nonl ** nleof white ** )) ** {{ end prim prim-c-code 2! skipsynclines on }} |
{{ skipsynclines off line @ c-line ! filename 2@ c-filename 2! start }} |
|
(( (( ` { nonl ** nleof (( (( nobracenl {{ line @ drop }} nonl ** )) ?? nleof )) ** ` } white ** nleof white ** )) |
|
|| (( nocolonnl nonl ** nleof white ** )) ** )) |
|
{{ end prim prim-c-code 2! skipsynclines on }} |
(( ` : white ** nleof |
(( ` : white ** nleof |
{{ start }} (( nonl ++ nleof white ** )) ++ {{ end prim prim-forth-code 2! }} |
{{ start }} (( nonl ++ nleof white ** )) ++ {{ end prim prim-forth-code 2! }} |
)) ?? {{ process-simple }} |
)) ?? {{ process-simple }} |
Line 1246 Variable c-flag
|
Line 1259 Variable c-flag
|
(( {{ make-prim to prim 0 to combined |
(( {{ make-prim to prim 0 to combined |
line @ name-line ! filename 2@ name-filename 2! |
line @ name-line ! filename 2@ name-filename 2! |
function-number @ prim prim-num ! |
function-number @ prim prim-num ! |
start }} forth-ident {{ end 2dup prim prim-name 2! prim prim-c-name 2! }} white ++ |
start }} [ifdef] vmgen c-ident [else] forth-ident [then] {{ end |
|
2dup prim prim-name 2! prim prim-c-name 2! }} white ** |
(( ` / white ** {{ start }} c-ident {{ end prim prim-c-name 2! }} white ** )) ?? |
(( ` / white ** {{ start }} c-ident {{ end prim prim-c-name 2! }} white ** )) ?? |
(( simple-primitive || combined-primitive )) {{ 1 function-number +! }} |
(( simple-primitive || combined-primitive )) {{ 1 function-number +! }} |
)) <- primitive ( -- ) |
)) <- primitive ( -- ) |