Annotation of gforth/look.fs, revision 1.10

1.1       anton       1: \ LOOK.FS      xt -> lfa                               22may93jaw
                      2: 
1.3       anton       3: \ Copyright (C) 1995 Free Software Foundation, Inc.
                      4: 
                      5: \ This file is part of Gforth.
                      6: 
                      7: \ Gforth is free software; you can redistribute it and/or
                      8: \ modify it under the terms of the GNU General Public License
                      9: \ as published by the Free Software Foundation; either version 2
                     10: \ of the License, or (at your option) any later version.
                     11: 
                     12: \ This program is distributed in the hope that it will be useful,
                     13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
                     14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     15: \ GNU General Public License for more details.
                     16: 
                     17: \ You should have received a copy of the GNU General Public License
                     18: \ along with this program; if not, write to the Free Software
                     19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                     20: 
1.1       anton      21: \ Look checks first if the word is a primitive. If yes then the
                     22: \ vocabulary in the primitive area is beeing searched, meaning
                     23: \ creating for each word a xt and comparing it...
                     24: 
                     25: \ If a word is no primitive look searches backwards to find the nfa.
                     26: \ Problems: A compiled xt via compile, might be created with noname:
                     27: \           a noname: leaves now a empty name field
                     28: 
                     29: decimal
                     30: 
1.8       jwilke     31: \ look                                                  17may93jaw
1.1       anton      32: 
1.8       jwilke     33: \ rename to discover!!!
1.1       anton      34: 
                     35: : (look)  ( xt startlfa -- lfa flag )
                     36:         false swap
                     37:         BEGIN @ dup
1.5       anton      38:         WHILE dup name>int
1.1       anton      39:               3 pick = IF nip dup THEN
                     40:         REPEAT
                     41:         drop nip
                     42:         dup 0<> ;
                     43: 
1.8       jwilke     44: 
                     45: \ !!! nicht optimal!
                     46: [IFUNDEF] look
1.9       jwilke     47: has? ec [IF]
                     48: 
1.10    ! jwilke     49: has? rom 
1.8       jwilke     50: [IF]
1.9       jwilke     51: : look
                     52:     dup [ unlock rom-dictionary area lock ] 
                     53:     literal literal within
                     54:     IF
                     55:        >name dup ?? <>
                     56:     ELSE
                     57:        forth-wordlist @ (look)
                     58:     THEN ;
                     59: [ELSE]
1.8       jwilke     60: : look ( cfa -- lfa flag )
1.9       jwilke     61:     >name dup ??? <> ;
                     62: [THEN]
1.8       jwilke     63: 
                     64: [ELSE]
                     65: 
                     66: : PrimStart ['] true >name ;
                     67: 
1.1       anton      68: : look ( cfa -- lfa flag )
1.9       jwilke     69:     dup dictionary-end forthstart within
                     70:     IF
                     71:        PrimStart (look)
                     72:     ELSE
                     73:        >name dup ??? <>
                     74:     THEN ;
1.1       anton      75: 
1.8       jwilke     76: [THEN]
                     77: [THEN]

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>