version 1.10, 1997/09/13 12:04:56
|
version 1.15, 2000/09/23 15:46:57
|
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 16
|
Line 16
|
|
|
\ You should have received a copy of the GNU General Public License |
\ You should have received a copy of the GNU General Public License |
\ along with this program; if not, write to the Free Software |
\ along with this program; if not, write to the Free Software |
\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. |
|
|
\ Look checks first if the word is a primitive. If yes then the |
\ Look checks first if the word is a primitive. If yes then the |
\ vocabulary in the primitive area is beeing searched, meaning |
\ vocabulary in the primitive area is beeing searched, meaning |
Line 52 has? rom
|
Line 52 has? rom
|
dup [ unlock rom-dictionary area lock ] |
dup [ unlock rom-dictionary area lock ] |
literal literal within |
literal literal within |
IF |
IF |
>name dup ?? <> |
>head-noprim dup ?? <> |
ELSE |
ELSE |
forth-wordlist @ (look) |
forth-wordlist @ (look) |
THEN ; |
THEN ; |
[ELSE] |
[ELSE] |
: look ( cfa -- lfa flag ) |
: look ( cfa -- lfa flag ) |
>name dup ??? <> ; |
>head-noprim dup ??? <> ; |
[THEN] |
[THEN] |
|
|
[ELSE] |
[ELSE] |
|
|
: PrimStart ['] true >name ; |
: PrimStart ['] true >head-noprim ; |
|
|
: look ( cfa -- lfa flag ) |
: look ( cfa -- lfa flag ) |
dup dictionary-end forthstart within |
dup in-dictionary? |
IF |
IF |
PrimStart (look) |
>head-noprim dup ??? <> |
ELSE |
ELSE |
>name dup ??? <> |
PrimStart (look) |
THEN ; |
THEN ; |
|
|
[THEN] |
[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} |