--- gforth/prim 2001/03/18 22:20:27 1.80 +++ gforth/prim 2002/01/04 20:31:53 1.88 @@ -132,6 +132,8 @@ undefine(`index') undefine(`shift') undefine(`symbols') +\g control + noop ( -- ) gforth : ; @@ -179,6 +181,7 @@ \$1 ( `#'ndisp \$2 ) \$3 \$4 SET_IP((Xt *)(((Cell)(IP-1))+ndisp)); TAIL; } +SUPER_CONTINUE; \$5 \+glocals @@ -188,6 +191,7 @@ \$4 lp += nlocals; SET_IP((Xt *)(((Cell)(IP-2))+ndisp)); TAIL; } +SUPER_CONTINUE; \+ ) @@ -214,6 +218,7 @@ if (f==0) { SET_IP((Xt *)(((Cell)(IP-1))+ndisp)); TAIL; } +SUPER_CONTINUE; ?dup-0=-?branch ( #ndisp f -- ) new question_dupe_zero_equals_question_branch ""The run-time procedure compiled by @code{?DUP-0=-IF}."" @@ -226,6 +231,7 @@ if (f!=0) { SET_IP((Xt *)(((Cell)(IP-1))+ndisp)); NEXT; } +SUPER_CONTINUE; \+ \f[THEN] @@ -307,6 +313,7 @@ if (nstart == nlimit) { SET_IP((Xt *)(((Cell)(IP-1))+ndisp)); TAIL; } +SUPER_CONTINUE; : 2dup = IF r> swap rot >r >r @@ -322,6 +329,7 @@ if (nstart >= nlimit) { SET_IP((Xt *)(((Cell)(IP-1))+ndisp)); TAIL; } +SUPER_CONTINUE; : swap 2dup r> swap >r swap >r @@ -337,6 +345,7 @@ if (ustart >= ulimit) { SET_IP((Xt *)(((Cell)(IP-1))+ndisp)); TAIL; } +SUPER_CONTINUE; : swap 2dup r> swap >r swap >r @@ -352,6 +361,7 @@ if (nstart <= nlimit) { SET_IP((Xt *)(((Cell)(IP-1))+ndisp)); TAIL; } +SUPER_CONTINUE; : swap 2dup r> swap >r swap >r @@ -367,6 +377,7 @@ if (ustart <= ulimit) { SET_IP((Xt *)(((Cell)(IP-1))+ndisp)); TAIL; } +SUPER_CONTINUE; : swap 2dup r> swap >r swap >r @@ -409,6 +420,8 @@ k ( R:n R:d1 R:d2 -- n R:n R:d1 R:d2 ) \ digit is high-level: 0/0% +\g strings + move ( c_from c_to ucount -- ) core ""Copy the contents of @i{ucount} aus at @i{c-from} to @i{c-to}. @code{move} works correctly even if the two areas overlap."" @@ -518,6 +531,8 @@ u2 = u1-n; : tuck - >r + r> dup 0< IF - 0 THEN ; +\g arith + + ( n1 n2 -- n ) core plus n = n1+n2; @@ -915,6 +930,8 @@ f = FLAG(u1-u2 < u3-u2); : over - >r - r> u< ; +\g internal + sp@ ( -- a_addr ) gforth sp_fetch a_addr = sp+1; @@ -942,6 +959,8 @@ fp = f_addr; ""The primitive compiled by @code{EXIT}."" SET_IP((Xt *)w); +\g stack + >r ( w -- R:w ) core to_r : (>r) ; @@ -1381,6 +1400,8 @@ n=1; \f[THEN] +\g hostos + key-file ( wfileid -- n ) gforth paren_key_file #ifdef HAS_FILE fflush(stdout); @@ -1454,7 +1475,7 @@ c_addr2 = getenv(cstr(c_addr1,u1,1)); u2 = (c_addr2 == NULL ? 0 : strlen(c_addr2)); open-pipe ( c_addr u wfam -- wfileid wior ) gforth open_pipe -wfileid=(Cell)popen(cstr(c_addr,u,1),fileattr[wfam]); /* ~ expansion of 1st arg? */ +wfileid=(Cell)popen(cstr(c_addr,u,1),pfileattr[wfam]); /* ~ expansion of 1st arg? */ wior = IOR(wfileid==0); /* !! the man page says that errno is not set reliably */ close-pipe ( wfileid -- wretval wior ) gforth close_pipe @@ -1596,7 +1617,7 @@ if (wior) clearerr((FILE *)wfileid); read-line ( c_addr u1 wfileid -- u2 flag wior ) file read_line -""this is only for backward compatibility"" +/* this may one day be replaced with : read-line (read-line) nip ; */ Cell c; flag=-1; for(u2=0; u2