Diff for /gforth/cross.fs between versions 1.30 and 1.44

version 1.30, 1995/11/07 18:06:35 version 1.44, 1997/02/09 21:51:38
Line 91  H Line 91  H
   
 >CROSS  >CROSS
   
   \ Parameter for target systems                         06oct92py
   
   mach-file count included
   
   also Forth definitions
   
   [IFDEF] asm-include asm-include [THEN]
   
   previous
   
   >CROSS
   
 \ Variables                                            06oct92py  \ Variables                                            06oct92py
   
 -1 Constant NIL  
 Variable image  Variable image
 Variable tlast    NIL tlast !  \ Last name field  Variable tlast    NIL tlast !  \ Last name field
 Variable tlastcfa \ Last code field  Variable tlastcfa \ Last code field
Line 102  Variable bit$ Line 113  Variable bit$
 Variable tdp  Variable tdp
 : there  tdp @ ;  : there  tdp @ ;
   
 \ Parameter for target systems                         06oct92py  
   
 included  
   
 \ Create additional parameters                         19jan95py  \ Create additional parameters                         19jan95py
   
 T  T
Line 131  H Line 138  H
 >TARGET  >TARGET
 20 CONSTANT bl  20 CONSTANT bl
 -1 Constant NIL  -1 Constant NIL
 -2 Constant :docol  
 -3 Constant :docon  
 -4 Constant :dovar  
 -5 Constant :douser  
 -6 Constant :dodefer  
 -7 Constant :dofield  
 -8 Constant :dodoes  
 -9 Constant :doesjump  
   
 >CROSS  >CROSS
   
Line 173  bigendian Line 172  bigendian
 \ MakeKernal                                           12dec92py  \ MakeKernal                                           12dec92py
   
 >MINIMAL  >MINIMAL
 : makekernal ( targetsize -- targetsize )  : makekernel ( targetsize -- targetsize )
   bit$  over 1- cell>bit rshift 1+ initmem    bit$  over 1- cell>bit rshift 1+ initmem
   image over initmem tdp off ;    image over initmem tdp off ;
   
Line 194  CREATE Bittable 80 c, 40 c, 20 c, 10 c, Line 193  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 )  : cfalign+  ( taddr -- rest )
     \ see kernal.fs:cfaligned      \ see kernel.fs:cfaligned
     float tuck 1- and - [ float 1- ] Literal and ;      /maxalign tuck 1- and - [ /maxalign 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 )  : cfaligned ( taddr1 -- taddr2 )
     \ see kernal.fs      \ see kernel.fs
     dup cfalign+ + ;      dup cfalign+ + ;
   
 >CROSS  >CROSS
Line 233  CREATE Bittable 80 c, 40 c, 20 c, 10 c, Line 232  CREATE Bittable 80 c, 40 c, 20 c, 10 c,
   
 \ threading modell                                     13dec92py  \ threading modell                                     13dec92py
   
 \ generic threading modell  
 : docol,  ( -- ) :docol T A, 0 , H ;  
   
 >TARGET  >TARGET
 : >body   ( cfa -- pfa ) T cell+ cell+ H ;  : >body   ( cfa -- pfa ) T cell+ cell+ H ;
 >CROSS  >CROSS
   
 : dodoes, ( -- ) T :doesjump A, 0 , H ;  
   
 \ Ghost Builder                                        06oct92py  \ Ghost Builder                                        06oct92py
   
 \ <T T> new version with temp variable                 10may93jaw  \ <T T> new version with temp variable                 10may93jaw
Line 252  VARIABLE VocTemp Line 246  VARIABLE VocTemp
 : T>  previous VocTemp @ set-current ;  : T>  previous VocTemp @ set-current ;
   
 4711 Constant <fwd>             4712 Constant <res>  4711 Constant <fwd>             4712 Constant <res>
 4713 Constant <imm>  4713 Constant <imm>             4714 Constant <do:>
   
 \ iForth makes only immediate directly after create  \ iForth makes only immediate directly after create
 \ make atonce trick! ?  \ make atonce trick! ?
