Diff for /gforth/prims2x.fs between versions 1.97 and 1.103

version 1.97, 2001/05/13 11:02:59 version 1.103, 2001/12/24 20:39:29
Line 59  include startup.fs Line 59  include startup.fs
   
 : struct% struct ; \ struct is redefined in gray  : struct% struct ; \ struct is redefined in gray
   
   warnings off
   
 include ./gray.fs  include ./gray.fs
   
 32 constant max-effect \ number of things on one side of a stack effect  32 constant max-effect \ number of things on one side of a stack effect
Line 645  stack inst-stream IP Cell Line 647  stack inst-stream IP Cell
     2drop type ;      2drop type ;
   
 : print-entry ( -- )  : print-entry ( -- )
     ." I_" prim prim-c-name 2@ type ." :" ;      ." LABEL(" prim prim-c-name 2@ type ." ):" ;
           
 : output-c ( -- )   : output-c ( -- ) 
  print-entry ."  /* " prim prim-name 2@ type ."  ( " prim prim-stack-string 2@ type ." ) */" cr   print-entry ."  /* " prim prim-name 2@ type ."  ( " prim prim-stack-string 2@ type ." ) */" cr
Line 701  stack inst-stream IP Cell Line 703  stack inst-stream IP Cell
     endif      endif
     ." }" cr ;      ." }" cr ;
   
   : output-superend ( -- )
       \ output flag specifying whether the current word ends a dynamic superinst
       prim prim-c-code 2@  s" SET_IP"    search nip nip
       prim prim-c-code 2@  s" SUPER_END" search nip nip or 0<>
       prim prim-c-code 2@  s" SUPER_CONTINUE" search nip nip 0= and
       negate 0 .r ." , /* " prim prim-name 2@ type ."  */" cr ;
   
 : gen-arg-parm { item -- }  : gen-arg-parm { item -- }
     item item-stack @ inst-stream = if      item item-stack @ inst-stream = if
         ." , " item item-type @ type-c-name 2@ type space          ." , " item item-type @ type-c-name 2@ type space
Line 765  stack inst-stream IP Cell Line 774  stack inst-stream IP Cell
 \      cr ;  \      cr ;
   
 : output-label ( -- )    : output-label ( -- )  
     ." (Label)&&I_" prim prim-c-name 2@ type ." ," cr ;      ." INST_ADDR(" prim prim-c-name 2@ type ." )," cr ;
   
 : output-alias ( -- )   : output-alias ( -- ) 
     ( primitive-number @ . ." alias " ) ." Primitive " prim prim-name 2@ type cr ;      ( primitive-number @ . ." alias " ) ." Primitive " prim prim-name 2@ type cr ;
Line 797  stack inst-stream IP Cell Line 806  stack inst-stream IP Cell
     name-line @ 0 .r      name-line @ 0 .r
     ." ,0" cr ;      ." ,0" cr ;
   
   : output-vi-tag ( -- )
       name-filename 2@ type #tab emit
       prim prim-name 2@ type #tab emit
       ." /^" prim prim-name 2@ type ."  *(/" cr ;
   
 [IFDEF] documentation  [IFDEF] documentation
 : register-doc ( -- )  : register-doc ( -- )
     prim prim-name 2@ documentation ['] create insert-wordlist      prim prim-name 2@ documentation ['] create insert-wordlist
Line 1174  Variable c-flag Line 1188  Variable c-flag
         THEN }}          THEN }}
 )) <- if-comment  )) <- if-comment
   
 (( (( eval-comment || forth-comment || c-comment || else-comment || if-comment )) ?? nonl ** )) <- comment-body  (( (( ` g || ` G )) {{ start }} nonl **
      {{ end
         forth-flag @ IF  ." group " type cr  THEN
         c-flag @     IF  ." GROUP(" type ." )" cr  THEN }}
   )) <- group-comment
   
   (( (( eval-comment || forth-comment || c-comment || else-comment || if-comment || group-comment )) ?? nonl ** )) <- comment-body
   
 (( ` \ comment-body nleof )) <- comment ( -- )  (( ` \ comment-body nleof )) <- comment ( -- )
   

Removed from v.1.97  
changed lines
  Added in v.1.103


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