--- gforth/see.fs 1995/11/02 14:20:53 1.8 +++ gforth/see.fs 1996/05/13 16:37:02 1.12 @@ -1,11 +1,32 @@ \ SEE.FS highend SEE for ANSforth 16may93jaw +\ 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 \ I'm sorry. This is really not "forthy" enough. \ Ideas: Level should be a stack +require termsize.fs + decimal \ Screen format words 16may93jaw @@ -37,7 +58,7 @@ DEFER nlcount ' noop IS nlcount XPos @ Level @ = ?Exit C-Formated @ IF C-Output @ - IF C-Clearline @ IF 80 XPos @ - spaces + IF C-Clearline @ IF cols XPos @ - spaces ELSE cr THEN 1 YPos +! 0 XPos ! Level @ spaces @@ -45,7 +66,7 @@ DEFER nlcount ' noop IS nlcount : warp? ( len -- len ) nlflag @ IF (nl) nlflag off THEN - XPos @ over + 79 u> IF (nl) THEN ; + XPos @ over + cols u>= IF (nl) THEN ; : ctype ( adr len -- ) warp? dup XPos +! C-Output @ IF type ELSE 2drop THEN ; @@ -181,11 +202,13 @@ VARIABLE C-Pass : ahead? ( n -- flag ) 0> ; : c-(compile) - Display? IF s" POSTPONE " Com# .string - dup @ look 0= ABORT" SEE: No valid XT" - cell+ count $1F and 0 .string bl cemit - THEN - cell+ ; + Display? + IF + s" POSTPONE " Com# .string + dup @ look 0= ABORT" SEE: No valid XT" + name>string 0 .string bl cemit + THEN + cell+ ; : c-lit Display? IF @@ -472,7 +495,7 @@ CREATE C-Table WHILE 2 pick <> WHILE 2 cells + REPEAT - nip cell+ @ EXECUTE + nip cell+ perform true ELSE 2drop drop false @@ -537,13 +560,17 @@ DEFER dosee DisplayMode c-pass ! makepass ; : doali here @ .name ." Alias " .name cr here @ dosee ; -: docol S" : " Com# .string - dup cell+ count $1F and 2 pick wordinfo .string bl cemit bl cemit - ( XPos @ ) 2 Level ! - name> >body - C-Pass @ DebugMode = IF ScanMode c-pass ! EXIT THEN - ScanMode c-pass ! dup makepass - DisplayMode c-pass ! makepass ; +: docol + S" : " Com# .string + dup name>string 2 pick wordinfo .string bl cemit bl cemit + ( XPos @ ) 2 Level ! + name> >body + C-Pass @ DebugMode = + IF + ScanMode c-pass ! EXIT + THEN + ScanMode c-pass ! dup makepass + DisplayMode c-pass ! makepass ; create wordtypes Pri# , ' dopri A, @@ -563,8 +590,9 @@ create wordtypes wordtypes BEGIN dup @ dup WHILE 2 pick = IF cell+ @ nip EXECUTE - r> dup 32 and IF ." immediate" THEN - 64 and IF ." restrict" THEN EXIT THEN + r> dup immediate-mask and IF ." immediate" THEN + restrict-mask and IF ." restrict" THEN + EXIT THEN 2 cells + REPEAT 2drop rdrop