version 1.4, 1996/05/13 16:37:01
|
version 1.14, 2000/09/23 15:06:01
|
Line 1
|
Line 1
|
\ LOOK.FS xt -> lfa 22may93jaw |
\ LOOK.FS xt -> lfa 22may93jaw |
|
|
\ Copyright (C) 1995 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1996,1997,2000 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 28
|
Line 28
|
|
|
decimal |
decimal |
|
|
\ >NAME PRIMSTART 22may93jaw |
|
|
|
\ : >name ( xt -- nfa ) |
|
\ BEGIN 1 chars - |
|
\ dup c@ alias-mask and |
|
\ UNTIL ; |
|
|
|
: PrimStart ['] true >name ; |
|
|
|
\ look 17may93jaw |
\ look 17may93jaw |
|
|
|
\ rename to discover!!! |
|
|
: (look) ( xt startlfa -- lfa flag ) |
: (look) ( xt startlfa -- lfa flag ) |
false swap |
false swap |
BEGIN @ dup |
BEGIN @ dup |
WHILE dup name> |
WHILE dup name>int |
3 pick = IF nip dup THEN |
3 pick = IF nip dup THEN |
REPEAT |
REPEAT |
drop nip |
drop nip |
dup 0<> ; |
dup 0<> ; |
|
|
|
|
|
\ !!! nicht optimal! |
|
[IFUNDEF] look |
|
has? ec [IF] |
|
|
|
has? rom |
|
[IF] |
|
: look |
|
dup [ unlock rom-dictionary area lock ] |
|
literal literal within |
|
IF |
|
>head-noprim dup ?? <> |
|
ELSE |
|
forth-wordlist @ (look) |
|
THEN ; |
|
[ELSE] |
|
: look ( cfa -- lfa flag ) |
|
>head-noprim dup ??? <> ; |
|
[THEN] |
|
|
|
[ELSE] |
|
|
|
: PrimStart ['] true >head-noprim ; |
|
|
: look ( cfa -- lfa flag ) |
: look ( cfa -- lfa flag ) |
dup forthstart < |
dup in-dictionary? |
IF PrimStart (look) |
IF |
ELSE >name true THEN ; |
>head-noprim dup ??? <> |
|
ELSE |
|
PrimStart (look) |
|
THEN ; |
|
|
|
[THEN] |
|
[THEN] |
|
|
|
: >head ( cfa -- nt|0 ) \ gforth to-head |
|
\G tries to find the name token nt of the word represented by cfa; |
|
\G returns 0 if it fails. This word is not absolutely reliable, |
|
\G it may give false positives and produce wrong nts. |
|
look and ; |
|
|
|
' >head ALIAS >name \ gforth to-name |
|
\G old name of @code{>head} |