xxxprim

\ Gforth primitives

\ Copyright (C) 1995,1996,1997,1998,2000,2003,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 3
\ of the License, or (at your option) any later version.

\ This program is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
\ 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, see http://www.gnu.org/licenses/.


\ WARNING: This file is processed by m4. Make sure your identifiers
\ don't collide with m4's (e.g. by undefining them).
\ 
\ 
\ 
\ This file contains primitive specifications in the following format:
\ 
\ forth name	( stack effect )	category	[pronunciation]
\ [""glossary entry""]
\ C code
\ [:
\ Forth code]
\ 
\ Note: Fields in brackets are optional.  Word specifications have to
\ be separated by at least one empty line
\
\ Both pronounciation and stack items (in the stack effect) must
\ conform to the C identifier syntax or the C compiler will complain.
\ If you don't have a pronounciation field, the Forth name is used,
\ and has to conform to the C identifier syntax.
\ 
\ These specifications are automatically translated into C-code for the
\ interpreter and into some other files. I hope that your C compiler has
\ decent optimization, otherwise the automatically generated code will
\ be somewhat slow. The Forth version of the code is included for manual
\ compilers, so they will need to compile only the important words.
\ 
\ Note that stack pointer adjustment is performed according to stack
\ effect by automatically generated code and NEXT is automatically
\ appended to the C code. Also, you can use the names in the stack
\ effect in the C code. Stack access is automatic. One exception: if
\ your code does not fall through, the results are not stored into the
\ stack. Use different names on both sides of the '--', if you change a
\ value (some stores to the stack are optimized away).
\
\ For superinstructions the syntax is:
\
\ forth-name [/ c-name] = forth-name forth-name ...
\
\ 
\ The stack variables have the following types:
\ 
\ name matches	type
\ f.*		Bool
\ c.*		Char
\ [nw].*	Cell
\ u.*		UCell
\ d.*		DCell
\ ud.*		UDCell
\ r.*		Float
\ a_.*		Cell *
\ c_.*		Char *
\ f_.*		Float *
\ df_.*		DFloat *
\ sf_.*		SFloat *
\ xt.*		XT
\ f83name.*	F83Name *

\E stack data-stack   sp Cell
\E stack fp-stack     fp Float
\E stack return-stack rp Cell
\E
\E get-current prefixes set-current
\E 
\E s" Bool"		single data-stack type-prefix f
\E s" Char"		single data-stack type-prefix c
\E s" Cell"		single data-stack type-prefix n
\E s" Cell"		single data-stack type-prefix w
\E s" UCell"		single data-stack type-prefix u
\E s" DCell"		double data-stack type-prefix d
\E s" UDCell"		double data-stack type-prefix ud
\E s" Float"		single fp-stack   type-prefix r
\E s" Cell *"		single data-stack type-prefix a_
\E s" Char *"		single data-stack type-prefix c_
\E s" Float *"		single data-stack type-prefix f_
\E s" DFloat *"		single data-stack type-prefix df_
\E s" SFloat *"		single data-stack type-prefix sf_
\E s" Xt"		single data-stack type-prefix xt
\E s" struct F83Name *"	single data-stack type-prefix f83name
\E s" struct Longname *" single data-stack type-prefix longname
\E 
\E return-stack stack-prefix R:
\E inst-stream  stack-prefix #
\E 
\E set-current
\E store-optimization on
\E ' noop tail-nextp2 ! \ now INST_TAIL just stores, but does not jump
\E
\E include-skipped-insts on \ static superinsts include cells for components
\E                          \ useful for dynamic programming and
\E                          \ superinsts across entry points

\ 
\ 
\ 
\ In addition the following names can be used:
\ ip	the instruction pointer
\ sp	the data stack pointer
\ rp	the parameter stack pointer
\ lp	the locals stack pointer
\ NEXT	executes NEXT
\ cfa	
\ NEXT1	executes NEXT1
\ FLAG(x)	makes a Forth flag from a C flag
\ 
\ 
\ 
\ Percentages in comments are from Koopmans book: average/maximum use
\ (taken from four, not very representative benchmarks)
\ 
\ 
\ 
\ To do:
\ 
\ throw execute, cfa and NEXT1 out?
\ macroize *ip, ip++, *ip++ (pipelining)?

\ set up stack caching states

\E register IPTOS Cell
\E register spTOS Cell
\E register sp1 Cell
\E register sp2 Cell
\E register sp3 Cell

\E create IPregs IPTOS ,
\E create regs sp2 , sp1 , spTOS ,

\E IPregs 1 0 stack-state IPss1
\E regs 3 cells + 0 -1 stack-state ss0
\E regs 2 cells + 1  0 stack-state ss1
\E regs 1 cells + 2  1 stack-state ss2
\E regs 0 cells + 3  2 stack-state ss3

\ the first of these is the default state
\E state S1
\E state S0
\E state S2
\E state S3

\E ss0 data-stack S0 set-ss
\E ss1 data-stack S1 set-ss
\E ss2 data-stack S2 set-ss
\E ss3 data-stack S3 set-ss

\E IPss1 inst-stream S0 set-ss
\E IPss1 inst-stream S1 set-ss
\E IPss1 inst-stream S2 set-ss
\E IPss1 inst-stream S3 set-ss

\E data-stack to cache-stack
\E here 4 cache-states 2! s0 , s1 , s2 , s3 ,

\E S1 to state-default
\E state-default to state-in
\E state-default to state-out

+	( n1 n2 -- n )		core	plus
n = n1+n2;

lit	( #w -- w )		gforth
:
 r> dup @ swap cell+ >r ;

over ( n1 n2 -- n1 n2 n1 )

drop ( n -- )

?branch ( #a_target f -- ) f83	question_branch
if (f==0) {
  SET_IP((Xt *)a_target);
  INST_TAIL; NEXT_P2;
}
SUPER_CONTINUE;

noop ( -- )

\E prim-states drop
\E prim-states over

\E branch-states ?branch

\E gen-transitions noop