--- gforth/see.fs 2004/12/28 19:51:44 1.55 +++ gforth/see.fs 2007/12/31 18:40:24 1.63 @@ -1,12 +1,12 @@ \ 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. \ 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 +\ as published by the Free Software Foundation, either version 3 \ of the License, or (at your option) any later version. \ This program is distributed in the hope that it will be useful, @@ -15,8 +15,7 @@ \ 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., 59 Temple Place, Suite 330, Boston, MA 02111, USA. +\ along with this program. If not, see http://www.gnu.org/licenses/. \ May be cross-compiled @@ -71,13 +70,9 @@ DEFER nlcount ' noop IS nlcount nlflag @ IF (nl) nlflag off 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 -- ) 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 ELSE 2drop THEN ; @@ -124,9 +119,10 @@ VARIABLE Colors Colors on else base @ >r try 8 base ! 0 <<# # # # '\ hold #> ctype #>> 0 - recover + restore + r@ base ! endtry - r> base ! throw + rdrop throw endif endif 1 /string @@ -266,11 +262,11 @@ VARIABLE C-Pass \ print x as a word if possible dup look 0= IF drop dup threaded>name dup 0= if - 2drop dup 1 cells - @ dup body> look + drop over 1 cells - @ dup body> look IF - nip dup ." <" name>string rot wordinfo .string ." > " + nip nip dup ." <" name>string rot wordinfo .string ." > " ELSE - drop ." <" 0 .r ." > " + 2drop ." <" 0 .r ." > " THEN EXIT then @@ -761,6 +757,7 @@ Defer discode ( addr u -- ) \ gforth dup >code-address CASE docon: of seecon endof + dovalue: of seevalue endof docol: of seecol endof dovar: of seevar endof [ [IFDEF] douser: ]