--- gforth/prims2x.fs 2007/02/24 14:45:53 1.166 +++ gforth/prims2x.fs 2007/12/31 18:40:24 1.169 @@ -1,12 +1,12 @@ \ 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 Free Software Foundation, Inc. \ This file is part of Gforth. \ Gforth is free software; you can redistribute it and/or \ 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. \ This program is distributed in the hope that it will be useful, @@ -15,8 +15,7 @@ \ GNU General Public License for more details. \ You should have received a copy of the GNU General Public License -\ along with this program; if not, write to the Free Software -\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. +\ along with this program. If not, see http://www.gnu.org/licenses/. \ This is not very nice (hard limits, no checking, assumes 1 chars = 1). @@ -371,7 +370,7 @@ variable name-line 2variable last-name-filename Variable function-number 0 function-number ! Variable function-old 0 function-old ! -: function-diff ( n -- ) +: function-diff ( -- ) ." GROUPADD(" function-number @ function-old @ - 0 .r ." )" cr function-number @ function-old ! ; : forth-fdiff ( -- ) @@ -685,7 +684,7 @@ get-current prefixes set-current set-current 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 ) \ initialize item at addr1 with name addr u, next item is at addr2 @@ -1855,15 +1854,18 @@ Variable c-flag )) <- else-comment (( ` + {{ start }} nonl ** {{ end - dup - IF c-flag @ - IF - function-diff - ." #ifdef HAS_" bounds ?DO I c@ toupper emit LOOP cr - THEN - forth-flag @ - IF forth-fdiff ." has? " type ." [IF]" cr THEN - ELSE 2drop + dup + IF + c-flag @ IF + function-diff + ." #ifdef HAS_" 2dup bounds ?DO I c@ toupper emit LOOP cr + THEN + forth-flag @ IF + forth-fdiff ." has? " 2dup type ." [IF]" cr + THEN + 2drop + ELSE + 2drop c-flag @ IF function-diff ." #endif" cr THEN forth-flag @ IF forth-fdiff ." [THEN]" cr THEN @@ -1872,9 +1874,10 @@ Variable c-flag (( (( ` g || ` G )) {{ start }} nonl ** {{ 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 - ." GROUP(" type ." , " function-number @ 0 .r ." )" cr THEN }} + ." GROUP(" 2dup type ." , " function-number @ 0 .r ." )" cr THEN + 2drop }} )) <- group-comment (( (( eval-comment || forth-comment || c-comment || else-comment || if-comment || group-comment )) ?? nonl ** )) <- comment-body @@ -1892,7 +1895,7 @@ Variable c-flag (( {{ prim create-prim prim init-simple }} ` ( white ** {{ start }} stack-effect {{ end prim prim-stack-string 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 (( ` " ` " {{ start }} (( noquote ++ ` " )) ++ {{ end 1- prim prim-doc 2! }} ` " white ** nleof )) ?? {{ skipsynclines off line @ c-line ! filename 2@ c-filename 2! start }}