[gforth] / gforth / prims2x.fs  

gforth: gforth/prims2x.fs

Diff for /gforth/prims2x.fs between version 1.77 and 1.78

version 1.77, Tue Feb 6 16:53:06 2001 UTC version 1.78, Wed Feb 7 09:58:46 2001 UTC
Line 259 
Line 259 
     item item-stack @ dup >r stack-in @ ( in-size r:stack )      item item-stack @ dup >r stack-in @ ( in-size r:stack )
     item r> stack-in-index-xt @ execute ;      item r> stack-in-index-xt @ execute ;
   
   : item-stack-type-name ( item -- addr u )
       item-stack @ stack-type @ type-c-name 2@ ;
   
 : fetch-single ( item -- )  : fetch-single ( item -- )
  \ fetch a single stack item from its stack   \ fetch a single stack item from its stack
  >r   >r
  r@ item-name 2@ type   r@ item-name 2@ type
  ."  = vm_" r@ item-stack @ stack-type @ type-c-name 2@ type   ."  = vm_" r@ item-stack-type-name type
  ." 2" r@ item-type @ print-type-prefix ." ("   ." 2" r@ item-type @ print-type-prefix ." ("
  r@ item-in-index r@ item-stack @ stack-access   r@ item-in-index r@ item-stack @ stack-access
  ." );" cr   ." );" cr
Line 272 
Line 275 
 : fetch-double ( item -- )  : fetch-double ( item -- )
  \ fetch a double stack item from its stack   \ fetch a double stack item from its stack
  >r   >r
  ." FETCH_DCELL("   ." vm_two"
    r@ item-stack-type-name type ." 2"
    r@ item-type @ print-type-prefix ." ("
  r@ item-name 2@ type ." , "   r@ item-name 2@ type ." , "
  r@ item-in-index r@ item-stack @ 2dup ." (Cell)" stack-access   r@ item-in-index r@ item-stack @ 2dup ." (Cell)" stack-access
  ." , "                      -1 under+ ." (Cell)" stack-access   ." , "                      -1 under+ ." (Cell)" stack-access
Line 304 
Line 309 
  >r   >r
  r@ item-out-index r@ item-stack @ stack-access ."  = vm_"   r@ item-out-index r@ item-stack @ stack-access ."  = vm_"
  r@ item-type @ print-type-prefix ." 2"   r@ item-type @ print-type-prefix ." 2"
  r@ item-stack @ stack-type @ type-c-name 2@ type ." ("   r@ item-stack-type-name type ." ("
  r@ item-name 2@ type ." );"   r@ item-name 2@ type ." );"
  rdrop ;   rdrop ;
   
Line 325 
Line 330 
 : store-double ( item -- )  : store-double ( item -- )
 \ !! store optimization is not performed, because it is not yet needed  \ !! store optimization is not performed, because it is not yet needed
  >r   >r
  ." STORE_DCELL(" r@ item-name 2@ type ." , "   ." vm_"
    r@ item-type @ print-type-prefix ." 2two"
    r@ item-stack-type-name type ." ("
    r@ item-name 2@ type ." , "
  r@ item-out-index r@ item-stack @ 2dup stack-access   r@ item-out-index r@ item-stack @ 2dup stack-access
  ." , "                       -1 under+ stack-access   ." , "                       -1 under+ stack-access
  ." );" cr   ." );" cr

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help