--- gforth/prim 1999/12/03 18:24:22 1.41 +++ gforth/prim 2000/05/16 09:51:21 1.45 @@ -496,13 +496,10 @@ if (n<0) else if (n>0) n = 1; : - rot 2dup - >r min swap -text dup - IF rdrop - ELSE drop r@ 0> - IF rdrop -1 - ELSE r> 1 and - THEN - THEN ; + rot 2dup swap - >r min swap -text dup + IF rdrop ELSE drop r> sgn THEN ; +: sgn ( n -- -1/0/1 ) + dup 0= IF EXIT THEN 0< 2* 1+ ; -text c_addr1 u c_addr2 -- n new dash_text n = memcmp(c_addr1, c_addr2, u); @@ -514,8 +511,8 @@ else if (n>0) swap bounds ?DO dup c@ I c@ = WHILE 1+ LOOP drop 0 ELSE c@ I c@ - unloop THEN -text-flag ; -: -text-flag ( n -- -1/0/1 ) - dup 0< IF drop -1 ELSE 0> 1 and THEN ; +: sgn ( n -- -1/0/1 ) + dup 0= IF EXIT THEN 0< 2* 1+ ; toupper c1 -- c2 gforth ""If @i{c1} is a lower-case character (in the current locale), @i{c2} @@ -1499,6 +1496,8 @@ wretval = pclose((FILE *)wfileid); wior = IOR(wretval==-1); time&date -- nsec nmin nhour nday nmonth nyear facility-ext time_and_date +""Report the current time of day. Seconds, minutes and hours are numbered from 0. +Months are numbered from 1."" struct timeval time1; struct timezone zone1; struct tm *ltime; @@ -1512,6 +1511,7 @@ nmin =ltime->tm_min; nsec =ltime->tm_sec; ms n -- facility-ext +""Wait at least @i{n} milli-second."" struct timeval timeout; timeout.tv_sec=n/1000; timeout.tv_usec=1000*(n%1000); @@ -1636,21 +1636,26 @@ if (wior) clearerr((FILE *)wfileid); read-line c_addr u1 wfileid -- u2 flag wior file read_line -/* +#if 1 Cell c; flag=-1; for(u2=0; u20); switch(number[u]) { @@ -1884,7 +1896,7 @@ if((flag=FLAG(!(Cell)*endconv))) { IF_FTOS(fp[0] = FTOS); fp += -1; - FTOS = r; + FTOS = sign ? -r : r; } else if(*endconv=='d' || *endconv=='D') { @@ -1894,7 +1906,7 @@ else if(*endconv=='d' || *endconv=='D') { IF_FTOS(fp[0] = FTOS); fp += -1; - FTOS = r; + FTOS = sign ? -r : r; } } @@ -2191,3 +2203,14 @@ fp=FP; IF_TOS(TOS=sp[0];) IF_FTOS(FTOS=fp[0]); +newline -- c_addr u gforth +""String containing the newline sequence of the host OS"" +char newline[] = { +#ifdef unix +'\n' +#else +'\r','\n' +#endif +}; +c_addr=newline; +u=sizeof(newline);