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

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

Removed from v.1.74  
changed lines
  Added in v.1.76


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