Diff for /gforth/prims2x.fs between versions 1.166 and 1.172

version 1.166, 2007/02/24 14:45:53 version 1.172, 2010/05/02 16:21:32
Line 1 Line 1
 \ converts primitives to, e.g., C code   \ converts primitives to, e.g., C code 
   
 \ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006 Free Software Foundation, Inc.  \ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2009 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
 \ Gforth is free software; you can redistribute it and/or  \ Gforth is free software; you can redistribute it and/or
 \ modify it under the terms of the GNU General Public License  \ modify it under the terms of the GNU General Public License
 \ as published by the Free Software Foundation; either version 2  \ as published by the Free Software Foundation, either version 3
 \ of the License, or (at your option) any later version.  \ of the License, or (at your option) any later version.
   
 \ This program is distributed in the hope that it will be useful,  \ This program is distributed in the hope that it will be useful,
Line 15 Line 15
 \ GNU General Public License for more details.  \ GNU General Public License for more details.
   
 \ You should have received a copy of the GNU General Public License  \ You should have received a copy of the GNU General Public License
 \ along with this program; if not, write to the Free Software  \ along with this program. If not, see http://www.gnu.org/licenses/.
 \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.  
   
   
 \ This is not very nice (hard limits, no checking, assumes 1 chars = 1).  \ This is not very nice (hard limits, no checking, assumes 1 chars = 1).
Line 371  variable name-line Line 370  variable name-line
 2variable last-name-filename  2variable last-name-filename
 Variable function-number 0 function-number !  Variable function-number 0 function-number !
 Variable function-old 0 function-old !  Variable function-old 0 function-old !
 : function-diff ( n -- )  : function-diff ( -- )
     ." GROUPADD(" function-number @ function-old @ - 0 .r ." )" cr      ." GROUPADD(" function-number @ function-old @ - 0 .r ." )" cr
     function-number @ function-old ! ;      function-number @ function-old ! ;
 : forth-fdiff ( -- )  : forth-fdiff ( -- )
Line 685  get-current prefixes set-current Line 684  get-current prefixes set-current
 set-current  set-current
   
 create ...-item ( -- addr ) \ just used for letting stack-prefixes work on it  create ...-item ( -- addr ) \ just used for letting stack-prefixes work on it
 item% %allot                \ stores the stack temporarily until used by ...  item% %allot drop           \ stores the stack temporarily until used by ...
   
 : init-item1 ( addr1 addr u -- addr2 )  : init-item1 ( addr1 addr u -- addr2 )
     \ initialize item at addr1 with name addr u, next item is at addr2      \ initialize item at addr1 with name addr u, next item is at addr2
Line 1054  variable tail-nextp2 \ xt to execute for Line 1053  variable tail-nextp2 \ xt to execute for
     tail-nextp2 @ output-c-tail1-no-stores ;      tail-nextp2 @ output-c-tail1-no-stores ;
   
 : output-c-tail2-no-stores ( -- )  : output-c-tail2-no-stores ( -- )
       prim prim-c-code 2@ s" VM_JUMP(" search nip nip abort" Currently VM_JUMP is not supported in static superinstructions"
     ['] output-label2 output-c-tail1-no-stores ;      ['] output-label2 output-c-tail1-no-stores ;
   
 : type-c-code ( c-addr u xt -- )  : type-c-code ( c-addr u xt -- )
Line 1556  variable reprocessed-num 0 reprocessed-n Line 1556  variable reprocessed-num 0 reprocessed-n
     stores ;      stores ;
   
 : output-combined-tail ( -- )  : output-combined-tail ( -- )
     part-output-c-tail  
     in-part @ >r in-part off      in-part @ >r in-part off
       part-output-c-tail
     combined ['] output-c-tail-no-stores prim-context      combined ['] output-c-tail-no-stores prim-context
     r> in-part ! ;      r> in-part ! ;
   
Line 1855  Variable c-flag Line 1855  Variable c-flag
 )) <- else-comment  )) <- else-comment
   
 (( ` + {{ start }} nonl ** {{ end  (( ` + {{ start }} nonl ** {{ end
         dup          dup
         IF      c-flag @          IF
             IF              c-flag @ IF
                 function-diff                  function-diff
                 ." #ifdef HAS_" bounds ?DO  I c@ toupper emit  LOOP cr                  ." #ifdef HAS_" 2dup bounds ?DO  I c@ toupper emit  LOOP cr
                 THEN              THEN
                 forth-flag @              forth-flag @ IF
                 IF  forth-fdiff  ." has? " type ."  [IF]"  cr THEN                  forth-fdiff  ." has? " 2dup type ."  [IF]"  cr
         ELSE    2drop              THEN
               2drop
           ELSE
               2drop
             c-flag @      IF              c-flag @      IF
                 function-diff  ." #endif" cr THEN                  function-diff  ." #endif" cr THEN
             forth-flag @  IF  forth-fdiff  ." [THEN]"  cr THEN              forth-flag @  IF  forth-fdiff  ." [THEN]"  cr THEN
Line 1872  Variable c-flag Line 1875  Variable c-flag
   
 (( (( ` g || ` G )) {{ start }} nonl **  (( (( ` g || ` G )) {{ start }} nonl **
    {{ end     {{ end
       forth-flag @ IF  forth-fdiff  ." group " type cr  THEN        forth-flag @ IF  forth-fdiff  ." group " 2dup type cr  THEN
       c-flag @     IF  function-diff        c-flag @     IF  function-diff
           ." GROUP(" type ." , " function-number @ 0 .r ." )" cr  THEN }}            ." GROUP(" 2dup type ." , " function-number @ 0 .r ." )" cr  THEN
         2drop }}
 )) <- group-comment  )) <- group-comment
   
 (( (( eval-comment || forth-comment || c-comment || else-comment || if-comment || group-comment )) ?? nonl ** )) <- comment-body  (( (( eval-comment || forth-comment || c-comment || else-comment || if-comment || group-comment )) ?? nonl ** )) <- comment-body
Line 1892  Variable c-flag Line 1896  Variable c-flag
 (( {{ prim create-prim prim init-simple }}  (( {{ prim create-prim prim init-simple }}
    ` ( white ** {{ start }} stack-effect {{ end prim prim-stack-string 2! }} ` ) white **     ` ( white ** {{ start }} stack-effect {{ end prim prim-stack-string 2! }} ` ) white **
    (( {{ start }} forth-ident {{ end prim prim-wordset 2! }} white **     (( {{ start }} forth-ident {{ end prim prim-wordset 2! }} white **
       (( {{ start }}  c-ident {{ end 2dup prim-c-name-2! }} )) ??        (( {{ start }}  c-ident {{ end prim-c-name-2! }} )) ??
    )) ??  nleof     )) ??  nleof
    (( ` " ` "  {{ start }} (( noquote ++ ` " )) ++ {{ end 1- prim prim-doc 2! }} ` " white ** nleof )) ??     (( ` " ` "  {{ start }} (( noquote ++ ` " )) ++ {{ end 1- prim prim-doc 2! }} ` " white ** nleof )) ??
    {{ skipsynclines off line @ c-line ! filename 2@ c-filename 2! start }}     {{ skipsynclines off line @ c-line ! filename 2@ c-filename 2! start }}

Removed from v.1.166  
changed lines
  Added in v.1.172


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