--- gforth/look.fs 1997/03/27 13:31:02 1.7 +++ gforth/look.fs 2000/05/27 09:41:28 1.13 @@ -1,6 +1,6 @@ \ LOOK.FS xt -> lfa 22may93jaw -\ Copyright (C) 1995 Free Software Foundation, Inc. +\ Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -28,10 +28,10 @@ decimal -: PrimStart ['] true >name ; - \ look 17may93jaw +\ rename to discover!!! + : (look) ( xt startlfa -- lfa flag ) false swap BEGIN @ dup @@ -41,11 +41,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 dictionary-end forthstart within - IF - PrimStart (look) - ELSE - >name dup ??? <> - 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}