| : 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 |
| 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 |
| (( letter (( letter || digit )) ** |
(( letter (( letter || digit )) ** |
| )) <- c-ident ( -- ) |
)) <- c-ident ( -- ) |
| |
|
| (( ` # ?? (( letter || digit || ` : )) ** |
(( ` # ?? (( letter || digit || ` : )) ++ |
| )) <- stack-ident ( -- ) |
)) <- stack-ident ( -- ) |
| |
|
| (( nowhitebq nowhite ** )) |
(( nowhitebq nowhite ** )) |
| (( {{ 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 }} |
| (( {{ 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 ( -- ) |
