--- gforth/prim 1999/05/09 21:21:55 1.30 +++ gforth/prim 1999/08/07 21:40:35 1.37 @@ -129,6 +129,7 @@ EXEC(*(Xt *)a_addr); : @ execute ; +\fhas? skipbranchprims 0= [IF] \+glocals branch-lp+!# -- gforth branch_lp_plus_store_number @@ -208,6 +209,8 @@ else INC_IP(1); \+ +\f[THEN] +\fhas? skiploopprims 0= [IF] condbranch((next),-- cmFORTH paren_next, if ((*rp)--) { @@ -437,30 +440,33 @@ n = rp[4]; r> r> r> r> r> r> dup itmp ! >r >r >r >r >r >r itmp @ ; [IFUNDEF] itmp variable itmp [THEN] +\f[THEN] + \ digit is high-level: 0/0% move c_from c_to ucount -- core -"" If @i{ucount}>0, copy the contents of @i{ucount} address units -at @i{c-from} to @i{c-to}. @code{move} chooses its copy direction -to avoid problems when @i{c-from}, @i{c-to} overlap."" +""Copy the contents of @i{ucount} address units at @i{c-from} to +@i{c-to}. @code{move} works correctly even if the two areas overlap."" memmove(c_to,c_from,ucount); /* make an Ifdef for bsd and others? */ : >r 2dup u< IF r> cmove> ELSE r> cmove THEN ; cmove c_from c_to u -- string -"" If @i{u}>0, copy the contents of @i{ucount} characters from -data space at @i{c-from} to @i{c-to}. The copy proceeds @code{char}-by-@code{char} -from low address to high address."" +""Copy the contents of @i{ucount} characters from data space at +@i{c-from} to @i{c-to}. The copy proceeds @code{char}-by-@code{char} +from low address to high address; i.e., for overlapping areas it is +safe if @i{c-to}=<@i{c-from}."" while (u-- > 0) *c_to++ = *c_from++; : bounds ?DO dup c@ I c! 1+ LOOP drop ; cmove> c_from c_to u -- string c_move_up -"" If @i{u}>0, copy the contents of @i{ucount} characters from -data space at @i{c-from} to @i{c-to}. The copy proceeds @code{char}-by-@code{char} -from high address to low address."" +""Copy the contents of @i{ucount} characters from data space at +@i{c-from} to @i{c-to}. The copy proceeds @code{char}-by-@code{char} +from high address to low address; i.e., for overlapping areas it is +safe if @i{c-to}>=@i{c-from}."" while (u-- > 0) c_to[u] = c_from[u]; : @@ -482,7 +488,11 @@ the first string is smaller, @i{n} is -1 is 1. Currently this is based on the machine's character comparison. In the future, this may change to consider the current locale and its collation order."" +#ifdef MEMCMP_AS_SUBROUTINE +n = gforth_memcmp(c_addr1, c_addr2, u10) THEN ; -text c_addr1 u c_addr2 -- n new dash_text +#ifdef MEMCMP_AS_SUBROUTINE +n = gforth_memcmp(c_addr1, c_addr2, u); +#else n = memcmp(c_addr1, c_addr2, u); +#endif if (n<0) n = -1; else if (n>0) @@ -713,6 +727,7 @@ ud = (UDCell)u1 * (UDCell)u2; and >r >r 2dup d+ swap r> + swap r> ; um/mod ud u1 -- u2 u3 core u_m_slash_mod +""ud=u3*u1+u2, u1>u2>=0"" #ifdef BUGGY_LONG_LONG UDCell r = umdiv(ud,u1); u2=r.hi; @@ -928,6 +943,13 @@ dcomparisons(du, ud1 ud2, d_u_, ud1, ud2 \+ within u1 u2 u3 -- f core-ext +""u2=r - r> u< ; @@ -1252,7 +1274,11 @@ while(a_addr != NULL) f83name1=(struct F83Name *)(a_addr[1]); a_addr=(Cell *)(a_addr[0]); if ((UCell)F83NAME_COUNT(f83name1)==u && +#ifdef MEMCMP_AS_SUBROUTINE + gforth_memcmp(c_addr, f83name1->name, u)== 0 /* or inline? */) +#else memcmp(c_addr, f83name1->name, u)== 0 /* or inline? */) +#endif { f83name2=f83name1; break; @@ -1339,7 +1365,8 @@ a_addr = PFA(xt); : 2 cells + ; -\+standardthreading +\ threading stuff is currently only interesting if we have a compiler +\fhas? standardthreading has? compiler and [IF] >code-address xt -- c_addr gforth to_code_address ""@i{c-addr} is the code address of the word @i{xt}."" @@ -1401,7 +1428,7 @@ n=1; : 1 ; -\+ +\f[THEN] key-file wfileid -- n gforth paren_key_file #ifdef HAS_FILE @@ -1667,7 +1694,7 @@ wior = FILEIO(putc(c, (FILE *)wfileid)== if (wior) clearerr((FILE *)wfileid); #else -putc(c, stdout); +PUTC(c); #endif \+file @@ -2164,3 +2191,12 @@ UP=up=(char *)a_addr; : up ! ; Variable UP + +wcall u -- gforth +IF_FTOS(fp[0]=FTOS); +FP=fp; +sp=(SYSCALL(Cell(*)(Cell *, void *))u)(sp, &FP); +fp=FP; +IF_TOS(TOS=sp[0];) +IF_FTOS(FTOS=fp[0]); +