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

Diff for /gforth/prims2x.fs between versions 1.44 and 1.47

version 1.44, 1999/05/17 13:13:27 version 1.47, 2000/09/23 15:06:02
Line 1 Line 1
 \ converts primitives to, e.g., C code   \ converts primitives to, e.g., C code 
   
 \ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.  \ Copyright (C) 1995,1996,1997,1998,2000 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
Line 214  print-token ! Line 214  print-token !
   
 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
 bl singleton                                            charclass blank  bl singleton tab-char over add-member                   charclass white
 tab-char singleton                                      charclass tab  
 nl-char singleton eof-char over add-member complement   charclass nonl  nl-char singleton eof-char over add-member complement   charclass nonl
 nl-char singleton eof-char over add-member char : over add-member complement  charclass nocolonnl  nl-char singleton eof-char over add-member
 bl 1+ maxchar ..                                        charclass nowhite      char : over add-member complement                   charclass nocolonnl
   bl 1+ maxchar .. char \ singleton complement intersection
                                                           charclass nowhitebq
   bl 1+ maxchar ..                                        charclass nowhite
 char " singleton eof-char over add-member complement    charclass noquote  char " singleton eof-char over add-member complement    charclass noquote
 nl-char singleton                                       charclass nl  nl-char singleton                                       charclass nl
 eof-char singleton                                      charclass eof  eof-char singleton                                      charclass eof
Line 227  eof-char singleton     charclass eof Line 229  eof-char singleton     charclass eof
 (( letter (( letter || digit )) **  (( letter (( letter || digit )) **
 )) <- c-name ( -- )  )) <- c-name ( -- )
   
 nowhite ++  (( nowhitebq nowhite ** ))
 <- name ( -- )  <- name ( -- )
   
 Variable forth-flag  Variable forth-flag
Line 254  Variable c-flag Line 256  Variable c-flag
                 forth-flag @                  forth-flag @
                 IF  ." has? " type ."  [IF]"  cr THEN                  IF  ." has? " type ."  [IF]"  cr THEN
         ELSE    2drop          ELSE    2drop
                 c-flag @              c-flag @      IF  ." #endif"  cr THEN
                 IF  ." #endif"  cr THEN              forth-flag @  IF  ." [THEN]"  cr THEN
                 forth-flag @  
                 IF  ." [THEN]"  cr THEN  
         THEN }}          THEN }}
 )) <- if-comment  )) <- if-comment
   
Line 265  Variable c-flag Line 265  Variable c-flag
   
 (( ` \ comment-body nl )) <- comment ( -- )  (( ` \ comment-body nl )) <- comment ( -- )
   
 (( {{ effect-in }} (( {{ start }} c-name {{ end 2 pick item-name 2! item-descr + }} blank ** )) ** {{ effect-in-end ! }}  (( {{ effect-in }} (( {{ start }} c-name {{ end 2 pick item-name 2! item-descr + }} white ** )) ** {{ effect-in-end ! }}
    ` - ` - blank **     ` - ` - white **
    {{ effect-out }} (( {{ start }} c-name {{ end 2 pick item-name 2! item-descr + }} blank ** )) ** {{ effect-out-end ! }}     {{ effect-out }} (( {{ start }} c-name {{ end 2 pick item-name 2! item-descr + }} white ** )) ** {{ effect-out-end ! }}
 )) <- stack-effect ( -- )  )) <- stack-effect ( -- )
   
 (( {{ s" " doc 2! s" " forth-code 2! }}  (( {{ s" " doc 2! s" " forth-code 2! }}
    (( comment || nl )) **  
    (( {{ line @ name-line ! filename 2@ name-filename 2! }}     (( {{ line @ name-line ! filename 2@ name-filename 2! }}
       {{ start }} name {{ end 2dup forth-name 2! c-name 2! }}  tab ++        {{ start }} name {{ end 2dup forth-name 2! c-name 2! }}  white ++
       {{ start }} stack-effect {{ end stack-string 2! }} tab ++        ` ( white ** {{ start }} stack-effect {{ end stack-string 2! }} ` ) white **
         {{ start }} name {{ end wordset 2! }} tab **          {{ start }} name {{ end wordset 2! }} white **
         (( {{ start }}  c-name {{ end c-name 2! }} )) ??  nl          (( {{ start }}  c-name {{ end c-name 2! }} )) ??  nl
    ))     ))
    (( ` " ` "  {{ start }} (( noquote ++ ` " )) ++ {{ end 1- doc 2! }} ` " nl )) ??     (( ` " ` "  {{ start }} (( noquote ++ ` " )) ++ {{ end 1- doc 2! }} ` " nl )) ??
    {{ skipsynclines off line @ c-line ! filename 2@ c-filename 2! start }} (( nocolonnl nonl **  nl )) ** {{ end c-code 2! skipsynclines on }}     {{ skipsynclines off line @ c-line ! filename 2@ c-filename 2! start }} (( nocolonnl nonl **  nl )) ** {{ end c-code 2! skipsynclines on }}
    (( ` :  nl     (( ` :  nl
       {{ start }} (( nonl ++  nl )) ++ {{ end forth-code 2! }}        {{ start }} (( nonl ++  nl )) ++ {{ end forth-code 2! }}
    )) ??     )) ?? {{ printprim }}
    (( nl || eof ))     (( nl || eof ))
 )) <- primitive ( -- )  )) <- primitive ( -- )
   
 (( (( primitive {{ printprim }} )) ** eof ))  (( (( comment || primitive || nl )) ** eof ))
 parser primitives2something  parser primitives2something
 warnings @ [IF]  warnings @ [IF]
 .( parser generated ok ) cr  .( parser generated ok ) cr
Line 611  set-current Line 610  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
  ." NAME(" [char] " emit forth-name 2@ type [char] " emit ." )" cr \ debugging   ." NAME(" [char] " emit forth-name 2@ type [char] " emit ." )" cr \ debugging
  ." {" cr   ." {" cr
Removed from v.1.44  
changed lines
  Added in v.1.47

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