| \ : faligned ( addr -- f-addr ) \ float f-aligned |
\ : faligned ( addr -- f-addr ) \ float f-aligned |
| \ [ 1 floats 1- ] Literal + [ -1 floats ] Literal and ; |
\ [ 1 floats 1- ] Literal + [ -1 floats ] Literal and ; |
| |
|
| |
has? ec 0= [IF] |
| : falign ( -- ) \ float f-align |
: falign ( -- ) \ float f-align |
| \G If the data-space pointer is not float-aligned, reserve |
\G If the data-space pointer is not float-aligned, reserve |
| \G enough space to align it. |
\G enough space to align it. |
| ?DO |
?DO |
| bl c, |
bl c, |
| LOOP ; |
LOOP ; |
| |
[THEN] |
| |
|
| : maxalign ( -- ) \ gforth |
: maxalign ( -- ) \ gforth |
| \G Align data-space pointer for all alignment requirements. |
\G Align data-space pointer for all alignment requirements. |
| \ information through global variables), but they are useful for dealing |
\ information through global variables), but they are useful for dealing |
| \ with existing/independent defining words |
\ with existing/independent defining words |
| |
|
| defer (header) |
|
| defer header ( -- ) \ gforth |
|
| ' (header) IS header |
|
| |
|
| : string, ( c-addr u -- ) \ gforth |
: string, ( c-addr u -- ) \ gforth |
| \G puts down string as cstring |
\G puts down string as cstring |
| dup [ has? rom [IF] ] $E0 [ [ELSE] ] alias-mask [ [THEN] ] or c, |
dup [ has? rom [IF] ] $E0 [ [ELSE] ] alias-mask [ [THEN] ] or c, |
| [ [THEN] ] |
[ [THEN] ] |
| cfalign ; |
cfalign ; |
| |
|
| |
has? ec [IF] |
| |
: header ( "name" -- ) |
| |
parse-name name-too-short? header, ; |
| |
[ELSE] |
| |
defer (header) |
| |
defer header ( -- ) \ gforth |
| |
' (header) IS header |
| |
|
| : input-stream-header ( "name" -- ) |
: input-stream-header ( "name" -- ) |
| parse-name name-too-short? header, ; |
parse-name name-too-short? header, ; |
| |
|
| |
|
| 2variable nextname-string |
2variable nextname-string |
| |
|
| has? OS [IF] |
|
| : nextname-header ( -- ) |
: nextname-header ( -- ) |
| nextname-string 2@ header, |
nextname-string 2@ header, |
| nextname-string free-mem-var |
nextname-string free-mem-var |
| input-stream ; |
input-stream ; |
| [THEN] |
|
| |
|
| \ the next name is given in the string |
\ the next name is given in the string |
| |
|
| has? OS [IF] |
|
| : nextname ( c-addr u -- ) \ gforth |
: nextname ( c-addr u -- ) \ gforth |
| \g The next defined word will have the name @var{c-addr u}; the |
\g The next defined word will have the name @var{c-addr u}; the |
| \g defining word will leave the input stream alone. |
\g defining word will leave the input stream alone. |
| nextname-string free-mem-var |
nextname-string free-mem-var |
| save-mem nextname-string 2! |
save-mem nextname-string 2! |
| ['] nextname-header IS (header) ; |
['] nextname-header IS (header) ; |
| [THEN] |
|
| |
|
| : noname-header ( -- ) |
: noname-header ( -- ) |
| 0 last ! cfalign |
0 last ! cfalign |
| \g leave the input stream alone. The xt of the defined word will |
\g leave the input stream alone. The xt of the defined word will |
| \g be given by @code{latestxt}. |
\g be given by @code{latestxt}. |
| ['] noname-header IS (header) ; |
['] noname-header IS (header) ; |
| |
[THEN] |
| |
|
| : latestxt ( -- xt ) \ gforth |
: latestxt ( -- xt ) \ gforth |
| \G @i{xt} is the execution token of the last word defined. |
\G @i{xt} is the execution token of the last word defined. |