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

Diff for /gforth/prims2x.fs between versions 1.82 and 1.85

version 1.82, 2001/02/24 09:58:31 version 1.85, 2001/02/27 10:30:02
Line 484  does> ( item -- ) Line 484  does> ( item -- )
     item declaration ;      item declaration ;
   
 \ types pointed to by stacks for use in combined prims  \ types pointed to by stacks for use in combined prims
 s" Cell"  single 0 create-type cell-type  \ !! output-c-combined shouldn't use these names!
 s" Float" single 0 create-type float-type  s" Cell"  single 0 create-type w
   s" Float" single 0 create-type r
 s" sp" save-mem cell-type  s" (Cell)" make-stack data-stack   
 s" fp" save-mem float-type s" "       make-stack fp-stack  s" sp" save-mem w s" (Cell)" make-stack data-stack 
 s" rp" save-mem cell-type  s" (Cell)" make-stack return-stack  s" fp" save-mem r s" "       make-stack fp-stack
 s" IP" save-mem cell-type  s" error don't use # on results" make-stack inst-stream  s" rp" save-mem w s" (Cell)" make-stack return-stack
   s" IP" save-mem w s" error don't use # on results" make-stack inst-stream
 ' inst-in-index inst-stream stack-in-index-xt !  ' inst-in-index inst-stream stack-in-index-xt !
 ' inst-stream <is> inst-stream-f  ' inst-stream <is> inst-stream-f
 \ !! initialize stack-in and stack-out  \ !! initialize stack-in and stack-out
Line 589  s" IP" save-mem cell-type  s" error don' Line 590  s" IP" save-mem cell-type  s" error don'
     ." NEXT_P1;" cr      ." NEXT_P1;" cr
     stores      stores
     fill-tos      fill-tos
     ." NEXT_P2;" cr ;      ." NEXT_P2;" ;
   
 : type-c ( c-addr u -- )  : type-c-code ( c-addr u xt -- )
     \ like TYPE, but replaces "TAIL;" with tail code      \ like TYPE, but replaces "TAIL;" with tail code produced by xt
       { xt }
     begin ( c-addr1 u1 )      begin ( c-addr1 u1 )
         2dup s" TAIL;" search          2dup s" TAIL;" search
     while ( c-addr1 u1 c-addr3 u3 )      while ( c-addr1 u1 c-addr3 u3 )
         2dup 2>r drop nip over - type          2dup 2>r drop nip over - type
         output-c-tail          xt execute
         2r> 5 /string          2r> 5 /string
         \ !! resync #line missing          \ !! resync #line missing
     repeat      repeat
Line 633  s" IP" save-mem cell-type  s" error don' Line 635  s" IP" save-mem cell-type  s" error don'
  stack-pointer-updates   stack-pointer-updates
  ." {" cr   ." {" cr
  ." #line " c-line @ . quote c-filename 2@ type quote cr   ." #line " c-line @ . quote c-filename 2@ type quote cr
  prim prim-c-code 2@ type-c   prim prim-c-code 2@ ['] output-c-tail type-c-code
  ." }" cr   ." }" cr
  output-c-tail   output-c-tail
  ." }" cr   ." }" cr
Line 921  s" IP" save-mem cell-type  s" error don' Line 923  s" IP" save-mem cell-type  s" error don'
     fetches ;      fetches ;
   
 : part-output-c-tail ( -- )  : part-output-c-tail ( -- )
     output-c-tail ;      stores ;
   
   : output-combined-tail ( -- )
       part-output-c-tail
       prim >r combined to prim
       in-part @ >r in-part off
       output-c-tail
       r> in-part ! r> to prim ;
   
 : output-part ( p -- )  : output-part ( p -- )
     to prim      to prim
Line 934  s" IP" save-mem cell-type  s" error don' Line 943  s" IP" save-mem cell-type  s" error don'
     prim add-depths \ !! right place?      prim add-depths \ !! right place?
     ." {" cr      ." {" cr
     ." #line " c-line @ . quote c-filename 2@ type quote cr      ." #line " c-line @ . quote c-filename 2@ type quote cr
     prim prim-c-code 2@ type-c \ !! deal with TAIL      prim prim-c-code 2@ ['] output-combined-tail type-c-code
     ." }" cr      ." }" cr
     part-output-c-tail      part-output-c-tail
     ." }" cr ;      ." }" cr ;
Line 968  s" IP" save-mem cell-type  s" error don' Line 977  s" IP" save-mem cell-type  s" error don'
 ;  ;
   
   
 \ compile VM insts  \ peephole optimization rules
   
 \ in order for this to work as intended, shorter combinations for each  \ in order for this to work as intended, shorter combinations for each
 \ length must be present, and the longer combinations must follow  \ length must be present, and the longer combinations must follow
 \ shorter ones (this restriction may go away in the future).  \ shorter ones (this restriction may go away in the future).
       
 : output-pregen-combined ( -- )  : output-peephole ( -- )
     combined-prims num-combined @ 1- cells combinations search-wordlist      combined-prims num-combined @ 1- cells combinations search-wordlist
     s" the prefix for this combination must be defined earlier" ?print-error      s" the prefix for this combination must be defined earlier" ?print-error
     ." {"      ." {"
Removed from v.1.82  
changed lines
  Added in v.1.85

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