Diff for /gforth/cross.fs between versions 1.7 and 1.23

version 1.7, 1994/07/08 15:00:30 version 1.23, 1995/02/08 13:38:50
Line 1 Line 1
 \ CROSS.FS     The Cross-Compiler                      06oct92py  \ CROSS.FS     The Cross-Compiler                      06oct92py
 \ $Id$  \ $Id$
 \ Idea and implementation: Bernd Paysan (py)  \ Idea and implementation: Bernd Paysan (py)
 \ Copyright 1992 by the ANSI figForth Development Group  \ Copyright 1992-94 by the GNU Forth Development Group
   
 \ Log:  \ Log:
 \       changed in ; [ to state off           12may93jaw  \       changed in ; [ to state off           12may93jaw
Line 21 Line 21
 \             targets                         09jun93jaw  \             targets                         09jun93jaw
 \       added: 2user and value                11jun93jaw  \       added: 2user and value                11jun93jaw
   
 include other.fs       \ ansforth extentions for cross  \ include other.fs       \ ansforth extentions for cross
   
   : string, ( c-addr u -- )
       \ puts down string as cstring
       dup c, here swap chars dup allot move ;
   ' falign Alias cfalign
 : comment? ( c-addr u -- c-addr u )  : comment? ( c-addr u -- c-addr u )
         2dup s" (" compare 0=          2dup s" (" compare 0=
         IF    postpone (          IF    postpone (
Line 31  include other.fs       \ ansforth extent Line 35  include other.fs       \ ansforth extent
   
 decimal  decimal
   
 \ number?                                               11may93jaw  
   
 \ checks for +, -, $, & ...  
 : leading? ( c-addr u -- c-addr u doubleflag negflag base )  
         2dup 1- chars + c@ [char] . =   \ process double  
         IF dup 1 chars = IF over 1 swap c! false ELSE 1 chars - true THEN  
         \ only if more than only . ( may be number output! )  
         \ if only . => store garbage  
         ELSE false THEN >r      \ numbers  
         false -rot base @ -rot  
         BEGIN over c@  
                 dup [char] - =  
                         IF drop >r >r >r  
                            drop true r> r> r> 0 THEN  
                 dup [char] + =  
                         IF drop 0 THEN  
                 dup [char] $ =  
                         IF drop >r >r drop 16 r> r> 0 THEN  
                 dup [char] & =  
                         IF drop >r >r drop 10 r> r> 0 THEN  
               0= IF 1 chars - swap char+ swap false ELSE true THEN  
               over 0= or  
         UNTIL  
               rot >r rot r> r> -rot ;  
   
 : number? ( c-addr -- n/d flag )  
 \ return -1 if cell 1 if double 0 if garbage  
                 0 swap 0 swap           \ create double number  
                 count leading?  
                 base @ >r base !  
                 >r >r  
                 >number IF 2drop false r> r> 2drop  
                            r> base ! EXIT THEN  
                 drop r> r>  
                 IF IF dnegate 1  
                    ELSE drop negate -1 THEN  
                 ELSE IF 1 ELSE drop -1 THEN  
                 THEN r> base ! ;  
   
   
   
 \ Begin CROSS COMPILER:  \ Begin CROSS COMPILER:
   
 \ GhostNames                                            9may93jaw  \ GhostNames                                            9may93jaw
Line 80  decimal Line 43  decimal
 VARIABLE GhostNames  VARIABLE GhostNames
 0 GhostNames !  0 GhostNames !
 : GhostName ( -- addr )  : GhostName ( -- addr )
         here GhostNames @ , GhostNames ! here 0 ,      here GhostNames @ , GhostNames ! here 0 ,
         name count      bl word count
 \        2dup type space      \ 2dup type space
         dup c, here over chars allot swap move align ;      string, cfalign ;
   
 hex  hex
   
Line 125  Variable tdp Line 88  Variable tdp
   
 \ Parameter for target systems                         06oct92py  \ Parameter for target systems                         06oct92py
   
 include machine.fs  included
   
   \ Create additional parameters                         19jan95py
   
   T
   cell               Constant tcell
   cell<<             Constant tcell<<
   cell>bit           Constant tcell>bit
   bits/byte          Constant tbits/byte
   float              Constant tfloat
   1 bits/byte lshift Constant maxbyte
   H
   
 >TARGET  >TARGET
   
 \ Byte ordering and cell size                          06oct92py  \ Byte ordering and cell size                          06oct92py
   
 : cell+         cell + ;  : cell+         tcell + ;
 : cells         cell<< lshift ;  : cells         tcell<< lshift ;
 : chars         ;  : chars         ;
 : floats        float * ;  : floats        tfloat * ;
           
 >CROSS  >CROSS
 : cell/         cell<< rshift ;  : cell/         tcell<< rshift ;
 >TARGET  >TARGET
 20 CONSTANT bl  20 CONSTANT bl
 -1 Constant NIL  -1 Constant NIL
Line 145  include machine.fs Line 119  include machine.fs
 -3 Constant :docon  -3 Constant :docon
 -4 Constant :dovar  -4 Constant :dovar
 -5 Constant :douser  -5 Constant :douser
 -6 Constant :dodoes  -6 Constant :dodefer
 -7 Constant :doesjump  -7 Constant :dodoes
   -8 Constant :doesjump
   
 >CROSS  >CROSS
   
 endian  0 pad ! -1 pad c! pad @ 0<  bigendian
 = [IF]   : bswap ; immediate   [IF]
 [ELSE]   : bswap ( big / little -- little / big )  0     : T!  ( n addr -- )  >r s>d r> tcell bounds swap 1-
            cell 1- FOR  bits/byte lshift over       DO  maxbyte ud/mod rot I c!  -1 +LOOP  2drop ;
                         [ 1 bits/byte lshift 1- ] Literal and or     : T@  ( addr -- n )  >r 0 0 r> tcell bounds
                         swap bits/byte rshift swap  NEXT  nip ;       DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  LOOP d>s ;
   [ELSE]
      : T!  ( n addr -- )  >r s>d r> tcell bounds
        DO  maxbyte ud/mod rot I c!  LOOP  2drop ;
      : T@  ( addr -- n )  >r 0 0 r> tcell bounds swap 1-
        DO  maxbyte * swap maxbyte um* rot + swap I c@ + swap  -1 +LOOP d>s ;
 [THEN]  [THEN]
   
 \ Memory initialisation                                05dec92py  \ Memory initialisation                                05dec92py
Line 196  CREATE Bittable 80 c, 40 c, 20 c, 10 c, Line 176  CREATE Bittable 80 c, 40 c, 20 c, 10 c,
   
 : align+  ( taddr -- rest )  : align+  ( taddr -- rest )
     cell tuck 1- and - [ cell 1- ] Literal and ;      cell tuck 1- and - [ cell 1- ] Literal and ;
   : cfalign+  ( taddr -- rest )
       \ see kernal.fs:cfaligned
       float tuck 1- and - [ float 1- ] Literal and ;
   
 >TARGET  >TARGET
 : aligned ( taddr -- ta-addr )  dup align+ + ;  : aligned ( taddr -- ta-addr )  dup align+ + ;
 \ assumes cell alignment granularity (as GNU C)  \ assumes cell alignment granularity (as GNU C)
   
   : cfaligned ( taddr1 -- taddr2 )
       \ see kernal.fs
       dup cfalign+ + ;
   
 >CROSS  >CROSS
 : >image ( taddr -- absaddr )  image @ + ;  : >image ( taddr -- absaddr )  image @ + ;
 >TARGET  >TARGET
 : @  ( taddr -- w )     >image @ bswap ;  : @  ( taddr -- w )     >image t@ ;
 : !  ( w taddr -- )     >r bswap r> >image ! ;  : !  ( w taddr -- )     >image t! ;
 : c@ ( taddr -- char )  >image c@ ;  : c@ ( taddr -- char )  >image c@ ;
 : c! ( char taddr -- )  >image c! ;  : c! ( char taddr -- )  >image c! ;
 : 2@ ( taddr -- x1 x2 ) T dup cell+ @ swap @ H ;  : 2@ ( taddr -- x1 x2 ) T dup cell+ @ swap @ H ;
Line 219  CREATE Bittable 80 c, 40 c, 20 c, 10 c, Line 206  CREATE Bittable 80 c, 40 c, 20 c, 10 c,
 : ,     ( w -- )        T here H cell T allot  ! H ;  : ,     ( w -- )        T here H cell T allot  ! H ;
 : c,    ( char -- )     T here    1 allot c! H ;  : c,    ( char -- )     T here    1 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 ( -- )
       T here H cfalign+ 0 ?DO  bl T c, H LOOP ;
   
 : A!                    dup relon T ! H ;  : A!                    dup relon T ! H ;
 : A,    ( w -- )        T here H relon T , H ;  : A,    ( w -- )        T here H relon T , H ;
Line 260  Variable atonce atonce off Line 249  Variable atonce atonce off
 : >magic ; : >link cell+ ; : >exec cell+ cell+ ;  : >magic ; : >link cell+ ; : >exec cell+ cell+ ;
 : >end 3 cells + ;  : >end 3 cells + ;
   
   Variable last-ghost
 : 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
   here tuck swap ! ghostheader T>    here tuck swap ! ghostheader T>
   DOES>  >exec @ execute ;    DOES> dup last-ghost ! >exec @ execute ;
   
 \ ghost words                                          14oct92py  \ ghost words                                          14oct92py
 \                                          changed:    10may93py/jaw  \                                          changed:    10may93py/jaw
Line 273  Variable atonce atonce off Line 263  Variable atonce atonce off
 \ searches for string in word-list ghosts  \ searches for string in word-list ghosts
 \ !! wouldn't it be simpler to just use search-wordlist ? ae  \ !! wouldn't it be simpler to just use search-wordlist ? ae
   dup count [ ' ghosts >body ] ALiteral search-wordlist    dup count [ ' ghosts >body ] ALiteral search-wordlist
 \ >r get-order  0 set-order also ghosts  r> find >r >r    dup IF  >r >body nip r>  THEN ;
   >r r@ IF  >body nip  THEN  r> ;  
 \ set-order  r> r@  IF  >body  THEN  r> ;  
   
 VARIABLE Already  VARIABLE Already
   
 : ghost   ( "name" -- ghost )  : ghost   ( "name" -- ghost )
   Already off    Already off
   >in @  name gfind   IF  Already on nip EXIT  THEN    >in @  bl word gfind   IF  Already on nip EXIT  THEN
   drop  >in !  Make-Ghost ;    drop  >in !  Make-Ghost ;
   
 \ resolve                                              14oct92py  \ resolve                                              14oct92py
Line 297  VARIABLE Already Line 285  VARIABLE Already
   BEGIN @ dup    BEGIN @ dup
   WHILE 2dup cell+ @ =    WHILE 2dup cell+ @ =
   UNTIL    UNTIL
         nip 2 cells + count cr ." CROSS: Exists: " type 4 spaces          2 cells + count cr ." CROSS: Exists: " type 4 spaces drop
         swap cell+ !          swap cell+ !
   ELSE true ABORT" CROSS: Ghostnames inconsistent"    ELSE true ABORT" CROSS: Ghostnames inconsistent"
   THEN ;    THEN ;
Line 336  variable ResolveFlag Line 324  variable ResolveFlag
   Ghostnames    Ghostnames
   BEGIN @ dup    BEGIN @ dup
   WHILE dup ?resolved    WHILE dup ?resolved
   REPEAT drop ResolveFlag @ 0= IF ." Nothing!" THEN cr ;    REPEAT drop ResolveFlag @
     IF
         abort" Unresolved words!"
     ELSE
         ." Nothing!"
     THEN
     cr ;
   
 >CROSS  >CROSS
 \ Header states                                        12dec92py  \ Header states                                        12dec92py
Line 347  VARIABLE ^imm Line 341  VARIABLE ^imm
   
 >TARGET  >TARGET
 : immediate     20 flag!  : immediate     20 flag!
                 ^imm @ @ dup <imm> = ?EXIT                  ^imm @ @ dup <imm> = IF  drop  EXIT  THEN
                 <res> <> ABORT" CROSS: Cannot immediate a unresolved word"                  <res> <> ABORT" CROSS: Cannot immediate a unresolved word"
                 <imm> ^imm @ ! ;                  <imm> ^imm @ ! ;
 : restrict      ;  : restrict      40 flag! ;
 >CROSS  >CROSS
   
 \ ALIAS2 ansforth conform alias                          9may93jaw  \ ALIAS2 ansforth conform alias                          9may93jaw
   
 : ALIAS2 create here 0 , DOES> @ execute ;  : ALIAS2 create here 0 , DOES> @ execute ;
 \ usage:  \ usage:
 \ ' alias2 bla !  \ ' <name> alias2 bla !
   
 \ Target Header Creation                               01nov92py  \ Target Header Creation                               01nov92py
   
 : string,  ( addr count -- )  : string,  ( addr count -- )
   dup T c, H bounds  DO  I c@ T c, H  LOOP ;     dup T c, H bounds  DO  I c@ T c, H  LOOP ; 
 : name,  ( "name" -- )  name count string, T align H ;  : name,  ( "name" -- )  bl word count string, T cfalign H ;
 : view,   ( -- ) ( dummy ) ;  : view,   ( -- ) ( dummy ) ;
   
 VARIABLE CreateFlag CreateFlag off  VARIABLE CreateFlag CreateFlag off
Line 372  VARIABLE CreateFlag CreateFlag off Line 366  VARIABLE CreateFlag CreateFlag off
   tlast @ dup 0> IF  T 1 cells - THEN  A, H  there tlast !    tlast @ dup 0> IF  T 1 cells - THEN  A, H  there tlast !
   >in @ name, >in ! T here H tlastcfa !    >in @ name, >in ! T here H tlastcfa !
   CreateFlag @ IF    CreateFlag @ IF
   >in @ alias2 swap >in !         \ create alias in target         >in @ alias2 swap >in !         \ create alias in target
   >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
   ELSE ghost THEN    ELSE ghost THEN
   dup >magic ^imm !     \ a pointer for immediate    dup >magic ^imm !     \ a pointer for immediate
   Already @ IF  dup >end tdoes !    Already @ IF  dup >end tdoes !
Line 384  VARIABLE CreateFlag CreateFlag off Line 378  VARIABLE CreateFlag CreateFlag off
   
 VARIABLE ;Resolve 1 cells allot  VARIABLE ;Resolve 1 cells allot
   
 : Theader  ( "name" -- )     (THeader there resolve 0 ;Resolve ! ;  : Theader  ( "name" -- ghost )
     (THeader dup there resolve 0 ;Resolve ! ;
   
 >TARGET  >TARGET
 : Alias    ( cfa -- ) \ name  : Alias    ( cfa -- ) \ name
Line 424  ghost unloop    ghost ;S Line 419  ghost unloop    ghost ;S
 ghost lit       ghost (compile) ghost !         2drop drop  ghost lit       ghost (compile) ghost !         2drop drop
 ghost (;code)   ghost noop                      2drop  ghost (;code)   ghost noop                      2drop
 ghost (.")      ghost (S")      ghost (ABORT")  2drop drop  ghost (.")      ghost (S")      ghost (ABORT")  2drop drop
   ghost '
   
 \ compile                                              10may93jaw  \ compile                                              10may93jaw
   
 : compile  ( -- ) \ name  : compile  ( -- ) \ name
   restrict?    restrict?
   name gfind dup 0= ABORT" CROSS: Can't compile "    bl word gfind dup 0= ABORT" CROSS: Can't compile "
   0> ( immediate? )    0> ( immediate? )
   IF    >exec @ compile,    IF    >exec @ compile,
   ELSE  postpone literal postpone gexecute  THEN ;    ELSE  postpone literal postpone gexecute  THEN ;
                                         immediate                                          immediate
   
 >TARGET  >TARGET
 : '  ( -- cfa ) name gfind 0= ABORT" CROSS: undefined "  : '  ( -- cfa ) bl word gfind 0= ABORT" CROSS: undefined "
   dup >magic @ <fwd> = ABORT" CROSS: forward " >link @ ;    dup >magic @ <fwd> = ABORT" CROSS: forward " >link @ ;
   
 Cond: [']  compile lit ghost gexecute ;Cond  Cond: [']  compile lit ghost gexecute ;Cond
   
   Cond: chars ;Cond
   
 >CROSS  >CROSS
 \ tLiteral                                             12dec92py  \ tLiteral                                             12dec92py
   
Line 473  Cond: [Char]   ( "<char>" -- )  restrict Line 471  Cond: [Char]   ( "<char>" -- )  restrict
   
 : ] state on  : ] state on
     BEGIN      BEGIN
         BEGIN >in @ name          BEGIN >in @ bl word
               dup c@ 0= WHILE 2drop refill 0=                dup c@ 0= WHILE 2drop refill 0=
               ABORT" CROSS: End of file while target compiling"                ABORT" CROSS: End of file while target compiling"
         REPEAT          REPEAT
Line 520  Cond: DOES> restrict? Line 518  Cond: DOES> restrict?
   >in @ alias2 swap dup >in ! >r >r    >in @ alias2 swap dup >in ! >r >r
   Make-Ghost rot swap >exec ! ,    Make-Ghost rot swap >exec ! ,
   r> r> >in !    r> r> >in !
   also ghosts ' previous swap !    also ghosts ' previous swap ! ;
   DOES> dup >exec @ execute ;  \  DOES>  dup >exec @ execute ;
   
 : gdoes,  ( ghost -- )  >end @ dup >magic @ <fwd> <>  : gdoes,  ( ghost -- )  >end @ dup >magic @ <fwd> <>
   IF dup >link @ dup 0< IF T A, 0 , H drop EXIT THEN drop THEN    IF dup >link @ dup 0< IF T A, 0 , H drop EXIT THEN drop THEN
   :dodoes T A, H gexecute T here H cell - reloff ;    :dodoes T A, H gexecute T here H cell - reloff ;
   
 : TCreate ( ghost -- )  : TCreate ( -- )
     last-ghost @
   CreateFlag on    CreateFlag on
   Theader dup gdoes,    Theader >r dup gdoes,
   >end @ >exec @ execute ;    >end @ >exec @ r> >exec ! ;
   
 : Build:  ( -- [xt] [colon-sys] )  : Build:  ( -- [xt] [colon-sys] )
   :noname  postpone TCreate ;    :noname  postpone TCreate ;
   
 : gdoes>  ( ghost -- addr flag )  : gdoes>  ( ghost -- addr flag )
     last-ghost @
   state @ IF  gexecute true EXIT  THEN    state @ IF  gexecute true EXIT  THEN
   cell+ @ T >body H false ;    cell+ @ T >body H false ;
   
 \ DO: ;DO                                               11may93jaw  \ DO: ;DO                                               11may93jaw
 \ changed to ?EXIT                                      10may93jaw  \ changed to ?EXIT                                      10may93jaw
   
 : (does>)        postpone does> ; immediate \ second level does>  
   
 : DO:     ( -- addr [xt] [colon-sys] )  : DO:     ( -- addr [xt] [colon-sys] )
   here ghostheader    here ghostheader
   :noname    :noname postpone gdoes> postpone ?EXIT ;
   postpone (does>) postpone gdoes> postpone ?EXIT ;  
   
 : ;DO ( addr [xt] [colon-sys] -- )  : ;DO ( addr [xt] [colon-sys] -- )
   postpone ;    ( S addr xt )    postpone ;    ( S addr xt )
Line 579  Variable tup  0 tup ! Line 576  Variable tup  0 tup !
 Variable tudp 0 tudp !  Variable tudp 0 tudp !
 : u,  ( n -- udp )  : u,  ( n -- udp )
   tup @ tudp @ + T  ! H    tup @ tudp @ + T  ! H
   tudp @ dup cell+ tudp ! ;    tudp @ dup T cell+ H tudp ! ;
 : au, ( n -- udp )  : au, ( n -- udp )
   tup @ tudp @ + T A! H    tup @ tudp @ + T A! H
   tudp @ dup cell+ tudp ! ;    tudp @ dup T cell+ H tudp ! ;
 >TARGET  >TARGET
   
 Build: T 0 u, , H ;  Build: T 0 u, , H ;
Line 614  Builder Value Line 611  Builder Value
 Build:  ( -- ) compile noop ;  Build:  ( -- ) compile noop ;
 DO: ( ghost -- ) ABORT" CROSS: Don't execute" ;DO  DO: ( ghost -- ) ABORT" CROSS: Don't execute" ;DO
 Builder Defer  Builder Defer
   by Defer :dodefer resolve
   
 \ structural conditionals                              17dec92py  \ structural conditionals                              17dec92py
   
Line 682  Cond: ABORT"    restrict? compile (ABORT Line 680  Cond: ABORT"    restrict? compile (ABORT
   
 Cond: IS        T ' >body H compile ALiteral compile ! ;Cond  Cond: IS        T ' >body H compile ALiteral compile ! ;Cond
 : IS            T ' >body ! H ;  : IS            T ' >body ! H ;
   Cond: TO        T ' >body H compile ALiteral compile ! ;Cond
   : TO            T ' >body ! H ;
   
 \ LINKED ERR" ENV" 2ENV"                                18may93jaw  \ LINKED ERR" ENV" 2ENV"                                18may93jaw
   
Line 701  Cond: IS        T ' >body H compile ALit Line 701  Cond: IS        T ' >body H compile ALit
 \ compile must be last                                 22feb93py  \ compile must be last                                 22feb93py
   
 Cond: compile ( -- ) restrict? \ name  Cond: compile ( -- ) restrict? \ name
       name 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) gexecute THEN THEN ;Cond
   
 Cond: postpone ( -- ) restrict? \ name  Cond: postpone ( -- ) restrict? \ name
       name 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
Line 722  also minimal Line 722  also minimal
   
 \ define new [IFDEF] and [IFUNDEF]                      20may93jaw  \ define new [IFDEF] and [IFUNDEF]                      20may93jaw
   
 : there? name gfind IF >magic @ <fwd> <> ELSE drop false THEN ;  : there? bl word gfind IF >magic @ <fwd> <> ELSE drop false THEN ;
   
 : [IFDEF] there? postpone [IF] ;  : [IFDEF] there? postpone [IF] ;
 : [IFUNDEF] there? 0= postpone [IF] ;  : [IFUNDEF] there? 0= postpone [IF] ;
Line 762  Cond: [ELSE]    [ELSE] ;Cond Line 762  Cond: [ELSE]    [ELSE] ;Cond
 \ [THEN]  \ [THEN]
 \ included throw after create-file                     11may93jaw  \ included throw after create-file                     11may93jaw
   
 endian Constant endian  bigendian Constant bigendian
   
 : save-cross ( "name" -- )  : save-cross ( "name" -- )
   bl parse ." Saving to " 2dup type    bl parse ." Saving to " 2dup type
   w/o bin create-file throw >r    w/o bin create-file throw >r
   image @ there r@ write-file throw    s" gforth00"  r@ write-file throw \ write magic
   bit$  @ there 1- cell>bit rshift 1+ r@ write-file throw    image @ there r@ write-file throw \ write image
     bit$  @ there 1- cell>bit rshift 1+
                   r@ write-file throw \ write tags
   r> close-file throw ;    r> close-file throw ;
   
 \ words that should be in minimal  \ words that should be in minimal
   
 : + + ;         : 1- 1- ;  : + + ;         : 1- 1- ;
 : - - ;         : 2* 2* ;  : - - ;         : 2* 2* ;
   : * * ;         : / / ;
 : dup dup ;     : over over ;  : dup dup ;     : over over ;
 : swap swap ;   : rot rot ;  : swap swap ;   : rot rot ;
   : drop drop ;   : =   = ;
   : lshift lshift ; : 2/ 2/ ;
   : . . ;
   cell constant cell
   
 \ include bug5.fs  \ include bug5.fs
 \ only forth also minimal definitions  \ only forth also minimal definitions

Removed from v.1.7  
changed lines
  Added in v.1.23


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