[BACK]Return to cross.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/cross.fs between versions 1.130 and 1.133

version 1.130, 2002/12/14 17:34:12 version 1.133, 2003/01/01 17:28:29
Line 2270  Defer setup-prim-semantics Line 2270  Defer setup-prim-semantics
   
 Variable prim#  Variable prim#
 : first-primitive ( n -- )  prim# ! ;  : first-primitive ( n -- )  prim# ! ;
   : group 0 word drop prim# @ 1- -$200 and prim# ! ;
 : Primitive  ( -- ) \ name  : Primitive  ( -- ) \ name
   >in @ skip? IF  drop  EXIT  THEN  >in !    >in @ skip? IF  drop  EXIT  THEN  >in !
   s" prims" T $has? H 0=    s" prims" T $has? H 0=
Line 2929  compile: does-resolved ;compile Line 2930  compile: does-resolved ;compile
   
 : >mark       ( -- sys )        T here  ( dup ." M" hex. ) 0 , H ;  : >mark       ( -- sys )        T here  ( dup ." M" hex. ) 0 , H ;
   
 : branchoffset ( src dest -- )  - tchar / ; \ ?? jaw  X has? abranch [IF]
       : branchoffset ( src dest -- )  drop ;
       : offset, ( n -- )  X A, ;
   [ELSE]
       : branchoffset ( src dest -- )  - tchar / ; \ ?? jaw
       : offset, ( n -- )  X , ;
   [THEN]
   
 :noname compile branch X here branchoffset X , ;  :noname compile branch X here branchoffset offset, ;
   IS branch, ( target-addr -- )    IS branch, ( target-addr -- )
 :noname compile ?branch X here branchoffset X , ;  :noname compile ?branch X here branchoffset offset, ;
   IS ?branch, ( target-addr -- )    IS ?branch, ( target-addr -- )
 :noname compile branch T here 0 , H ;  :noname compile branch T here 0 H offset, ;
   IS branchmark, ( -- branchtoken )    IS branchmark, ( -- branchtoken )
 :noname compile ?branch T here 0 , H ;  :noname compile ?branch T here 0 H offset, ;
   IS ?branchmark, ( -- branchtoken )    IS ?branchmark, ( -- branchtoken )
 :noname T here 0 , H ;  :noname T here 0 H offset, ;
   IS ?domark, ( -- branchtoken )    IS ?domark, ( -- branchtoken )
 :noname dup X @ ?struc X here over branchoffset swap X ! ;  :noname dup X @ ?struc X here over branchoffset swap X ! ;
   IS branchtoresolve, ( branchtoken -- )    IS branchtoresolve, ( branchtoken -- )
Line 3012  Cond: ?LEAVE    ?leave, ;Cond Line 3019  Cond: ?LEAVE    ?leave, ;Cond
   
 : loop] ( target-addr -- )  : loop] ( target-addr -- )
   branchto,     branchto, 
   dup   X here branchoffset X ,     dup   X here branchoffset offset, 
   tcell - (done) ;    tcell - (done) ;
   
 : skiploop] ?dup IF branchto, branchtoresolve, THEN ;  : skiploop] ?dup IF branchto, branchtoresolve, THEN ;
Line 3117  Cond: LOOP 1 ncontrols? loop, ;Cond Line 3124  Cond: LOOP 1 ncontrols? loop, ;Cond
 Cond: +LOOP     1 ncontrols? +loop, ;Cond  Cond: +LOOP     1 ncontrols? +loop, ;Cond
 Cond: NEXT      1 ncontrols? next, ;Cond  Cond: NEXT      1 ncontrols? next, ;Cond
   
 \ Absoulte branches                                     26sep02jaw  
   
 \ This section defined different semantics for  
 \ conditionals, using and compiling absolute branches  
   
 X has? abranch [IF]  
   
 Ghost abranch drop  
 Ghost a?branch drop  
 Ghost a(?do) drop  
 Ghost a(do) drop  
 Ghost a(next) drop  
 Ghost a(+loop) drop  
 Ghost a(loop) drop  
   
 :noname compile abranch X a, ;             plugin-of branch,  
   
 :noname compile a?branch X a, ;            plugin-of ?branch,  
   
 :noname compile abranch T here 0  a, H ;   plugin-of branchmark,  
   
 :noname compile a?branch T here 0 a, H ;   plugin-of ?branchmark,  
   
 :noname   
   dup X @ ABORT" CROSS: branch already resolved"  
   X here swap X a! ;                       plugin-of branchtoresolve,  
   
 :noname   
   0 compile a(?do) ?domark, (leave)  
   branchtomark, 2 to1 ;                    plugin-of ?do,  
   
 : aloop] ( target-addr -- )  
   branchto,   
   dup X a,   
   tcell - (done) ;  
   
 :noname   
   1to compile a(loop) aloop]   
   compile unloop skiploop] ;               plugin-of loop,  
   
 :noname   
   1to compile a(+loop) aloop]  
   compile unloop skiploop] ;               plugin-of +loop,  
   
 :noname  
   compile a(next) aloop] compile unloop ;   plugin-of next,  
   
 [THEN]  
   
 \ String words                                         23feb93py  \ String words                                         23feb93py
   
 : ,"            [char] " parse ht-string, X align ;  : ,"            [char] " parse ht-string, X align ;
Line 3229  Cond: postpone ( -- ) \ name Line 3187  Cond: postpone ( -- ) \ name
 hex  hex
   
 >CROSS  >CROSS
 Create magic  s" Gforth2x" here over allot swap move  Create magic  s" Gforth3x" here over allot swap move
   
 bigendian 1+ \ strangely, in magic big=0, little=1  bigendian 1+ \ strangely, in magic big=0, little=1
 tcell 1 = 0 and or  tcell 1 = 0 and or
Line 3718  previous Line 3676  previous
 : bye           bye ;  : bye           bye ;
   
 \ dummy  \ dummy
 : group 0 word drop ;  
   
 \ turnkey direction  \ turnkey direction
 : H forth ; immediate  : H forth ; immediate
Removed from v.1.130  
changed lines
  Added in v.1.133

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