--- gforth/prim	2009/10/05 15:54:28	1.244
+++ gforth/prim	2010/07/05 18:46:19	1.251
@@ -1,6 +1,6 @@
 \ Gforth primitives
 
-\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008 Free Software Foundation, Inc.
+\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008,2009 Free Software Foundation, Inc.
 
 \ This file is part of Gforth.
 
@@ -229,9 +229,28 @@ fprintf(stderr, "dodoes to %x, push %x\n
 SET_IP(DOES_CODE1(CFA));
 #endif /* !defined(NO_IP) */
 
-(does-handler) ( -- )	gforth-internal	paren_does_handler
-""just a slot to have an encoding for the DOESJUMP, 
-which is no longer used anyway (!! eliminate this)""
+(doabicode) ( ... -- ...)	gforth-internal	paren_doabicode
+""run-time routine for @code{ABI-code} definitions""
+abifunc *f = (abifunc *)PFA(CFA);
+Float *fp_mem = fp;
+sp = (*f)(sp, &fp_mem);
+fp = fp_mem;
+#ifdef NO_IP
+INST_TAIL;
+goto *next_code;
+#endif /* defined(NO_IP) */
+
+(do;abicode) ( ... -- ... ) gforth-internal paren_do_semicolon_abi_code
+""run-time routine for @code{;abi-code}-defined words""
+Float *fp_mem = fp;
+Address body = (Address)PFA(CFA);
+semiabifunc *f = (semiabifunc *)DOES_CODE1(CFA);
+sp = (*f)(sp, &fp_mem, body);
+fp = fp_mem;
+#ifdef NO_IP
+INST_TAIL;
+goto *next_code;
+#endif /* defined(NO_IP) */
 
 \F [endif]
 
@@ -2473,6 +2492,54 @@ c_addr = "libltdl is not configured";
 u = strlen(c_addr);
 #endif
 
+\ w!be ( w c_addr -- )	gforth w_store_be
+\ ""Store the bottom 16 bits of @i{w} at @i{c_addr} in big endian format.""
+\ *(Wyde*)(c_addr) = htobe16(w);
+\ 
+\ l!be ( w c_addr -- )	gforth l_store_be
+\ ""Store the bottom 32 bits of @i{w} at @i{c_addr} in big endian format.""
+\ *(Tetrabyte*)(c_addr) = htobe32(w);
+\ 
+\ x!be ( w c_addr -- )	gforth x_store_be
+\ ""Store the bottom 64 bits of @i{w} at @i{c_addr} in big endian format.""
+\ *(Octabyte*)(c_addr) = htobe64(w);
+\ 
+\ w!le ( w c_addr -- )	gforth w_store_le
+\ ""Store the bottom 16 bits of @i{w} at @i{c_addr} in big endian format.""
+\ *(Wyde*)(c_addr) = htole16(w);
+\ 
+\ l!le ( w c_addr -- )	gforth l_store_le
+\ ""Store the bottom 32 bits of @i{w} at @i{c_addr} in big endian format.""
+\ *(Tetrabyte*)(c_addr) = htole32(w);
+\ 
+\ x!le ( w c_addr -- )	gforth x_store_le
+\ ""Store the bottom 64 bits of @i{w} at @i{c_addr} in big endian format.""
+\ *(Octabyte*)(c_addr) = htole64(w);
+\ 
+\ w@be ( c_addr -- u )	gforth w_fetch_be
+\ ""@i{u} is the zero-extended 16-bit big endian value stored at @i{c_addr}.""
+\ u = be16toh(*(UWyde*)(c_addr));
+\ 
+\ l@be ( c_addr -- u )	gforth l_fetch_be
+\ ""@i{u} is the zero-extended 32-bit big endian value stored at @i{c_addr}.""
+\ u = be32toh(*(UTetrabyte*)(c_addr));
+\ 
+\ x@be ( c_addr -- u )	gforth x_fetch_be
+\ ""@i{u} is the zero-extended 64-bit big endian value stored at @i{c_addr}.""
+\ u = be64toh(*(UOctabyte*)(c_addr));
+\ 
+\ w@le ( c_addr -- u )	gforth w_fetch_le
+\ ""@i{u} is the zero-extended 16-bit little endian value stored at @i{c_addr}.""
+\ u = le16toh(*(UWyde*)(c_addr));
+\ 
+\ l@le ( c_addr -- u )	gforth l_fetch_le
+\ ""@i{u} is the zero-extended 32-bit little endian value stored at @i{c_addr}.""
+\ u = le32toh(*(UTetrabyte*)(c_addr));
+\ 
+\ x@le ( c_addr -- u )	gforth x_fetch_le
+\ ""@i{u} is the zero-extended 64-bit little endian value stored at @i{c_addr}.""
+\ u = le64toh(*(UOctabyte*)(c_addr));
+
 \+
 \g peephole
 
@@ -2520,6 +2587,36 @@ a_addr = groups;
 
 \+
 
+\g primitive_centric
+
+\ primitives for primitive-centric code
+\ another one is does-exec
+
+abi-call	( #a_callee ... -- ... ) gforth-internal abi_call
+/* primitive for compiled ABI-CODE words */
+abifunc *f = (abifunc *)a_callee;
+Float *fp_mem = fp;
+sp = (*f)(sp, &fp_mem);
+fp = fp_mem;
+
+;abi-code-exec ( #a_cfa ... -- ... ) gforth-internal semi_abi_code_exec
+/* primitive for performing ;ABI-CODE words */
+Float *fp_mem = fp;
+semiabifunc *f = (semiabifunc *)DOES_CODE1(a_cfa);
+Address body = (Address)PFA(a_cfa);
+sp = (*f)(sp, &fp_mem, body);
+fp = fp_mem;
+
+lit-execute	( #a_addr -- )	new	lit_execute
+/* for ;code and code words; a static superinstruction would be more general, 
+   but VM_JUMP is currently not supported there */
+#ifndef NO_IP
+ip=IP;
+#endif
+SUPER_END;
+VM_JUMP(EXEC1((Xt)a_addr));
+
+
 \g static_super
 
 ifdef(`STACK_CACHE_FILE',