Diff for /gforth/cross.fs between versions 1.2 and 1.4

version 1.2, 1994/05/03 15:24:11 version 1.4, 1994/05/18 17:29:50
Line 117  Variable bit$ Line 117  Variable bit$
 Variable tdp  Variable tdp
 : there  tdp @ ;  : there  tdp @ ;
   
 \ Constants                                            06apr93py  
   
 -2 Constant :docol  
 -3 Constant :docon  
 -4 Constant :dovar  
 -5 Constant :dodoes  
   
 \ Parameter for target systems                         06oct92py  \ Parameter for target systems                         06oct92py
   
 include machine.fs  include machine.fs
Line 144  include machine.fs Line 137  include machine.fs
 -2 Constant :docol  -2 Constant :docol
 -3 Constant :docon  -3 Constant :docon
 -4 Constant :dovar  -4 Constant :dovar
 -5 Constant :dodoes  -5 Constant :douser
   -6 Constant :dodoes
   -7 Constant :doesjump
   
 >CROSS  >CROSS
   
Line 186  CREATE Bittable 80 c, 40 c, 20 c, 10 c, Line 181  CREATE Bittable 80 c, 40 c, 20 c, 10 c,
   
 : >bit ( addr n -- c-addr mask ) 8 /mod rot + swap bits ;  : >bit ( addr n -- c-addr mask ) 8 /mod rot + swap bits ;
 : +bit ( addr n -- )  >bit over c@ or swap c! ;  : +bit ( addr n -- )  >bit over c@ or swap c! ;
   : -bit ( addr n -- )  >bit invert over c@ and swap c! ;
 : relon ( taddr -- )  bit$ @ swap cell/ +bit ;  : relon ( taddr -- )  bit$ @ swap cell/ +bit ;
   : reloff ( taddr -- )  bit$ @ swap cell/ -bit ;
   
 \ Target memory access                                 06oct92py  \ Target memory access                                 06oct92py
   
Line 228  CREATE Bittable 80 c, 40 c, 20 c, 10 c, Line 225  CREATE Bittable 80 c, 40 c, 20 c, 10 c,
 : >body   ( cfa -- pfa ) T cell+ cell+ H ;  : >body   ( cfa -- pfa ) T cell+ cell+ H ;
 >CROSS  >CROSS
   
 : dodoes, ( -- ) T 0 , 0 , H ;  : dodoes, ( -- ) T :doesjump A, 0 , H ;
   
 \ Ghost Builder                                        06oct92py  \ Ghost Builder                                        06oct92py
   
Line 515  Cond: DOES> restrict? Line 512  Cond: DOES> restrict?
   
 : 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 ;    :dodoes T A, H gexecute T here H cell - reloff ;
   
 : TCreate ( ghost -- )  : TCreate ( ghost -- )
   CreateFlag on    CreateFlag on
Line 562  Build: T 0 A, H ; Line 559  Build: T 0 A, H ;
 by Create  by Create
 Builder AVariable  Builder AVariable
   
 Build: T 0 , H ;  \ User variables                                       04may94py
 by Create  
   >CROSS
   Variable tup  0 tup !
   Variable tudp 0 tudp !
   : u,  ( n -- udp )
     tup @ tudp @ + T  ! H
     tudp @ dup cell+ tudp ! ;
   : au, ( n -- udp )
     tup @ tudp @ + T A! H
     tudp @ dup cell+ tudp ! ;
   >TARGET
   
   Build: T 0 u, , H ;
   DO: ( ghost -- up-addr )  T @ H tup @ + ;DO
 Builder User  Builder User
   by User :douser resolve
   
 Build: T 0 , 0 , H ;  Build: T 0 u, , 0 u, drop H ;
 by Create  by User
 Builder 2User  Builder 2User
   
 Build: T 0 A, H ;  Build: T 0 au, , H ;
 by Create  by User
 Builder AUser  Builder AUser
   
 Build:  ( n -- ) T , H ;  Build:  ( n -- ) T , H ;
Line 771  only forth also minimal definitions Line 782  only forth also minimal definitions
 : decimal       decimal ;  : decimal       decimal ;
 : hex           hex ;  : hex           hex ;
   
   : tudp          T tudp H ;
   : tup           T tup H ;  minimal
   
 \ for debugging...  \ for debugging...
 : order         order ;  : order         order ;

Removed from v.1.2  
changed lines
  Added in v.1.4


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