--- gforth/prim 2010/08/21 19:08:46 1.254 +++ gforth/prim 2011/12/19 19:43:29 1.263 @@ -1,6 +1,6 @@ \ Gforth primitives -\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008,2009 Free Software Foundation, Inc. +\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008,2009,2010 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -612,6 +612,24 @@ SET_IP((Xt *)a_target); cell+ THEN >r ; +(try1) ( ... a_oldhandler a_recovery -- R:a_recovery R:a_sp R:f_fp R:c_lp R:a_oldhandler a_newhandler ) gforth paren_try1 +a_sp = sp-1; +f_fp = fp; +c_lp = lp; +a_newhandler = rp-5; + +(throw1) ( ... wball a_handler -- ... wball ) gforth paren_throw1 +rp = a_handler; +lp = (Address)rp[1]; +fp = (Float *)rp[2]; +sp = (Cell *)rp[3]; +#ifndef NO_IP +ip=IP; +#endif +SUPER_END; +VM_JUMP(EXEC1(*(Xt *)rp[4])); + + \+ \ don't make any assumptions where the return stack is!! @@ -1085,6 +1103,22 @@ lshift ( u1 n -- u2 ) core l_shift : 0 ?DO 2* LOOP ; +umax ( u1 u2 -- u ) core +if (u1 IF swap THEN drop ; + \g compare \ comparisons(prefix, args, prefix, arg1, arg2, wordsets...) @@ -1786,6 +1820,8 @@ if (a_addr1==NULL) else a_addr2 = (Cell *)realloc(a_addr1, u); wior = IOR(a_addr2==NULL); /* !! Define a return code */ +if (a_addr2==NULL) + a_addr2 = a_addr1; strerror ( n -- c_addr u ) gforth c_addr = (Char *)strerror(n); @@ -2013,6 +2049,19 @@ duser = timeval2us(&time1); dsystem = DZERO; #endif +ntime ( -- dtime ) gforth +""Report the current time in nanoseconds since some epoch."" +struct timespec time1; +#ifdef HAVE_CLOCK_GETTIME +clock_gettime(CLOCK_REALTIME,&time1); +#else +struct timeval time2; +gettimeofday(&time2,NULL); +time1.tv_sec = time2.tv_sec; +time1.tv_nsec = time2.tv_usec*1000; +#endif +dtime = timespec2ns(&time1); + \+ \+floating