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

version 1.1, 1994/02/11 16:30:45 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 412  ghost (do)      ghost (?do) Line 409  ghost (do)      ghost (?do)
 ghost (for)                                     drop  ghost (for)                                     drop
 ghost (loop)    ghost (+loop)                   2drop  ghost (loop)    ghost (+loop)                   2drop
 ghost (next)                                    drop  ghost (next)                                    drop
 ghost unloop    ghost EXIT                      2drop  ghost unloop    ghost ;S                        2drop
 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
Line 481  Cond: [Char]   ( "<char>" -- )  restrict Line 478  Cond: [Char]   ( "<char>" -- )  restrict
   (THeader ;Resolve ! there ;Resolve cell+ !    (THeader ;Resolve ! there ;Resolve cell+ !
   docol, depth T ] H ;    docol, depth T ] H ;
   
   Cond: EXIT ( -- )  restrict?  compile ;S  ;Cond
   
 Cond: ; ( -- ) restrict?  Cond: ; ( -- ) restrict?
                depth ?dup IF   1- <> ABORT" CROSS: Stack changed"                 depth ?dup IF   1- <> ABORT" CROSS: Stack changed"
                           ELSE true ABORT" CROSS: Stack empty" THEN                            ELSE true ABORT" CROSS: Stack empty" THEN
                compile EXIT state off                 compile ;S state off
                ;Resolve @                 ;Resolve @
                IF ;Resolve @ ;Resolve cell+ @ resolve THEN                 IF ;Resolve @ ;Resolve cell+ @ resolve THEN
                ;Cond                 ;Cond
Line 513  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 560  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 769  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.1  
changed lines
  Added in v.1.4


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