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

Diff for /gforth/prims2x.fs between versions 1.88 and 1.91

version 1.88, 2001/03/01 14:27:22 version 1.91, 2001/03/18 10:33:25
Line 585  s" IP" save-mem w s" error don't use # o Line 585  s" IP" save-mem w s" error don't use # o
 : stores ( -- )  : stores ( -- )
     prim prim-effect-out prim prim-effect-out-end @ ['] store map-items ;      prim prim-effect-out prim prim-effect-out-end @ ['] store map-items ;
   
   : print-debug-arg { item -- }
       ." fputs(" quote space item item-name 2@ type ." =" quote ." , vm_out); "
       ." printarg_" item item-type @ print-type-prefix
       ." (" item item-name 2@ type ." );" cr ;
       
   : print-debug-args ( -- )
       ." #ifdef VM_DEBUG" cr
       ." if (vm_debug) {" cr
       prim prim-effect-in prim prim-effect-in-end @ ['] print-debug-arg map-items
   \    ." fputc('\n', vm_out);" cr
       ." }" cr
       ." #endif" cr ;
   
   : print-debug-result { item -- }
       item item-first @ if
           item print-debug-arg
       endif ;
   
   : print-debug-results ( -- )
       cr
       ." #ifdef VM_DEBUG" cr
       ." if (vm_debug) {" cr
       ." fputs(" quote ."  -- " quote ." , vm_out); "
       prim prim-effect-out prim prim-effect-out-end @ ['] print-debug-result map-items
       ." fputc('\n', vm_out);" cr
       ." }" cr
       ." #endif" cr ;
   
 : output-super-end ( -- )  : output-super-end ( -- )
     prim prim-c-code 2@ s" SET_IP" search if      prim prim-c-code 2@ s" SET_IP" search if
         ." SUPER_END;" cr          ." SUPER_END;" cr
Line 594  s" IP" save-mem w s" error don't use # o Line 622  s" IP" save-mem w s" error don't use # o
 : output-c-tail ( -- )  : output-c-tail ( -- )
     \ the final part of the generated C code      \ the final part of the generated C code
     output-super-end      output-super-end
       print-debug-results
     ." NEXT_P1;" cr      ." NEXT_P1;" cr
     stores      stores
     fill-tos      fill-tos
Line 612  s" IP" save-mem w s" error don't use # o Line 641  s" IP" save-mem w s" error don't use # o
     repeat      repeat
     2drop type ;      2drop type ;
   
 : print-debug-arg { item -- }  
     ." fputs(" quote space item item-name 2@ type ." =" quote ." , vm_out); "  
     ." printarg_" item item-type @ print-type-prefix  
     ." (" item item-name 2@ type ." );" cr ;  
       
 : print-debug-args ( -- )  
     ." #ifdef VM_DEBUG" cr  
     ." if (vm_debug) {" cr  
     prim prim-effect-in prim prim-effect-in-end @ ['] print-debug-arg map-items  
     ." fputc('\n', vm_out);" cr  
     ." }" cr  
     ." #endif" cr ;  
   
 : print-entry ( -- )  : print-entry ( -- )
     ." I_" prim prim-c-name 2@ type ." :" ;      ." I_" prim prim-c-name 2@ type ." :" ;
           
Line 666  s" IP" save-mem w s" error don't use # o Line 682  s" IP" save-mem w s" error don't use # o
     ."   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
     ." } else " ;      ."   goto _endif_;" cr
       ." }" cr ;
   
 : output-profile ( -- )  : output-profile ( -- )
     \ generate code for postprocessing the VM block profile stuff      \ generate code for postprocessing the VM block profile stuff
Line 676  s" IP" save-mem w s" error don't use # o Line 693  s" IP" save-mem w s" error don't use # o
     prim prim-c-code 2@  s" SET_IP"    search nip nip      prim prim-c-code 2@  s" SET_IP"    search nip nip
     prim prim-c-code 2@  s" SUPER_END" search nip nip or if      prim prim-c-code 2@  s" SUPER_END" search nip nip or if
         ."   return;" cr          ."   return;" cr
       else
           ."   goto _endif_;" cr
     endif      endif
     ." } else " cr ;      ." }" cr ;
   
 : gen-arg-parm { item -- }  : gen-arg-parm { item -- }
     item item-stack @ inst-stream = if      item item-stack @ inst-stream = if
Line 943  s" IP" save-mem w s" error don't use # o Line 962  s" IP" save-mem w s" error don't use # o
     fetches ;      fetches ;
   
 : part-output-c-tail ( -- )  : part-output-c-tail ( -- )
       print-debug-results
     stores ;      stores ;
   
 : output-combined-tail ( -- )  : output-combined-tail ( -- )
Line 1013  s" IP" save-mem w s" error don't use # o Line 1033  s" IP" save-mem w s" error don't use # o
     combined prim-c-name 2@ type ."  */"      combined prim-c-name 2@ type ."  */"
     cr ;      cr ;
   
   : output-forth-peephole ( -- )
       combined-prims num-combined @ 1- cells combinations search-wordlist
       s" the prefix for this combination must be defined earlier" ?print-error
       execute prim-num @ 5 .r
       combined-prims num-combined @ 1- th @ prim-num @ 5 .r
       combined prim-num @ 5 .r ."  prim, \ "
       combined prim-c-name 2@ type
       cr ;
   
   
 \ the parser  \ the parser
   
Line 1167  Variable c-flag Line 1196  Variable c-flag
 )) <- simple-primitive ( -- )  )) <- simple-primitive ( -- )
   
 (( {{ init-combined }}  (( {{ init-combined }}
    ` = (( white ++ {{ start }} forth-ident {{ end add-prim }} )) ++     ` = white ** (( {{ start }} forth-ident {{ end add-prim }} white ** )) ++
    nleof {{ process-combined }}     nleof {{ process-combined }}
 )) <- combined-primitive  )) <- combined-primitive
   
Removed from v.1.88  
changed lines
  Added in v.1.91

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