[gforth] / gforth / see.fs  

gforth: gforth/see.fs

Diff for /gforth/see.fs between version 1.55 and 1.62

version 1.55, Tue Dec 28 19:51:44 2004 UTC version 1.62, Mon Dec 31 17:34:58 2007 UTC
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,2006,2007 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
Line 71 
Line 71 
                 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 124 
Line 120 
                     else                      else
                         base @ >r try                          base @ >r try
                             8 base ! 0 <<# # # # '\ hold #> ctype #>> 0                              8 base ! 0 <<# # # # '\ hold #> ctype #>> 0
                         recover                          restore
                               r@ base !
                         endtry                          endtry
                         r> base ! throw                          rdrop throw
                     endif                      endif
                 endif                  endif
                 1 /string                  1 /string
Line 266 
Line 263 
     \ 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
Line 761 
Line 758 
     dup >code-address      dup >code-address
     CASE      CASE
         docon: of seecon endof          docon: of seecon endof
           dovalue: of seevalue endof
         docol: of seecol endof          docol: of seecol endof
         dovar: of seevar endof          dovar: of seevar endof
 [ [IFDEF] douser: ]  [ [IFDEF] douser: ]

Generate output suitable for use with a patch program
Legend:
Removed from v.1.55  
changed lines
  Added in v.1.62
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help