version 1.73, 1999/05/05 12:07:55
|
version 1.74, 1999/05/05 18:07:51
|
Line 58 Warnings off
|
Line 58 Warnings off
|
\ we have to set current to be topmost context wordlist |
\ we have to set current to be topmost context wordlist |
get-order get-order get-current swap 1+ set-order |
get-order get-order get-current swap 1+ set-order |
r> ['] to execute |
r> ['] to execute |
set-order order |
set-order |
ELSE Value THEN ; |
ELSE Value THEN ; |
|
|
: DefaultValue ( n -- <name> ) |
: DefaultValue ( n -- <name> ) |
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 |
|
|
[IFUNDEF] DebugMaskSrouce Variable DebugMaskSource 0 DebugMaskSource ! [THEN] |
|
[IFUNDEF] DebugMaskCross Variable DebugMaskCross 0 DebugMaskCross ! [THEN] |
|
|
|
|
|
previous >CROSS |
previous >CROSS |
|
|
Line 143 stack-warn [IF]
|
Line 144 stack-warn [IF]
|
: defempty? ; immediate |
: defempty? ; immediate |
[THEN] |
[THEN] |
|
|
|
\ debugging |
|
|
|
0 [IF] |
|
|
|
This implements debugflags for the cross compiler and the compiled |
|
images. It works identical to the has-flags in the environment. |
|
The debugflags are defined in a vocabluary. If the word exists and |
|
its value is true, the flag is switched on. |
|
|
|
[THEN] |
|
|
|
Vocabulary debugflags \ debug flags for cross |
|
also debugflags get-order over |
|
Constant debugflags-wl |
|
set-order previous |
|
|
|
: DebugFlag |
|
get-current >r debugflags-wl set-current |
|
SetValue |
|
r> set-current ; |
|
|
|
: Debug? ( adr u -- flag ) |
|
\G return true if debug flag is defined or switched on |
|
debugflags-wl search-wordlist |
|
IF EXECUTE |
|
ELSE false THEN ; |
|
|
|
: D? ( <name> -- flag ) |
|
\G return true if debug flag is defined or switched on |
|
\G while compiling we do not return the current value but |
|
bl word count debug? ; |
|
|
|
: [d?] |
|
\G compile the value-xt so the debug flag can be switched |
|
\G the flag must exist! |
|
bl word count debugflags-wl search-wordlist |
|
IF compile, |
|
ELSE -1 ABORT" unknown debug flag" |
|
\ POSTPONE false |
|
THEN ; immediate |
|
|
\ \ GhostNames Ghosts 9may93jaw |
\ \ GhostNames Ghosts 9may93jaw |
|
|
Line 748 T has? relocate H
|
Line 788 T has? relocate H
|
\ \ Load Assembler |
\ \ Load Assembler |
|
|
>TARGET |
>TARGET |
H also Forth definitions \ ." asm: " order |
H also Forth definitions |
|
|
: X also target bl word find |
: X also target bl word find |
IF state @ IF compile, |
IF state @ IF compile, |
Line 866 Create NoFile ," #load-file#"
|
Line 906 Create NoFile ," #load-file#"
|
REPEAT |
REPEAT |
2drop drop false ; |
2drop drop false ; |
|
|
|
false DebugFlag showincludedfiles |
|
|
: included |
: included |
\ cr ." Including: " 2dup type ." ..." |
[d?] showincludedfiles |
|
IF cr ." Including: " 2dup type ." ..." THEN |
FileMem >r |
FileMem >r |
2dup add-included-file included |
2dup add-included-file included |
r> to FileMem ; |
r> to FileMem ; |
Line 2020 Cond: [IFUNDEF] postpone [IFUNDEF] ;Cond
|
Line 2063 Cond: [IFUNDEF] postpone [IFUNDEF] ;Cond
|
|
|
also minimal |
also minimal |
|
|
\G doesn't skip line when bit is set in debugmask |
: d? d? ; |
: \D name evaluate debugmasksource @ and 0= IF postpone \ THEN ; |
|
|
\G doesn't skip line when debug switch is on |
|
: \D D? 0= IF postpone \ THEN ; |
|
|
\G interprets the line if word is not defined |
\G interprets the line if word is not defined |
: \- defined? IF postpone \ THEN ; |
: \- defined? IF postpone \ THEN ; |
Line 2191 minimal
|
Line 2236 minimal
|
\ these ones are pefered: |
\ these ones are pefered: |
|
|
: lock turnkey ; |
: lock turnkey ; |
: unlock forth also cross ; |
: unlock previous forth also cross ; |
|
|
: [[ also unlock ; |
: [[ also unlock ; |
: ]] previous previous ; |
: ]] previous previous ; |