version 1.9, 1995/11/07 18:06:59
|
version 1.13, 1996/08/21 14:58:44
|
Line 25
|
Line 25
|
|
|
\ Ideas: Level should be a stack |
\ Ideas: Level should be a stack |
|
|
|
require termsize.fs |
|
|
decimal |
decimal |
|
|
\ Screen format words 16may93jaw |
\ Screen format words 16may93jaw |
Line 56 DEFER nlcount ' noop IS nlcount
|
Line 58 DEFER nlcount ' noop IS nlcount
|
XPos @ Level @ = ?Exit |
XPos @ Level @ = ?Exit |
C-Formated @ IF |
C-Formated @ IF |
C-Output @ |
C-Output @ |
IF C-Clearline @ IF 80 XPos @ - spaces |
IF C-Clearline @ IF cols XPos @ - spaces |
ELSE cr THEN |
ELSE cr THEN |
1 YPos +! 0 XPos ! |
1 YPos +! 0 XPos ! |
Level @ spaces |
Level @ spaces |
Line 64 DEFER nlcount ' noop IS nlcount
|
Line 66 DEFER nlcount ' noop IS nlcount
|
|
|
: warp? ( len -- len ) |
: warp? ( len -- len ) |
nlflag @ IF (nl) nlflag off THEN |
nlflag @ IF (nl) nlflag off THEN |
XPos @ over + 79 u> IF (nl) THEN ; |
XPos @ over + cols u>= IF (nl) THEN ; |
|
|
: ctype ( adr len -- ) |
: ctype ( adr len -- ) |
warp? dup XPos +! C-Output @ IF type ELSE 2drop THEN ; |
warp? dup XPos +! C-Output @ IF type ELSE 2drop THEN ; |
Line 200 VARIABLE C-Pass
|
Line 202 VARIABLE C-Pass
|
: ahead? ( n -- flag ) 0> ; |
: ahead? ( n -- flag ) 0> ; |
|
|
: c-(compile) |
: c-(compile) |
Display? IF s" POSTPONE " Com# .string |
Display? |
dup @ look 0= ABORT" SEE: No valid XT" |
IF |
cell+ count $1F and 0 .string bl cemit |
s" POSTPONE " Com# .string |
THEN |
dup @ look 0= ABORT" SEE: No valid XT" |
cell+ ; |
name>string 0 .string bl cemit |
|
THEN |
|
cell+ ; |
|
|
: c-lit |
: c-lit |
Display? IF |
Display? IF |
Line 491 CREATE C-Table
|
Line 495 CREATE C-Table
|
WHILE 2 pick <> |
WHILE 2 pick <> |
WHILE 2 cells + |
WHILE 2 cells + |
REPEAT |
REPEAT |
nip cell+ @ EXECUTE |
nip cell+ perform |
true |
true |
ELSE |
ELSE |
2drop drop false |
2drop drop false |
Line 542 DEFER dosee
|
Line 546 DEFER dosee
|
: dopri .name ." is primitive" cr ; |
: dopri .name ." is primitive" cr ; |
: dovar ." Variable " .name cr ; |
: dovar ." Variable " .name cr ; |
: douse ." User " .name cr ; |
: douse ." User " .name cr ; |
: docon dup cell+ (name>) >body @ . ." Constant " .name cr ; |
: docon dup ((name>)) >body @ . ." Constant " .name cr ; |
: doval dup cell+ (name>) >body @ . ." Value " .name cr ; |
: doval dup ((name>)) >body @ . ." Value " .name cr ; |
: dodef ." Defer " dup >r .name cr |
: dodef ." Defer " dup >r .name cr |
r@ cell+ (name>) >body @ look |
r@ ((name>)) >body @ look |
0= ABORT" SEE: No valid xt in deferred word" |
0= ABORT" SEE: No valid xt in deferred word" |
dup dosee cr |
dup dosee cr |
." ' " .name r> ." IS " .name cr ; |
." ' " .name r> ." IS " .name cr ; |
: dodoe ." Create " dup .name cr |
: dodoe ." Create " dup .name cr |
S" DOES> " Com# .string XPos @ Level ! name> |
S" DOES> " Com# .string XPos @ Level ! name>int |
>does-code dup C-Pass @ DebugMode = IF ScanMode c-pass ! EXIT THEN |
>does-code dup C-Pass @ DebugMode = IF ScanMode c-pass ! EXIT THEN |
ScanMode c-pass ! dup makepass |
ScanMode c-pass ! dup makepass |
DisplayMode c-pass ! makepass ; |
DisplayMode c-pass ! makepass ; |
: doali here @ .name ." Alias " .name cr |
: doali here @ .name ." Alias " .name cr |
here @ dosee ; |
here @ dosee ; |
: docol S" : " Com# .string |
: docol |
dup cell+ count $1F and 2 pick wordinfo .string bl cemit bl cemit |
S" : " Com# .string |
( XPos @ ) 2 Level ! |
dup name>string 2 pick wordinfo .string bl cemit bl cemit |
name> >body |
( XPos @ ) 2 Level ! |
C-Pass @ DebugMode = IF ScanMode c-pass ! EXIT THEN |
name>int >body |
ScanMode c-pass ! dup makepass |
C-Pass @ DebugMode = |
DisplayMode c-pass ! makepass ; |
IF |
|
ScanMode c-pass ! EXIT |
|
THEN |
|
ScanMode c-pass ! dup makepass |
|
DisplayMode c-pass ! makepass ; |
|
|
create wordtypes |
create wordtypes |
Pri# , ' dopri A, |
Pri# , ' dopri A, |
Line 582 create wordtypes
|
Line 590 create wordtypes
|
wordtypes |
wordtypes |
BEGIN dup @ dup |
BEGIN dup @ dup |
WHILE 2 pick = IF cell+ @ nip EXECUTE |
WHILE 2 pick = IF cell+ @ nip EXECUTE |
r> dup 32 and IF ." immediate" THEN |
r> dup immediate-mask and IF ." immediate" THEN |
64 and IF ." restrict" THEN EXIT THEN |
restrict-mask and IF ." restrict" THEN |
|
EXIT THEN |
2 cells + |
2 cells + |
REPEAT |
REPEAT |
2drop rdrop |
2drop rdrop |
Line 596 create wordtypes
|
Line 605 create wordtypes
|
cr c-init |
cr c-init |
dosee ; |
dosee ; |
|
|
: see name sfind 0= IF ." Word unknown" cr exit THEN |
: see ( "name" -- ) \ tools |
xtc ; |
name find-name dup 0= |
|
IF |
|
drop -&13 bounce |
|
THEN |
|
name>int xtc ; |
|
|
: lfc cr c-init cell+ dosee ; |
: lfc cr c-init cell+ dosee ; |
: nfc cr c-init dosee ; |
: nfc cr c-init dosee ; |