Make sure port locks get released after I/O errors.
This commit is contained in:
		
							parent
							
								
									5f7ed5befe
								
							
						
					
					
						commit
						12ced00589
					
				| 
						 | 
					@ -84,7 +84,7 @@
 | 
				
			||||||
	interrupts      ; {en|dis}able-interrupts!
 | 
						interrupts      ; {en|dis}able-interrupts!
 | 
				
			||||||
	number-i/o      ; number->string for debugging
 | 
						number-i/o      ; number->string for debugging
 | 
				
			||||||
	exceptions      ; wrong-number-of-args stuff
 | 
						exceptions      ; wrong-number-of-args stuff
 | 
				
			||||||
	handle)		; report-errors-as-warnings
 | 
						handle)		; report-errors-as-warnings with-handler
 | 
				
			||||||
  (files (rts port)
 | 
					  (files (rts port)
 | 
				
			||||||
	 (rts current-port))
 | 
						 (rts current-port))
 | 
				
			||||||
  (optimize auto-integrate))
 | 
					  (optimize auto-integrate))
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -206,7 +206,14 @@
 | 
				
			||||||
	   (begin
 | 
						   (begin
 | 
				
			||||||
	     (obtain-port-lock ?port)         ; lock the port
 | 
						     (obtain-port-lock ?port)         ; lock the port
 | 
				
			||||||
	     (if (open-port? ?port)           ; check that it's open
 | 
						     (if (open-port? ?port)           ; check that it's open
 | 
				
			||||||
		 (let ((value ?body))         ; do the work
 | 
							 (let ((value		      ; do the work
 | 
				
			||||||
 | 
								(with-handler
 | 
				
			||||||
 | 
								 (lambda (condition punt)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
								   (release-port-lock ?port)
 | 
				
			||||||
 | 
								   (punt))
 | 
				
			||||||
 | 
								 (lambda ()
 | 
				
			||||||
 | 
								   ?body))))
 | 
				
			||||||
		   (release-port-lock ?port)  ; release the lock
 | 
							   (release-port-lock ?port)  ; release the lock
 | 
				
			||||||
		   value)                     ; return
 | 
							   value)                     ; return
 | 
				
			||||||
		 (begin
 | 
							 (begin
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue