| \ SEE.FS highend SEE for ANSforth 16may93jaw |
\ SEE.FS highend SEE for ANSforth 16may93jaw |
| |
|
| \ Copyright (C) 1995 Free Software Foundation, Inc. |
\ Copyright (C) 1995,2000 Free Software Foundation, Inc. |
| |
|
| \ This file is part of Gforth. |
\ This file is part of Gforth. |
| |
|
| |
|
| \ You should have received a copy of the GNU General Public License |
\ You should have received a copy of the GNU General Public License |
| \ along with this program; if not, write to the Free Software |
\ 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. |
| |
|
| |
|
| \ May be cross-compiled |
\ May be cross-compiled |
| require look.fs |
require look.fs |
| require termsize.fs |
require termsize.fs |
| require wordinfo.fs |
require wordinfo.fs |
| [IFUNDEF] .name : .name name>string type space ; [THEN] |
[IFUNDEF] .name |
| |
: id. ( nt -- ) \ gforth |
| |
\G Print the name of the word represented by @var{nt}. |
| |
\ this name comes from fig-Forth |
| |
name>string type space ; |
| |
|
| |
' id. alias .id ( nt -- ) |
| |
\G F83 name for @code{id.}. |
| |
|
| |
' id. alias .name ( nt -- ) |
| |
\G Gforth <=0.5.0 name for @code{id.}. |
| |
|
| |
[THEN] |
| |
|
| decimal |
decimal |
| |
|
| IF 2drop ELSE XPos +! C-Output @ IF emit ELSE drop THEN |
IF 2drop ELSE XPos +! C-Output @ IF emit ELSE drop THEN |
| THEN ; |
THEN ; |
| |
|
| DEFER .string |
DEFER .string ( c-addr u n -- ) |
| |
|
| [IFDEF] Green |
[IFDEF] Green |
| VARIABLE Colors Colors on |
VARIABLE Colors Colors on |
| THEN |
THEN |
| cell+ ; |
cell+ ; |
| |
|
| |
: .word ( addr xt -- addr ) |
| |
look 0= IF |
| |
drop dup 1 cells - @ dup body> look |
| |
IF |
| |
nip dup ." <" name>string rot wordinfo .string ." >" |
| |
ELSE |
| |
drop ." <" 0 .r ." >" |
| |
THEN |
| |
ELSE |
| |
dup cell+ @ immediate-mask and |
| |
IF |
| |
bl cemit ." POSTPONE " |
| |
THEN |
| |
dup name>string rot wordinfo .string |
| |
THEN ; |
| |
|
| |
: c-call |
| |
Display? IF dup @ body> .word bl cemit THEN cell+ ; |
| |
|
| : .name-without ( addr -- addr ) |
: .name-without ( addr -- addr ) |
| \ prints a name without () e.g. (+LOOP) or (s") |
\ prints a name without () e.g. (+LOOP) or (s") |
| dup 1 cells - @ look |
dup 1 cells - @ look |
| |
|
| CREATE C-Table |
CREATE C-Table |
| ' lit A, ' c-lit A, |
' lit A, ' c-lit A, |
| |
[IFDEF] call ' call A, ' c-call A, [THEN] |
| ' (s") A, ' c-c" A, |
' (s") A, ' c-c" A, |
| ' (.") A, ' c-c" A, |
' (.") A, ' c-c" A, |
| ' "lit A, ' c-c" A, |
' "lit A, ' c-c" A, |
| dup cell+ swap @ |
dup cell+ swap @ |
| dup >r DoTable r> swap IF drop EXIT THEN |
dup >r DoTable r> swap IF drop EXIT THEN |
| Display? |
Display? |
| IF look 0= IF drop dup 1 cells - @ . \ ABORT" SEE: Bua!" |
IF |
| |
.word bl cemit |
| ELSE |
ELSE |
| dup cell+ count dup immediate-mask and |
drop |
| IF bl cemit ." POSTPONE " THEN |
|
| 31 and rot wordinfo .string THEN bl cemit |
|
| ELSE drop |
|
| THEN ; |
THEN ; |
| |
|
| : c-init |
: c-init |