[BACK]Return to see.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/see.fs between versions 1.8 and 1.12

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>