Diff for /gforth/prims2x.fs between versions 1.18 and 1.21

version 1.18, 1995/12/26 17:35:37 version 1.21, 1996/05/09 18:13:02
Line 164  print-token ! Line 164  print-token !
     0. r> 6 chars + 20 >number drop >r drop line ! r> ( c-addr )      0. r> 6 chars + 20 >number drop >r drop line ! r> ( c-addr )
     dup c@ bl = if      dup c@ bl = if
         char+ dup c@ [char] " <> abort" sync line syntax"          char+ dup c@ [char] " <> abort" sync line syntax"
         char+ dup 100 [char] " scan drop swap 2dup - filename 2!          char+ dup 100 [char] " scan drop swap 2dup - save-string filename 2!
         char+          char+
     endif      endif
     dup c@ nl-char <> abort" sync line syntax"      dup c@ nl-char <> abort" sync line syntax"
Line 203  print-token ! Line 203  print-token !
   
 : ` ( -- terminal ) ( use: ` c )  : ` ( -- terminal ) ( use: ` c )
  ( creates anonymous terminal for the character c )   ( creates anonymous terminal for the character c )
  [compile] ascii singleton ['] ?nextchar make-terminal ;   char singleton ['] ?nextchar make-terminal ;
   
 char a char z ..  char A char Z ..  union char _ singleton union  charclass letter  char a char z ..  char A char Z ..  union char _ singleton union  charclass letter
 char 0 char 9 ..                                        charclass digit  char 0 char 9 ..                                        charclass digit
Line 305  constant type-description Line 305  constant type-description
   
 : fetch-double ( item -- )  : fetch-double ( item -- )
  >r   >r
  r@ item-name 2@ type    ." FETCH_DCELL("
  ." = ({Double_Store _d; _d.cells.low = "   r@ item-name 2@ type ." , "
  r@ item-d-offset @ dup    effect-in-size 2@ data-stack-access   r@ item-d-offset @ dup    effect-in-size 2@ data-stack-access
  ." ; _d.cells.high = " 1+ effect-in-size 2@ data-stack-access   ." , "                 1+ effect-in-size 2@ data-stack-access
  ." ; _d.dcell;});" cr   ." );" cr
  rdrop ;   rdrop ;
   
 : fetch-float ( item -- )  : fetch-float ( item -- )
Line 360  constant type-description Line 360  constant type-description
 : 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
  ." {Double_Store _d; _d.dcell = " r@ item-name 2@ type ." ; "   ." STORE_DCELL(" r@ item-name 2@ type ." , "
  r@ item-d-offset @ dup    effect-out-size 2@ data-stack-access    r@ item-d-offset @ dup    effect-out-size 2@ data-stack-access
  ."  = _d.cells.low; " 1+ effect-out-size 2@ data-stack-access   ." , "                 1+ effect-out-size 2@ data-stack-access
  ." = _d.cells.high;}" cr   ." );" cr
  rdrop ;   rdrop ;
   
 : f-same-as-in? ( item -- f )  : f-same-as-in? ( item -- f )

Removed from v.1.18  
changed lines
  Added in v.1.21


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