Line 263  Variable atonce atonce off Line 257  Variable atonce atonce off
   
 : GhostHeader <fwd> , 0 , ['] NoExec , ;  : GhostHeader <fwd> , 0 , ['] NoExec , ;
   
 : >magic ; : >link cell+ ; : >exec cell+ cell+ ;  : >magic ;
   : >link cell+ ;
   : >exec cell+ cell+ ;
 : >end 3 cells + ;  : >end 3 cells + ;
   
 Variable last-ghost  Variable last-ghost
Line 278  Variable last-ghost Line 274  Variable last-ghost
   
 : gfind   ( string -- ghost true/1 / string false )  : gfind   ( string -- ghost true/1 / string false )
 \ 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  
   dup count [ ' ghosts >body ] ALiteral search-wordlist    dup count [ ' ghosts >body ] ALiteral search-wordlist
   dup IF  >r >body nip r>  THEN ;    dup IF >r >body nip r>  THEN ;
   
 VARIABLE Already  VARIABLE Already
   
Line 357  variable ResolveFlag Line 352  variable ResolveFlag
 VARIABLE ^imm  VARIABLE ^imm
   
 >TARGET  >TARGET
 : immediate     20 flag!  : immediate     40 flag!
                 ^imm @ @ dup <imm> = IF  drop  EXIT  THEN                  ^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      40 flag! ;  : restrict      20 flag! ;
 >CROSS  >CROSS
   
 \ ALIAS2 ansforth conform alias                          9may93jaw  \ ALIAS2 ansforth conform alias                          9may93jaw
Line 382  VARIABLE ^imm Line 377  VARIABLE ^imm
 s" crossdoc.fd" r/w create-file throw value doc-file-id  s" 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
   
 : \G ( -- )  : T-\G ( -- )
     source >in @ /string doc-file-id write-line throw      source >in @ /string doc-file-id write-line throw
     source >in ! drop ; immediate      postpone \ ;
   
 Variable to-doc  Variable to-doc  to-doc on
   
 : cross-doc-entry  ( -- )  : cross-doc-entry  ( -- )
     to-doc @ tlast @ 0<> and    \ not an anonymous (i.e. noname) header      to-doc @ tlast @ 0<> and    \ not an anonymous (i.e. noname) header
Line 399  Variable to-doc Line 394  Variable to-doc
         [char] ) parse doc-file-id write-file throw          [char] ) parse doc-file-id write-file throw
         s"  )" doc-file-id write-file throw          s"  )" doc-file-id write-file throw
         [char] \ parse 2drop                                              [char] \ parse 2drop                                    
         POSTPONE \g          T-\G
         >in !          >in !
     THEN  to-doc on ;      THEN ;
   
 \ Target TAGS creation  \ Target TAGS creation
   
 s" TAGS" r/w create-file throw value tag-file-id  s" kernel.TAGS" r/w create-file throw value tag-file-id
 \ contains the file-id of the tags file  \ contains the file-id of the tags file
   
 Create tag-beg 2 c,  7F c, bl c,  Create tag-beg 2 c,  7F c, bl c,
Line 418  Create tag-bof 1 c,  0C c, Line 413  Create tag-bof 1 c,  0C c,
     loadfilename 2@ last-loadfilename 2@ d<>      loadfilename 2@ last-loadfilename 2@ d<>
     IF      IF
         tag-bof count tag-file-id write-line throw          tag-bof count tag-file-id write-line throw
         loadfilename 2@ 2dup          sourcefilename 2dup
         tag-file-id write-file throw          tag-file-id write-file throw
         last-loadfilename 2!          last-loadfilename 2!
         s" ,0" tag-file-id write-line throw          s" ,0" tag-file-id write-line throw
