Return to look.fs CVS log

Up to [gforth] / gforth

Annotation of gforth/look.fs, revision 1.3

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: 
                     31: \ >NAME PRIMSTART                                       22may93jaw
                     32: 
                     33: \ : >name ( xt -- nfa )
                     34: \         BEGIN   1 chars -
                     35: \                 dup c@ 128 and
                     36: \         UNTIL ;
                     37: 
                     38: : PrimStart ['] true >name ;
                     39: 
                     40: \ look                                                  17may93jaw
                     41: 
                     42: : (look)  ( xt startlfa -- lfa flag )
                     43:         false swap
                     44:         BEGIN @ dup
1.2       pazsan     45:         WHILE dup name>
1.1       anton      46:               3 pick = IF nip dup THEN
                     47:         REPEAT
                     48:         drop nip
                     49:         dup 0<> ;
                     50: 
                     51: : look ( cfa -- lfa flag )
1.2       pazsan     52:         dup forthstart <
1.1       anton      53:         IF PrimStart (look)
                     54:         ELSE >name true THEN ;
                     55: