--- gforth/look.fs 2000/05/27 09:41:28 1.13 +++ gforth/look.fs 2002/12/21 17:27:13 1.20 @@ -1,6 +1,6 @@ \ LOOK.FS xt -> lfa 22may93jaw -\ Copyright (C) 1995,1996,1997 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,20 +26,37 @@ \ Problems: A compiled xt via compile, might be created with noname: \ a noname: leaves now a empty name field +require stuff.fs +require environ.fs + decimal \ look 17may93jaw \ rename to discover!!! +: xt>threaded ( xt -- x ) +\G produces the threaded-code cell for the primitive xt + threading-method 0= if + @ + then ; + : (look) ( xt startlfa -- lfa flag ) - false swap - BEGIN @ dup - WHILE dup name>int - 3 pick = IF nip dup THEN - REPEAT - drop nip - dup 0<> ; + swap + [IFDEF] decompile-prim + decompile-prim + [THEN] + false rot + BEGIN + @ dup + WHILE + dup name>int xt>threaded + 3 pick = IF + nip dup + THEN + REPEAT + drop nip + dup 0<> ; \ !!! nicht optimal!