[BACK]Return to cross.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/cross.fs between versions 1.72 and 1.74

version 1.72, 1999/02/22 19:05:45 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 315  false DefaultValue header Line 355  false DefaultValue header
 true DefaultValue interpreter  true DefaultValue interpreter
 true DefaultValue ITC  true DefaultValue ITC
 false DefaultValue rom  false DefaultValue rom
   true DefaultValue standardthreading
   
 >TARGET  >TARGET
 s" relocate" T environment? H   s" relocate" T environment? H 
Line 747  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 865  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 2019  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 2190  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 ;
Removed from v.1.72  
changed lines
  Added in v.1.74

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>