--- gforth/prim	2002/08/28 21:46:58	1.97
+++ gforth/prim	2002/09/24 16:50:28	1.99
@@ -2427,14 +2427,20 @@ a_addr = (Cell *)(up+u);
 compile-prim ( xt1 -- xt2 )	new	compile_prim
 xt2 = (Xt)compile_prim((Label)xt1);
 
-lit@ / lit_fetch = lit @
+\ lit@ / lit_fetch = lit @
+
+lit@		( #a_addr -- w ) new	lit_fetch
+w = *a_addr;
 
 lit-perform	( #a_addr -- )	new	lit_perform
 ip=IP;
 SUPER_END;
 EXEC(*(Xt *)a_addr);
 
-lit+ / lit_plus = lit +
+\ lit+ / lit_plus = lit +
+
+lit+	( n1 #n2 -- n )		new	lit_plus
+n=n1+n2;
 
 does-exec ( #a_cfa -- R:nest a_pfa )	new	does_exec
 a_pfa = PFA(a_cfa);
@@ -2449,6 +2455,217 @@ IF_spTOS(spTOS = sp[0]);
 #endif
 SET_IP(DOES_CODE1(a_cfa));
 
+abranch-lp+!# ( #a_target #nlocals -- )	gforth	abranch_lp_plus_store_number
+/* this will probably not be used */
+lp += nlocals;
+SET_IP((Xt *)a_target);
+
+\+
+
+abranch	( #a_target -- )	gforth
+SET_IP((Xt *)a_target);
+:
+ r> @ >r ;
+
+\ acondbranch(forthname,stackeffect,restline,code,forthcode)
+\ this is non-syntactical: code must open a brace that is closed by the macro
+define(acondbranch,
+$1 ( `#'a_target $2 ) $3
+$4	SET_IP((Xt *)a_target);
+INST_TAIL;
+}
+SUPER_CONTINUE;
+$5
+
+\+glocals
+
+$1-lp+!`#' ( `#'a_target `#'nlocals $2 ) $3_lp_plus_store_number
+$4    lp += nlocals;
+SET_IP((Xt *)a_target);
+INST_TAIL;
+}
+SUPER_CONTINUE;
+
+\+
+)
+
+acondbranch(a?branch,f --,f83	aquestion_branch,
+if (f==0) {
+,:
+ 0= dup     \ !f !f \ !! still uses relative addresses
+ r> dup @   \ !f !f IP branchoffset
+ rot and +  \ !f IP|IP+branchoffset
+ swap 0= cell and + \ IP''
+ >r ;)
+
+\ we don't need an lp_plus_store version of the ?dup-stuff, because it
+\ is only used in if's (yet)
+
+\+xconds
+
+a?dup-?branch	( #a_target f -- f )	new	aquestion_dupe_question_branch
+""The run-time procedure compiled by @code{?DUP-IF}.""
+if (f==0) {
+  sp++;
+  IF_spTOS(spTOS = sp[0]);
+  SET_IP((Xt *)a_target);
+  INST_TAIL;
+}
+SUPER_CONTINUE;
+
+a?dup-0=-?branch ( #a_target f -- ) new	aquestion_dupe_zero_equals_question_branch
+""The run-time procedure compiled by @code{?DUP-0=-IF}.""
+/* the approach taken here of declaring the word as having the stack
+effect ( f -- ) and correcting for it in the branch-taken case costs a
+few cycles in that case, but is easy to convert to a CONDBRANCH
+invocation */
+if (f!=0) {
+  sp--;
+  SET_IP((Xt *)a_target);
+  NEXT;
+}
+SUPER_CONTINUE;
+
+\+
+\f[THEN]
+\fhas? skiploopprims 0= [IF]
+
+acondbranch(a(next),R:n1 -- R:n2,cmFORTH	aparen_next,
+n2=n1-1;
+if (n1) {
+,:
+ r> r> dup 1- >r
+ IF @ >r ELSE cell+ >r THEN ;)
+
+acondbranch(a(loop),R:nlimit R:n1 -- R:nlimit R:n2,gforth	aparen_loop,
+n2=n1+1;
+if (n2 != nlimit) {
+,:
+ r> r> 1+ r> 2dup =
+ IF >r 1- >r cell+ >r
+ ELSE >r >r @ >r THEN ;)
+
+acondbranch(a(+loop),n R:nlimit R:n1 -- R:nlimit R:n2,gforth aparen_plus_loop,
+/* !! check this thoroughly */
+/* sign bit manipulation and test: (x^y)<0 is equivalent to (x<0) != (y<0) */
+/* dependent upon two's complement arithmetic */
+Cell olddiff = n1-nlimit;
+n2=n1+n;	
+if ((olddiff^(olddiff+n))>=0   /* the limit is not crossed */
+    || (olddiff^n)>=0          /* it is a wrap-around effect */) {
+,:
+ r> swap
+ r> r> 2dup - >r
+ 2 pick r@ + r@ xor 0< 0=
+ 3 pick r> xor 0< 0= or
+ IF    >r + >r @ >r
+ ELSE  >r >r drop cell+ >r THEN ;)
+
+\+xconds
+
+acondbranch(a(-loop),u R:nlimit R:n1 -- R:nlimit R:n2,gforth aparen_minus_loop,
+UCell olddiff = n1-nlimit;
+n2=n1-u;
+if (olddiff>u) {
+,)
+
+acondbranch(a(s+loop),n R:nlimit R:n1 -- R:nlimit R:n2,gforth	aparen_symmetric_plus_loop,
+""The run-time procedure compiled by S+LOOP. It loops until the index
+crosses the boundary between limit and limit-sign(n). I.e. a symmetric
+version of (+LOOP).""
+/* !! check this thoroughly */
+Cell diff = n1-nlimit;
+Cell newdiff = diff+n;
+if (n<0) {
+    diff = -diff;
+    newdiff = -newdiff;
+}
+n2=n1+n;
+if (diff>=0 || newdiff<0) {
+,)
+
+a(?do) ( #a_target nlimit nstart -- R:nlimit R:nstart ) gforth	aparen_question_do
+if (nstart == nlimit) {
+    SET_IP((Xt *)a_target);
+    INST_TAIL;
+}
+SUPER_CONTINUE;
+:
+  2dup =
+  IF   r> swap rot >r >r
+       @ >r
+  ELSE r> swap rot >r >r
+       cell+ >r
+  THEN ;				\ --> CORE-EXT
+
+\+xconds
+
+a(+do)	( #a_target nlimit nstart -- R:nlimit R:nstart ) gforth	aparen_plus_do
+if (nstart >= nlimit) {
+    SET_IP((Xt *)a_target);
+    INST_TAIL;
+}
+SUPER_CONTINUE;
+:
+ swap 2dup
+ r> swap >r swap >r
+ >=
+ IF
+     @
+ ELSE
+     cell+
+ THEN  >r ;
+
+a(u+do)	( #a_target ulimit ustart -- R:ulimit R:ustart ) gforth	aparen_u_plus_do
+if (ustart >= ulimit) {
+    SET_IP((Xt *)a_target);
+    INST_TAIL;
+}
+SUPER_CONTINUE;
+:
+ swap 2dup
+ r> swap >r swap >r
+ u>=
+ IF
+     @
+ ELSE
+     cell+
+ THEN  >r ;
+
+a(-do)	( #a_target nlimit nstart -- R:nlimit R:nstart ) gforth	aparen_minus_do
+if (nstart <= nlimit) {
+    SET_IP((Xt *)a_target);
+    INST_TAIL;
+}
+SUPER_CONTINUE;
+:
+ swap 2dup
+ r> swap >r swap >r
+ <=
+ IF
+     @
+ ELSE
+     cell+
+ THEN  >r ;
+
+a(u-do)	( #a_target ulimit ustart -- R:ulimit R:ustart ) gforth	aparen_u_minus_do
+if (ustart <= ulimit) {
+    SET_IP((Xt *)a_target);
+    INST_TAIL;
+}
+SUPER_CONTINUE;
+:
+ swap 2dup
+ r> swap >r swap >r
+ u<=
+ IF
+     @
+ ELSE
+     cell+
+ THEN  >r ;
+
+\+
+
 include(peeprules.vmg)
 
 \+