[gforth] / gforth / cross.fs  

gforth: gforth/cross.fs

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

version 1.41, Sun Oct 20 20:35:24 1996 UTC version 1.42, Thu Feb 6 21:22:58 1997 UTC
Line 104 
Line 104 
   
 \ 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 
Line 131 
 >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 
Line 225 
   
 \ 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 
Line 239 
 : 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 
Line 451 
 >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 
Line 489 
 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 
Line 501 
   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 
Line 581 
 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 
Line 603 
 \  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 
Line 630 
   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 
Line 645 
 \ 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 
Line 670 
 >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 
Line 682 
 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 
Line 702 
 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 
Line 719 
   
 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 
Line 914 
 : 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

Generate output suitable for use with a patch program
Legend:
Removed from v.1.41  
changed lines
  Added in v.1.42
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help