Line 432  Create tag-bof 1 c,  0C c, Line 427  Create tag-bof 1 c,  0C c,
         tag-beg count tag-file-id write-file throw          tag-beg count tag-file-id write-file throw
         tlast @ >image count $1F and tag-file-id write-file throw          tlast @ >image count $1F and tag-file-id write-file throw
         tag-end count tag-file-id write-file throw          tag-end count tag-file-id write-file throw
         base @ decimal loadline @ 0 <# #s #> tag-file-id write-file throw          base @ decimal sourceline# 0 <# #s #> tag-file-id write-file throw
 \       >in @ 0 <# #s [char] , hold #> tag-file-id write-line throw  \       >in @ 0 <# #s [char] , hold #> tag-file-id write-line throw
         s" ,0" tag-file-id write-line throw          s" ,0" tag-file-id write-line throw
         base !          base !
     THEN ;      THEN ;
   
   \ Check for words
   
   Defer skip? ' false IS skip?
   
   : defined? ( -- flag ) \ name
       ghost >magic @ <fwd> <> ;
   
   : needed? ( -- flag ) \ name
       ghost dup >magic @ <fwd> =
       IF  >link @ 0<>  ELSE  drop false  THEN ;
   
   : doer? ( -- flag ) \ name
       ghost >magic @ <do:> = ;
   
   : skip-defs ( -- )
       BEGIN  refill  WHILE  source -trailing nip 0= UNTIL  THEN ;
   
 \ Target header creation  \ Target header creation
   
 VARIABLE CreateFlag CreateFlag off  VARIABLE CreateFlag CreateFlag off
   
 : (Theader ( "name" -- ghost ) T align H view,  : (Theader ( "name" -- ghost )
   \  >in @ bl word count type 2 spaces >in !
     T align H view,
   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
Line 464  VARIABLE ;Resolve 1 cells allot Line 478  VARIABLE ;Resolve 1 cells allot
   
 >TARGET  >TARGET
 : Alias    ( cfa -- ) \ name  : Alias    ( cfa -- ) \ name
   dup 0< IF  to-doc off  THEN      >in @ skip? IF  2drop  EXIT  THEN  >in !
   (THeader over resolve T A, H 80 flag! ;      dup 0< has-prims 0= and
       IF
           ." needs prim: " >in @ bl word count type >in ! cr
       THEN
       (THeader over resolve T A, H 80 flag! ;
   : Alias:   ( cfa -- ) \ name
       >in @ skip? IF  2drop  EXIT  THEN  >in !
       dup 0< has-prims 0= and
       IF
           ." needs doer: " >in @ bl word count type >in ! cr
       THEN
       ghost tuck swap resolve <do:> swap >magic ! ;
 >CROSS  >CROSS
   
 \ Conditionals and Comments                            11may93jaw  \ Conditionals and Comments                            11may93jaw
Line 501  ghost unloop    ghost ;S Line 526  ghost unloop    ghost ;S
 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 '  ghost '                                         drop
   ghost :docol    ghost :doesjump ghost :dodoes   2drop drop
   
 \ compile                                              10may93jaw  \ compile                                              10may93jaw
   
Line 513  ghost ' Line 539  ghost '
   ELSE  postpone literal postpone gexecute  THEN ;    ELSE  postpone literal postpone gexecute  THEN ;
                                         immediate                                          immediate
   
   \ generic threading modell
   : docol,  ( -- ) compile :docol T 0 , H ;
   
   : dodoes, ( -- ) compile :doesjump T 0 , H ;
   
   [IFUNDEF] (code) 
   Defer (code)
   Defer (end-code)
   [THEN]
   
 >TARGET  >TARGET
   : Code
       (THeader there resolve
       there 2 T cells H + T a, 0 , H
       depth (code) ;
   
   : Code:
       ghost dup there resolve  <do:> swap >magic !
       depth (code) ;
   
   : end-code
       depth ?dup IF   1- <> ABORT" CROSS: Stack changed"
       ELSE true ABORT" CROSS: Stack empty" THEN
       (end-code) ;
                  
 : '  ( -- cfa ) bl word 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 @ ;
   
Line 528  Cond: chars ;Cond Line 578  Cond: chars ;Cond
 : alit, ( n -- )  compile lit T A,  H ;  : alit, ( n -- )  compile lit T A,  H ;
   
 >TARGET  >TARGET
   Cond: \G  T-\G ;Cond
   
 Cond:  Literal ( n -- )   restrict? lit, ;Cond  Cond:  Literal ( n -- )   restrict? lit, ;Cond
 Cond: ALiteral ( n -- )   restrict? alit, ;Cond  Cond: ALiteral ( n -- )   restrict? alit, ;Cond
   
 : Char ( "<char>" -- )  bl word char+ c@ ;  : Char ( "<char>" -- )  bl word char+ c@ ;
 Cond: [Char]   ( "<char>" -- )  restrict? Char  lit, ;Cond  Cond: [Char]   ( "<char>" -- )  restrict? Char  lit, ;Cond
   
   \ some special literals                                 27jan97jaw
   
   Cond: MAXU
    restrict? compile lit 
    tcell 0 ?DO FF T c, H LOOP ;Cond
   
   Cond: MINI
    restrict? compile lit
    bigendian 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
    THEN
    ;Cond
    
   Cond: MAXI
    restrict? compile lit
    bigendian 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
    THEN
    ;Cond
   
 >CROSS  >CROSS
 \ Target compiling loop                                12dec92py  \ Target compiling loop                                12dec92py
 \ ">tib trick thrown out                               10may93jaw  \ ">tib trick thrown out                               10may93jaw
Line 566  Cond: [Char]   ( "<char>" -- )  restrict Line 642  Cond: [Char]   ( "<char>" -- )  restrict
 \             is not allowed if a system should be ans conform  \             is not allowed if a system should be ans conform
   
 : : ( -- colon-sys ) \ Name  : : ( -- colon-sys ) \ Name
     >in @ skip? IF  drop skip-defs  EXIT  THEN  >in !
   (THeader ;Resolve ! there ;Resolve cell+ !    (THeader ;Resolve ! there ;Resolve cell+ !
   docol, depth T ] H ;    docol, depth T ] H ;
   
   : :noname ( -- colon-sys )
     T align H there docol, depth T ] H ;
   
 Cond: EXIT ( -- )  restrict?  compile ;S  ;Cond  Cond: EXIT ( -- )  restrict?  compile ;S  ;Cond
   
 Cond: ?EXIT ( -- ) 1 abort" CROSS: using ?exit" ;Cond  Cond: ?EXIT ( -- ) 1 abort" CROSS: using ?exit" ;Cond
Line 583  Cond: ; ( -- ) restrict? Line 663  Cond: ; ( -- ) restrict?
 Cond: [  restrict? state off ;Cond  Cond: [  restrict? state off ;Cond
   
 >CROSS  >CROSS
 : !does  :dodoes tlastcfa @ tuck T ! cell+ ! H ;  : !does
       tlastcfa @ dup there >r tdp ! compile :dodoes r> tdp ! T cell+ ! H ;
   
 >TARGET  >TARGET
 Cond: DOES> restrict?  Cond: DOES> restrict?
Line 604  Cond: DOES> restrict? Line 685  Cond: DOES> restrict?
 \  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
   :dodoes T A, H gexecute T here H cell - reloff ;          dup >magic @ <do:> =
           IF  gexecute T 0 , H  EXIT THEN
       THEN
       compile :dodoes gexecute T here H cell - reloff ;
   
 : TCreate ( -- )  : TCreate ( -- )
   last-ghost @    last-ghost @
Line 628  Cond: DOES> restrict? Line 712  Cond: DOES> restrict?
   here ghostheader    here ghostheader
   :noname postpone gdoes> postpone ?EXIT ;    :noname postpone gdoes> postpone ?EXIT ;
   
   : by:     ( -- addr [xt] [colon-sys] ) \ name
     ghost
     :noname postpone gdoes> postpone ?EXIT ;
   
 : ;DO ( addr [xt] [colon-sys] -- )  : ;DO ( addr [xt] [colon-sys] -- )
   postpone ;    ( S addr xt )    postpone ;    ( S addr xt )
   over >exec ! ; immediate    over >exec ! ; immediate
Line 639  Cond: DOES> restrict? Line 727  Cond: DOES> restrict?
 \ Variables and Constants                              05dec92py  \ Variables and Constants                              05dec92py
   
 Build:  ;  Build:  ;
 DO: ( ghost -- addr ) ;DO  by: :dovar ( ghost -- addr ) ;DO
 Builder Create  Builder Create
 by Create :dovar resolve  
   
 Build: T 0 , H ;  Build: T 0 , H ;
 by Create  by Create
Line 665  Variable tudp 0 tudp ! Line 752  Variable tudp 0 tudp !
 >TARGET  >TARGET
   
 Build: T 0 u, , H ;  Build: T 0 u, , H ;
 DO: ( ghost -- up-addr )  T @ H tup @ + ;DO  by: :douser ( ghost -- up-addr )  T @ H tup @ + ;DO
 Builder User  Builder User
 by User :douser resolve  
   
 Build: T 0 u, , 0 u, drop H ;  Build: T 0 u, , 0 u, drop H ;
 by User  by User
Line 677  Build: T 0 au, , H ; Line 763  Build: T 0 au, , H ;
 by User  by User
 Builder AUser  Builder AUser
   
   Build:  ( n -- ) ;
   by: :docon ( ghost -- n ) T @ H ;DO
   Builder (Constant)
   
 Build:  ( n -- ) T , H ;  Build:  ( n -- ) T , H ;
 DO: ( ghost -- n ) T @ H ;DO  by (Constant)
 Builder Constant  Builder Constant
 by Constant :docon resolve  
   
 Build:  ( n -- ) T A, H ;  Build:  ( n -- ) T A, H ;
 by Constant  by (Constant)
 Builder AConstant  Builder AConstant
   
 Build:  ( d -- ) T , , H ;  Build:  ( d -- ) T , , H ;
Line 691  DO: ( ghost -- d ) T dup cell+ @ swap @ Line 780  DO: ( ghost -- d ) T dup cell+ @ swap @
 Builder 2Constant  Builder 2Constant
   
 Build: T 0 , H ;  Build: T 0 , H ;
 by Constant  by (Constant)
 Builder Value  Builder Value
   
   Build: T 0 A, H ;
   by (Constant)
   Builder AValue
   
 Build:  ( -- ) compile noop ;  Build:  ( -- ) compile noop ;
 DO: ( ghost -- ) ABORT" CROSS: Don't execute" ;DO  by: :dodefer ( ghost -- ) ABORT" CROSS: Don't execute" ;DO
 Builder Defer  Builder Defer
 by Defer :dodefer resolve  
   Build:  ( inter comp -- ) swap T immediate A, A, H ;
   DO: ( ghost -- ) ABORT" CROSS: Don't execute" ;DO
   Builder interpret/compile:
   
 \ Sturctures                                           23feb95py  \ Sturctures                                           23feb95py
   
Line 707  by Defer :dodefer resolve Line 803  by Defer :dodefer resolve
  1- tuck +  swap invert and ;   1- tuck +  swap invert and ;
 >TARGET  >TARGET
   
   Build: ;
   by: :dofield T @ H + ;DO
   Builder (Field)
   
 Build:  >r rot r@ nalign  dup T , H  ( align1 size offset )  Build:  >r rot r@ nalign  dup T , H  ( align1 size offset )
         + swap r> nalign ;          + swap r> nalign ;
 DO: T @ H + ;DO  by (Field)
 Builder Field  Builder Field
 by Field :dofield resolve  
   
 : struct  T 0 1 chars H ;  : struct  T 0 1 chars H ;
 : end-struct  T 2Constant H ;  : end-struct  T 2Constant H ;
Line 831  also minimal Line 930  also minimal
   
 \ define new [IFDEF] and [IFUNDEF]                      20may93jaw  \ define new [IFDEF] and [IFUNDEF]                      20may93jaw
   
 : there? bl word gfind IF >magic @ <fwd> <> ELSE drop false THEN ;  : defined? defined? ;
   : needed? needed? ;
   : doer? doer? ;
   
 : [IFDEF] there? postpone [IF] ;  : [IFDEF] defined? postpone [IF] ;
 : [IFUNDEF] there? 0= postpone [IF] ;  : [IFUNDEF] defined? 0= postpone [IF] ;
   
 \ C: \- \+ Conditional Compiling                         09jun93jaw  \ C: \- \+ Conditional Compiling                         09jun93jaw
   
 : C: >in @ there? 0=  : C: >in @ defined? 0=
      IF    >in ! T : H       IF    >in ! T : H
      ELSE drop       ELSE drop
         BEGIN bl word dup c@          BEGIN bl word dup c@
Line 850  also minimal Line 951  also minimal
   
 also minimal  also minimal
   
 : \- there? IF postpone \ THEN ;  : \- defined? IF postpone \ THEN ;
 : \+ there? 0= IF postpone \ THEN ;  : \+ defined? 0= IF postpone \ THEN ;
   
 : [IF]   postpone [IF] ;  : [IF]   postpone [IF] ;
 : [THEN] postpone [THEN] ;  : [THEN] postpone [THEN] ;
Line 873  Cond: [ELSE]    [ELSE] ;Cond Line 974  Cond: [ELSE]    [ELSE] ;Cond
   
 bigendian Constant bigendian  bigendian Constant bigendian
   
 Create magic  s" gforth00" here over allot swap move  Create magic  s" Gforth10" here over allot swap move
   
 [char] 1 bigendian + cell + magic 7 + c!  char 1 bigendian + cell + magic 7 + c!
   
 : save-cross ( "name" -- )  : save-cross ( "image-name" "binary-name" -- )
   bl parse ." Saving to " 2dup type    bl parse ." Saving to " 2dup type cr
   w/o bin create-file throw >r    w/o bin create-file throw >r
   magic 8       r@ write-file throw \ write magic    NIL IF
         s" #! "   r@ write-file throw
         bl parse  r@ write-file throw
         s"  -i"   r@ write-file throw
         #lf       r@ emit-file throw
         r@ dup file-position throw drop 8 mod 8 swap ( file-id limit index )
         ?do
             bl over emit-file throw
         loop
         drop
         magic 8       r@ write-file throw \ write magic
     ELSE
         bl parse 2drop
     THEN
   image @ there r@ write-file throw \ write image    image @ there r@ write-file throw \ write image
   bit$  @ there 1- cell>bit rshift 1+    NIL IF
         bit$  @ there 1- cell>bit rshift 1+
                 r@ write-file throw \ write tags                  r@ write-file throw \ write tags
     THEN
   r> close-file throw ;    r> close-file throw ;
   
 \ words that should be in minimal  \ words that should be in minimal
   
 : + + ;         : 1- 1- ;  : here there ;
 : - - ;         : 2* 2* ;  also forth [IFDEF] Label : Label Label ; [THEN] previous
 : * * ;         : / / ;  : + + ;
 : dup dup ;     : over over ;  : or or ;
 : swap swap ;   : rot rot ;  : 1- 1- ;
 : drop drop ;   : =   = ;  : - - ;
 : lshift lshift ; : 2/ 2/ ;  : 2* 2* ;
   : * * ;
   : / / ;
   : dup dup ;
   : over over ;
   : swap swap ;
   : rot rot ;
   : drop drop ;
   : =   = ;
   : 0=   0= ;
   : lshift lshift ;
   : 2/ 2/ ;
 : . . ;  : . . ;
 cell constant cell  
   
 \ include bug5.fs  mach-file count included
 \ only forth also minimal definitions  
   
 : \  postpone \ ;  : all-words    ['] false    IS skip? ;
 : \G postpone \G ;  : needed-words ['] needed?  IS skip? ;
 : (  postpone ( ;  : undef-words  ['] defined? IS skip? ;
   
   : \  postpone \ ;  immediate
   : (  postpone ( ;  immediate
 : include bl word count included ;  : include bl word count included ;
 : .( [char] ) parse type ;  : .( [char] ) parse type ;
 : cr cr ;  : cr cr ;
Line 917  only forth also minimal definitions Line 1045  only forth also minimal definitions
 : hex           hex ;  : hex           hex ;
   
 : tudp          T tudp H ;  : tudp          T tudp H ;
 : tup           T tup H ;  minimal  : tup           T tup H ;
   
   : doc-off       false T to-doc H ! ;
   : doc-on        true  T to-doc H ! ;
   
   minimal
   
 \ for debugging...  \ for debugging...
 : order         order ;  : order         order ;

Removed from v.1.30  
changed lines
  Added in v.1.44


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