Diff for /gforth/cross.fs between versions 1.132 and 1.136

version 1.132, 2002/12/28 17:18:26 version 1.136, 2003/01/20 17:07:37
Line 1412  T has? rom H Line 1412  T has? rom H
   
 \ MakeKernel                                                    22feb99jaw  \ MakeKernel                                                    22feb99jaw
   
 : makekernel ( targetsize -- )  : makekernel ( start targetsize -- )
 \G convenience word to setup the memory of the target  \G convenience word to setup the memory of the target
 \G used by main.fs of the c-engine based systems  \G used by main.fs of the c-engine based systems
   100 swap dictionary (region)    dictionary (region) setup-target ;
   setup-target ;  
   
 >MINIMAL  >MINIMAL
 : makekernel makekernel ;  : makekernel makekernel ;
Line 2581  Cond: [ ( -- ) interpreting-state ;Cond Line 2580  Cond: [ ( -- ) interpreting-state ;Cond
   
 Defer instant-interpret-does>-hook  Defer instant-interpret-does>-hook
   
   T has? peephole H [IF]
 : does-resolved ( ghost -- )  : does-resolved ( ghost -- )
     compile does-exec g>xt T a, H ;      compile does-exec g>xt T a, H ;
   [ELSE]
   : does-resolved ( ghost -- )
       g>xt T a, H ;
   [THEN]
   
 : resolve-does>-part ( -- )  : resolve-does>-part ( -- )
 \ resolve words made by builders  \ resolve words made by builders
Line 2930  compile: does-resolved ;compile Line 2934  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 3013  Cond: ?LEAVE    ?leave, ;Cond Line 3023  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 3118  Cond: LOOP 1 ncontrols? loop, ;Cond Line 3128  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 ;

Removed from v.1.132  
changed lines
  Added in v.1.136


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