[gforth] / gforth / prims2x.fs  

gforth: gforth/prims2x.fs

Diff for /gforth/prims2x.fs between version 1.105 and 1.106

version 1.105, Sun Jun 2 10:31:28 2002 UTC version 1.106, Sun Jun 2 15:46:16 2002 UTC
Line 314 
Line 314 
 : 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      ." vm_" r@ item-stack-type-name 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 ." ,"
       r@ item-name 2@ type
  ." );" cr   ." );" cr
  rdrop ;   rdrop ;
   
Line 327 
Line 327 
  ." vm_two"   ." vm_two"
  r@ item-stack-type-name type ." 2"   r@ item-stack-type-name type ." 2"
  r@ item-type @ print-type-prefix ." ("   r@ item-type @ print-type-prefix ." ("
  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
  ." );" cr      ." , " r@ item-name 2@ type
       ." )" cr
  rdrop ;   rdrop ;
   
 : same-as-in? ( item -- f )  : same-as-in? ( item -- f )
Line 356 
Line 356 
   
 : really-store-single ( item -- )  : really-store-single ( item -- )
  >r   >r
  r@ item-out-index r@ item-stack @ stack-access ."  = vm_"      ." vm_"
  r@ item-type @ print-type-prefix ." 2"   r@ item-type @ print-type-prefix ." 2"
  r@ item-stack-type-name type ." ("   r@ item-stack-type-name type ." ("
  r@ item-name 2@ type ." );"      r@ item-name 2@ type ." ,"
       r@ item-out-index r@ item-stack @ stack-access ." );"
  rdrop ;   rdrop ;
   
 : store-single ( item -- )  : store-single ( item -- )
Line 385 
Line 386 
  r@ item-name 2@ 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
  rdrop ;   rdrop ;
   
 : single ( -- xt1 xt2 n )  : single ( -- xt1 xt2 n )
Line 673 
Line 674 
 : disasm-arg { item -- }  : disasm-arg { item -- }
     item item-stack @ inst-stream = if      item item-stack @ inst-stream = if
         ."   fputc(' ', vm_out); "          ."   fputc(' ', vm_out); "
         ." printarg_" item item-type @ print-type-prefix          \ !! change this to first convert args to the right type and
           \ then print them
           ." /* printarg_" item item-type @ print-type-prefix
         ." ((" item item-type @ type-c-name 2@ type ." )"          ." ((" item item-type @ type-c-name 2@ type ." )"
         ." ip[" item item-offset @ 1+ 0 .r ." ]);" cr          ." ip[" item item-offset @ 1+ 0 .r ." ]); */" cr
     endif ;      endif ;
   
 : disasm-args ( -- )  : disasm-args ( -- )
Line 683 
Line 686 
   
 : output-disasm ( -- )  : output-disasm ( -- )
     \ generate code for disassembling VM instructions      \ generate code for disassembling VM instructions
     ." if (ip[0] == prim[" function-number @ 0 .r ." ]) {" cr      ." if (VM_IS_INST(*ip, " function-number @ 0 .r ." )) {" cr
     ."   fputs(" quote prim prim-name 2@ type quote ." , vm_out);" cr      ."   fputs(" quote prim prim-name 2@ type quote ." , vm_out);" cr
     disasm-args      disasm-args
     ."   ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr      ."   ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help