Changeset 8837


Ignore:
Timestamp:
Mar 21, 2008, 5:38:34 AM (11 years ago)
Author:
gb
Message:

Conditionalize some TIME/GET-INTERNAL-RUN-TIME stuff for win64.

Location:
branches/win64/lib
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/win64/lib/misc.lisp

    r8728 r8837  
    370370;;
    371371
     372
     373(defun %page-fault-info ()
     374  #-(or darwin-target windows-target)
     375  (rlet ((usage :rusage))
     376    (%%rusage usage)
     377    (values (pref usage :rusage.ru_minflt)
     378            (pref usage :rusage.ru_majflt)
     379            (pref usage :rusage.ru_nswap)))
     380  #+darwin-target
     381  (rlet ((count #>mach_msg_type_number_t #$TASK_EVENTS_INFO_COUNT)
     382         (info #>task_events_info))
     383    (#_task_info (#_mach_task_self) #$TASK_EVENTS_INFO info count)
     384    (values (pref info #>task_events_info.cow_faults)
     385            (pref info #>task_events_info.faults)
     386            (pref info #>task_events_info.pageins)))
     387  #+windows-target
     388  ;; Um, don't know how to determine this, or anything like it.
     389  (values 0 0 0))
     390
     391
     392         
    372393(defparameter *report-time-function* nil
    373394  "If non-NULL, should be a function which accepts the following
     
    423444             0
    424445             (* (logand (+ 2 (uvsize i)) (lognot 1)) 4))))
    425     (rlet ((start :rusage)
    426            (stop :rusage)
    427            (timediff :timeval))
    428       (let* ((initial-real-time (get-internal-real-time))
    429              (initial-gc-time (gctime))
    430              (initial-consed (total-bytes-allocated))           
    431              (initial-overhead (integer-size-in-bytes initial-consed)))
    432         (%%rusage start)
    433         (let* ((results (multiple-value-list (funcall thunk))))
    434           (declare (dynamic-extent results))
    435           (%%rusage stop)         
    436           (let* ((new-consed (total-bytes-allocated))               
    437                  (bytes-consed
    438                   (- new-consed (+ initial-overhead initial-consed)))
    439                  (elapsed-real-time
    440                   (- (get-internal-real-time) initial-real-time))
    441                  (elapsed-gc-time (- (gctime) initial-gc-time))
    442                  (elapsed-user-time
    443                   (progn
    444                     (%sub-timevals timediff
    445                                    (pref stop :rusage.ru_utime)
    446                                    (pref start :rusage.ru_utime))
    447                     (ecase internal-time-units-per-second
    448                       (1000000 (timeval->microseconds timediff))
    449                       (1000 (timeval->milliseconds timediff)))))
    450                  (elapsed-system-time
    451                   (progn
    452                     (%sub-timevals timediff
    453                                    (pref stop :rusage.ru_stime)
    454                                    (pref start :rusage.ru_stime))
    455                     (ecase internal-time-units-per-second
    456                       (1000000 (timeval->microseconds timediff))
    457                       (1000 (timeval->milliseconds timediff)))))
    458                  (elapsed-minor (- (pref stop :rusage.ru_minflt)
    459                                    (pref start :rusage.ru_minflt)))
    460                  (elapsed-major (- (pref stop :rusage.ru_majflt)
    461                                    (pref start :rusage.ru_majflt)))
    462                  (elapsed-swaps (- (pref stop :rusage.ru_nswap)
    463                                    (pref start :rusage.ru_nswap))))
    464             (funcall (or *report-time-function*
    465                          #'standard-report-time)
    466                      :form form
    467                      :results results
    468                      :elapsed-time elapsed-real-time
    469                      :user-time elapsed-user-time
    470                      :system-time elapsed-system-time
    471                      :gc-time elapsed-gc-time
    472                      :bytes-allocated bytes-consed
    473                      :minor-page-faults elapsed-minor
    474                      :major-page-faults elapsed-major
    475                      :swaps elapsed-swaps)))))))
     446    (multiple-value-bind (user-start system-start)
     447        (%internal-run-time)
     448      (multiple-value-bind (minor-start major-start swaps-start)
     449          (%page-fault-info)
     450        (let* ((initial-real-time (get-internal-real-time))
     451               (initial-gc-time (gctime))
     452               (initial-consed (total-bytes-allocated))           
     453               (initial-overhead (integer-size-in-bytes initial-consed)))
     454          (let* ((results (multiple-value-list (funcall thunk))))
     455            (declare (dynamic-extent results))
     456            (multiple-value-bind (user-end system-end)
     457                (%internal-run-time)
     458              (multiple-value-bind (minor-end major-end swaps-end)
     459                  (%page-fault-info)
     460                (let* ((new-consed (total-bytes-allocated))                 
     461                       (bytes-consed
     462                        (- new-consed (+ initial-overhead initial-consed)))
     463                       (elapsed-real-time
     464                        (- (get-internal-real-time) initial-real-time))
     465                       (elapsed-gc-time (- (gctime) initial-gc-time))
     466                       (elapsed-user-time
     467                        (- user-end user-start))
     468                       (elapsed-system-time
     469                        (- system-end system-start))
     470                       (elapsed-minor (- minor-end minor-start))
     471                       (elapsed-major (- major-end major-start))
     472                       (elapsed-swaps (- swaps-end swaps-start)))
     473                  (funcall (or *report-time-function*
     474                               #'standard-report-time)
     475                           :form form
     476                           :results results
     477                           :elapsed-time elapsed-real-time
     478                           :user-time elapsed-user-time
     479                           :system-time elapsed-system-time
     480                           :gc-time elapsed-gc-time
     481                           :bytes-allocated bytes-consed
     482                           :minor-page-faults elapsed-minor
     483                           :major-page-faults elapsed-major
     484                           :swaps elapsed-swaps))))))))))
    476485
    477486
  • branches/win64/lib/time.lisp

    r8738 r8837  
    6060;;; For now, if the time won't fit in a :time_t, use an arbitrary time
    6161;;; value to get the time zone and assume that DST was -not- in effect.
     62#-windows-target
    6263(defun get-timezone (time)
    6364  (let* ((toobig (not (typep time '(unsigned-byte
     
    7576            (values (floor (pref tm :tm.tm_gmtoff) -60)
    7677                    (unless toobig (not (zerop (pref tm :tm.tm_isdst)))))))))))
     78
     79#+windows-target
     80(defun get-timezone (time)
     81  (declare (ignore time))
     82  (rlet ((tzinfo #>TIME_ZONE_INFORMATION))
     83    (let* ((id (#_GetTimeZoneInformation tzinfo))
     84           (minutes-west (pref tzinfo #>TIME_ZONE_INFORMATION.Bias))
     85           (is-dst (= id #$TIME_ZONE_ID_DAYLIGHT)))
     86      (values (floor (+ minutes-west
     87                        (if is-dst
     88                          (pref tzinfo #>TIME_ZONE_INFORMATION.DaylightBias)
     89                          0)))
     90              is-dst))))
    7791
    7892
     
    209223  )
    210224
    211 (defun get-internal-run-time ()
    212   "Return the run time in the internal time format. (See
    213   INTERNAL-TIME-UNITS-PER-SECOND.) This is useful for finding CPU usage."
     225
     226(defun %internal-run-time ()
     227  ;; Returns user and system times in internal-time-units as multiple values.
     228  #-windows-target
    214229  (rlet ((usage :rusage))
    215230    (%%rusage usage)
     
    218233           (user-micros (pref usage :rusage.ru_utime.tv_usec))
    219234           (system-micros (pref usage :rusage.ru_stime.tv_usec)))
    220       (+ (* (+ user-seconds system-seconds) internal-time-units-per-second)
    221          (round (+ user-micros system-micros) (floor 1000000 internal-time-units-per-second))))))
     235      (values (+ (* user-seconds internal-time-units-per-second)
     236                 (round user-micros (floor 1000000 internal-time-units-per-second)))
     237              (+ (* system-seconds internal-time-units-per-second)
     238                 (round system-micros (floor 1000000 internal-time-units-per-second))))))
     239  #+windows-target
     240  (rlet ((start #>FILETIME)
     241         (end #>FILETIME)
     242         (kernel #>FILETIME)
     243         (user #>FILETIME))
     244    (#_GetProcessTimes (#_GetCurrentProcess) start end kernel user)
     245    (let* ((user-100ns (dpb (pref user #>FILETIME.dwHighDateTime)
     246                            (byte 32 32)
     247                            (pref user #>FILETIME.dwLowDateTime)))
     248           (kernel-100ns (dpb (pref kernel #>FILETIME.dwHighDateTime)
     249                            (byte 32 32)
     250                            (pref kernel #>FILETIME.dwLowDateTime)))
     251           (convert (floor 10000000 internal-time-units-per-second)))
     252      (values (floor user-100ns convert) (floor kernel-100ns convert)))))
     253
     254(defun get-internal-run-time ()
     255  "Return the run time in the internal time format. (See
     256  INTERNAL-TIME-UNITS-PER-SECOND.) This is useful for finding CPU usage."
     257  (multiple-value-bind (user sys) (%internal-run-time)
     258    (+ user sys)))
    222259
    223260
Note: See TracChangeset for help on using the changeset viewer.