version 1.74, 1999/05/05 18:07:51
|
version 1.75, 1999/05/10 13:57:37
|
Line 211 VARIABLE VocTemp
|
Line 211 VARIABLE VocTemp
|
hex |
hex |
4711 Constant <fwd> 4712 Constant <res> |
4711 Constant <fwd> 4712 Constant <res> |
4713 Constant <imm> 4714 Constant <do:> |
4713 Constant <imm> 4714 Constant <do:> |
|
4715 Constant <skip> |
|
|
\ iForth makes only immediate directly after create |
\ iForth makes only immediate directly after create |
\ make atonce trick! ? |
\ make atonce trick! ? |
Line 280 VARIABLE Already
|
Line 281 VARIABLE Already
|
: forward? ( ghost -- flag ) |
: forward? ( ghost -- flag ) |
>magic @ <fwd> = ; |
>magic @ <fwd> = ; |
|
|
|
: undefined? ( ghost -- flag ) |
|
>magic @ dup <fwd> = swap <skip> = or ; |
|
|
\ Predefined ghosts 12dec92py |
\ Predefined ghosts 12dec92py |
|
|
ghost 0= drop |
ghost 0= drop |
Line 321 VARIABLE env-current \ save information
|
Line 325 VARIABLE env-current \ save information
|
: has? bl word count T environment? H |
: has? bl word count T environment? H |
IF \ environment variable is present, return its value |
IF \ environment variable is present, return its value |
ELSE \ environment variable is not present, return false |
ELSE \ environment variable is not present, return false |
\ !! JAW abort is just for testing |
false \ debug true ABORT" arg" |
false true ABORT" arg" |
|
THEN ; |
THEN ; |
|
|
: $has? T environment? H IF ELSE false THEN ; |
: $has? T environment? H IF ELSE false THEN ; |
Line 1013 Exists-Warnings on
|
Line 1016 Exists-Warnings on
|
\G resolve referencies to ghost with tcfa |
\G resolve referencies to ghost with tcfa |
\ is ghost resolved?, second resolve means another definition with the |
\ is ghost resolved?, second resolve means another definition with the |
\ same name |
\ same name |
over forward? 0= IF exists EXIT THEN |
over undefined? 0= IF exists EXIT THEN |
\ get linked-list |
\ get linked-list |
swap >r r@ >link @ swap \ ( list tcfa R: ghost ) |
swap >r r@ >link @ swap \ ( list tcfa R: ghost ) |
\ mark ghost as resolved |
\ mark ghost as resolved |
Line 1190 Create tag-bof 1 c, 0C c,
|
Line 1193 Create tag-bof 1 c, 0C c,
|
|
|
Defer skip? ' false IS skip? |
Defer skip? ' false IS skip? |
|
|
|
: skipdef ( <name> -- ) |
|
\G skip definition of an undefined word in undef-words mode |
|
ghost dup forward? |
|
IF >magic <skip> swap ! |
|
ELSE drop THEN ; |
|
|
: defined? ( -- flag ) \ name |
: defined? ( -- flag ) \ name |
|
ghost undefined? 0= ; |
|
|
|
: defined2? ( -- flag ) \ name |
|
\G return true for anything else than forward, even for <skip> |
|
\G that's what we want |
ghost forward? 0= ; |
ghost forward? 0= ; |
|
|
: needed? ( -- flag ) \ name |
: needed? ( -- flag ) \ name |
Line 1199 Defer skip? ' false IS skip?
|
Line 1213 Defer skip? ' false IS skip?
|
\G a forward reference exists |
\G a forward reference exists |
\G so the definition is not skipped! |
\G so the definition is not skipped! |
bl word gfind |
bl word gfind |
IF dup forward? |
IF dup undefined? |
nip |
nip |
0= |
0= |
ELSE drop true THEN ; |
ELSE drop true THEN ; |
Line 1332 Comment ( Comment \
|
Line 1346 Comment ( Comment \
|
THEN ; immediate |
THEN ; immediate |
|
|
: ghost>cfa |
: ghost>cfa |
dup forward? ABORT" CROSS: forward " >link @ ; |
dup undefined? ABORT" CROSS: forward " >link @ ; |
|
|
>TARGET |
>TARGET |
|
|
Line 1566 Cond: DOES> restrict?
|
Line 1580 Cond: DOES> restrict?
|
|
|
: gdoes, ( ghost -- ) |
: gdoes, ( ghost -- ) |
\ makes the codefield for a word that is built |
\ makes the codefield for a word that is built |
>end @ dup forward? 0= |
>end @ dup undefined? 0= |
IF |
IF |
dup >magic @ <do:> = |
dup >magic @ <do:> = |
IF doer, |
IF doer, |
Line 2190 previous
|
Line 2204 previous
|
|
|
: all-words ['] false IS skip? ; |
: all-words ['] false IS skip? ; |
: needed-words ['] needed? IS skip? ; |
: needed-words ['] needed? IS skip? ; |
: undef-words ['] defined? IS skip? ; |
: undef-words ['] defined2? IS skip? ; |
|
: skipdef skipdef ; |
|
|
: \ postpone \ ; immediate |
: \ postpone \ ; immediate |
: \G T-\G ; immediate |
: \G T-\G ; immediate |