Diff for /gforth/cross.fs between versions 1.53 and 1.62

version 1.53, 1997/09/13 12:04:55 version 1.62, 1998/12/22 15:18:50
Line 1 Line 1
 \ CROSS.FS     The Cross-Compiler                      06oct92py  \ CROSS.FS     The Cross-Compiler                      06oct92py
 \ Idea and implementation: Bernd Paysan (py)  \ Idea and implementation: Bernd Paysan (py)
   
 \ Copyright (C) 1995 Free Software Foundation, Inc.  \ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
Line 41 Line 41
 \       mach file is only loaded into target  \       mach file is only loaded into target
 \       cell corrected  \       cell corrected
 \       romable extansions                      27apr97-5jun97jaw  \       romable extansions                      27apr97-5jun97jaw
   \       environmental query support             01sep97jaw
   \       added own [IF] ... [ELSE] ... [THEN]    14sep97jaw
   \       extra resolver for doers                20sep97jaw
   \       added killref for DOES>                 20sep97jaw
   
   
 hex     \ the defualt base for the cross-compiler is hex !!  hex     \ the defualt base for the cross-compiler is hex !!
Line 48  Warnings off Line 52  Warnings off
   
 \ words that are generaly useful  \ words that are generaly useful
   
   : KB  400 * ;
 : >wordlist ( vocabulary-xt -- wordlist-struct )  : >wordlist ( vocabulary-xt -- wordlist-struct )
   also execute get-order swap >r 1- set-order r> ;    also execute get-order swap >r 1- set-order r> ;
   
