Diff for /gforth/prims2x.fs between versions 1.1 and 1.2

version 1.1, 1994/05/07 14:56:04 version 1.2, 1994/05/18 17:29:59
Line 204  parser primitives2something Line 204  parser primitives2something
  here swap read-whole-file   here swap read-whole-file
  dup endinput !   dup endinput !
  here - allot   here - allot
    align
  primitives2something ;   primitives2something ;
   
 \ types  \ types
Line 220  constant type-description Line 221  constant type-description
 \ n1 is the offset of the accessed item, n2, n3 are effect-*-size  \ n1 is the offset of the accessed item, n2, n3 are effect-*-size
  drop swap - 1- dup   drop swap - 1- dup
  if   if
    ." sp[" . ." ]"     ." sp[" 0 .r ." ]"
  else   else
    drop ." TOS"     drop ." TOS"
  endif ;   endif ;
Line 229  constant type-description Line 230  constant type-description
 \ n1 is the offset of the accessed item, n2, n3 are effect-*-size  \ n1 is the offset of the accessed item, n2, n3 are effect-*-size
  nip swap - 1- dup   nip swap - 1- dup
  if   if
    ." fp[" . ." ]"     ." fp[" 0 .r ." ]"
  else   else
    drop ." FTOS"     drop ." FTOS"
  endif ;   endif ;
Line 300  constant type-description Line 301  constant type-description
  >r   >r
  ." {Double_Store _d; _d.dcell = " r@ item-name 2@ type ." ; "   ." {Double_Store _d; _d.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   ."  = _d.cells.low; " 1+ effect-out-size 2@ data-stack-access
  ." =  _d.cells.high;}" cr   ." = _d.cells.high;}" cr
  rdrop ;   rdrop ;
   
 : f-same-as-in? ( item -- f )  : f-same-as-in? ( item -- f )
Line 489  set-current Line 490  set-current
  effect-out-size 2@   effect-out-size 2@
  rot swap - ( d-in d-out f-diff )   rot swap - ( d-in d-out f-diff )
  rot rot - ( f-diff d-diff )   rot rot - ( f-diff d-diff )
  ." sp += " . ." ;" cr   ?dup IF  ." sp += " 0 .r ." ;" cr  THEN
  ." fp += " . ." ;" cr ;   ?dup IF  ." fp += " 0 .r ." ;" cr  THEN ;
   
 : store ( item -- )  : store ( item -- )
 \ f is true if the item should be stored  \ f is true if the item should be stored
Line 503  set-current Line 504  set-current
  item-descr +loop ;    item-descr +loop ; 
   
 : output-c ( -- )  : output-c ( -- )
  ." I_" c-name 2@ type ." : /* " forth-name 2@ type ."  ( " stack-string 2@ type ."  ) */" cr   ." I_" c-name 2@ type ." :     /* " forth-name 2@ type ."  ( " stack-string 2@ type ."  ) */" cr
  ." /* " doc 2@ type ."  */" cr   ." /* " doc 2@ type ."  */" cr
  ." {" cr   ." {" cr
  ." DEF_CA" cr   ." DEF_CA" cr
Line 511  set-current Line 512  set-current
  compute-offsets \ for everything else   compute-offsets \ for everything else
  flush-tos   flush-tos
  fetches   fetches
  stack-pointer-updates   stack-pointer-updates cr
  ." NAME(" [char] " emit forth-name 2@ type [char] " emit ." )" cr \ debugging   ." NAME(" [char] " emit forth-name 2@ type [char] " emit ." )" cr \ debugging
  ." {" cr   ." {" cr
  c-code 2@ type   c-code 2@ type

Removed from v.1.1  
changed lines
  Added in v.1.2


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