--- gforth/see.fs 2004/06/19 15:32:31 1.54 +++ gforth/see.fs 2006/12/31 13:39:13 1.59 @@ -1,6 +1,6 @@ \ SEE.FS highend SEE for ANSforth 16may93jaw -\ Copyright (C) 1995,2000,2003 Free Software Foundation, Inc. +\ Copyright (C) 1995,2000,2003,2004,2006 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -71,13 +71,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 ; @@ -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 @@ -673,13 +669,15 @@ Defer discode ( addr u -- ) \ gforth cell +loop here ; +[ifundef] umin \ !! bootstrapping help : umin ( u1 u2 -- u ) 2dup u> if swap then drop ; - +[then] + : next-prim ( addr1 -- addr2 ) \ gforth \G find the next primitive after addr1 (unreliable) 1+ >r -1 primstart