--- gforth/look.fs 1996/08/21 14:58:42 1.5 +++ gforth/look.fs 2001/09/16 10:20:39 1.16 @@ -1,6 +1,6 @@ \ 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. @@ -16,7 +16,7 @@ \ You should have received a copy of the GNU General Public License \ 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 \ vocabulary in the primitive area is beeing searched, meaning @@ -26,19 +26,15 @@ \ Problems: A compiled xt via compile, might be created with noname: \ a noname: leaves now a empty name field -decimal - -\ >NAME PRIMSTART 22may93jaw - -\ : >name ( xt -- nfa ) -\ BEGIN 1 chars - -\ dup c@ alias-mask and -\ UNTIL ; +require stuff.fs +require environ.fs -: PrimStart ['] true >name ; +decimal \ look 17may93jaw +\ rename to discover!!! + : (look) ( xt startlfa -- lfa flag ) false swap BEGIN @ dup @@ -48,8 +44,46 @@ decimal drop nip 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 ) - dup forthstart < - IF PrimStart (look) - ELSE >name true THEN ; + dup in-dictionary? + IF + >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}