- (once-only ((hash-table hash-table))
- `(progn
- (flet ((body-fun ()
- ,@body)
- (error-fun ()
- ;; Don't signal more errors for this table.
- (setf (hash-table-concurrent-access-error ,hash-table) nil)
- (error "Concurrent access to ~A" ,hash-table)))
- (if (hash-table-concurrent-access-error ,hash-table)
- (let ((thread (hash-table-accessing-thread ,hash-table)))
+ (let ((thread-slot-accessor (if (eq operation :read)
+ 'hash-table-reading-thread
+ 'hash-table-writing-thread)))
+ (once-only ((hash-table hash-table))
+ `(progn
+ (flet ((body-fun ()
+ ,@body)
+ (error-fun ()
+ ;; Don't signal more errors for this table.
+ (setf (hash-table-signal-concurrent-access ,hash-table) nil)
+ (cerror "Ignore the concurrent access"
+ "Concurrent access to ~A" ,hash-table)))
+ (declare (inline body-fun))
+ (if (hash-table-signal-concurrent-access ,hash-table)