Line 59  Warnings off Line 64  Warnings off
     dup c, here swap chars dup allot move ;      dup c, here swap chars dup allot move ;
   
 : SetValue ( n -- <name> )  : SetValue ( n -- <name> )
 \G Same behaviour as "Value" when the <name> is not defined  \G Same behaviour as "Value" if the <name> is not defined
 \G Same behaviour as "to" when <name> is defined  \G Same behaviour as "to" if <name> is defined
 \G SetValue searches in the current vocabulary  \G SetValue searches in the current vocabulary
  save-input bl word >r restore-input throw r> count   save-input bl word >r restore-input throw r> count
  get-current search-wordlist   get-current search-wordlist
  IF bl word drop >body ! ELSE Value THEN ;   IF ['] to execute ELSE Value THEN ;
   
 : DefaultValue ( n -- <name> )  : DefaultValue ( n -- <name> )
 \G Same behaviour as "Value" when the <name> is not defined  \G Same behaviour as "Value" if the <name> is not defined
 \G SetValue searches in the current vocabulary  \G DefaultValue searches in the current vocabulary
  save-input bl word >r restore-input throw r> count   save-input bl word >r restore-input throw r> count
  get-current search-wordlist   get-current search-wordlist
  IF bl word drop drop drop ELSE Value THEN ;   IF bl word drop 2drop ELSE Value THEN ;
   
 hex  hex
   
Line 149  stack-warn [IF] Line 154  stack-warn [IF]
 [THEN]  [THEN]
   
   
   
 \ \ GhostNames Ghosts                                  9may93jaw  \ \ GhostNames Ghosts                                  9may93jaw
   
 \ second name source to search trough list  \ second name source to search trough list
Line 234  VARIABLE Already Line 240  VARIABLE Already
   BEGIN @ dup    BEGIN @ dup
   WHILE 2dup cell+ @ =    WHILE 2dup cell+ @ =
   UNTIL nip 2 cells + count    UNTIL nip 2 cells + count
   ELSE  2drop true abort" CROSS: Ghostnames inconsistent"    ELSE  2drop 
           \ true abort" CROSS: Ghostnames inconsistent"
           s" ?!?!?!"
   THEN ;    THEN ;
   
 ' >ghostname ALIAS @name  ' >ghostname ALIAS @name
Line 256  ghost (does>)   ghost noop Line 264  ghost (does>)   ghost noop
 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 over      ghost =         ghost drop      2drop drop  ghost over      ghost =         ghost drop      2drop drop
 ghost - drop  ghost - drop
   ghost 2drop drop
   ghost 2dup drop
   
 \ \ Parameter for target systems                         06oct92py  \ \ Parameter for target systems                         06oct92py
   
Line 286  VARIABLE env-current \ save information Line 297  VARIABLE env-current \ save information
   
 : $has? T environment? H IF ELSE false THEN ;  : $has? T environment? H IF ELSE false THEN ;
   
 >ENVIRON  >ENVIRON get-order get-current swap 1+ set-order
 false SetValue ionly  true SetValue compiler
 true  SetValue cross  true  SetValue cross
 >TARGET  true SetValue standard-threading
   >TARGET previous
   
   
 mach-file count included hex  mach-file count included hex
   
 >ENVIRON  >ENVIRON
   
 s" interpreter" T environment? H 0= ?dup nip [IF] true Value interpreter [THEN]  T has? ec H
 s" ITC" T environment? H 0= ?dup nip [IF] true SetValue ITC [THEN]  [IF]
 s" rom" T environment? H 0= ?dup nip [IF] false Value rom [THEN]  false DefaultValue relocate
   false DefaultValue file
   false DefaultValue OS
   false DefaultValue prims
   false DefaultValue floating
   false DefaultValue glocals
   false DefaultValue dcomps
   false DefaultValue hash
   false DefaultValue xconds
   false DefaultValue header
   [THEN]
   
   true DefaultValue interpreter
   true DefaultValue ITC
   false DefaultValue rom
   
 >TARGET  >TARGET
 s" relocate" T environment? H   s" relocate" T environment? H 
Line 309  s" relocate" T environment? H Line 336  s" relocate" T environment? H
   
 \ \ Create additional parameters                         19jan95py  \ \ Create additional parameters                         19jan95py
   
   1 8 lshift Constant maxbyte
 T  T
 NIL                Constant TNIL  NIL                Constant TNIL
 cell               Constant tcell  cell               Constant tcell
 cell<<             Constant tcell<<  cell<<             Constant tcell<<
 cell>bit           Constant tcell>bit  cell>bit           Constant tcell>bit
 bits/byte          Constant tbits/byte  bits/byte          Constant tbits/byte
   bits/byte 8 /      Constant tchar
 float              Constant tfloat  float              Constant tfloat
 1 bits/byte lshift Constant maxbyte  1 bits/byte lshift Constant tmaxbyte
 H  H
   
 \ Variables                                            06oct92py  \ Variables                                            06oct92py
Line 358  Variable user-vars 0 user-vars ! Line 387  Variable user-vars 0 user-vars !
   
 >CROSS  >CROSS
   
 \ memregion.fs  \ \ memregion.fs
   
   
 Variable last-defined-region    \ pointer to last defined region  Variable last-defined-region    \ pointer to last defined region
Line 473  T has? rom H Line 502  T has? rom H
   ABORT" CROSS: define at least address-space or dictionary!!"    ABORT" CROSS: define at least address-space or dictionary!!"
   + makekernel drop ;    + makekernel drop ;
   
 \ switched tdp for rom support                          03jun97jaw  \ \ switched tdp for rom support                                03jun97jaw
   
 \ second value is here to store some maximal value for statistics  \ second value is here to store some maximal value for statistics
 \ tempdp is also embedded here but has nothing to do with rom support  \ tempdp is also embedded here but has nothing to do with rom support
Line 564  bigendian Line 593  bigendian
      DO  maxbyte ud/mod rot I c!  -1 +LOOP  2drop ;       DO  maxbyte ud/mod rot I c!  -1 +LOOP  2drop ;
    : S@  ( addr -- n )  >r 0 0 r> tcell bounds     : S@  ( addr -- n )  >r 0 0 r> tcell bounds
      DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  LOOP d>s ;       DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  LOOP d>s ;
      : Sc!  ( n addr -- )  >r s>d r> tchar bounds swap 1-
        DO  maxbyte ud/mod rot I c!  -1 +LOOP  2drop ;
      : Sc@  ( addr -- n )  >r 0 0 r> tchar bounds
        DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  LOOP d>s ;
 [ELSE]  [ELSE]
    : S!  ( n addr -- )  >r s>d r> tcell bounds     : S!  ( n addr -- )  >r s>d r> tcell bounds
      DO  maxbyte ud/mod rot I c!  LOOP  2drop ;       DO  maxbyte ud/mod rot I c!  LOOP  2drop ;
    : S@  ( addr -- n )  >r 0 0 r> tcell bounds swap 1-     : S@  ( addr -- n )  >r 0 0 r> tcell bounds swap 1-
      DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  -1 +LOOP d>s ;       DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  -1 +LOOP d>s ;
      : Sc!  ( n addr -- )  >r s>d r> tchar bounds
        DO  maxbyte ud/mod rot I c!  LOOP  2drop ;
      : Sc@  ( addr -- n )  >r 0 0 r> tchar bounds swap 1-
        DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  -1 +LOOP d>s ;
 [THEN]  [THEN]
   
 >CROSS  >CROSS
Line 604  CREATE Bittable 80 c, 40 c, 20 c, 10 c, Line 641  CREATE Bittable 80 c, 40 c, 20 c, 10 c,
 >TARGET  >TARGET
 : @  ( taddr -- w )     >image S@ ;  : @  ( taddr -- w )     >image S@ ;
 : !  ( w taddr -- )     >image S! ;  : !  ( w taddr -- )     >image S! ;
 : c@ ( taddr -- char )  >image c@ ;  : c@ ( taddr -- char )  >image Sc@ ;
 : c! ( char taddr -- )  >image c! ;  : c! ( char taddr -- )  >image Sc! ;
 : 2@ ( taddr -- x1 x2 ) T dup cell+ @ swap @ H ;  : 2@ ( taddr -- x1 x2 ) T dup cell+ @ swap @ H ;
 : 2! ( x1 x2 taddr -- ) T swap over ! cell+ ! H ;  : 2! ( x1 x2 taddr -- ) T swap over ! cell+ ! H ;
   
Line 615  CREATE Bittable 80 c, 40 c, 20 c, 10 c, Line 652  CREATE Bittable 80 c, 40 c, 20 c, 10 c,
 : here  ( -- there )    there ;  : here  ( -- there )    there ;
 : allot ( n -- )        tdp +! ;  : allot ( n -- )        tdp +! ;
 : ,     ( w -- )        T here H tcell T allot  ! H T here drop H ;  : ,     ( w -- )        T here H tcell T allot  ! H T here drop H ;
 : c,    ( char -- )     T here    1 allot c! H ;  : c,    ( char -- )     T here    tchar allot c! H ;
 : align ( -- )          T here H align+ 0 ?DO  bl T c, H LOOP ;  : align ( -- )          T here H align+ 0 ?DO  bl T c, H LOOP ;
 : cfalign ( -- )  : cfalign ( -- )
     T here H cfalign+ 0 ?DO  bl T c, H LOOP ;      T here H cfalign+ 0 ?DO  bl T c, tchar H +LOOP ;
   
 : A!                    dup relon T ! H ;  : >address              dup 0>= IF tchar / THEN ;
 : A,    ( w -- )        T here H relon T , H ;  : A!                    swap >address swap dup relon T ! H ;
   : A,    ( w -- )        >address T here H relon T , H ;
   
 >CROSS  >CROSS
   
 : tcmove ( source dest len -- )  : tcmove ( source dest len -- )
 \G cmove in target memory  \G cmove in target memory
   bounds    tchar * bounds
   ?DO  dup T c@ H I T c! H 1+    ?DO  dup T c@ H I T c! H 1+
   LOOP  drop ;    tchar +LOOP  drop ;
   
 >TARGET  >TARGET
 H also Forth definitions \ ." asm: " order  H also Forth definitions \ ." asm: " order
Line 648  previous Line 686  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 lit, ( n -- )
 Defer alit, ( n -- )  Defer alit, ( n -- )
 Defer branch, ( target-addr -- )  
 Defer ?branch, ( target-addr -- )  Defer branch, ( target-addr -- )        \ compiles a branch
 Defer branchmark, ( -- branch-addr )  Defer ?branch, ( target-addr -- )       \ compiles a ?branch
 Defer ?branchmark, ( -- branch-addr )  Defer branchmark, ( -- branch-addr )    \ reserves room for a branch
 Defer branchto,  Defer ?branchmark, ( -- branch-addr )   \ reserves room for a ?branch
 Defer branchtoresolve, ( branch-addr -- )  Defer ?domark, ( -- branch-addr )       \ reserves room for a ?do branch
 Defer branchfrom, ( -- )  Defer branchto, ( -- )                  \ actual program position is target of a branch (do e.g. alignment)
 Defer branchtomark, ( -- target-addr )  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 colon, ( tcfa -- )                \ compiles call to tcfa at current position
   Defer colonmark, ( -- addr )            \ marks a colon call
 Defer colon-resolve ( tcfa addr -- )  Defer colon-resolve ( tcfa addr -- )
   
 Defer addr-resolve ( target-addr 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  [IFUNDEF] ca>native
 defer ca>native   defer ca>native 
Line 671  DEFER >body             \ we need the sy Line 730  DEFER >body             \ we need the sy
                         \ and the target >body                          \ and the target >body
 >CROSS  >CROSS
 T 2 cells H VALUE xt>body  T 2 cells H VALUE xt>body
 DEFER doprim,  DEFER doprim,   \ compiles start of a primitive
 DEFER docol,     \ compiles start of definition and doer  DEFER docol,    \ compiles start of a colon definition
 DEFER doer,               DEFER doer,             
 DEFER fini,      \ compiles end of definition ;s  DEFER fini,      \ compiles end of definition ;s
 DEFER doeshandler,  DEFER doeshandler,
Line 681  DEFER dodoes, Line 740  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,  : (cc) T a, H ;                                 ' (cc) IS colon,
 : (cr) >tempdp ]comp colon, comp[ tempdp> ; ' (cr) IS colon-resolve  
 : (ar) T ! H ;                  ' (ar) IS addr-resolve  : (cr) >tempdp ]comp colon, comp[ tempdp> ;     ' (cr) IS colon-resolve
   : (ar) T ! H ;                                  ' (ar) IS addr-resolve
   : (dr)  ( ghost res-pnt target-addr addr )
           >tempdp drop over 
           dup >magic @ <do:> =
           IF      doer,
           ELSE    dodoes,
           THEN 
           tempdp> ;                               ' (dr) IS doer-resolve
   
   : (cm) ( -- addr )
       T here align H
       -1 colon, ;                                 ' (cm) IS colonmark,
   
 >TARGET  >TARGET
 : compile, colon, ;  : compile, colon, ;
Line 691  DEFER comp[     \ ends compilation Line 762  DEFER comp[     \ ends compilation
   
 \ file loading  \ file loading
   
   : >fl-id   1 cells + ;
   : >fl-name 2 cells + ;
   
 Variable filelist 0 filelist !  Variable filelist 0 filelist !
 0 Value  loadfile  0 Value  filemem
   : loadfile filemem >fl-name ;
   
 0 [IF] \ !! JAW WIP  1 [IF] \ !! JAW WIP
   
 : add-included-file ( adr len -- )  : add-included-file ( adr len -- )
         dup 2 cells + allocate throw >r          dup char+ >fl-name allocate throw >r
         r@ 1 cells + dup TO loadfile place          r@ >fl-name place
         filelist @ r@ !          filelist @ r@ !
         r> filelist ! ;          r> dup filelist ! to FileMem
           ;
   
 : included? ( c-addr u -- f )  : included? ( c-addr u -- f )
         filelist          filelist
Line 712  Variable filelist 0 filelist ! Line 788  Variable filelist 0 filelist !
         2drop drop false ;                2drop drop false ;      
   
 : included   : included 
         cr ." Including: " 2dup type ." ..."  \       cr ." Including: " 2dup type ." ..."
         2dup add-included-file included ;          FileMem >r
           2dup add-included-file included 
           r> to FileMem ;
   
 : include bl word count included ;  : include bl word count included ;
   
Line 724  Variable filelist 0 filelist ! Line 802  Variable filelist 0 filelist !
 \ resolve structure  \ resolve structure
   
 : >next ;               \ link to next field  : >next ;               \ link to next field
 : >tag cell+ ;          \ indecates type of reference: 0: call, 1: address  : >tag cell+ ;          \ indecates type of reference: 0: call, 1: address, 2: doer
 : >taddr cell+ cell+ ;    : >taddr cell+ cell+ ;  
 : >ghost 3 cells + ;  : >ghost 3 cells + ;
 : >file 4 cells + ;  : >file 4 cells + ;
 : >line 5 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
   swap >r here r@ >link @ , r@ >link ! ( tag ) ,      T here aligned H swap (refered)
   T here aligned H , r> drop  last-header-ghost @ ,     ;
   loadfile , sourceline# ,   
   : killref ( addr ghost -- )
   \G kills a forward reference to ghost at position addr
   \G this is used to eleminate a :dovar refence after making a DOES>
       dup >magic @ <fwd> <> IF 2drop EXIT THEN
       swap >r >link
       BEGIN dup @ dup  ( addr last this )
       WHILE dup >taddr @ r@ =
            IF   @ over !
            ELSE nip THEN
       REPEAT rdrop 2drop 
   ;    ;
   
 Defer resolve-warning  Defer resolve-warning
Line 750  Defer resolve-warning Line 848  Defer resolve-warning
     
 \ resolve                                              14oct92py  \ resolve                                              14oct92py
   
  : resolve-loop ( ghost tcfa -- ghost tcfa )   : resolve-loop ( ghost resolve-list tcfa -- )
   >r dup >link      >r
   BEGIN @ dup WHILE       BEGIN dup WHILE 
         resolve-warning   \         dup >tag @ 2 = IF reswarn-forward THEN
         r@ over >taddr @             resolve-warning 
         2 pick >tag @            r@ over >taddr @ 
         IF      addr-resolve            2 pick >tag @
         ELSE    colon-resolve            CASE  0 OF colon-resolve ENDOF
         THEN                  1 OF addr-resolve ENDOF
   REPEAT drop r> ;                  2 OF doer-resolve ENDOF
             ENDCASE
             @ \ next list element
       REPEAT 2drop rdrop 
     ;
   
 \ : resolve-loop ( ghost tcfa -- ghost tcfa )  \ : resolve-loop ( ghost tcfa -- ghost tcfa )
 \  >r dup >link @  \  >r dup >link @
Line 786  Exists-Warnings on Line 888  Exists-Warnings on
   THEN ;    THEN ;
   
 : resolve  ( ghost tcfa -- )  : resolve  ( ghost tcfa -- )
 \ resolve referencies to ghost with tcfa  \G resolve referencies to ghost with tcfa
   over forward? 0= IF  exists EXIT THEN      \ is ghost resolved?, second resolve means another definition with the
   resolve-loop  over >link ! <res> swap >magic !       \ same name
   ['] noop IS resolve-warning       over forward? 0= IF  exists EXIT THEN
       \ get linked-list
       swap >r r@ >link @ swap \ ( list tcfa R: ghost )
       \ mark ghost as resolved
       dup r@ >link ! <res> r@ >magic !
       \ loop through forward referencies
       r> -rot 
       comp-state @ >r Resolving comp-state !
       resolve-loop 
       r> comp-state !
   
       ['] noop IS resolve-warning 
   ;    ;
   
 \ gexecute ghost,                                      01nov92py  \ gexecute ghost,                                      01nov92py
   
 : is-forward   ( ghost -- )  : is-forward   ( ghost -- )
 \  >link dup @ there rot !  T  A,  H ;    colonmark, 0 (refered) ; \ compile space for call
   0 refered  -1 colon, ;  
   
 : is-resolved   ( ghost -- )  : is-resolved   ( ghost -- )
   >link @ colon, ; \ compile-call    >link @ colon, ; \ compile-call
Line 870  VARIABLE ^imm Line 982  VARIABLE ^imm
                 <imm> ^imm @ ! ;                  <imm> ^imm @ ! ;
 : restrict      20 flag! ;  : restrict      20 flag! ;
   
 : isdoer        <do:> last-header-ghost @ >magic ! ;  : isdoer        
   \G define a forth word as doer, this makes obviously only sence on
   \G forth processors such as the PSC1000
                   <do:> last-header-ghost @ >magic ! ;
 >CROSS  >CROSS
   
 \ ALIAS2 ansforth conform alias                          9may93jaw  \ ALIAS2 ansforth conform alias                          9may93jaw
Line 890  VARIABLE ^imm Line 1005  VARIABLE ^imm
   
 \ Target Document Creation (goes to crossdoc.fd)       05jul95py  \ Target Document Creation (goes to crossdoc.fd)       05jul95py
   
 s" doc/crossdoc.fd" r/w create-file throw value doc-file-id  s" ./doc/crossdoc.fd" r/w create-file throw value doc-file-id
 \ contains the file-id of the documentation file  \ contains the file-id of the documentation file
   
 : T-\G ( -- )  : T-\G ( -- )
Line 975  Defer skip? ' false IS skip? Line 1090  Defer skip? ' false IS skip?
   
 \ Target header creation  \ Target header creation
   
   Variable CreateFlag
   CreateFlag off
   
 VARIABLE CreateFlag CreateFlag off  Variable NoHeaderFlag
   NoHeaderFlag off
   
 : 0.r ( n1 n2 -- ) 0 swap <# 0 ?DO # LOOP #> type ;  : 0.r ( n1 n2 -- ) 
       base @ >r hex 
       0 swap <# 0 ?DO # LOOP #> type 
       r> base ! ;
 : .sym  : .sym
   bounds     bounds 
   DO I c@ dup    DO I c@ dup
Line 986  VARIABLE CreateFlag CreateFlag off Line 1107  VARIABLE CreateFlag CreateFlag off
                 '\ OF drop ." \\" ENDOF                  '\ OF drop ." \\" ENDOF
                 dup OF emit ENDOF                  dup OF emit ENDOF
         ENDCASE          ENDCASE
   LOOP ;      LOOP ;
   
 : (Theader ( "name" -- ghost )  : (Theader ( "name" -- ghost )
 \  >in @ bl word count type 2 spaces >in !      \  >in @ bl word count type 2 spaces >in !
 \ wordheaders will always be compiled to rom      \ wordheaders will always be compiled to rom
   switchrom      switchrom
   T align H view,      \ build header in target
   tlast @ dup 0> IF  T 1 cells - THEN  A, H  there tlast !      NoHeaderFlag @
   1 headers-named +!    \ Statistic      IF  NoHeaderFlag off
   >in @ T name, H >in ! T here H tlastcfa !      ELSE
   \ Symbol table          T align H view,
   \ >in @ cr ." sym:s/CFA=" there 4 0.r ." /"  bl word count .sym ." /g" cr >in !          tlast @ dup 0> IF  T 1 cells - H THEN T A, H  there tlast !
   CreateFlag @ IF          1 headers-named +!      \ Statistic
        >in @ alias2 swap >in !         \ create alias in target          >in @ T name, H >in !
        >in @ ghost swap >in !      THEN
        swap also ghosts ' previous swap !     \ tick ghost and store in alias      T cfalign here H tlastcfa !
        CreateFlag off      \ Symbol table
   ELSE ghost THEN  \    >in @ cr ." sym:s/CFA=" there 4 0.r ." /"  bl word count .sym ." /g" cr >in !
   dup Last-Header-Ghost !      CreateFlag @
   dup >magic ^imm !     \ a pointer for immediate      IF
   Already @ IF  dup >end tdoes !          >in @ alias2 swap >in !         \ create alias in target
   ELSE 0 tdoes ! THEN          >in @ ghost swap >in !
   80 flag!          swap also ghosts ' previous swap !     \ tick ghost and store in alias
   cross-doc-entry cross-tag-entry ;          CreateFlag off
       ELSE ghost
       THEN
       dup Last-Header-Ghost !
       dup >magic ^imm !     \ a pointer for immediate
       Already @
       IF  dup >end tdoes !
       ELSE 0 tdoes !
       THEN
       80 flag!
       cross-doc-entry cross-tag-entry ;
   
 VARIABLE ;Resolve 1 cells allot  VARIABLE ;Resolve 1 cells allot
 \ this is the resolver information from ":"  \ this is the resolver information from ":"
Line 1095  Cond: [']  T ' H alit, ;Cond Line 1226  Cond: [']  T ' H alit, ;Cond
 \ modularized                                           14jun97jaw  \ modularized                                           14jun97jaw
   
 : fillcfa   ( usedcells -- )  : fillcfa   ( usedcells -- )
   T cells H xt>body swap - 0 ?DO 0 T c, H LOOP ;    T cells H xt>body swap - 0 ?DO 0 T c, tchar H +LOOP ;
   
 : (>body)   ( cfa -- pfa ) xt>body + ;          ' (>body) T IS >body H  : (>body)   ( cfa -- pfa ) xt>body + ;          ' (>body) T IS >body H
   
Line 1145  Defer (end-code) Line 1276  Defer (end-code)
     ELSE true ABORT" CROSS: Stack empty" THEN      ELSE true ABORT" CROSS: Stack empty" THEN
     ;      ;
   
 Cond: chars ;Cond  ( Cond ) : chars tchar * ; ( Cond )
   
 >CROSS  >CROSS
   
Line 1210  Cond: MAXI Line 1341  Cond: MAXI
 \ ]                                                     9may93py/jaw  \ ]                                                     9may93py/jaw
   
 : ] state on  : ] state on
       Compiling comp-state !
     BEGIN      BEGIN
         BEGIN >in @ bl word          BEGIN >in @ bl word
               dup c@ 0= WHILE 2drop refill 0=                dup c@ 0= WHILE 2drop refill 0=
Line 1254  Cond: ; ( -- ) restrict? Line 1386  Cond: ; ( -- ) restrict?
                state off                 state off
                ;Resolve @                 ;Resolve @
                IF ;Resolve @ ;Resolve cell+ @ resolve THEN                 IF ;Resolve @ ;Resolve cell+ @ resolve THEN
                   Interpreting comp-state !
                ;Cond                 ;Cond
 Cond: [  restrict? state off ;Cond  Cond: [  restrict? state off Interpreting comp-state ! ;Cond
   
 >CROSS  >CROSS
   
   Create GhostDummy ghostheader
   <res> GhostDummy >magic !
   
 : !does ( does-action -- )  : !does ( does-action -- )
 \ !! zusammenziehen und dodoes, machen!  \ !! zusammenziehen und dodoes, machen!
     tlastcfa @ dup there >r tdp ! compile :dodoes r> tdp ! T cell+ ! H ;      tlastcfa @ [G'] :dovar killref
   \    tlastcfa @ dup there >r tdp ! compile :dodoes r> tdp ! T cell+ ! H ;
 \ !! geht so nicht, da dodoes, ghost will!  \ !! geht so nicht, da dodoes, ghost will!
 \     tlastcfa @ >tempdp dodoes, tempdp> ;      GhostDummy >link ! GhostDummy 
       tlastcfa @ >tempdp dodoes, tempdp> ;
   
 >TARGET  >TARGET
 Cond: DOES> restrict?  Cond: DOES> restrict?
Line 1284  Cond: DOES> restrict? Line 1423  Cond: DOES> restrict?
 \ 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
   
   >in @ alias2 swap dup >in ! >r >r    >in @ alias2 swap dup >in ! >r >r
   Make-Ghost rot swap >exec ! ,    Make-Ghost 
     rot swap >exec dup @ ['] NoExec <>
     IF 2drop ELSE ! THEN
     ,
   r> r> >in !    r> r> >in !
   also ghosts ' previous swap ! ;    also ghosts ' previous swap ! ;
 \  DOES>  dup >exec @ execute ;  \  DOES>  dup >exec @ execute ;
Line 1294  Cond: DOES> restrict? Line 1436  Cond: DOES> restrict?
   >end @ dup forward? 0=    >end @ dup forward? 0=
   IF    IF
         dup >magic @ <do:> =          dup >magic @ <do:> =
         IF  doer, EXIT THEN          IF       doer, 
           ELSE    dodoes,
           THEN
           EXIT
   THEN    THEN
 \  compile :dodoes gexecute  \  compile :dodoes gexecute
 \  T here H tcell - reloff   \  T here H tcell - reloff 
   dodoes,    2 refered 
 ;    0 fillcfa
     ;
   
 : TCreate ( <name> -- )  : TCreate ( <name> -- )
   executed-ghost @    executed-ghost @
Line 1384  by: :dovar ( ghost -- addr ) ;DO Line 1530  by: :dovar ( ghost -- addr ) ;DO
 Builder Create  Builder Create
   
 T has? rom H [IF]  T has? rom H [IF]
 Build: ( n -- ) T here 0 , H switchram T align here swap ! 0 , H ( switchrom ) ;  Build: ( -- ) T here 0 , H switchram T align here swap ! 0 , H ( switchrom ) ;
 by (Constant)  by (Constant)
 Builder Variable  Builder Variable
 [ELSE]  [ELSE]
Line 1394  Builder Variable Line 1540  Builder Variable
 [THEN]  [THEN]
   
 T has? rom H [IF]  T has? rom H [IF]
 Build: ( n -- ) T here 0 , H switchram T align here swap ! 0 , H ( switchrom ) ;  Build: ( -- ) T here 0 , H switchram T align here swap ! 0 , 0 , H ( switchrom ) ;
   by (Constant)
   Builder 2Variable
   [ELSE]
   Build: T 0 , 0 , H ;
   by Create
   Builder 2Variable
   [THEN]
   
   T has? rom H [IF]
   Build: ( -- ) T here 0 , H switchram T align here swap ! 0 , H ( switchrom ) ;
 by (Constant)  by (Constant)
 Builder AVariable  Builder AVariable
 [ELSE]  [ELSE]
Line 1471  Builder Field Line 1627  Builder Field
 \ ' 2Constant Alias2 end-struct  \ ' 2Constant Alias2 end-struct
 \ 0 1 T Chars H 2Constant struct  \ 0 1 T Chars H 2Constant struct
   
 0 [IF]  
   
 \ structural conditionals                              17dec92py  
   
 >CROSS  
 : ?struc      ( flag -- )       ABORT" CROSS: unstructured " ;  
 : sys?        ( sys -- sys )    dup 0= ?struc ;  
 : >mark       ( -- sys )        T here  ( dup ." M" hex. ) 0 , H ;  
   
 : branchoffset ( src dest -- ) - ;  
 : >resolve    ( sys -- )        T here ( dup ." >" hex. ) over branchoffset swap ! H ;  
 : <resolve    ( sys -- )        T here ( dup ." <" hex. ) branchoffset , H ;  
 >TARGET  
   
 \ Structural Conditionals                              12dec92py  
   
 Cond: BUT       restrict? sys? swap ;Cond  
 Cond: YET       restrict? sys? dup ;Cond  
   
 >CROSS  
 Variable tleavings  
 >TARGET  
   
 Cond: DONE   ( addr -- )  restrict? tleavings @  
       BEGIN  2dup u> 0=  WHILE  dup T @ H swap >resolve REPEAT  
       tleavings ! drop ;Cond  
   
 >CROSS  
 : (leave  T here H tleavings @ T , H  tleavings ! ;  
 >TARGET  
   
 Cond: LEAVE     restrict? compile branch (leave ;Cond  
 Cond: ?LEAVE    restrict? compile 0=  compile ?branch (leave  ;Cond  
   
 \ Structural Conditionals                              12dec92py  
   
 Cond: AHEAD     restrict? compile branch >mark ;Cond  
 Cond: IF        restrict? compile ?branch >mark ;Cond  
 Cond: THEN      restrict? sys? branchto, dup T @ H ?struc >resolve ;Cond  
 Cond: ELSE      restrict? sys? compile AHEAD swap compile THEN ;Cond  
   
 Cond: BEGIN     restrict? T branchto, here ( dup ." B" hex. ) H ;Cond  
 Cond: WHILE     restrict? sys? compile IF swap ;Cond  
 Cond: AGAIN     restrict? sys? compile branch <resolve ;Cond  
 Cond: UNTIL     restrict? sys? compile ?branch <resolve ;Cond  
 Cond: REPEAT    restrict? over 0= ?struc compile AGAIN compile THEN ;Cond  
   
 Cond: CASE      restrict? 0 ;Cond  
 Cond: OF        restrict? 1+ >r compile over compile =  
                 compile IF compile drop r> ;Cond  
 Cond: ENDOF     restrict? >r compile ELSE r> ;Cond  
 Cond: ENDCASE   restrict? compile drop 0 ?DO  compile THEN  LOOP ;Cond  
   
 \ Structural Conditionals                              12dec92py  
   
 Cond: DO        restrict? compile (do)   T here H ;Cond  
 Cond: ?DO       restrict? compile (?do)  T (leave here H ;Cond  
 Cond: FOR       restrict? compile (for)  T here H ;Cond  
   
 >CROSS  
 : loop]   dup <resolve tcell - compile DONE compile unloop ;  
 >TARGET  
   
 Cond: LOOP      restrict? sys? compile (loop)  loop] ;Cond  
 Cond: +LOOP     restrict? sys? compile (+loop) loop] ;Cond  
 Cond: NEXT      restrict? sys? compile (next)  loop] ;Cond  
   
 [ELSE]  
   
 \ structural conditionals                              17dec92py  \ structural conditionals                              17dec92py
   
 >CROSS  >CROSS
Line 1547  Cond: NEXT      restrict? sys? compile ( Line 1634  Cond: NEXT      restrict? sys? compile (
 : sys?        ( sys -- sys )    dup 0= ?struc ;  : sys?        ( sys -- sys )    dup 0= ?struc ;
 : >mark       ( -- sys )        T here  ( dup ." M" hex. ) 0 , H ;  : >mark       ( -- sys )        T here  ( dup ." M" hex. ) 0 , H ;
   
 : branchoffset ( src dest -- ) - ;  : branchoffset ( src dest -- ) - tchar / ;
   
 : >resolve    ( sys -- )        T here ( dup ." >" hex. ) over branchoffset swap ! H ;  : >resolve    ( sys -- )        T here ( dup ." >" hex. ) over branchoffset swap ! H ;
   
 : <resolve    ( sys -- )        T here ( dup ." <" hex. ) branchoffset , H ;  : <resolve    ( sys -- )        T here ( dup ." <" hex. ) branchoffset , H ;
   
 :noname compile branch T here branchoffset , H ; IS branch,  :noname compile branch T here branchoffset , H ;
 :noname compile ?branch T here branchoffset , H ; IS ?branch,    IS branch, ( target-addr -- )
 :noname compile branch T here 0 , H ; IS branchmark,  :noname compile ?branch T here branchoffset , H ;
 :noname compile ?branch T here 0 , H ; IS  ?branchmark,    IS ?branch, ( target-addr -- )
 :noname dup T @ H ?struc T here over branchoffset swap ! H ; IS branchtoresolve,  :noname compile branch T here 0 , H ;
 :noname branchto, T here H ; IS branchtomark,    IS branchmark, ( -- branchtoken )
   :noname compile ?branch T here 0 , H ;
     IS ?branchmark, ( -- branchtoken )
   :noname T here 0 , H ;
     IS ?domark, ( -- branchtoken )
   :noname dup T @ H ?struc T here over branchoffset swap ! H ;
     IS branchtoresolve, ( branchtoken -- )
   :noname branchto, T here H ;
     IS branchtomark, ( -- target-addr )
   
 >TARGET  >TARGET
   
Line 1567  Cond: NEXT      restrict? sys? compile ( Line 1662  Cond: NEXT      restrict? sys? compile (
 Cond: BUT       restrict? sys? swap ;Cond  Cond: BUT       restrict? sys? swap ;Cond
 Cond: YET       restrict? sys? dup ;Cond  Cond: YET       restrict? sys? dup ;Cond
   
 1 [IF]  0 [IF]
 >CROSS  >CROSS
 Variable tleavings  Variable tleavings
 >TARGET  >TARGET
Line 1577  Cond: DONE   ( addr -- )  restrict? tlea Line 1672  Cond: DONE   ( addr -- )  restrict? tlea
       tleavings ! drop ;Cond        tleavings ! drop ;Cond
   
 >CROSS  >CROSS
 : (leave  T here H tleavings @ T , H  tleavings ! ;  : (leave)  T here H tleavings @ T , H  tleavings ! ;
 >TARGET  >TARGET
   
 Cond: LEAVE     restrict? compile branch (leave ;Cond  Cond: LEAVE     restrict? compile branch (leave) ;Cond
 Cond: ?LEAVE    restrict? compile 0=  compile ?branch (leave  ;Cond  Cond: ?LEAVE    restrict? compile 0=  compile ?branch (leave)  ;Cond
   
 [ELSE]  [ELSE]
     \ !! This is WIP      \ !! This is WIP
Line 1590  Cond: ?LEAVE    restrict? compile 0=  co Line 1685  Cond: ?LEAVE    restrict? compile 0=  co
           
 >CROSS  >CROSS
 Variable tleavings 0 tleavings !  Variable tleavings 0 tleavings !
   : (done) ( addr -- )
       tleavings @
       BEGIN  dup
       WHILE
           >r dup r@ cell+ @ \ address of branch
           u> 0=      \ lower than DO?     
       WHILE
           r@ 2 cells + @ \ branch token
           branchtoresolve,
           r@ @ r> free throw
       REPEAT  r>  THEN
       tleavings ! drop ;
   
 >TARGET  >TARGET
   
 Cond: DONE   ( addr -- )    Cond: DONE   ( addr -- )  restrict? (done) ;Cond
       restrict? tleavings @  
       BEGIN  dup  
       WHILE  >r dup r@ cell+ @ \ address of branch  
              u> 0=         \ lower than DO?       
       WHILE  r@ 2 cells + @ \ branch token  
              branchtoresolve,  
              r@ @ r> free throw  
       REPEAT drop r>  
       THEN  
       tleavings ! drop ;Cond  
   
 >CROSS  >CROSS
 : (leave ( branchtoken -- )  : (leave) ( branchtoken -- )
     3 cells allocate throw >r      3 cells allocate throw >r
     T here H r@ cell+ !      T here H r@ cell+ !
     r@ 2 cells + !      r@ 2 cells + !
Line 1613  Cond: DONE   ( addr -- ) Line 1711  Cond: DONE   ( addr -- )
     r> tleavings ! ;      r> tleavings ! ;
 >TARGET  >TARGET
   
 Cond: LEAVE     restrict? branchmark, (leave ;Cond  Cond: LEAVE     restrict? branchmark, (leave) ;Cond
 Cond: ?LEAVE    restrict? compile 0=  ?branchmark, (leave  ;Cond  Cond: ?LEAVE    restrict? compile 0=  ?branchmark, (leave)  ;Cond
   
 [THEN]  [THEN]
   
   >CROSS
   \ !!JW ToDo : Move to general tools section
   
   : to1 ( x1 x2 xn n -- addr )
   \G packs n stack elements in a allocated memory region
      dup dup 1+ cells allocate throw dup >r swap 1+
      0 DO tuck ! cell+ LOOP
      drop r> ;
   : 1to ( addr -- x1 x2 xn )
   \G unpacks the elements saved by to1
       dup @ swap over cells + swap
       0 DO  dup @ swap 1 cells -  LOOP
       free throw ;
   
   : loop]     branchto, dup <resolve tcell - (done) ;
   
   : skiploop] ?dup IF branchto, branchtoresolve, THEN ;
   
   >TARGET
   
 \ Structural Conditionals                              12dec92py  \ Structural Conditionals                              12dec92py
   
 >TARGET  >TARGET
Line 1640  Cond: ENDCASE   restrict? compile drop 0 Line 1758  Cond: ENDCASE   restrict? compile drop 0
   
 \ Structural Conditionals                              12dec92py  \ Structural Conditionals                              12dec92py
   
 Cond: DO        restrict? compile (do)   T here H ;Cond  :noname
 Cond: ?DO       restrict? compile (?do)  T (leave here H ;Cond      0 compile (do)
 Cond: FOR       restrict? compile (for)  T here H ;Cond      branchtomark,  2 to1 ;
     IS do, ( -- target-addr )
 >CROSS  
 : loop]   branchto, dup <resolve tcell - compile DONE compile unloop ;  \ :noname
 >TARGET  \     compile 2dup compile = compile IF
   \     compile 2drop compile ELSE
 Cond: LOOP      restrict? sys? compile (loop)  loop] ;Cond  \     compile (do) branchtomark, 2 to1 ;
 Cond: +LOOP     restrict? sys? compile (+loop) loop] ;Cond  \   IS ?do,
 Cond: NEXT      restrict? sys? compile (next)  loop] ;Cond      
   :noname
 [THEN]      0 compile (?do)  ?domark, (leave)
       branchtomark,  2 to1 ;
     IS ?do, ( -- target-addr )
   :noname compile (for) branchtomark, ;
     IS for, ( -- target-addr )
   :noname 1to compile (loop)  loop] compile unloop skiploop] ;
     IS loop, ( target-addr -- )
   :noname 1to compile (+loop)  loop] compile unloop skiploop] ;
     IS +loop, ( target-addr -- )
   :noname compile (next)  loop] compile unloop ;
     IS next, ( target-addr -- )
   
   Cond: DO        restrict? do, ;Cond
   Cond: ?DO       restrict? ?do, ;Cond
   Cond: FOR       restrict? for, ;Cond
   
   Cond: LOOP      restrict? sys? loop, ;Cond
   Cond: +LOOP     restrict? sys? +loop, ;Cond
   Cond: NEXT      restrict? sys? next, ;Cond
   
 \ String words                                         23feb93py  \ String words                                         23feb93py
   
Line 1694  Cond: compile ( -- ) restrict? \ name Line 1830  Cond: compile ( -- ) restrict? \ name
       0> IF    gexecute        0> IF    gexecute
          ELSE  dup >magic @ <imm> =           ELSE  dup >magic @ <imm> =
                IF   gexecute                 IF   gexecute
                ELSE compile (compile) gexecute THEN THEN ;Cond                 ELSE compile (compile) addr, THEN THEN ;Cond
   
 Cond: postpone ( -- ) restrict? \ name  Cond: postpone ( -- ) restrict? \ name
       bl word gfind dup 0= ABORT" CROSS: Can't compile"        bl word gfind dup 0= ABORT" CROSS: Can't compile"
       0> IF    gexecute        0> IF    gexecute
          ELSE  dup >magic @ <imm> =           ELSE  dup >magic @ <imm> =
                IF   gexecute                 IF   gexecute
                ELSE compile (compile) gexecute THEN THEN ;Cond                 ELSE compile (compile) addr, THEN THEN ;Cond
              
   \ \ minimal definitions
              
 >MINIMAL  >MINIMAL
 also minimal  also minimal
 \ Usefull words                                        13feb93py  \ Usefull words                                        13feb93py
   
 : KB  400 * ;  : KB  400 * ;
   
   \ \ [IF] [ELSE] [THEN] ...                              14sep97jaw
   
   \ it is useful to define our own structures and not to rely
   \ on the words in the compiler
   \ The words in the compiler might be defined with vocabularies
   \ this doesn't work with our self-made compile-loop
   
   Create parsed 20 chars allot    \ store word we parsed
   
   : upcase
       parsed count bounds
       ?DO I c@ toupper I c! LOOP ;
   
   : [ELSE]
       1 BEGIN
           BEGIN bl word count dup WHILE
               comment? parsed place upcase parsed count
               2dup s" [IF]" compare 0= >r 
               2dup s" [IFUNDEF]" compare 0= >r
               2dup s" [IFDEF]" compare 0= r> or r> or
               IF   2drop 1+
               ELSE 2dup s" [ELSE]" compare 0=
                   IF   2drop 1- dup
                       IF 1+
                       THEN
                   ELSE
                       2dup s" [ENDIF]" compare 0= >r
                       s" [THEN]" compare 0= r> or
                       IF 1- THEN
                   THEN
               THEN
               ?dup 0= ?EXIT
           REPEAT
           2drop refill 0=
       UNTIL drop ; immediate
     
   : [THEN] ( -- ) ; immediate
   
   : [ENDIF] ( -- ) ; immediate
   
   : [IF] ( flag -- )
       0= IF postpone [ELSE] THEN ; immediate 
   
   Cond: [IF]      postpone [IF] ;Cond
   Cond: [THEN]    postpone [THEN] ;Cond
   Cond: [ELSE]    postpone [ELSE] ;Cond
   
 \ define new [IFDEF] and [IFUNDEF]                      20may93jaw  \ define new [IFDEF] and [IFUNDEF]                      20may93jaw
   
 : defined? defined? ;  : defined? defined? ;
Line 1727  also minimal Line 1912  also minimal
   
 : [IFUNDEF] defined? 0= postpone [IF] ;  : [IFUNDEF] defined? 0= postpone [IF] ;
   
   Cond: [IFDEF]   postpone [IFDEF] ;Cond
   
   Cond: [IFUNDEF] postpone [IFUNDEF] ;Cond
   
 \ C: \- \+ Conditional Compiling                         09jun93jaw  \ C: \- \+ Conditional Compiling                         09jun93jaw
   
 : C: >in @ defined? 0=  : C: >in @ defined? 0=
Line 1760  Cond: \D \D ;Cond Line 1949  Cond: \D \D ;Cond
 \G defines ghost for words that we want to be compiled  \G defines ghost for words that we want to be compiled
   BEGIN >in @ bl word c@ WHILE >in ! ghost drop REPEAT drop ;    BEGIN >in @ bl word c@ WHILE >in ! ghost drop REPEAT drop ;
   
 : [IF]   postpone [IF] ;  
 : [THEN] postpone [THEN] ;  
 : [ELSE] postpone [ELSE] ;  
   
 Cond: [IF]      [IF] ;Cond  
 Cond: [IFDEF]   [IFDEF] ;Cond  
 Cond: [IFUNDEF] [IFUNDEF] ;Cond  
 Cond: [THEN]    [THEN] ;Cond  
 Cond: [ELSE]    [ELSE] ;Cond  
   
 previous  previous
   
 \ save-cross                                           17mar93py  \ save-cross                                           17mar93py
   
 >CROSS  >CROSS
 Create magic  s" Gforth10" here over allot swap move  Create magic  s" Gforth2x" here over allot swap move
   
 char 1 bigendian + tcell + magic 7 + c!  bigendian
   tcell 1 = 0 and
   tcell 2 = 2 and or
   tcell 4 = 4 and or
   tcell 8 = 6 and or
   magic 7 + c!
   
 : save-cross ( "image-name" "binary-name" -- )  : save-cross ( "image-name" "binary-name" -- )
   bl parse ." Saving to " 2dup type cr    bl parse ." Saving to " 2dup type cr
Line 1818  also minimal Line 2002  also minimal
   
 bigendian Constant bigendian  bigendian Constant bigendian
 : here there ;  : here there ;
   
   \ compiler directives
 : >ram >ram ;  : >ram >ram ;
 : >rom >rom ;  : >rom >rom ;
 : >auto >auto ;  : >auto >auto ;
Line 1825  bigendian Constant bigendian Line 2011  bigendian Constant bigendian
 : tempdp> tempdp> ;  : tempdp> tempdp> ;
 : const constflag on ;  : const constflag on ;
 : warnings name 3 = 0= twarnings ! drop ;  : warnings name 3 = 0= twarnings ! drop ;
   : | ;
   \ : | NoHeaderFlag on ; \ This is broken (damages the last word)
   
 : save-cross save-cross ;  : save-cross save-cross ;
 : save-region save-region ;  : save-region save-region ;

Removed from v.1.53  
changed lines
  Added in v.1.62


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