Diff for /gforth/cross.fs between versions 1.92 and 1.96

version 1.92, 2001/02/04 22:37:12 version 1.96, 2001/03/18 22:20:26
Line 656  hex Line 656  hex
 4713 Constant <imm>             4714 Constant <do:>  4713 Constant <imm>             4714 Constant <do:>
 4715 Constant <skip>  4715 Constant <skip>
   
 \ iForth makes only immediate directly after create  \  Compiler States
 \ make atonce trick! ?  
   
 Variable atonce atonce off  Variable comp-state
   0 Constant interpreting
   1 Constant compiling
   2 Constant resolving
   3 Constant assembling
   
 : NoExec true ABORT" CROSS: Don't execute ghost, or immediate target word" ;  Defer lit, ( n -- )
   Defer alit, ( n -- )
   
   Defer branch, ( target-addr -- )        \ compiles a branch
   Defer ?branch, ( target-addr -- )       \ compiles a ?branch
   Defer branchmark, ( -- branch-addr )    \ reserves room for a branch
   Defer ?branchmark, ( -- branch-addr )   \ reserves room for a ?branch
   Defer ?domark, ( -- branch-addr )       \ reserves room for a ?do branch
   Defer branchto, ( -- )                  \ actual program position is target of a branch (do e.g. alignment)
   Defer branchtoresolve, ( branch-addr -- ) \ resolves a forward reference from branchmark
   Defer branchfrom, ( -- )                \ ?!
   Defer branchtomark, ( -- target-addr )  \ marks a branch destination
   
   Defer colon, ( tcfa -- )                \ compiles call to tcfa at current position
   Defer prim, ( tcfa -- )                 \ compiles a primitive invocation
                                           \ at current position
   Defer colonmark, ( -- addr )            \ marks a colon call
   Defer colon-resolve ( tcfa addr -- )
   
   Defer addr-resolve ( target-addr addr -- )
   Defer doer-resolve ( ghost res-pnt target-addr addr -- ghost res-pnt )
   
   Defer do,       ( -- do-token )
   Defer ?do,      ( -- ?do-token )
   Defer for,      ( -- for-token )
   Defer loop,     ( do-token / ?do-token -- )
   Defer +loop,    ( do-token / ?do-token -- )
   Defer next,     ( for-token )
   
 : GhostHeader <fwd> , 0 , ['] NoExec , ;  [IFUNDEF] ca>native
   defer ca>native 
   [THEN]
   
   \ ghost structure
   
 : >magic ;              \ type of ghost  : >magic ;              \ type of ghost
 : >link cell+ ;         \ pointer where ghost is in target, or if unresolved  : >link cell+ ;         \ pointer where ghost is in target, or if unresolved
                         \ points to the where we have to resolve (linked-list)                          \ points to the where we have to resolve (linked-list)
 : >exec cell+ cell+ ;   \ execution symantics (while target compiling) of ghost  : >exec cell+ cell+ ;   \ execution symantics (while target compiling) of ghost
 : >end 3 cells + ;      \ room for additional tags  : >comp 3 cells + ;     \ compilation semantics
   : >end 4 cells + ;      \ room for additional tags
                         \ for builder (create, variable...) words the                          \ for builder (create, variable...) words the
                         \ execution symantics of words built are placed here                          \ execution symantics of words built are placed here
   
   \ resolve structure
   
   : >next ;               \ link to next field
   : >tag cell+ ;          \ indecates type of reference: 0: call, 1: address, 2: doer
   : >taddr cell+ cell+ ;  
   : >ghost 3 cells + ;
   : >file 4 cells + ;
   : >line 5 cells + ;
   
   \ refer variables
   
 Variable executed-ghost \ last executed ghost, needed in tcreate and gdoes>  Variable executed-ghost \ last executed ghost, needed in tcreate and gdoes>
 Variable last-ghost     \ last ghost that is created  Variable last-ghost     \ last ghost that is created
 Variable last-header-ghost \ last ghost definitions with header  Variable last-header-ghost \ last ghost definitions with header
   
   : (refered) ( ghost addr tag -- )
   \G creates a reference to ghost at address taddr
       rot >r here r@ >link @ , r> >link ! 
       ( taddr tag ) ,
       ( taddr ) , 
       last-header-ghost @ , 
       loadfile , 
       sourceline# , 
     ;
   
   \ iForth makes only immediate directly after create
   \ make atonce trick! ?
   
   Variable atonce atonce off
   
   : NoExec true ABORT" CROSS: Don't execute ghost, or immediate target word" ;
   
   : is-forward   ( ghost -- )
     colonmark, 0 (refered) ; \ compile space for call
   
   : GhostHeader <fwd> , 0 , ['] NoExec , ['] is-forward , ;
   
 : Make-Ghost ( "name" -- ghost )  : Make-Ghost ( "name" -- ghost )
   >in @ GhostName swap >in !    >in @ GhostName swap >in !
   <T Create atonce @ IF immediate atonce off THEN    <T Create atonce @ IF immediate atonce off THEN
Line 740  ghost (next) Line 808  ghost (next)
 ghost unloop    ghost ;S                        2drop  ghost unloop    ghost ;S                        2drop
 ghost lit       ghost (compile) ghost !         2drop drop  ghost lit       ghost (compile) ghost !         2drop drop
 ghost (does>)   ghost noop                      2drop  ghost (does>)   ghost noop                      2drop
 ghost (.")      ghost (S")      ghost (ABORT")  2drop drop  ghost (.")      ghost (S")      ghost (ABORT")  2drop drop ( " )
 ghost '                                         drop  ghost '                                         drop
 ghost :docol    ghost :doesjump ghost :dodoes   2drop drop  ghost :docol    ghost :doesjump ghost :dodoes   2drop drop
 ghost :dovar                                    drop  ghost :dovar    ghost :dodefer  ghost :dofield  2drop drop
 ghost over      ghost =         ghost drop      2drop drop  ghost over      ghost =         ghost drop      2drop drop
 ghost - drop  ghost call      ghost useraddr  ghost execute   2drop drop
   ghost +         ghost -         ghost @         2drop drop
 ghost 2drop drop  ghost 2drop drop
 ghost 2dup drop  ghost 2dup drop
   
Line 1268  previous Line 1337  previous
   
 \ \ --------------------        Compiler Plug Ins               01aug97jaw  \ \ --------------------        Compiler Plug Ins               01aug97jaw
   
 \  Compiler States  
   
 Variable comp-state  
 0 Constant interpreting  
 1 Constant compiling  
 2 Constant resolving  
 3 Constant assembling  
   
 Defer lit, ( n -- )  
 Defer alit, ( n -- )  
   
 Defer branch, ( target-addr -- )        \ compiles a branch  
 Defer ?branch, ( target-addr -- )       \ compiles a ?branch  
 Defer branchmark, ( -- branch-addr )    \ reserves room for a branch  
 Defer ?branchmark, ( -- branch-addr )   \ reserves room for a ?branch  
 Defer ?domark, ( -- branch-addr )       \ reserves room for a ?do branch  
 Defer branchto, ( -- )                  \ actual program position is target of a branch (do e.g. alignment)  
 Defer branchtoresolve, ( branch-addr -- ) \ resolves a forward reference from branchmark  
 Defer branchfrom, ( -- )                \ ?!  
 Defer branchtomark, ( -- target-addr )  \ marks a branch destination  
   
 Defer colon, ( tcfa -- )                \ compiles call to tcfa at current position  
 Defer colonmark, ( -- addr )            \ marks a colon call  
 Defer colon-resolve ( tcfa addr -- )  
   
 Defer addr-resolve ( target-addr addr -- )  
 Defer doer-resolve ( ghost res-pnt target-addr addr -- ghost res-pnt )  
   
 Defer do,       ( -- do-token )  
 Defer ?do,      ( -- ?do-token )  
 Defer for,      ( -- for-token )  
 Defer loop,     ( do-token / ?do-token -- )  
 Defer +loop,    ( do-token / ?do-token -- )  
 Defer next,     ( for-token )  
   
 [IFUNDEF] ca>native  
 defer ca>native   
 [THEN]  
   
 >TARGET  >TARGET
 DEFER >body             \ we need the system >body  DEFER >body             \ we need the system >body
                         \ and the target >body                          \ and the target >body
Line 1322  DEFER dodoes, Line 1352  DEFER dodoes,
 DEFER ]comp     \ starts compilation  DEFER ]comp     \ starts compilation
 DEFER comp[     \ ends compilation  DEFER comp[     \ ends compilation
   
 : (cc) T a, H ;                                 ' (cc) IS colon,  : (prim) T a, H ;                               ' (prim) IS prim,
   
 : (cr) >tempdp ]comp colon, comp[ tempdp> ;     ' (cr) IS colon-resolve  : (cr) >tempdp ]comp prim, comp[ tempdp> ;      ' (cr) IS colon-resolve
 : (ar) T ! H ;                                  ' (ar) IS addr-resolve  : (ar) T ! H ;                                  ' (ar) IS addr-resolve
 : (dr)  ( ghost res-pnt target-addr addr )  : (dr)  ( ghost res-pnt target-addr addr )
         >tempdp drop over           >tempdp drop over 
Line 1336  DEFER comp[     \ ends compilation Line 1366  DEFER comp[     \ ends compilation
   
 : (cm) ( -- addr )  : (cm) ( -- addr )
     T here align H      T here align H
     -1 colon, ;                                 ' (cm) IS colonmark,      -1 prim, ;                                  ' (cm) IS colonmark,
   
 >TARGET  >TARGET
 : compile, colon, ;  : compile, prim, ;
 >CROSS  >CROSS
   
 \ resolve structure  
   
 : >next ;               \ link to next field  
 : >tag cell+ ;          \ indecates type of reference: 0: call, 1: address, 2: doer  
 : >taddr cell+ cell+ ;    
 : >ghost 3 cells + ;  
 : >file 4 cells + ;  
 : >line 5 cells + ;  
   
 : (refered) ( ghost addr tag -- )  
 \G creates a reference to ghost at address taddr  
     rot >r here r@ >link @ , r> >link !   
     ( taddr tag ) ,  
     ( taddr ) ,   
     last-header-ghost @ ,   
     loadfile ,   
     sourceline# ,   
   ;  
   
 : refered ( ghost tag -- )  : refered ( ghost tag -- )
 \G creates a resolve structure  \G creates a resolve structure
     T here aligned H swap (refered)      T here aligned H swap (refered)
Line 1430  Exists-Warnings on Line 1441  Exists-Warnings on
   ELSE  true abort" CROSS: Ghostnames inconsistent "    ELSE  true abort" CROSS: Ghostnames inconsistent "
   THEN ;    THEN ;
   
   : colon-resolved   ( ghost -- )
       >link @ colon, ; \ compile-call
   : prim-resolved  ( ghost -- )
       >link @ prim, ;
   
 : resolve  ( ghost tcfa -- )  : resolve  ( ghost tcfa -- )
 \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
Line 1439  Exists-Warnings on Line 1455  Exists-Warnings on
     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
     dup r@ >link ! <res> r@ >magic !      dup r@ >link ! <res> r@ >magic !
       r@ >comp @ ['] is-forward = IF
           ['] prim-resolved  r@ >comp !  THEN
     \ loop through forward referencies      \ loop through forward referencies
     r> -rot       r> -rot 
     comp-state @ >r Resolving comp-state !      comp-state @ >r Resolving comp-state !
Line 1450  Exists-Warnings on Line 1468  Exists-Warnings on
   
 \ gexecute ghost,                                      01nov92py  \ gexecute ghost,                                      01nov92py
   
 : is-forward   ( ghost -- )  
   colonmark, 0 (refered) ; \ compile space for call  
   
 : is-resolved   ( ghost -- )  
   >link @ colon, ; \ compile-call  
   
 : gexecute   ( ghost -- )  : gexecute   ( ghost -- )
   dup @ <fwd> = IF  is-forward  ELSE  is-resolved  THEN ;      dup >comp @ execute ;
   
 : addr,  ( ghost -- )  : addr,  ( ghost -- )
   dup @ <fwd> = IF  1 refered 0 T a, H ELSE >link @ T a, H THEN ;    dup forward? IF  1 refered 0 T a, H ELSE >link @ T a, H THEN ;
   
 \ !! : ghost,     ghost  gexecute ;  \ !! : ghost,     ghost  gexecute ;
   
Line 1765  Comment (       Comment \ Line 1777  Comment (       Comment \
   ELSE  postpone literal postpone gexecute  THEN ;    ELSE  postpone literal postpone gexecute  THEN ;
                                         immediate                                          immediate
   
   T has? peephole H [IF]
   : (cc) compile call T >body a, H ;              ' (cc) IS colon,
   [ELSE]
       ' (prim) IS colon,
   [THEN]
   
 : [G']   : [G'] 
 \G ticks a ghost and returns its address  \G ticks a ghost and returns its address
   bl word gfind 0= ABORT" CROSS: Ghost don't exists"    bl word gfind 0= ABORT" CROSS: Ghost don't exists"
Line 1798  Cond: [']  T ' H alit, ;Cond Line 1816  Cond: [']  T ' H alit, ;Cond
   
 : (>body)   ( cfa -- pfa ) xt>body + ;          ' (>body) T IS >body H  : (>body)   ( cfa -- pfa ) xt>body + ;          ' (>body) T IS >body H
   
 : (doer,)   ( ghost -- ) ]comp gexecute comp[ 1 fillcfa ;   ' (doer,) IS doer,  : (doer,)   ( ghost -- ) ]comp addr, comp[ 1 fillcfa ;   ' (doer,) IS doer,
   
 : (docol,)  ( -- ) [G'] :docol doer, ;          ' (docol,) IS docol,  : (docol,)  ( -- ) [G'] :docol doer, ;          ' (docol,) IS docol,
   
Line 1868  Cond: [Char]   ( "<char>" -- )  restrict Line 1886  Cond: [Char]   ( "<char>" -- )  restrict
 \ some special literals                                 27jan97jaw  \ some special literals                                 27jan97jaw
   
 \ !! Known Bug: Special Literals and plug-ins work only correct  \ !! Known Bug: Special Literals and plug-ins work only correct
 \ on 16 and 32 Bit Targets and 32 Bit Hosts!  \ on targets with char = 8 bit
   
 Cond: MAXU  Cond: MAXU
   restrict?     restrict? 
   tcell 1 cells u>     compile lit tcell 0 ?DO FF T c, H LOOP 
   IF    compile lit tcell 0 ?DO FF T c, H LOOP   
   ELSE  ffffffff lit, THEN  
   ;Cond    ;Cond
   
 Cond: MINI  Cond: MINI
   restrict?    restrict?
   tcell 1 cells u>    compile lit bigendian 
   IF    compile lit bigendian     IF    80 T c, H tcell 1 ?DO 0 T c, H LOOP 
         IF      80 T c, H tcell 1 ?DO 0 T c, H LOOP     ELSE  tcell 1 ?DO 0 T c, H LOOP 80 T c, H
         ELSE    tcell 1 ?DO 0 T c, H LOOP 80 T c, H    THEN
         THEN  
   ELSE  tcell 2 = IF 8000 ELSE 80000000 THEN lit, THEN  
   ;Cond    ;Cond
     
 Cond: MAXI  Cond: MAXI
  restrict?   restrict?
  tcell 1 cells u>   compile lit bigendian 
  IF     compile lit bigendian    IF     7F T c, H tcell 1 ?DO FF T c, H LOOP
         IF      7F T c, H tcell 1 ?DO FF T c, H LOOP   ELSE   tcell 1 ?DO FF T c, H LOOP 7F T c, H
         ELSE    tcell 1 ?DO FF T c, H LOOP 7F T c, H   THEN
         THEN  
  ELSE   tcell 2 = IF 7fff ELSE 7fffffff THEN lit, THEN  
  ;Cond   ;Cond
   
 >CROSS  >CROSS
Line 1967  Cond: ; ( -- ) restrict? Line 1979  Cond: ; ( -- ) restrict?
                comp[                 comp[
                state off                 state off
                ;Resolve @                 ;Resolve @
                IF ;Resolve @ ;Resolve cell+ @ resolve THEN                 IF ;Resolve @ ;Resolve cell+ @ resolve
                     ['] colon-resolved ;Resolve @ >comp ! THEN
                 Interpreting comp-state !                  Interpreting comp-state !
                ;Cond                 ;Cond
 Cond: [  restrict? state off Interpreting comp-state ! ;Cond  Cond: [  restrict? state off Interpreting comp-state ! ;Cond
Line 1985  Create GhostDummy ghostheader Line 1998  Create GhostDummy ghostheader
     GhostDummy >link ! GhostDummy       GhostDummy >link ! GhostDummy 
     tlastcfa @ >tempdp dodoes, tempdp> ;      tlastcfa @ >tempdp dodoes, tempdp> ;
   
   : g>body ( ghost -- body )
       >link @ T >body H ;
   : does-resolved ( ghost -- )
       dup g>body alit, >end @ g>body colon, ;
   
 >TARGET  >TARGET
 Cond: DOES> restrict?  Cond: DOES> restrict?
         compile (does>) doeshandler,           compile (does>) doeshandler, 
         \ resolve words made by builders          \ resolve words made by builders
         tdoes @ ?dup IF  @ T here H resolve THEN          tdoes @ ?dup IF  @ dup T here H resolve
               ['] prim-resolved swap >comp !  THEN
         ;Cond          ;Cond
 : DOES> switchrom doeshandler, T here H !does depth T ] H ;  : DOES> switchrom doeshandler, T here H !does depth T ] H ;
   
Line 1998  Cond: DOES> restrict? Line 2017  Cond: DOES> restrict?
   
 \ Builder                                               11may93jaw  \ Builder                                               11may93jaw
   
 : Builder    ( Create-xt do:-xt "name" -- )  : Builder    ( Create-xt do-ghost "name" -- )
 \ builds up a builder in current vocabulary  \ builds up a builder in current vocabulary
 \ create-xt is executed when word is interpreted  \ create-xt is executed when word is interpreted
 \ do:-xt is executet when the created word from builder is executed  \ do:-xt is executet when the created word from builder is executed
 \ for do:-xt an additional entry after the normal ghost-enrys is used  \ for do:-xt an additional entry after the normal ghost-enrys is used
   
   Make-Ghost            ( Create-xt do:-xt ghost )    Make-Ghost            ( Create-xt do-ghost ghost )
   rot swap              ( do:-xt Create-xt ghost )    rot swap              ( do-ghost Create-xt ghost )
   >exec ! , ;    >exec ! , ;
 \  rot swap >exec dup @ ['] NoExec <>  
 \  IF 2drop ELSE ! THEN , ;  
   
 : gdoes,  ( ghost -- )  : gdoes,  ( ghost -- )
 \ makes the codefield for a word that is built  \ makes the codefield for a word that is built
Line 2030  Cond: DOES> restrict? Line 2047  Cond: DOES> restrict?
   executed-ghost @    executed-ghost @
   create-forward-warn    create-forward-warn
   IF ['] reswarn-forward IS resolve-warning THEN    IF ['] reswarn-forward IS resolve-warning THEN
   Theader >r dup gdoes,    Theader >r dup , dup gdoes,
 \ stores execution semantic in the built word  \ stores execution semantic in the built word
 \ if the word already has a semantic (concerns S", IS, .", DOES>)  \ if the word already has a semantic (concerns S", IS, .", DOES>)
 \ then keep it  \ then keep it
   >end @ >exec @ r> >exec dup @ ['] NoExec =    >end @
   IF ! ELSE 2drop THEN ;    dup >exec @ r@ >exec dup @ ['] NoExec =  IF ! ELSE 2drop THEN
     >comp @ r> >comp ! ;
   
 : RTCreate ( <name> -- )  : RTCreate ( <name> -- )
 \ creates a new word with code-field in ram  \ creates a new word with code-field in ram
Line 2070  Cond: DOES> restrict? Line 2088  Cond: DOES> restrict?
 : gdoes>  ( ghost -- addr flag )  : gdoes>  ( ghost -- addr flag )
   executed-ghost @    executed-ghost @
   state @ IF  gexecute true EXIT  THEN    state @ IF  gexecute true EXIT  THEN
   >link @ T >body H false ;    g>body false ;
   
 \ DO: ;DO                                               11may93jaw  \ DO: ;DO                                               11may93jaw
 \ changed to ?EXIT                                      10may93jaw  \ changed to ?EXIT                                      10may93jaw
   
 : DO:     ( -- addr [xt] [colon-sys] )  : DO:     ( -- ghost [xt] [colon-sys] )
   here ghostheader    here ghostheader
   :noname postpone gdoes> postpone ?EXIT ;    :noname postpone gdoes> postpone ?EXIT ;
   
 : by:     ( -- addr [xt] [colon-sys] ) \ name  : by:     ( -- ghost [xt] [colon-sys] ) \ name
   ghost    ghost
   :noname postpone gdoes> postpone ?EXIT ;    :noname postpone gdoes> postpone ?EXIT ;
   
 : ;DO ( addr [xt] [colon-sys] -- addr )  : ;DO ( ghost [xt] [colon-sys] -- ghost )
   postpone ;    ( S addr xt )    postpone ;    ( S addr xt )
   over >exec ! ; immediate    over >exec ! ; immediate
   
 : by      ( -- addr ) \ Name  T has? peephole H [IF]
   : compile: ( ghost -- ghost [xt] [colon-sys] )
       :noname  postpone g>body ;
   : ;compile ( ghost [xt] [colon-sys] -- ghost )
       postpone ;  over >comp ! ; immediate
   [ELSE]
   : compile:  ( ghost -- ghost xt colon-sys )  :noname ;
   : ;compile ( ghost xt colon-sys -- ghost )
       postpone ; drop ; immediate
   [THEN]
   
   : by      ( -- ghost ) \ Name
   ghost >end @ ;    ghost >end @ ;
   
 >TARGET  >TARGET
Line 2095  Cond: DOES> restrict? Line 2124  Cond: DOES> restrict?
   
 Build:  ( n -- ) ;  Build:  ( n -- ) ;
 by: :docon ( ghost -- n ) T @ H ;DO  by: :docon ( ghost -- n ) T @ H ;DO
   compile: alit, compile @ ;compile
 Builder (Constant)  Builder (Constant)
   
 Build:  ( n -- ) T , H ;  Build:  ( n -- ) T , H ;
Line 2111  Builder 2Constant Line 2141  Builder 2Constant
   
 BuildSmart: ;  BuildSmart: ;
 by: :dovar ( ghost -- addr ) ;DO  by: :dovar ( ghost -- addr ) ;DO
   \ compile: alit, ;compile
 Builder Create  Builder Create
   
 T has? rom H [IF]  T has? rom H [IF]
Line 2120  Builder Variable Line 2151  Builder Variable
 [ELSE]  [ELSE]
 Build: T 0 , H ;  Build: T 0 , H ;
 by Create  by Create
   \ compile: alit, ;compile
 Builder Variable  Builder Variable
 [THEN]  [THEN]
   
Line 2130  Builder 2Variable Line 2162  Builder 2Variable
 [ELSE]  [ELSE]
 Build: T 0 , 0 , H ;  Build: T 0 , 0 , H ;
 by Create  by Create
   \ compile: alit, ;compile
 Builder 2Variable  Builder 2Variable
 [THEN]  [THEN]
   
Line 2140  Builder AVariable Line 2173  Builder AVariable
 [ELSE]  [ELSE]
 Build: T 0 A, H ;  Build: T 0 A, H ;
 by Create  by Create
   \ compile: alit, ;compile
 Builder AVariable  Builder AVariable
 [THEN]  [THEN]
   
Line 2162  Variable tudp 0 tudp ! Line 2196  Variable tudp 0 tudp !
   
 Build: 0 u, X , ;  Build: 0 u, X , ;
 by: :douser ( ghost -- up-addr )  X @ tup @ + ;DO  by: :douser ( ghost -- up-addr )  X @ tup @ + ;DO
   compile: compile useraddr T @ , H ;compile
 Builder User  Builder User
   
 Build: 0 u, X , 0 u, drop ;  Build: 0 u, X , 0 u, drop ;
Line 2182  Builder AValue Line 2217  Builder AValue
   
 BuildSmart:  ( -- ) [T'] noop T A, H ;  BuildSmart:  ( -- ) [T'] noop T A, H ;
 by: :dodefer ( ghost -- ) ABORT" CROSS: Don't execute" ;DO  by: :dodefer ( ghost -- ) ABORT" CROSS: Don't execute" ;DO
   compile: alit, compile @ compile execute ;compile
 Builder Defer  Builder Defer
   
 Build: ( inter comp -- ) swap T immediate A, A, H ;  Build: ( inter comp -- ) swap T immediate A, A, H ;
Line 2198  Builder interpret/compile: Line 2234  Builder interpret/compile:
   
 Build: ;  Build: ;
 by: :dofield T @ H + ;DO  by: :dofield T @ H + ;DO
   compile: T @ H lit, compile + ;compile
 Builder (Field)  Builder (Field)
   
 Build: ( align1 offset1 align size "name" --  align2 offset2 )  Build: ( align1 offset1 align size "name" --  align2 offset2 )
Line 2368  Cond: NEXT restrict? sys? next, ;Cond Line 2405  Cond: NEXT restrict? sys? next, ;Cond
   
 : ,"            [char] " parse T string, align H ;  : ,"            [char] " parse T string, align H ;
   
 Cond: ."        restrict? compile (.")     T ," H ;Cond  Cond: ."        restrict? compile (.")     T ," H ;Cond ( " )
 Cond: S"        restrict? compile (S")     T ," H ;Cond  Cond: S"        restrict? compile (S")     T ," H ;Cond ( " )
 Cond: ABORT"    restrict? compile (ABORT") T ," H ;Cond  Cond: ABORT"    restrict? compile (ABORT") T ," H ;Cond ( " )
   
 Cond: IS        T ' >body H compile ALiteral compile ! ;Cond  Cond: IS        T ' >body H compile ALiteral compile ! ;Cond
 : IS            T >address ' >body ! H ;  : IS            T >address ' >body ! H ;

Removed from v.1.92  
changed lines
  Added in v.1.96


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