--- gforth/wordinfo.fs 1994/11/29 16:22:51 1.6 +++ gforth/wordinfo.fs 1997/07/06 14:29:34 1.14 @@ -1,59 +1,75 @@ \ WORDINFO.FS V1.0 17may93jaw +\ Copyright (C) 1995 Free Software Foundation, Inc. + +\ This file is part of Gforth. + +\ Gforth is free software; you can redistribute it and/or +\ modify it under the terms of the GNU General Public License +\ as published by the Free Software Foundation; either version 2 +\ of the License, or (at your option) any later version. + +\ This program is distributed in the hope that it will be useful, +\ but WITHOUT ANY WARRANTY; without even the implied warranty of +\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +\ GNU General Public License for more details. + +\ 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. + \ May be cross-compiled \ If you want check values then exclude comments, \ but keep in mind that this can't be cross-compiled -INCLUDE look.fs +\ INCLUDE look.fs \ Wordinfo is a tool that checks a nfa \ and finds out what wordtype we have \ it is used in SEE.FS -: alias? ( nfa -- flag ) - dup name> look - 0= ABORT" WINFO: CFA not found" -\ cell+ - 2dup <> - IF nip dup 1 cells - here ! - count $1f and here cell+ place true - ELSE 2drop false THEN ; +\ the old alias? did not work and it is not used, so I changed +\ it in many respects - anton +: alias? ( nfa1 -- nfa2|0 ) + \ if nfa1 is an alias, nfa2 is the name of the original word + dup cell+ c@ alias-mask and 0= + IF ( nfa1 ) + ((name>)) @ >name ( use look instead? ) + ELSE + drop 0 + THEN ; : var? ( nfa -- flag ) - cell+ (name>) - >code-address ['] udp >code-address = ; + ((name>)) >code-address dovar: = ; : con? ( nfa -- flag ) - cell+ (name>) - >code-address ['] bl >code-address = ; + ((name>)) >code-address docon: = ; : user? ( nfa -- flag ) - cell+ (name>) - >code-address ['] s0 >code-address = ; + ((name>)) >code-address douser: = ; : does? ( nfa -- flag ) - cell+ (name>) - >code-address ['] bits >code-address = ; + ((name>)) + >does-code 0<> ; : defered? ( nfa -- flag ) - cell+ (name>) - >code-address ['] source >code-address = ; + ((name>)) >code-address dodefer: = ; : colon? ( nfa -- flag ) - cell+ (name>) - >code-address ['] does? >code-address = ; - -\ VALUE VCheck + ((name>)) >code-address docol: = ; -\ : value? ( nfa -- flag ) -\ dup does? -\ IF here @ ['] VCheck cell+ @ = -\ dup IF swap (name>) >body @ here ! ELSE nip THEN -\ ELSE drop false THEN ; +\ the above words could be factored with create-does>, but this would +\ probably make this file incompatible with cross. +[IFDEF] forthstart +: xtprim? ( xt -- flag ) + forthstart u< ; +[ELSE] +: xtprim? ( xt -- flag ) + dup >body swap >code-address = ; +[THEN] : prim? ( nfa -- flag ) - name> - forthstart u< ; + name>int xtprim? ; \ None nestable IDs: