version 1.18, 1997/07/06 14:29:34
|
version 1.25, 2000/03/11 20:35:05
|
Line 72 DEFER nlcount ' noop IS nlcount
|
Line 72 DEFER nlcount ' noop IS nlcount
|
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 |
: c-to-upper ( c1 -- c2 ) \ gforth |
dup [char] a >= over [char] z <= and if bl - then ; |
\ 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 @ |
Line 135 VARIABLE SearchPointer
|
Line 136 VARIABLE SearchPointer
|
\ The branchtable consists of three entrys: |
\ The branchtable consists of three entrys: |
\ address of branch , branch destination , branch type |
\ address of branch , branch destination , branch type |
|
|
CREATE BranchTable 500 allot |
CREATE BranchTable 128 cells allot |
here 3 cells - |
here 3 cells - |
ACONSTANT MaxTable |
ACONSTANT MaxTable |
|
|
Line 235 VARIABLE C-Pass
|
Line 236 VARIABLE C-Pass
|
: back? ( n -- flag ) 0< ; |
: back? ( n -- flag ) 0< ; |
: ahead? ( 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 |
: c-lit |
Display? IF |
Display? IF |
dup @ dup abs 0 <# #S rot sign #> 0 .string bl cemit |
dup @ dup abs 0 <# #S rot sign #> 0 .string bl cemit |
Line 393 VARIABLE C-Pass
|
Line 385 VARIABLE C-Pass
|
THEN |
THEN |
Debug? IF drop THEN ; |
Debug? IF drop THEN ; |
|
|
: c-does> \ end of create part |
|
Display? IF S" DOES> " Com# .string THEN |
|
Cell+ cell+ ; |
|
|
|
: c-abort" |
: c-abort" |
count 2dup + aligned -rot |
count 2dup + aligned -rot |
Display? |
Display? |
Line 406 VARIABLE C-Pass
|
Line 394 VARIABLE C-Pass
|
ELSE 2drop |
ELSE 2drop |
THEN ; |
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 |
CREATE C-Table |
' lit A, ' c-lit A, |
' lit A, ' c-lit A, |
Line 428 CREATE C-Table
|
Line 432 CREATE C-Table
|
[IFDEF] (-loop) ' (-loop) A, ' c-loop A, [THEN] |
[IFDEF] (-loop) ' (-loop) A, ' c-loop A, [THEN] |
' (next) A, ' c-loop A, |
' (next) A, ' c-loop A, |
' ;s A, ' c-exit A, |
' ;s A, ' c-exit A, |
' (does>) A, ' c-does> A, |
|
' (abort") A, ' c-abort" 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 , |
0 , here 0 , |
|
|
avariable c-extender |
avariable c-extender |
Line 518 IS discode
|
Line 523 IS discode
|
|
|
: seecode ( xt -- ) |
: seecode ( xt -- ) |
dup s" Code" .defname |
dup s" Code" .defname |
>body discode |
threading-method |
|
if |
|
>code-address |
|
then |
|
discode |
." end-code" cr ; |
." end-code" cr ; |
: seevar ( xt -- ) |
: seevar ( xt -- ) |
s" Variable" .defname cr ; |
s" Variable" .defname cr ; |
Line 612 IS discode
|
Line 621 IS discode
|
then |
then |
rdrop drop ; |
rdrop drop ; |
|
|
: see ( "name" -- ) \ tools |
: see ( "<spaces>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= |
name find-name dup 0= |
IF |
IF |
drop -&13 bounce |
drop -&13 throw |
THEN |
THEN |
name-see ; |
name-see ; |
|
|