Diff for /gforth/cross.fs between versions 1.41 and 1.42

version 1.41, 1996/10/20 20:35:24 version 1.42, 1997/02/06 21:22:58
Line 104  Variable tdp Line 104  Variable tdp
   
 \ Parameter for target systems                         06oct92py  \ Parameter for target systems                         06oct92py
   
 included  mach-file count included
   
 \ Create additional parameters                         19jan95py  \ Create additional parameters                         19jan95py
   
Line 131  H Line 131  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 233  CREATE Bittable 80 c, 40 c, 20 c, 10 c, Line 225  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 239  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 464  VARIABLE ;Resolve 1 cells allot Line 451  VARIABLE ;Resolve 1 cells allot
 >TARGET  >TARGET
 : Alias    ( cfa -- ) \ name  : Alias    ( cfa -- ) \ name
   (THeader over resolve T A, H 80 flag! ;    (THeader over resolve T A, H 80 flag! ;
   : Alias:   ( cfa -- ) \ name
     ghost tuck swap resolve <do:> swap >magic ! ;
 >CROSS  >CROSS
   
 \ Conditionals and Comments                            11may93jaw  \ Conditionals and Comments                            11may93jaw
Line 500  ghost lit       ghost (compile) ghost ! Line 489  ghost lit       ghost (compile) ghost !
 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
   
 \ compile                                              10may93jaw  \ compile                                              10may93jaw
   
Line 511  ghost ' Line 501  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 ;
   
 >TARGET  >TARGET
 : '  ( -- 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 586  Cond: ; ( -- ) restrict? Line 581  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 607  Cond: DOES> restrict? Line 603  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 631  Cond: DOES> restrict? Line 630  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 642  Cond: DOES> restrict? Line 645  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 668  Variable tudp 0 tudp ! Line 670  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 681  by User Line 682  by User
 Builder AUser  Builder AUser
   
 Build:  ( n -- ) T , H ;  Build:  ( n -- ) T , H ;
 DO: ( ghost -- n ) T @ H ;DO  by: :docon ( ghost -- n ) T @ H ;DO
 Builder Constant  Builder Constant
 by Constant :docon resolve  
   
 Build:  ( n -- ) T A, H ;  Build:  ( n -- ) T A, H ;
 by Constant  by Constant
Line 702  by Constant Line 702  by Constant
 Builder AValue  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 ;  Build:  ( inter comp -- ) swap T immediate A, A, H ;
 DO: ( ghost -- ) ABORT" CROSS: Don't execute" ;DO  DO: ( ghost -- ) ABORT" CROSS: Don't execute" ;DO
Line 720  Builder interpret/compile: Line 719  Builder interpret/compile:
   
 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: :dofield T @ H + ;DO
 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 916  char 1 bigendian + cell + magic 7 + c! Line 914  char 1 bigendian + cell + magic 7 + c!
 : drop drop ;   : =   = ;  : drop drop ;   : =   = ;
 : lshift lshift ; : 2/ 2/ ;  : lshift lshift ; : 2/ 2/ ;
 : . . ;  : . . ;
 cell constant cell  \ cell constant cell
   
   mach-file count included
   
 \ include bug5.fs  \ include bug5.fs
 \ only forth also minimal definitions  \ only forth also minimal definitions

Removed from v.1.41  
changed lines
  Added in v.1.42


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