[gforth] / gforth / look.fs  

gforth: gforth/look.fs


1 : anton 1.1 \ LOOK.FS xt -> lfa 22may93jaw
2 :    
3 : anton 1.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 :    
21 : anton 1.1 \ 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 :     : PrimStart ['] true >name ;
32 :    
33 :     \ look 17may93jaw
34 :    
35 :     : (look) ( xt startlfa -- lfa flag )
36 :     false swap
37 :     BEGIN @ dup
38 : anton 1.5 WHILE dup name>int
39 : anton 1.1 3 pick = IF nip dup THEN
40 :     REPEAT
41 :     drop nip
42 :     dup 0<> ;
43 :    
44 :     : look ( cfa -- lfa flag )
45 : anton 1.7 dup dictionary-end forthstart within
46 : anton 1.6 IF
47 :     PrimStart (look)
48 :     ELSE
49 :     >name dup ??? <>
50 :     THEN ;
51 : anton 1.1

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help