Changeset 13617


Ignore:
Timestamp:
10/02/11 14:36:58 (10 years ago)
Author:
Mark Evenson
Message:

Fix compile errors of the thread pool abstraction.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/threads-jss.lisp

    r13616 r13617  
    1010
    1111;;; XXX possibly need multiple thread pools
    12 (defparameter *thread-pool* nil)
     12(defparameter *thread-pool* nil
     13  "The current JVM class implementing the ScheduledThreadPool abstraction.")
    1314(defparameter *scheduled-futures* nil)
    1415(defparameter *incoming-scheduled-future* nil)
     
    2425(defparameter *dirs* (list *incoming*))
    2526
     27(defparameter *queue* (merge-pathnames "queue/" *root*))
     28
     29(defparameter *processed* (merge-pathnames "processed/" *root*))
     30
     31
    2632;;;; A simple logging abstraction.
    2733
    2834(defconstant +month-names+ '("Jan" "Feb" "Mar" "Apr" "May" "Jun"
    2935                             "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
    30 
     36(defconstant +seconds+ (java:jfield "java.util.concurrent.TimeUnit" "SECONDS"))
    3137(defparameter *log* *standard-output*)
    3238
     
    9197         (make-process-incoming) 1 1 +seconds+)))
    9298
     99(defun make-process-incoming ()
     100  (java:jinterface-implementation "java.lang.Runnable" "run" #'process-incoming))
     101
     102(defun process-incoming ()
     103  (flet ((reject-input (file invalid)
     104           (warn (format nil "~A is ~A" file invalid))))
     105  (let ((incoming (directory (merge-pathnames *incoming* "*"))))
     106    (unless incoming
     107      (return-from process-incoming))
     108    (log "Processing ~A incoming items." (length incoming))
     109    (let (table error)
     110      (dolist (file incoming)
     111        (setf error nil)
     112        (log "Analyzing ~A." file)
     113        (setf table
     114              (handler-case
     115                  (load-table file)
     116                (t (e)
     117                  (log "Failed to process ~A because ~A" file e)
     118                  (setf error e))))
     119        (if error
     120            (reject-input file (if (listp error) error (list error)))
     121            (multiple-value-bind (valid invalid)
     122                (validate table)
     123              (if invalid
     124                  (progn
     125                    (log "Rejecting ~A because of invalid rows." file)
     126                    (reject-input file invalid))
     127                  (let ((incoming
     128                         (make-pathname :defaults *queue*
     129                                        :name (pathname-name file)
     130                                        :type (pathname-type file))))
     131                    (log "Inserting ~A." incoming)
     132                    (rename-file file incoming))))))))))
     133
Note: See TracChangeset for help on using the changeset viewer.