version 1.32, 2000/10/29 08:37:45
|
version 1.39, 2002/01/26 16:31:40
|
Line 99 DEFER nlcount ' noop IS nlcount
|
Line 99 DEFER nlcount ' noop IS nlcount
|
IF 2drop ELSE XPos +! C-Output @ IF emit ELSE drop THEN |
IF 2drop ELSE XPos +! C-Output @ IF emit ELSE drop THEN |
THEN ; |
THEN ; |
|
|
DEFER .string |
DEFER .string ( c-addr u n -- ) |
|
|
[IFDEF] Green |
[IFDEF] Green |
VARIABLE Colors Colors on |
VARIABLE Colors Colors on |
Line 254 VARIABLE C-Pass
|
Line 254 VARIABLE C-Pass
|
THEN |
THEN |
cell+ ; |
cell+ ; |
|
|
|
: .word ( addr xt -- addr ) |
|
look 0= IF |
|
drop dup 1 cells - @ dup body> look |
|
IF |
|
nip dup ." <" name>string rot wordinfo .string ." >" |
|
ELSE |
|
drop ." <" 0 .r ." >" |
|
THEN |
|
ELSE |
|
dup cell+ @ immediate-mask and |
|
IF |
|
bl cemit ." POSTPONE " |
|
THEN |
|
dup name>string rot wordinfo .string |
|
THEN ; |
|
|
|
: c-call |
|
Display? IF ." call " dup @ body> .word bl cemit THEN cell+ ; |
|
|
: .name-without ( addr -- addr ) |
: .name-without ( addr -- addr ) |
\ prints a name without () e.g. (+LOOP) or (s") |
\ prints a name without () e.g. (+LOOP) or (s") |
dup 1 cells - @ look |
dup 1 cells - @ look |
Line 425 VARIABLE C-Pass
|
Line 444 VARIABLE C-Pass
|
|
|
CREATE C-Table |
CREATE C-Table |
' lit A, ' c-lit A, |
' lit A, ' c-lit A, |
|
[IFDEF] call ' call A, ' c-call A, [THEN] |
' (s") A, ' c-c" A, |
' (s") A, ' c-c" A, |
' (.") A, ' c-c" A, |
' (.") A, ' c-c" A, |
' "lit A, ' c-c" A, |
' "lit A, ' c-c" A, |
Line 488 c-extender !
|
Line 508 c-extender !
|
THEN ; |
THEN ; |
|
|
: analyse ( a-addr1 -- a-addr2 ) |
: analyse ( a-addr1 -- a-addr2 ) |
Branches @ IF BranchTo? THEN |
Branches @ IF BranchTo? THEN |
dup cell+ swap @ |
dup cell+ swap @ |
dup >r DoTable r> swap IF drop EXIT THEN |
dup >r DoTable r> swap IF drop EXIT THEN |
Display? |
Display? |
IF look 0= IF drop dup 1 cells - @ . \ ABORT" SEE: Bua!" |
IF |
ELSE |
.word bl cemit |
dup cell+ count dup immediate-mask and |
ELSE |
IF bl cemit ." POSTPONE " THEN |
drop |
31 and rot wordinfo .string THEN bl cemit |
THEN ; |
ELSE drop |
|
THEN ; |
|
|
|
: c-init |
: c-init |
0 YPos ! 0 XPos ! |
0 YPos ! 0 XPos ! |
Line 566 Defer discode ( addr u -- ) \ gforth
|
Line 584 Defer discode ( addr u -- ) \ gforth
|
|
|
: seecode ( xt -- ) |
: seecode ( xt -- ) |
dup s" Code" .defname |
dup s" Code" .defname |
threading-method |
>code-address |
if |
|
>code-address |
|
then |
|
dup in-dictionary? \ user-defined code word? |
dup in-dictionary? \ user-defined code word? |
if |
if |
dup next-head |
dup next-head |