--- gforth/see.fs 1997/07/06 14:29:34 1.18 +++ gforth/see.fs 1999/11/20 12:12:52 1.24 @@ -72,8 +72,9 @@ DEFER nlcount ' noop IS nlcount nlflag @ IF (nl) nlflag off THEN XPos @ over + cols u>= IF (nl) THEN ; -: c-to-upper - dup [char] a >= over [char] z <= and if bl - 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 @ @@ -235,15 +236,6 @@ VARIABLE C-Pass : back? ( n -- flag ) 0< ; : ahead? ( n -- flag ) 0> ; -: c-(compile) - Display? - IF - s" POSTPONE " Com# .string - dup @ look 0= ABORT" SEE: No valid XT" - name>string 0 .string bl cemit - THEN - cell+ ; - : c-lit Display? IF dup @ dup abs 0 <# #S rot sign #> 0 .string bl cemit @@ -393,10 +385,6 @@ VARIABLE C-Pass THEN Debug? IF drop THEN ; -: c-does> \ end of create part - Display? IF S" DOES> " Com# .string THEN - Cell+ cell+ ; - : c-abort" count 2dup + aligned -rot Display? @@ -406,6 +394,22 @@ VARIABLE C-Pass ELSE 2drop THEN ; +[IFDEF] (does>) +: c-does> \ end of create part + Display? IF S" DOES> " Com# .string THEN + maxaligned /does-handler + ; +[THEN] + +[IFDEF] (compile) +: c-(compile) + Display? + IF + s" POSTPONE " Com# .string + dup @ look 0= ABORT" SEE: No valid XT" + name>string 0 .string bl cemit + THEN + cell+ ; +[THEN] CREATE C-Table ' lit A, ' c-lit A, @@ -428,9 +432,10 @@ CREATE C-Table [IFDEF] (-loop) ' (-loop) A, ' c-loop A, [THEN] ' (next) A, ' c-loop A, ' ;s A, ' c-exit A, - ' (does>) A, ' c-does> A, ' (abort") A, ' c-abort" A, - ' (compile) A, ' c-(compile) A, +\ only defined if compiler is loaded +[IFDEF] (compile) ' (compile) A, ' c-(compile) A, [THEN] +[IFDEF] (does>) ' (does>) A, ' c-does> A, [THEN] 0 , here 0 , avariable c-extender @@ -518,7 +523,11 @@ IS discode : seecode ( xt -- ) dup s" Code" .defname - >body discode + threading-method + if + >code-address + then + discode ." end-code" cr ; : seevar ( xt -- ) s" Variable" .defname cr ; @@ -612,10 +621,15 @@ IS discode then rdrop drop ; -: see ( "name" -- ) \ tools +: see ( "name" -- ) \ tools + \G Locate @var{name} using the current search order. Display the + \G definition of @var{name}. Since this is achieved by decompiling + \G the definition, the formatting is mechanised and some source + \G information (comments, interpreted sequences within definitions + \G etc.) is lost. name find-name dup 0= IF - drop -&13 bounce + drop -&13 throw THEN name-see ;