1 \ tag: FCode implementation functions
3 \ this code implements IEEE 1275-1994 ch. 5.3.3
5 \ Copyright (C) 2003 Stefan Reinauer
7 \ See the file "COPYING" for further information about
8 \ the copyright and warranty status of this work.
13 0 value fcode-sys-table \ table with built-in fcodes (0-0x7ff)
15 true value ?fcode-offset16 \ fcode offsets are 16 instead of 8 bit?
16 1 value fcode-spread \ fcode spread (1, 2 or 4)
17 0 value fcode-table \ pointer to fcode table
18 false value ?fcode-verbose \ do verbose fcode execution?
20 defer _fcode-debug? \ If true, save names for FCodes with headers
21 true value fcode-headers? \ If true, possibly save names for FCodes.
23 0 value fcode-stream-start \ start address of fcode stream
24 0 value fcode-stream \ current fcode stream address
26 variable fcode-end \ state variable, if true, fcode program terminates.
27 defer fcode-c@ \ get byte
29 : fcode-push-state ( -- <state information> )
40 : fcode-pop-state ( <state information> -- )
52 \ fcode access helper functions
56 \ convert FCode number to pointer to xt in FCode table.
58 : fcode-ptr ( u16 -- *xt )
60 fcode-table ?dup if + exit then
62 \ we are not parsing fcode at the moment
63 dup 800 cells u>= abort" User FCODE# referenced."
68 \ get xt according to an FCode#
70 : fcode>xt ( u16 -- xt )
75 \ get 8bit from FCode stream, taking spread into regard.
77 : fcode-num8 ( -- c ) ( F: c -- )
79 dup fcode-spread + to fcode-stream
83 \ fcode-num8-signed ( -- c ) ( F: c -- )
84 \ get 8bit signed from FCode stream
94 \ get 16bit from FCode stream
96 : fcode-num16 ( -- num16 )
97 fcode-num8 fcode-num8 swap bwjoin
100 \ fcode-num16-signed ( -- c ) ( F: c -- )
101 \ get 16bit signed from FCode stream
111 \ get 32bit from FCode stream
113 : fcode-num32 ( -- num32 )
114 fcode-num8 fcode-num8
115 fcode-num8 fcode-num8
116 swap 2swap swap bljoin
120 \ Get an FCode# from FCode stream
122 : fcode# ( -- fcode# )
125 fcode-num8 swap bwjoin
130 \ get offset from FCode stream.
132 : fcode-offset ( -- offset )
139 \ Display offset in verbose mode
141 dup ." (offset) " . cr
146 \ get a string from FCode stream, store in pocket.
148 : fcode-string ( -- addr len )
156 \ Display string in verbose mode
158 2dup ." (const) " type cr
163 \ retrieve FCode header from FCode stream
170 ." Found FCode header:" cr rot
171 ." Format : " u. cr swap
172 ." Checksum : " u. cr
180 \ writes currently created word as fcode# read from stream
183 : fcode! ( F:FCode# -- )
186 \ Display fcode# in verbose mode
188 dup ." (fcode#) " . cr
195 \ 5.3.3.1 Defining new FCode functions.
199 \ Mark next defining word as instance specific.
200 \ (defined in bootstrap.fs)
202 \ instance-init ( wid buffer -- )
203 \ Copy template from specified wordlist to instance
208 begin @ dup 0<> while
209 dup /n + @ instance-cfa? if \ buffer dict
210 2dup 2 /n* + @ + \ buffer dict dest
211 over 3 /n* + @ \ buffer dict dest size
212 2 pick 4 /n* + \ buffer dict dest size src
221 \ new-token ( F:/FCode#/ -- )
222 \ Create a new unnamed FCode function
230 \ named-token (F:FCode-string FCode#/ -- )
231 \ Create a new possibly named FCode function.
243 \ external-token (F:/FCode-string FCode#/ -- )
244 \ Create a new named FCode function
253 \ End an FCode colon definition.
260 \ b(:) ( -- ) ( E: ... -- ??? )
261 \ Defines type of new FCode function as colon definition.
268 \ b(buffer:) ( size -- ) ( E: -- a-addr )
269 \ Defines type of new FCode function as buffer:.
276 \ b(constant) ( nl -- ) ( E: -- nl )
277 \ Defines type of new FCode function as constant.
285 \ b(create) ( -- ) ( E: -- a-addr )
286 \ Defines type of new FCode function as create word.
295 \ b(defer) ( -- ) ( E: ... -- ??? )
296 \ Defines type of new FCode function as defer word.
300 ['] (undefined-defer) ,
306 \ b(field) ( offset size -- offset+size ) ( E: addr -- addr+offset )
307 \ Defines type of new FCode function as field.
320 \ b(value) ( x -- ) (E: -- x )
321 \ Defines type of new FCode function as value.
328 \ b(variable) ( -- ) ( E: -- a-addr )
329 \ Defines type of new FCode function as variable.
337 \ (is-user-word) ( name-str name-len xt -- ) ( E: ... -- ??? )
338 \ Create a new named user interface command.
344 \ get-token ( fcode# -- xt immediate? )
345 \ Convert FCode number to function execution token.
348 fcode>xt dup immediate?
352 \ set-token ( xt immediate? fcode# -- )
353 \ Assign FCode number to existing function.
356 nip \ TODO we use the xt's immediate state for now.
369 \ Numeric literal FCode. Followed by FCode-num32.
389 \ Function literal FCode. Followed by FCode#
399 \ b(") ( -- str len )
400 \ String literal FCode. Followed by FCode-string.
405 \ only run handle-text in compile-mode,
406 \ otherwise we would waste a pocket.
413 \ 5.3.3.3 Controlling values and defers
416 \ behavior ( defer-xt -- contents-xt )
417 \ defined in bootstrap.fs
419 \ b(to) ( new-value -- )
420 \ FCode for setting values and defers. Followed by FCode#.
436 \ 5.3.3.4 Control flow
441 \ Makes subsequent FCode-offsets use 16-bit (not 8-bit) form.
444 true to ?fcode-offset16
449 \ Unconditional branch FCode. Followed by FCode-offset.
452 fcode-offset 0< if \ if we jump backwards, we can forsee where it goes
457 setup-tmp-comp ['] dobranch ,
465 \ b?branch ( continue? -- )
466 \ Conditional branch FCode. Followed by FCode-offset.
469 fcode-offset 0< if \ if we jump backwards, we can forsee where it goes
474 setup-tmp-comp ['] do?branch ,
482 \ Target of backward branches.
491 \ Target of forward branches.
500 \ End FCode do..loop. Followed by FCode-offset.
508 \ b(+loop) ( delta -- )
509 \ End FCode do..+loop. Followed by FCode-offset.
517 \ b(do) ( limit start -- )
518 \ Begin FCode do..loop. Followed by FCode-offset.
526 \ b(?do) ( limit start -- )
527 \ Begin FCode ?do..loop. Followed by FCode-offset.
536 \ Exit from a do..loop.
543 \ b(case) ( sel -- sel )
544 \ Begin a case (multiple selection) statement.
551 \ b(endcase) ( sel | <nothing> -- )
552 \ End a case (multiple selection) statement.
559 \ b(of) ( sel of-val -- sel | <nothing> )
560 \ FCode for of in case statement. Followed by FCode-offset.
568 \ FCode for endof in case statement. Followed by FCode-offset.