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

version 1.1, 1994/05/07 14:56:04 version 1.5, 1994/07/21 10:52:49
Line 19 Line 19
 \ regarding problem 1 above: It would be better (for over) to implement  \ regarding problem 1 above: It would be better (for over) to implement
 \       the alternative  \       the alternative
   
   warnings off
   
   [IFUNDEF] vocabulary  include search-order.fs [THEN]
 include gray.fs  include gray.fs
 include search-order.fs  
   
 100 constant max-effect \ number of things on one side of a stack effect  100 constant max-effect \ number of things on one side of a stack effect
 4096 constant batch-size \ no meaning, just make sure it's >0  4096 constant batch-size \ no meaning, just make sure it's >0
Line 195  nowhite ++ Line 197  nowhite ++
   
 (( (( primitive {{ printprim }} )) **  eof ))  (( (( primitive {{ printprim }} )) **  eof ))
 parser primitives2something  parser primitives2something
   warnings @ [IF]
 .( parser generated ok ) cr  .( parser generated ok ) cr
   [THEN]
   
 : primfilter ( file-id xt -- )  : primfilter ( file-id xt -- )
 \ fileid is for the input file, xt ( -- ) is for the output word  \ fileid is for the input file, xt ( -- ) is for the output word
Line 204  parser primitives2something Line 208  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 225  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 234  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 305  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 494  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 508  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 516  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
Line 536  set-current Line 541  set-current
  if   if
    ." cannot open file" cr abort     ." cannot open file" cr abort
  endif   endif
  ." ------------ CUT HERE -------------" cr   warnings @ if
    ." ------------ CUT HERE -------------" cr  endif
  r> primfilter ;   r> primfilter ;
   

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


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