scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

use lock while creating temp-file

This commit is contained in:
interp 2002-09-18 15:33:42 +00:00
parent 911c56e668
commit 78e8cb3777
1 changed files with 4 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
scheme/httpd/surflets/profile.scm
View File

@ -22,7 +22,7 @@
;;; that contains all SPACE-INFO objects (see below for SPACE-INFO). ;;; that contains all SPACE-INFO objects (see below for SPACE-INFO).
;;; ;;;
;;; ;;;
;;; (MAKE-GNUPLOT-DATA output-file selector space-info-list) ;;; (WRITE-GNUPLOT-DATA-FILE output-file selector space-info-list)
;;; ;;;
;;; Creates a file named OUTPUT-FILE out of SPACE-INFO-LIST. The ;;; Creates a file named OUTPUT-FILE out of SPACE-INFO-LIST. The
;;; created file can be used with GNUPLOT (external program, not part ;;; created file can be used with GNUPLOT (external program, not part
@ -107,13 +107,16 @@
(define *run-count* 0) (define *run-count* 0)
(define *temp-file-lock* (make-lock))
;; PROFILE-SPACE writes result of call to (SPACE) to a file ;; PROFILE-SPACE writes result of call to (SPACE) to a file
(define (profile-space . maybe-file-name) (define (profile-space . maybe-file-name)
(obtain-lock *temp-file-lock*)
(let ((file-name (let ((file-name
(:optional maybe-file-name (:optional maybe-file-name
(create-temp-file "/var/tmp/profile")))) (create-temp-file "/var/tmp/profile"))))
(let ((out (open-output-file file-name open/append))) (let ((out (open-output-file file-name open/append)))
(release-lock *temp-file-lock*)
(set! *run-count* (+ 1 *run-count*)) (set! *run-count* (+ 1 *run-count*))
(format out "~%Run #~a~%" *run-count*) (format out "~%Run #~a~%" *run-count*)
(with-current-output-port* out space) (with-current-output-port* out space)