version 1.74, 1999/05/05 18:07:51
|
version 1.76, 1999/05/17 13:12:25
|
Line 118 also forth definitions \ these values m
|
Line 118 also forth definitions \ these values m
|
false DefaultValue stack-warn \ check on empty stack at any definition |
false DefaultValue stack-warn \ check on empty stack at any definition |
false DefaultValue create-forward-warn \ warn on forward declaration of created words |
false DefaultValue create-forward-warn \ warn on forward declaration of created words |
|
|
|
|
|
|
|
|
|
|
previous >CROSS |
previous >CROSS |
|
|
: .dec |
: .dec |
Line 211 VARIABLE VocTemp
|
Line 207 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! ? |
|
|
Variable atonce atonce off |
Variable atonce atonce off |
|
|
: NoExec true ABORT" CROSS: Don't execute ghost" ; |
: NoExec true ABORT" CROSS: Don't execute ghost, or immediate target word" ; |
|
|
: GhostHeader <fwd> , 0 , ['] NoExec , ; |
: GhostHeader <fwd> , 0 , ['] NoExec , ; |
|
|
Line 262 VARIABLE Already
|
Line 259 VARIABLE Already
|
|
|
: ghost ( "name" -- ghost ) |
: ghost ( "name" -- ghost ) |
Already off |
Already off |
>in @ bl word gfind IF Already on nip EXIT THEN |
>in @ bl word gfind IF atonce off Already on nip EXIT THEN |
drop >in ! Make-Ghost ; |
drop >in ! Make-Ghost ; |
|
|
: >ghostname ( ghost -- adr len ) |
: >ghostname ( ghost -- adr len ) |
Line 280 VARIABLE Already
|
Line 277 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 321 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 1012 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 1189 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 1209 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 1248 NoHeaderFlag off
|
Line 1258 NoHeaderFlag off
|
\ Symbol table |
\ Symbol table |
\ >in @ cr ." sym:s/CFA=" there 4 0.r ." /" bl word count .sym ." /g" cr >in ! |
\ >in @ cr ." sym:s/CFA=" there 4 0.r ." /" bl word count .sym ." /g" cr >in ! |
CreateFlag @ |
CreateFlag @ |
IF |
IF \ for a created word we need also a definition in target |
|
\ to execute the created word while compile time |
|
\ dont mind if a alias is defined twice |
|
Warnings @ >r Warnings off |
>in @ alias2 swap >in ! \ create alias in target |
>in @ alias2 swap >in ! \ create alias in target |
|
r> Warnings ! |
>in @ ghost swap >in ! |
>in @ ghost swap >in ! |
swap also ghosts ' previous swap ! \ tick ghost and store in alias |
swap also ghosts ' previous swap ! \ tick ghost and store in alias |
CreateFlag off |
CreateFlag off |
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 |