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

version 1.77, 2001/02/06 16:53:06 version 1.78, 2001/02/07 09:58:46
Line 259  Variable function-number 0 function-numb Line 259  Variable function-number 0 function-numb
     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  Variable function-number 0 function-numb Line 275  Variable function-number 0 function-numb
 : 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  Variable function-number 0 function-numb Line 309  Variable function-number 0 function-numb
  >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  Variable function-number 0 function-numb Line 330  Variable function-number 0 function-numb
 : 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

Removed from v.1.77  
changed lines
  Added in v.1.78


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