--- gforth/see.fs 1999/02/03 00:10:22 1.21 +++ gforth/see.fs 2000/05/27 18:55:55 1.26 @@ -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 @ @@ -135,7 +136,7 @@ VARIABLE SearchPointer \ The branchtable consists of three entrys: \ address of branch , branch destination , branch type -CREATE BranchTable 500 allot +CREATE BranchTable 128 cells allot here 3 cells - ACONSTANT MaxTable @@ -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 - maxaligned /does-handler + ; - : 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 @@ -537,10 +542,10 @@ IS discode : seedefer ( xt -- ) dup >body @ xt-see-xt cr dup s" Defer" .defname cr - >name dup ??? = if - drop ." lastxt >body !" - else + >name ?dup-if ." IS " .name cr + else + ." lastxt >body !" then ; : see-threaded ( addr -- ) C-Pass @ DebugMode = IF @@ -624,7 +629,7 @@ IS discode \G etc.) is lost. name find-name dup 0= IF - drop -&13 bounce + drop -&13 throw THEN name-see ;