Diff for /gforth/see.fs between versions 1.55 and 1.58

version 1.55, 2004/12/28 19:51:44 version 1.58, 2006/12/30 20:06:26
Line 1 Line 1
 \ SEE.FS       highend SEE for ANSforth                16may93jaw  \ SEE.FS       highend SEE for ANSforth                16may93jaw
   
 \ Copyright (C) 1995,2000,2003 Free Software Foundation, Inc.  \ Copyright (C) 1995,2000,2003,2004 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
Line 71  DEFER nlcount ' noop IS nlcount Line 71  DEFER nlcount ' noop IS nlcount
                 nlflag @ IF (nl) nlflag off THEN                  nlflag @ IF (nl) nlflag off THEN
                 XPos @ over + cols u>= IF (nl) THEN ;                  XPos @ over + cols u>= IF (nl) THEN ;
   
 : c-to-upper ( c1 -- c2 ) \ gforth  
     \ nac05feb1999 there is a primitive, toupper, with this function  
     dup [char] a >= over [char] z <= and if  bl -  then ;  
   
 : ctype         ( adr len -- )  : ctype         ( adr len -- )
                 warp? dup XPos +! C-Output @                   warp? dup XPos +! C-Output @ 
                 IF uppercase @ IF bounds ?DO i c@ c-to-upper emit LOOP                  IF uppercase @ IF bounds ?DO i c@ toupper emit LOOP
                                   uppercase off ELSE type THEN                                    uppercase off ELSE type THEN
                 ELSE 2drop THEN ;                  ELSE 2drop THEN ;
   
Line 266  VARIABLE C-Pass Line 262  VARIABLE C-Pass
     \ print x as a word if possible      \ print x as a word if possible
     dup look 0= IF      dup look 0= IF
         drop dup threaded>name dup 0= if          drop dup threaded>name dup 0= if
             2drop dup 1 cells - @ dup body> look              drop over 1 cells - @ dup body> look
             IF              IF
                 nip dup ." <" name>string rot wordinfo .string ." > "                  nip nip dup ." <" name>string rot wordinfo .string ." > "
             ELSE              ELSE
                 drop ." <" 0 .r ." > "                  2drop ." <" 0 .r ." > "
             THEN              THEN
             EXIT              EXIT
         then          then

Removed from v.1.55  
changed lines
  Added in v.1.58


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