| dup 0= -&16 and throw ; |
dup 0= -&16 and throw ; |
| |
|
| : name-too-long? ( c-addr u -- c-addr u ) |
: name-too-long? ( c-addr u -- c-addr u ) |
| dup $1F u> -&19 and throw ; |
dup lcount-mask u> -&19 and throw ; |
| |
|
| \ \ Number parsing 23feb93py |
\ \ Number parsing 23feb93py |
| |
|
| end-struct wordlist-struct |
end-struct wordlist-struct |
| |
|
| : f83find ( addr len wordlist -- nt / false ) |
: f83find ( addr len wordlist -- nt / false ) |
| wordlist-id @ (f83find) ; |
wordlist-id @ (listlfind) ; |
| |
|
| : initvoc ( wid -- ) |
: initvoc ( wid -- ) |
| dup wordlist-map @ hash-method perform ; |
dup wordlist-map @ hash-method perform ; |
| |
|
| \ \ header, finding, ticks 17dec92py |
\ \ header, finding, ticks 17dec92py |
| |
|
| hex |
|
| 80 constant alias-mask \ set when the word is not an alias! |
\ !! these should be done using the target's operations and cell size |
| 40 constant immediate-mask |
\ 0 invert 1 rshift invert ( u ) \ top bit set |
| 20 constant restrict-mask |
\ constant alias-mask \ set when the word is not an alias! |
| |
\ alias-mask 1 rshift constant immediate-mask |
| |
\ alias-mask 2 rshift constant restrict-mask |
| |
\ 0 invert 3 rshift constant lcount-mask |
| |
|
| |
\ as an intermediate step, I define them correctly for 32-bit machines: |
| |
|
| |
$80000000 constant alias-mask |
| |
$40000000 constant immediate-mask |
| |
$20000000 constant restrict-mask |
| |
$1fffffff constant lcount-mask |
| |
|
| \ higher level parts of find |
\ higher level parts of find |
| |
|
| then |
then |
| [ [THEN] ] ; |
[ [THEN] ] ; |
| |
|
| : (x>int) ( cfa b -- xt ) |
: (x>int) ( cfa w -- xt ) |
| \ get interpretation semantics of name |
\ get interpretation semantics of name |
| restrict-mask and |
restrict-mask and |
| if |
if |
| |
|
| : name>string ( nt -- addr count ) \ gforth head-to-string |
: name>string ( nt -- addr count ) \ gforth head-to-string |
| \g @i{addr count} is the name of the word represented by @i{nt}. |
\g @i{addr count} is the name of the word represented by @i{nt}. |
| cell+ count $1F and ; |
cell+ dup cell+ swap @ lcount-mask and ; |
| |
|
| : ((name>)) ( nfa -- cfa ) |
: ((name>)) ( nfa -- cfa ) |
| name>string + cfaligned ; |
name>string + cfaligned ; |
| |
|
| : (name>x) ( nfa -- cfa b ) |
: (name>x) ( nfa -- cfa w ) |
| \ cfa is an intermediate cfa and b is the flags byte of nfa |
\ cfa is an intermediate cfa and w is the flags cell of nfa |
| dup ((name>)) |
dup ((name>)) |
| swap cell+ c@ dup alias-mask and 0= |
swap cell+ @ dup alias-mask and 0= |
| IF |
IF |
| swap @ swap |
swap @ swap |
| THEN ; |
THEN ; |
| ; |
; |
| |
|
| : (name>intn) ( nfa -- xt +-1 ) |
: (name>intn) ( nfa -- xt +-1 ) |
| (name>x) tuck (x>int) ( b xt ) |
(name>x) tuck (x>int) ( w xt ) |
| swap immediate-mask and flag-sign ; |
swap immediate-mask and flag-sign ; |
| |
|
| const Create ??? 0 , 3 c, char ? c, char ? c, char ? c, |
const Create ??? 0 , 3 c, char ? c, char ? c, char ? c, |
| drop true ; |
drop true ; |
| |
|
| : >head-noprim ( cfa -- nt ) \ gforth to-head-noprim |
: >head-noprim ( cfa -- nt ) \ gforth to-head-noprim |
| |
\ also heuristic; finds only names with up to 32 chars |
| $25 cell do ( cfa ) |
$25 cell do ( cfa ) |
| dup i - count $9F and + cfaligned over alias-mask + = |
dup i - dup @ [ alias-mask lcount-mask or ] literal and ( cfa len|alias ) |
| |
swap + cell + cfaligned over alias-mask + = |
| if ( cfa ) |
if ( cfa ) |
| dup i - cell - dup head? |
dup i - cell - dup head? |
| if |
if |
| |
|
| : >head-noprim ( cfa -- nt ) \ gforth to-head-noprim |
: >head-noprim ( cfa -- nt ) \ gforth to-head-noprim |
| $25 cell do ( cfa ) |
$25 cell do ( cfa ) |
| dup i - count $9F and + cfaligned over alias-mask + = |
dup i - dup @ [ alias-mask lcount-mask or ] literal and ( cfa len|alias ) |
| |
swap + cell + cfaligned over alias-mask + = |
| if ( cfa ) i - cell - unloop exit |
if ( cfa ) i - cell - unloop exit |
| then |
then |
| cell +loop |
cell +loop |
