From: <cli...@li...> - 2010-12-14 20:08:09
|
Send clisp-cvs mailing list submissions to cli...@li... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to cli...@li... You can reach the person managing the list at cli...@li... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/src ChangeLog,1.7566,1.7567 pathname.d,1.525,1.526 (Sam Steingold) 2. clisp/tests path.tst,1.93,1.94 (Sam Steingold) 3. clisp/src ChangeLog, 1.7567, 1.7568 lispbibl.d, 1.915, 1.916 spvw.d, 1.542, 1.543 spvw_gcstat.d, 1.9, 1.10 stream.d, 1.691, 1.692 subr.d, 1.277, 1.278 time.d, 1.77, 1.78 zthread.d, 1.91, 1.92 (Vladimir Tzankov) 4. clisp/src ChangeLog,1.7568,1.7569 time.d,1.78,1.79 (Sam Steingold) ---------------------------------------------------------------------- Message: 1 Date: Thu, 21 Oct 2010 15:35:27 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog,1.7566,1.7567 pathname.d,1.525,1.526 To: cli...@li... Message-ID: <E1P...@sf...> Update of /cvsroot/clisp/clisp/src In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv8831/src Modified Files: ChangeLog pathname.d Log Message: whitespace Index: pathname.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/pathname.d,v retrieving revision 1.525 retrieving revision 1.526 diff -u -d -r1.525 -r1.526 --- pathname.d 21 Oct 2010 03:00:46 -0000 1.525 +++ pathname.d 21 Oct 2010 15:35:24 -0000 1.526 @@ -6004,7 +6004,7 @@ ? &filedata.ftLastWriteTime : &filedata.ftCreationTime); if (fsize) *fsize = off_to_I( ((uint64)filedata.nFileSizeHigh<<32)|filedata.nFileSizeLow); - if (filedata.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) + if (filedata.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) return NAMESTRING_DIR; else return NAMESTRING_FILE; } else { @@ -6043,8 +6043,8 @@ namestring_asciz, { while (true) { classification = classify_namestring(namestring_asciz,resolved, - &STACK_1/*fwd*/,&STACK_2/*fsize*/); - if (classification == NAMESTRING_NONE + &STACK_1/*fwd*/,&STACK_2/*fsize*/); + if (classification == NAMESTRING_NONE && namestring_asciz_bytelen > 1 /* no need to classify "" */ && cpslashp(namestring_asciz[namestring_asciz_bytelen-1])) namestring_asciz[--namestring_asciz_bytelen] = 0; /* strip last slash */ Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.7566 retrieving revision 1.7567 diff -u -d -r1.7566 -r1.7567 --- ChangeLog 21 Oct 2010 08:07:08 -0000 1.7566 +++ ChangeLog 21 Oct 2010 15:35:24 -0000 1.7567 @@ -1,6 +1,6 @@ 2010-10-21 Arseny Slobodyuk <am...@us...> - * makemake.in (cygwin_finish): use realpath and cygpath to + * makemake.in (cygwin_finish): use realpath and cygpath to avoid cygcheck bug with symbolic links 2010-10-21 Arseny Slobodyuk <am...@us...> @@ -8,7 +8,7 @@ Fix PROBE-PATHNAME: proper handle of "/" on UNIX, DWIM on WIN32 (broken 10-18) "lisp.exe/" -> "path/lisp.exe" * pathname.d (PROBE-PATHNAME): strip last "/" in a loop - (classify_namestring) [UNIX]: handle ENOTDIR + (classify_namestring) [UNIX]: handle ENOTDIR like ERROR_INVALID_NAME is handled on WIN32 2010-10-20 Sam Steingold <sd...@gn...> ------------------------------ Message: 2 Date: Thu, 21 Oct 2010 17:13:57 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/tests path.tst,1.93,1.94 To: cli...@li... Message-ID: <E1P...@sf...> Update of /cvsroot/clisp/clisp/tests In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv24790 Modified Files: path.tst Log Message: yet another win32 ext:probe-pathname test Index: path.tst =================================================================== RCS file: /cvsroot/clisp/clisp/tests/path.tst,v retrieving revision 1.93 retrieving revision 1.94 diff -u -d -r1.93 -r1.94 --- path.tst 15 Oct 2010 18:52:36 -0000 1.93 +++ path.tst 21 Oct 2010 17:13:55 -0000 1.94 @@ -1291,6 +1291,13 @@ (list (pathname-name p) (pathname-type p))) #+(and clisp win32) (NIL NIL) +#+(and clisp win32) +(equalp (multiple-value-list (ext:probe-pathname "/")) + (multiple-value-list (ext:probe-pathname ; default device + (make-pathname :directory '(:absolute) :defaults + (ext:default-directory))))) +#+(and clisp win32) T + #+(and clisp unicode) (block test-weird-pathnames (handler-bind ((parse-error ------------------------------ Message: 3 Date: Thu, 21 Oct 2010 18:42:20 +0000 From: Vladimir Tzankov <vt...@us...> Subject: clisp/src ChangeLog, 1.7567, 1.7568 lispbibl.d, 1.915, 1.916 spvw.d, 1.542, 1.543 spvw_gcstat.d, 1.9, 1.10 stream.d, 1.691, 1.692 subr.d, 1.277, 1.278 time.d, 1.77, 1.78 zthread.d, 1.91, 1.92 To: cli...@li... Message-ID: <E1P...@sf...> Update of /cvsroot/clisp/clisp/src In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv27699/src Modified Files: ChangeLog lispbibl.d spvw.d spvw_gcstat.d stream.d subr.d time.d zthread.d Log Message: [MULTITHREAD]: provide real/run time information on individual threads when supported by OS Index: spvw_gcstat.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw_gcstat.d,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- spvw_gcstat.d 17 Nov 2008 23:15:18 -0000 1.9 +++ spvw_gcstat.d 21 Oct 2010 18:42:17 -0000 1.10 @@ -48,10 +48,10 @@ #define gc_timer_on() \ { var internal_time_t gcstart_time; \ - get_running_time(gcstart_time); /* get current elapsed time and store */ + get_run_time(&gcstart_time); /* get current elapsed time and store */ #define gc_timer_off() \ { var internal_time_t gcend_time; \ - get_running_time(gcend_time); \ + get_run_time(&gcend_time); \ /* calculate difference between gcend_time and gcstart_time: */ \ sub_internal_time(gcend_time,gcstart_time, gcend_time); \ /* add this difference to gc_time: */ \ Index: zthread.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/zthread.d,v retrieving revision 1.91 retrieving revision 1.92 diff -u -d -r1.91 -r1.92 --- zthread.d 4 Oct 2010 21:52:12 -0000 1.91 +++ zthread.d 21 Oct 2010 18:42:17 -0000 1.92 @@ -15,7 +15,7 @@ global xmutex_t all_exemptions_lock; /* signals an error of obj is not thread. returns the thread*/ -local maygc object check_thread(object obj) +global maygc object check_thread(object obj) { while (!threadp(obj)) { pushSTACK(NIL); /* no PLACE */ @@ -255,6 +255,7 @@ error (error xxx) happens in the thread. */ finish_entry_frame(DRIVER,returner,,{ skipSTACK(2+3+1);STACK_0=NIL;goto end_of_thread;}); + init_time(); /* initialize thread time variables */ /* initialize the low level i/o stuff for this thread*/ init_reader_low(me); /* initialize thread special variables bindings */ Index: stream.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/stream.d,v retrieving revision 1.691 retrieving revision 1.692 diff -u -d -r1.691 -r1.692 --- stream.d 28 Sep 2010 14:22:21 -0000 1.691 +++ stream.d 21 Oct 2010 18:42:17 -0000 1.692 @@ -3997,7 +3997,7 @@ nonreturning_function(extern, error_unencodable, (object encoding, chart ch)); /* Avoid annoying warning caused by a wrongly standardized iconv() prototype. */ -#ifdef GNU_LIBICONV +#if defined(GNU_LIBICONV) && !defined(UNIX_MACOSX) #undef iconv #define iconv(cd,inbuf,inbytesleft,outbuf,outbytesleft) \ libiconv(cd,(ICONV_CONST char **)(inbuf),inbytesleft,outbuf,outbytesleft) @@ -4758,11 +4758,9 @@ var uintB b; pushSTACK(stream); /*restart_it:*/ - run_time_stop(); /* hold run time clock */ /* try to read a byte */ var ssize_t result; GC_SAFE_SYSTEM_CALL(result=, full_read(handle,&b,1)); - run_time_restart(); /* resume run time clock */ stream=popSTACK(); if (result<0) { #ifdef WIN32_NATIVE @@ -5035,12 +5033,10 @@ if ((persev == persev_immediate || persev == persev_bonus) && ChannelStream_regular(stream)) persev = persev_partial; - run_time_stop(); /* hold run time clock */ pushSTACK(stream); var ssize_t result; GC_SAFE_SYSTEM_CALL(result=, fd_read(handle,byteptr,len,persev)); stream = popSTACK(); - run_time_restart(); /* resume run time clock */ if (result<0) { #if !defined(WIN32_NATIVE) begin_system_call(); @@ -8768,11 +8764,9 @@ { /* read a character: */ var uintB c; read_next_char: { - run_time_stop(); /* hold run time clock */ begin_system_call(); var int result = read(stdin_handle,&c,1); /* try to read a byte */ end_system_call(); - run_time_restart(); /* resume run time clock */ if (result<0) { begin_system_call(); if (errno==EINTR) { /* break (poss. by Ctrl-C) ? */ @@ -8838,11 +8832,9 @@ pollfd_bag[0].events = POLLIN; pollfd_bag[0].revents = 0; restart_poll: - run_time_stop(); /* hold run time clock */ begin_system_call(); var int result = poll(&pollfd_bag[0],1,100); /* 1/10 sec */ end_system_call(); - run_time_restart(); /* resume run time clock */ if (result<0) { begin_system_call(); if (errno==EINTR) { @@ -8865,12 +8857,10 @@ FD_ZERO(&handle_set); FD_SET(stdin_handle,&handle_set); restart_select: small_time.tv_sec = 0; small_time.tv_usec = 1000000/10; /* 1/10 sec */ - run_time_stop(); /* hold run time clock */ begin_system_call(); var int result; result = select(FD_SETSIZE,&handle_set,NULL,NULL,&small_time); end_system_call(); - run_time_restart(); /* resume run time clock */ if (result<0) { begin_system_call(); if (errno==EINTR) { @@ -8899,7 +8889,6 @@ var struct termio oldtermio; var struct termio newtermio; #endif - run_time_stop(); /* hold run time clock */ begin_system_call(); #ifdef UNIX_TERM_TERMIOS if (!( tcgetattr(stdin_handle,&oldtermio) ==0)) { @@ -8937,7 +8926,6 @@ } #endif end_system_call(); - run_time_restart(); /* resume run time clock */ if (result<0) { begin_system_call(); if (errno==EINTR) { /* break (poss. by Ctrl-C) ? */ @@ -9733,12 +9721,10 @@ rl_basic_word_break_characters = "\t\n \"#'(),;`"; rl_basic_quote_characters = "\"|"; rl_completer_quote_characters = "\\|"; - run_time_stop(); /* hold run time clock */ begin_blocking_system_call(); rl_already_prompted = true; var char* line = strip_white(readline(prompt==NULL ? "" : prompt)); end_blocking_system_call(); - run_time_restart(); /* resume run time clock */ if (line==NULL) /* detect EOF (at the start of line) */ return eof_value; Index: time.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/time.d,v retrieving revision 1.77 retrieving revision 1.78 diff -u -d -r1.77 -r1.78 --- time.d 25 Oct 2009 14:01:16 -0000 1.77 +++ time.d 21 Oct 2010 18:42:17 -0000 1.78 @@ -44,15 +44,48 @@ #ifdef TIME_WIN32 /* The unit is 0.1 µsec. */ #endif - /* Running time: */ + /* Real time: */ +local bool realstart_time_initialized = false; local internal_time_t realstart_time; /* real time at start of LISP session */ -#ifndef HAVE_RUN_TIME -/* Time that the LISP session consumes: */ -local uintL run_time = 0; /* total runtime up to now */ -local uintL runstop_time; /* if the stop watch is running: - the time of the last run-stop change */ -local bool run_flag = false; /* true if the stop watch is running */ + +/* UP: return thread object from optional argument passed to + GET-INTERNAL-RUN-TIME and %%TIME + < obj: optional argument passed + > thread object (always nullobj w/o threads) */ +local inline object thread_from_arg(object obj) { +#ifndef MULTITHREAD + return nullobj; +#else + return missingp(obj) ? nullobj : + ((eq(T,obj)) ? current_thread()->_lthread : check_thread(obj)); +#endif +} + +/* UP: gets thread or process real start time */ +local /*maygc*/ bool real_start_time(object thread, internal_time_t *tp) { + var bool ret = true; + if (eq(thread, nullobj)) /* always true when ! MT*/ + *tp = realstart_time; + else +#ifdef MULTITHREAD + if (eq(thread, current_thread()->_lthread)) /* we are alive for sure */ + *tp = current_thread()->thr_realstart_time; + else { + /* it's another thread - have to be sure it does not exit while we + obtain its real start time (xth_globals are released upon termination)*/ + pushSTACK(thread); + WITH_OS_MUTEX_LOCK(1,&allthreads_lock, { + var clisp_thread_t *clt = TheThread(STACK_0)->xth_globals; + if ((ret = (clt != NULL))) /* still alive */ + *tp = clt->thr_realstart_time; + }); + skipSTACK(1); + } +#else /* ! MT */ + ASSERT(0); /* w/o MT thread == nullobj always */ #endif + return ret; +} #ifdef TIME_UNIX @@ -79,20 +112,39 @@ } /* Returns the run time counter. - get_run_time(&runtime); - < internal_time_t runtime: consumed run time since session start (in ticks) */ -global void get_run_time (internal_time_t* runtime) + get_thread_run_time(&runtime, thread); + > thread: thread for which to obtain info (nullobj for process wide) + < internal_time_t runtime: consumed run time since session start (in ticks) + < returns true if successful (may fail in MT) */ +global bool get_thread_run_time (internal_time_t* runtime, object thread) { #if defined(HAVE_GETRUSAGE) var struct rusage rusage; + var int who = RUSAGE_SELF; +#ifdef MULTITHREAD + if (!eq(thread, nullobj)) { + #ifdef RUSAGE_THREAD + /* we can obtain info only about current thread */ + if (!eq(thread, current_thread()->_lthread)) + return false; + who = RUSAGE_THREAD; + #else + /* TODO: implement for UNIX_MACOSX */ + return false; /* no RUSAGE_THREAD */ + #endif + } +#endif begin_system_call(); - if (!( getrusage(RUSAGE_SELF,&rusage) ==0)) { OS_error(); } + if (!( getrusage(who,&rusage) ==0)) { OS_error(); } end_system_call(); /* runtime = user time + system time */ add_internal_time(rusage.ru_utime,rusage.ru_stime, *runtime); #elif defined(HAVE_SYS_TIMES_H) var uintL used_time; /* consumed time, measured in 1/HZ seconds */ var struct tms tms; +#ifdef MULTITHREAD + if (!eq(thread, nullobj)) return false; +#endif begin_system_call(); if (times(&tms) == (clock_t)(-1)) used_time = 0; /* times() failed -> used_time unknown */ @@ -112,6 +164,7 @@ runtime->tv_sec = floor(used_time,HZ); runtime->tv_usec = (used_time % HZ) * floor(2*1000000+HZ,2*HZ); #endif + return true; } #endif @@ -125,72 +178,102 @@ { GetSystemTimeAsFileTime(it); } /* Returns the run time counter. - get_run_time(&runtime); - < internal_time_t runtime: consumed run time since session start (in ticks) */ -global void get_run_time (internal_time_t* runtime) + get_thread_run_time(&runtime, thread); + > thread: thread for which to obtain info (nullobj for process wide) + < internal_time_t runtime: consumed run time since session start (in ticks) + < returns true if successful (may fail in MT) */ +global bool get_thread_run_time (internal_time_t* runtime, object thread) { var FILETIME creation_time; var FILETIME exit_time; var FILETIME kernel_time; var FILETIME user_time; - begin_system_call(); - if (GetProcessTimes(GetCurrentProcess(),&creation_time,&exit_time, - &kernel_time,&user_time)) { + var BOOL time_obtained; +#ifdef MULTITHREAD + if (!eq(thread, nullobj)) { + time_obtained = FALSE; + var HANDLE hThread = OpenThread(THREAD_QUERY_INFORMATION , FALSE, + TheThread(thread)->xth_system); + if (hThread != NULL) { + time_obtained = GetThreadTimes(hThread,&creation_time, &exit_time, + &kernel_time,&user_time); + CloseHandle(hThread); + } + if (!time_obtained) return false; + } else +#endif + { + begin_system_call(); + time_obtained = GetProcessTimes(GetCurrentProcess(),&creation_time, + &exit_time,&kernel_time,&user_time); end_system_call(); + } + + if (time_obtained) { /* runtime = User time + Kernel time */ add_internal_time(user_time,kernel_time, *runtime); } else { if (!(GetLastError()==ERROR_CALL_NOT_IMPLEMENTED)) { OS_error(); } /* GetProcessTimes() is not implemented on Win95. Use get_real_time() instead. This is only a crude approximation, I know. - (We keep HAVE_RUN_TIME defined, so that Win95 users will notice - that "Run time" and "Real time" are always the same and draw their - conclusions from it.) */ - end_system_call(); + ( Win95 users will notice that "Run time" and "Real time" are always + the same and draw their conclusions from it.) */ var internal_time_t real_time; get_real_time(&real_time); sub_internal_time(real_time,realstart_time, *runtime); } + return true; } - #endif -/* Returns the whole set of run time counters. - get_running_times(×core); - < timescore.runtime: consumed run time since start of session (in ticks) - < timescore.realtime: real time since start of session (in ticks) - < timescore.gctime: GC time since start of session (in ticks) - < timescore.gccount: number of GCs since start of session - < timescore.gcfreed: number of reclaimed bytes since start of session */ -global void get_running_times (timescore_t* tm) -{ - #ifndef HAVE_RUN_TIME - var uintL time = get_time(); - tm->realtime = time - realstart_time; - tm->runtime = (run_flag ? - time - runstop_time + run_time : /* stop-watch still running*/ - run_time); /* stop-watched stopped */ - #endif - #ifdef TIME_UNIX - /* Get real time: */ - var internal_time_t real_time; - get_real_time(&real_time); - tm->realtime.tv_sec = real_time.tv_sec - realstart_time.tv_sec; - tm->realtime.tv_usec = real_time.tv_usec; - /* Get run time: */ - get_run_time(&tm->runtime); - #endif - #ifdef TIME_WIN32 - /* Get real time: */ - var internal_time_t real_time; - get_real_time(&real_time); - sub_internal_time(real_time,realstart_time, tm->realtime); - /* Get run time: */ - get_run_time(&tm->runtime); - #endif +/* UP: helper function for obtaining timing statistics for thread/process + > thread: thread for which we want info. nullobj for process + < tm: run time, real time, gc time and gc stat + < returns bitmask indicating which fields in tm are valid + Failures are possible only in threaded builds. Asking for process info + always succeeds and does not GC */ +#define RUN_TIME_INVALID 1 +#define REAL_TIME_INVALID 2 +local uintL /*maygc*/ get_running_times_helper (timescore_t* tm, object thread) { + var uintL ret = 0; /* everything valid */ + var internal_time_t real_start; + if (real_start_time(thread, &real_start)) { +#ifdef TIME_UNIX + /* Get real time: */ + var internal_time_t real_time; + get_real_time(&real_time); + tm->realtime.tv_sec = real_time.tv_sec - realstart_time.tv_sec; + tm->realtime.tv_usec = real_time.tv_usec; +#endif +#ifdef TIME_WIN32 + /* Get real time: */ + var internal_time_t real_time; + get_real_time(&real_time); + sub_internal_time(real_time,realstart_time, tm->realtime); +#endif + } else + ret |= REAL_TIME_INVALID; + /* Get run time: */ + if (!get_thread_run_time(&tm->runtime, thread)) + ret |= RUN_TIME_INVALID; + /* GC stat */ tm->gctime = gc_time; tm->gccount = gc_count; tm->gcfreed = gc_space; + return ret; +} + + +/* Returns the whole set of run time counters. + get_running_times(×core); + < timescore.runtime: Run-time since LISP-system-start (in Ticks) + < timescore.realtime: Real-time since LISP-system-start (in Ticks) + < timescore.gctime: GC-Time since LISP-system-start (in Ticks) + < timescore.gccount: Number of GC's since LISP-system-start + < timescore.gcfreed: Size of the space reclaimed by the GC's so far*/ +global void get_running_times (timescore_t* tm) { + /* no failure or GC possible with following call */ + get_running_times_helper(tm, nullobj); } /* Converts an internal_time_t to a Lisp integer. @@ -222,11 +305,14 @@ VALUES1(internal_time_to_I(&tp)); /* convert to integer */ } -LISPFUNNR(get_internal_run_time,0) -{ /* (GET-INTERNAL-RUN-TIME), CLTL p. 446 */ - var timescore_t tm; - get_running_times(&tm); /* get run time since start of session */ - VALUES1(internal_time_to_I(&tm.runtime)); /* convert to integer */ +LISPFUN(get_internal_run_time,seclass_read,0,1,norest,nokey,0,NIL) +{ /* (GET-INTERNAL-RUN-TIME), CLTL p. 446 + extension: optional argument (GET-INTERNAL-RUN-TIME thread) */ + var internal_time_t tp; + if (get_thread_run_time(&tp, thread_from_arg(popSTACK()))) + VALUES1(internal_time_to_I(&tp)); /* convert to integer */ + else + VALUES1(NIL); /* could not obtain it */ } /* ------------------------------------------------------------------------ @@ -378,21 +464,21 @@ VALUES1(UL_to_I(real_time_sec())); } -/* UP: Initialises the time variables at the LISP session start. +/* UP: Initialises the time variables at the LISP session/thread start. init_time(); */ -global void init_time (void) -{ /* No gc happened -> no time to be added. - gc_count=0; - gc_time=0; - gc_space=0; */ - #ifndef HAVE_RUN_TIME - /* run_time = 0; -- no run-time used, */ - run_flag = false; /* because system is not yet running. */ - run_time_restart(); /* start run-time stopwatch */ - #endif - #if defined(TIME_UNIX) || defined(TIME_WIN32) - get_real_time(&realstart_time); /* Current time counter, now at the session start */ - #endif +void init_time () { +#ifdef MULTITHREAD + get_real_time(¤t_thread()->thr_realstart_time); + if (!realstart_time_initialized) { + realstart_time = current_thread()->thr_realstart_time; + realstart_time_initialized = true; + } +#else /* ! MT */ + if (!realstart_time_initialized) { + get_real_time(&realstart_time); + realstart_time_initialized = true; + } +#endif } /* ------------------------------------------------------------------------ @@ -573,8 +659,8 @@ } #endif -LISPFUNNR(time,0) -{ /* (SYSTEM::%%TIME) returns the time/space resource usage, +LISPFUN(time,seclass_read,0,1,norest,nokey,0,NIL) +{ /* (SYSTEM::%%TIME thread) returns the time/space resource usage, without allocating space by itself and thereby causing a GC. 9 values: Real-Time (system time since system start) in 2 values, @@ -592,25 +678,32 @@ in 2 values: (ldb (byte 24 24) Space), (ldb (byte 24 0) Space). GC-Count (number of garbage collections in this session so far). */ var timescore_t tm; - get_running_times(&tm); /* get run-time */ + var uintL ts = get_running_times_helper(&tm, thread_from_arg(popSTACK())); #if defined(TIME_UNIX) #define as_2_values(time) \ pushSTACK(fixnum(time.tv_sec)); \ pushSTACK(fixnum(time.tv_usec)); #elif defined(TIME_WIN32) - #define as_2_values(time) \ - { var uintL tv_sec; \ - var uintL tv_usec; \ + #define as_2_values(time) \ + { var uintL tv_sec; \ + var uintL tv_usec; \ divu_6432_3232(time.dwHighDateTime,time.dwLowDateTime,ticks_per_second, tv_sec=, tv_usec=); \ - pushSTACK(fixnum(tv_sec)); \ - pushSTACK(fixnum(tv_usec)); \ + pushSTACK(fixnum(tv_sec)); \ + pushSTACK(fixnum(tv_usec)); \ } #else #error SYSTEM::%%TIME: neither TIME_UNIX nor TIME_WIN32 #endif - as_2_values(tm.realtime); /* first two values: Real-Time */ - as_2_values(tm.runtime); /* next two values: Run-Time */ - as_2_values(tm.gctime); /* next two values: GC-Time */ + /* first two values: Real-Time */ + if (ts & REAL_TIME_INVALID) { + pushSTACK(NIL); pushSTACK(NIL); + } else { as_2_values(tm.realtime); } + /* next two values: Run-Time */ + if (ts & RUN_TIME_INVALID) { + pushSTACK(NIL); pushSTACK(NIL); + } else { as_2_values(tm.runtime); } + /* next two values: GC-Time */ + as_2_values(tm.gctime); /* next two values: Space tm.gcfreed = freed space by the GC */ { Index: subr.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/subr.d,v retrieving revision 1.277 retrieving revision 1.278 diff -u -d -r1.277 -r1.278 --- subr.d 19 Feb 2010 20:36:06 -0000 1.277 +++ subr.d 21 Oct 2010 18:42:17 -0000 1.278 @@ -739,13 +739,13 @@ #endif /* ---------- TIME ---------- */ LISPFUNNR(get_internal_real_time,0) -LISPFUNNR(get_internal_run_time,0) +LISPFUN(get_internal_run_time,seclass_read,0,1,norest,nokey,0,NIL) LISPFUNNR(get_universal_time,0) #if defined(UNIX) || defined(WIN32) LISPFUNNR(default_time_zone,2) #endif LISPFUNN(sleep,2) -LISPFUNNR(time,0) +LISPFUN(time,seclass_read,0,1,norest,nokey,0,NIL) LISPFUNNF(delta4,5) /* ---------- PACKAGE ---------- */ LISPFUNNR(make_symbol,1) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.7567 retrieving revision 1.7568 diff -u -d -r1.7567 -r1.7568 --- ChangeLog 21 Oct 2010 15:35:24 -0000 1.7567 +++ ChangeLog 21 Oct 2010 18:42:17 -0000 1.7568 @@ -1,3 +1,34 @@ +2010-10-21 Vladimir Tzankov <vtz...@gm...> + + [MULTITHREAD]: provide real/run time information on individual threads + when supported by OS + * lispbibl.d: remove HAVE_RUN_TIME and dependencies + (get_thread_run_time, get_run_time): obtain thread or process run time + (struct clisp_thread_t): add thr_realstart_time - real time at which + thread has started + (check_thread): make it global (used from time.d) + * spvw_gcstat.d (gc_timer_on, gc_timer_off): use get_run_time() + instead of get_running_time() (which was causing unused C stack area to + be overwritten) + * stream.d: remove run_time_start()and run_time_restart() calls (anyway + these were nop when HAVE_RUN_TIME was not defined i.e. always) + * zthread.d (check_thread): make it global + (thread_stub): initialize thread real start time + * subr.d (GET-INTERNAL-RUN-TIME, SYSTEM::%%TIME): accept optional + thread argument + * time.d: remove HAVE_RUN_TIME and dependencies + (realstart_time_initialized): flag whether process start time was + initialized + (thread_from_arg): returns thread record from optional argument passed + to GET-INTERNAL-RUN-TIME and SYSTEM::%%TIME + (real_start_time): return the real start time of a thread or process + (get_thread_run_time): was get_run_time(). handle thread argument + (get_running_times_helper): was get_running_times(). handle thread + argument. never fails and does not GC when called for process wide data + (get_running_times): use it + (GET-INTERNAL-RUN-TIME, %%TIME): handle optional thread argument + (init_time): initialize thread real start time in MT + 2010-10-21 Arseny Slobodyuk <am...@us...> * makemake.in (cygwin_finish): use realpath and cygpath to Index: spvw.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw.d,v retrieving revision 1.542 retrieving revision 1.543 diff -u -d -r1.542 -r1.543 --- spvw.d 3 Oct 2010 20:40:58 -0000 1.542 +++ spvw.d 21 Oct 2010 18:42:17 -0000 1.543 @@ -3807,7 +3807,7 @@ #if defined(HAVE_SIGNALS) && defined(SIGPIPE) install_sigpipe_handler(); #endif - /* initialize time variables: */ + /* initialize global time variables: */ init_time(); /* Initialize locale dependent encodings: */ init_dependent_encodings(); Index: lispbibl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/lispbibl.d,v retrieving revision 1.915 retrieving revision 1.916 diff -u -d -r1.915 -r1.916 --- lispbibl.d 3 Oct 2010 20:40:58 -0000 1.915 +++ lispbibl.d 21 Oct 2010 18:42:17 -0000 1.916 @@ -2219,13 +2219,6 @@ #endif /* When changed: extend time.d */ -/* Whether the operating system can give us the run-time, or whether we'll have - to accumulate it ourselves: */ -#if defined(UNIX) || defined(WIN32_NATIVE) - #define HAVE_RUN_TIME -#endif -/* When changed: extend time.d */ - /* Whether the operating system provides virtual memory. */ #if (defined(UNIX) || defined(WIN32)) && !defined(NO_VIRTUAL_MEMORY) #define VIRTUAL_MEMORY @@ -8829,22 +8822,6 @@ } while(0) #endif -#ifndef HAVE_RUN_TIME -/* UP: Stops the run-time timer - run_time_stop(); */ - extern void run_time_stop (void); - /* is used by STREAM */ - - /* UP: restarts the run-time timer - run_time_restart(); */ - extern void run_time_restart (void); - /* is used by STREAM */ -#else - /* You don't need a run-time timer */ - #define run_time_stop() - #define run_time_restart() -#endif - /* UP: yields the real-time get_real_time() < internal_time_t* result: absolute time */ @@ -8857,7 +8834,7 @@ < timescore.realtime: Real-time since LISP-system-start (in Ticks) < timescore.gctime: GC-Time since LISP-system-start (in Ticks) < timescore.gccount: Number of GC's since LISP-system-start - < timescore.gcfreed: Size of the space reclaimed by the GC's so far */ + < timescore.gcfreed: Size of the space reclaimed by the GC's so far*/ typedef struct { internal_time_t runtime; internal_time_t realtime; @@ -8874,18 +8851,12 @@ /* used by TIME, DEBUG */ /* UP: yields the run-time - get_running_time(runtime); - < runtime: Run-time (in Ticks) */ - #ifndef HAVE_RUN_TIME - #define get_running_time(runtime) runtime = get_time() - extern uintL get_time (void); - #endif - #if defined(TIME_UNIX) || defined(TIME_WIN32) - #define get_running_time(runtime) get_run_time(&runtime) - #if defined(TIME_UNIX) || defined(TIME_WIN32) - extern void get_run_time (internal_time_t* runtime); - #endif - #endif + get_thread_run_time(&runtime, thread); + > thread: thread for which to obtain info (nullobj for process wide) + < runtime: Run-time (in Ticks) + < returns true if successful (may fail in MT) */ +extern bool get_thread_run_time (internal_time_t* runtime, object thread); +#define get_run_time(runtime) get_thread_run_time(runtime, nullobj) /* is used by SPVW */ /* Time in decoded-time: */ @@ -8957,9 +8928,8 @@ %% exportF(void,convert_time_from_universal,(object universal, FILETIME* time)); %% #endif -/* UP: Initializes the time variables upon the LISP-System-Start. - init_time(); */ - extern void init_time (void); +/* UP: Initializes the thread or global time variables. */ +extern void init_time (); /* is used by SPVW */ @@ -17106,6 +17076,8 @@ bool _thread_is_dying; /* the current thread. NOT GC VISIBLE. */ gcv_object_t _lthread; + /* real time when the thread started */ + internal_time_t thr_realstart_time; /* previous and next thread. all active threads are kept in double linked list*/ struct clisp_thread_t *thr_prev; @@ -17502,6 +17474,8 @@ global void release_exemptions(object list); /* called at thread exiting. performs cleanup/checks. */ global maygc void thread_cleanup(void); +/* signals an error of obj is not thread. returns the thread*/ +global maygc object check_thread(object obj); /* add per thread special symbol value - initialized to SYMVALUE_EMPTY. symbol: the symbol returns: the new index in the _symvalues thread array */ ------------------------------ Message: 4 Date: Thu, 21 Oct 2010 19:10:35 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog,1.7568,1.7569 time.d,1.78,1.79 To: cli...@li... Message-ID: <E1P...@sf...> Update of /cvsroot/clisp/clisp/src In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv712/src Modified Files: ChangeLog time.d Log Message: * src/time.d (GET-INTERNAL-RUN-TIME): when *ANSI*!=NIL, reject the optional argument (for strict ANSI compliance) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.7568 retrieving revision 1.7569 diff -u -d -r1.7568 -r1.7569 --- ChangeLog 21 Oct 2010 18:42:17 -0000 1.7568 +++ ChangeLog 21 Oct 2010 19:10:33 -0000 1.7569 @@ -1,3 +1,8 @@ +2010-10-21 Sam Steingold <sd...@gn...> + + * time.d (GET-INTERNAL-RUN-TIME): when *ANSI*!=NIL, reject the + optional argument (for strict ANSI compliance) + 2010-10-21 Vladimir Tzankov <vtz...@gm...> [MULTITHREAD]: provide real/run time information on individual threads @@ -7,9 +12,9 @@ (struct clisp_thread_t): add thr_realstart_time - real time at which thread has started (check_thread): make it global (used from time.d) - * spvw_gcstat.d (gc_timer_on, gc_timer_off): use get_run_time() - instead of get_running_time() (which was causing unused C stack area to - be overwritten) + * spvw_gcstat.d (gc_timer_on, gc_timer_off): use get_run_time() + instead of get_running_time() (which was causing unused C stack + area to be overwritten) * stream.d: remove run_time_start()and run_time_restart() calls (anyway these were nop when HAVE_RUN_TIME was not defined i.e. always) * zthread.d (check_thread): make it global Index: time.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/time.d,v retrieving revision 1.78 retrieving revision 1.79 diff -u -d -r1.78 -r1.79 --- time.d 21 Oct 2010 18:42:17 -0000 1.78 +++ time.d 21 Oct 2010 19:10:33 -0000 1.79 @@ -309,6 +309,8 @@ { /* (GET-INTERNAL-RUN-TIME), CLTL p. 446 extension: optional argument (GET-INTERNAL-RUN-TIME thread) */ var internal_time_t tp; + if (!nullp(O(ansi)) && !eq(STACK_0,unbound)) + error_too_many_args(unbound,S(get_internal_run_time),1,0); if (get_thread_run_time(&tp, thread_from_arg(popSTACK()))) VALUES1(internal_time_to_I(&tp)); /* convert to integer */ else ------------------------------ ------------------------------------------------------------------------------ Nokia and AT&T present the 2010 Calling All Innovators-North America contest Create new apps & games for the Nokia N8 for consumers in U.S. and Canada $10 million total in prizes - $4M cash, 500 devices, nearly $6M in marketing Develop with Nokia Qt SDK, Web Runtime, or Java and Publish to Ovi Store http://p.sf.net/sfu/nokia-dev2dev ------------------------------ _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 54, Issue 17 ***************************************** |