--- gforth/prim 1999/05/06 21:33:32 1.29 +++ gforth/prim 1999/08/20 17:22:51 1.38 @@ -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]; : @@ -713,6 +719,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 +935,13 @@ dcomparisons(du, ud1 ud2, d_u_, ud1, ud2 \+ within u1 u2 u3 -- f core-ext +""u2=r - r> u< ; @@ -1339,7 +1353,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 +1416,7 @@ n=1; : 1 ; -\+ +\f[THEN] key-file wfileid -- n gforth paren_key_file #ifdef HAS_FILE @@ -1636,7 +1651,7 @@ wior=FILEIO(ferror((FILE *)wfileid)); */ if ((flag=FLAG(!feof((FILE *)wfileid) && fgets(c_addr,u1+1,(FILE *)wfileid) != NULL))) { - wior=FILEIO(ferror((FILE *)wfileid)); /* !! ior? */ + wior=FILEIO(ferror((FILE *)wfileid)!=0); /* !! ior? */ if (wior) clearerr((FILE *)wfileid); u2 = strlen(c_addr); @@ -1667,7 +1682,7 @@ wior = FILEIO(putc(c, (FILE *)wfileid)== if (wior) clearerr((FILE *)wfileid); #else -putc(c, stdout); +PUTC(c); #endif \+file @@ -2164,3 +2179,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]); +