version 1.2, 1994/05/03 19:10:36
|
version 1.4, 1994/09/12 19:00:37
|
Line 427 CREATE C-Table
|
Line 427 CREATE C-Table
|
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= ABORT" SEE: Bua!" |
IF look 0= IF drop dup 1 cells - @ . \ ABORT" SEE: Bua!" |
cell+ dup count 31 and rot wordinfo .string bl cemit |
ELSE dup cell+ count 31 and rot wordinfo .string THEN bl cemit |
ELSE drop |
ELSE drop |
THEN ; |
THEN ; |
|
|
Line 449 CREATE C-Table
|
Line 449 CREATE C-Table
|
DEFER dosee |
DEFER dosee |
|
|
: dopri .name ." is primitive" cr ; |
: dopri .name ." is primitive" cr ; |
: dovar .name ." is variable" cr ; |
: dovar ." Variable " .name cr ; |
: docon dup .name ." is constant, value: " |
: douse ." User " .name cr ; |
cell+ (name>) >body @ . cr ; |
: docon dup cell+ (name>) >body @ . ." Constant " .name cr ; |
: doval .name ." is value" cr ; |
: doval dup cell+ (name>) >body @ . ." Value " .name cr ; |
: dodef .name ." is defered word, is: " |
: dodef ." Defer " dup >r .name cr |
here @ look 0= ABORT" SEE: No valid xt in defered word" |
here @ look 0= ABORT" SEE: No valid xt in defered word" |
.name cr here @ look drop dosee ; |
here @ look drop dosee cr |
: dodoe .name ." is created word" cr |
." ' " .name r> ." IS " .name cr ; |
|
: dodoe ." Create " .name cr |
S" DOES> " Com# .string XPos @ Level ! |
S" DOES> " Com# .string XPos @ Level ! |
here @ dup C-Pass @ DebugMode = IF ScanMode c-pass ! EXIT THEN |
here @ 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 .name ." is alias of " |
: doali here @ .name ." Alias " .name cr |
here @ .name cr |
|
here @ dosee ; |
here @ dosee ; |
: docol S" : " Com# .string |
: docol S" : " Com# .string |
cell+ dup count $1F and 2 pick wordinfo .string bl cemit bl cemit |
dup cell+ count $1F and 2 pick wordinfo .string bl cemit bl cemit |
( XPos @ ) 2 Level ! |
( XPos @ ) 2 Level ! |
name> >body |
name> >body |
C-Pass @ DebugMode = IF ScanMode c-pass ! EXIT THEN |
C-Pass @ DebugMode = IF ScanMode c-pass ! EXIT THEN |
Line 481 create wordtypes
|
Line 481 create wordtypes
|
Doe# , ' dodoe A, |
Doe# , ' dodoe A, |
Ali# , ' doali A, |
Ali# , ' doali A, |
Col# , ' docol A, |
Col# , ' docol A, |
|
Use# , ' douse A, |
0 , |
0 , |
|
|
: (dosee) ( lfa -- ) |
: (dosee) ( lfa -- ) |
dup cell+ dup c@ 32 and IF over .name ." is an immediate word" cr THEN |
dup dup cell+ c@ >r |
wordinfo |
wordinfo |
wordtypes |
wordtypes |
BEGIN dup @ dup |
BEGIN dup @ dup |
WHILE 2 pick = IF cell+ @ nip EXECUTE EXIT THEN |
WHILE 2 pick = IF cell+ @ nip EXECUTE |
|
r> dup 32 and IF ." immediate" THEN |
|
64 and IF ." restrict" THEN EXIT THEN |
2 cells + |
2 cells + |
REPEAT |
REPEAT |
2drop |
2drop rdrop |
.name ." Don't know how to handle" cr ; |
.name ." Don't know how to handle" cr ; |
|
|
' (dosee) IS dosee |
' (dosee) IS dosee |
|
|
: see name find cr 0= IF ." Word unknown" cr drop exit THEN |
|
>name c-init |
|
dosee ; |
|
|
|
: xtc ( xt -- ) \ do see at xt |
: xtc ( xt -- ) \ do see at xt |
Look 0= ABORT" SEE: No valid XT" |
Look 0= ABORT" SEE: No valid XT" |
cr c-init |
cr c-init |
dosee ; |
dosee ; |
|
|
|
: see name sfind 0= IF ." Word unknown" cr exit THEN |
|
xtc ; |
|
|
: lfc cr c-init cell+ dosee ; |
: lfc cr c-init cell+ dosee ; |
: nfc cr c-init dosee ; |
: nfc cr c-init dosee ; |
|
|