* New package definitions now that we have SRFI-13 and 14

* Introduced the nomenclature "sigevent"

scheme/rts/events.scm

@@ -1,79 +0,0 @@
-; Copyright (c) 1999-2001 by Martin Gasbichler. See file COPYING.
-
-;;; Functional event system.
-;;; System by Olin Shivers, implementation by Martin Gasbichler
-
-(define-record-type event :event
-  (really-make-event type next)
-  event?
-  (type event-type set-event-type!)
-  (next next-event set-next-event!))
-
-(define (make-event type)
-  (really-make-event type #f))
-
-(define empty-event (make-event #f))
-
-(define *most-recent-event* empty-event)
-
-(define (most-recent-event) *most-recent-event*)
-
-(define event-thread-queue #f)
-
-;Wait for an event of a certain type.
-(define (rts-wait-interrupt set pre-event type-in-set?)
-  (with-interrupts-inhibited
-   (lambda ()
-     (let lp ((event (next-event pre-event)))
-       (if event
-	   (if (type-in-set? (event-type event) set)
-	       event
-	       (lp (next-event event)))
-	   (begin (enqueue-thread! event-thread-queue (current-thread))
-		  (block)
-		  (lp (next-event pre-event))))))))
-
-; same as above, but don't block 
-(define (rts-maybe-wait-interrupt set pre-event type-in-set?)
-  (let ((event (next-event pre-event)))
-    (if event
-	(if (type-in-set? (event-type event) set)
-	    event
-	    (rts-maybe-wait-interrupt set (next-event event) type-in-set?))
-	#f)))
-
-
-;Called when the interrupt actually happened.
-;;; TODO w-i-i is problaly not necessary since they're off already
-(define (register-interrupt type)
-  (let ((waiters (with-interrupts-inhibited
-		  (lambda ()
-		    (set-next-event! *most-recent-event* (make-event type))
-		    (set! *most-recent-event* (next-event *most-recent-event*))
-		    (do ((waiters '() (cons (dequeue-thread! event-thread-queue)
-					    waiters)))
-			((thread-queue-empty? event-thread-queue)
-			 waiters))))))
-    (for-each make-ready waiters)))
-
-;;; has to be called with interrupts disabled
-(define (waiting-for-os-event?)
-  (not (thread-queue-empty? event-thread-queue)))
-  
-(define (initialize-events!)
-  (set! event-thread-queue (make-thread-queue))
-  (set-interrupt-handler! (enum interrupt os-signal) 
-			  (lambda (type arg enabled-interrupts)
-                            ; type is already set in the unix signal handler
-			    (register-interrupt type)))
-  (set-interrupt-handler! (enum interrupt keyboard) 
-			  (lambda (enabled-interrupts)
-			    (register-interrupt (enum interrupt keyboard))))
-;  (call-after-gc! (lambda () (register-interrupt (enum interrupt post-gc))))
-)
-;;; the vm uses the timer for the scheduler
-(define (schedule-timer-interrupt! msec)
-  (spawn (lambda ()
-	   (sleep msec)
-	   (register-interrupt (enum interrupt alarm)))))
-

scheme/rts/init.scm

@@ -30,7 +30,7 @@
 	     (lambda ()
 	       (with-threads
 		(lambda ()
-		  (initialize-events!)
+		  (initialize-sigevents!)
 		  (root-scheduler thunk
 				  200           ; thread quantum, in msec
 				  300)))))))))) ; port-flushing quantum

scheme/rts/root-scheduler.scm

@@ -98,7 +98,7 @@
 	      #t)
 	     ((or time-until-wakeup
 		  (waiting-for-i/o?)
-		  (waiting-for-os-event?))
+		  (waiting-for-sigevent?))
 	      (do-some-waiting time-until-wakeup)
 	      (set-enabled-interrupts! all-interrupts)
 	      (root-wait))

scheme/rts/sigevents.scm

@@ -0,0 +1,82 @@
+; Copyright (c) 1999-2001 by Martin Gasbichler. See file COPYING.
+
+;;; Functional event system.
+;;; System by Olin Shivers, implementation by Martin Gasbichler
+
+(define-record-type sigevent :sigevent
+  (really-make-sigevent type next)
+  sigevent?
+  (type sigevent-type set-sigevent-type!)
+  (next sigevent-next set-sigevent-next!))
+
+(define (make-sigevent type)
+  (really-make-sigevent type #f))
+
+(define empty-sigevent (make-sigevent #f))
+
+(define *most-recent-sigevent* empty-sigevent)
+
+(define (most-recent-sigevent) *most-recent-sigevent*)
+
+(define sigevent-thread-queue #f)
+
+;Wait for an sigevent of a certain type.
+(define (rts-next-sigevent pre-sigevent set type-in-set?)
+  (with-interrupts-inhibited
+   (lambda ()
+     (let lp ((pre-sigevent pre-sigevent))
+       (let ((sigevent (sigevent-next pre-sigevent)))
+	 (if sigevent
+	     (if (type-in-set? (sigevent-type sigevent) set)
+		 sigevent
+		 (lp sigevent))
+	     (begin (enqueue-thread! sigevent-thread-queue (current-thread))
+		    (block)
+		    (lp pre-sigevent))))))))
+
+; same as above, but don't block 
+(define (rts-next-sigevent/no-wait pre-sigevent set type-in-set?)
+  (let ((sigevent (sigevent-next pre-sigevent)))
+    (if sigevent
+	(if (type-in-set? (sigevent-type sigevent) set)
+	    sigevent
+	    (rts-next-sigevent/no-wait (sigevent-next sigevent) 
+				       set 
+				       type-in-set?))
+	#f)))
+
+
+;Called when the interrupt actually happened.
+;;; TODO w-i-i is problaly not necessary since they're off already
+(define (register-interrupt type)
+  (let ((waiters (with-interrupts-inhibited
+		  (lambda ()
+		    (set-sigevent-next! *most-recent-sigevent* (make-sigevent type))
+		    (set! *most-recent-sigevent* (sigevent-next *most-recent-sigevent*))
+		    (do ((waiters '() (cons (dequeue-thread! sigevent-thread-queue)
+					    waiters)))
+			((thread-queue-empty? sigevent-thread-queue)
+			 waiters))))))
+    (for-each make-ready waiters)))
+
+;;; has to be called with interrupts disabled
+(define (waiting-for-sigevent?)
+  (not (thread-queue-empty? sigevent-thread-queue)))
+  
+(define (initialize-sigevents!)
+  (set! sigevent-thread-queue (make-thread-queue))
+  (set-interrupt-handler! (enum interrupt os-signal) 
+			  (lambda (type arg enabled-interrupts)
+                            ; type is already set in the unix signal handler
+			    (register-interrupt type)))
+  (set-interrupt-handler! (enum interrupt keyboard) 
+			  (lambda (enabled-interrupts)
+			    (register-interrupt (enum interrupt keyboard))))
+;  (call-after-gc! (lambda () (register-interrupt (enum interrupt post-gc))))
+)
+;;; the vm uses the timer for the scheduler
+(define (schedule-timer-interrupt! msec)
+  (spawn (lambda ()
+	   (sleep msec)
+	   (register-interrupt (enum interrupt alarm)))))
+

scsh/event.scm

@@ -2,15 +2,23 @@
 
 ;;; Extend the functions of the RTS
 
-(define (wait-interrupt type pre-event)
+(define (next-sigevent pre-event type)
-  (rts-wait-interrupt type pre-event eq?))
+  (if (not (sigevent? pre-event))
+      (error "pre-event is not an event"))
+  (rts-next-sigevent pre-event type eq?))
 
-(define (wait-interrupt-set set pre-event)
+(define (next-sigevent-set pre-event set)
-  (rts-wait-interrupt set pre-event interrupt-in-set?))
+  (if (not (sigevent? pre-event))
+      (error "pre-event is not an event"))
+  (rts-next-sigevent pre-event set interrupt-in-set?))
 
-(define (maybe-wait-interrupt type pre-event)
+(define (next-sigevent/no-wait pre-event type)
-  (rts-maybe-wait-interrupt type pre-event eq?))
+  (if (not (sigevent? pre-event))
+      (error "pre-event is not an event"))
+  (rts-next-sigevent/no-wait pre-event type eq?))
 
-(define (maybe-wait-interrupt-set set pre-event)
+(define (next-sigevent-set/no-wait set pre-event)
-  (rts-maybe-wait-interrupt set pre-event interrupt-in-set?))
+  (if (not (sigevent? pre-event))
+      (error "pre-event is not an event"))
+  (rts-next-sigevent/no-wait pre-event set interrupt-in-set?))
 

scsh/scsh-interfaces.scm

@@ -315,7 +315,7 @@
 	  pid->proc
 
 	  autoreap-policy
-	  install-autoreaping
+	  with-autoreaping
 	  reap-zombies
 	  
 	  wait
@@ -701,80 +701,6 @@
 	  ))
 
 
-(define-interface char-set-interface
-  (export char:newline char:tab char:page char:return char:space char:vtab
-	  char-ascii?
-
-	  char-set?
-	  char-set-copy
-	  char-set=
-	  char-set<=
-	  char-set-size
-
-	  char-set-adjoin  char-set-delete
-	  char-set-adjoin! char-set-delete!
-	  char-set-for-each
-	  char-set-fold reduce-char-set
-
-	  char-set
-	  chars->char-set
-	  string->char-set
-	  ascii-range->char-set
-	  predicate->char-set
-	  ->char-set
-
-	  char-set-members
-	  char-set-contains?
-
-	  char-set-every?
-	  char-set-any
-
-	  char-set-invert
-	  char-set-union
-	  char-set-intersection
-	  char-set-difference
-
-	  char-set-invert!
-	  char-set-union!
-	  char-set-intersection!
-	  char-set-difference!
-
-	  char-set:lower-case
-	  char-set:upper-case
-	  char-set:alphabetic
-	  char-set:numeric
-	  char-set:alphanumeric
-	  char-set:graphic
-	  char-set:printing
-	  char-set:whitespace
-	  char-set:blank
-	  char-set:control
-	  char-set:punctuation
-	  char-set:hex-digit
-	  char-set:ascii
-	  char-set:empty
-	  char-set:full
-
-	  char-lower-case?
-	  char-upper-case?
-	  char-alphabetic?
-	  char-numeric?
-	  char-alphanumeric?
-	  char-graphic?
-	  char-printing?
-	  char-whitespace?
-	  char-blank?
-	  char-control?
-	  char-punctuation?
-	  char-hex-digit?
-	  char-ascii?
-
-	  ;; This is not properly part of the interface,
-	  ;; and should be moved to an internals interface --
-	  ;; it is used by rdelim.scm code.
-	  char-set:s))
-
-
 (define-interface scsh-field-reader-interface
   (export join-strings
 	  field-splitter infix-splitter suffix-splitter sloppy-suffix-splitter
@@ -1075,7 +1001,7 @@
 	  interrupt-set
 
 	  interrupt-handlers-vector  ; JMG: replaces vm vector
-	  %install-scsh-handlers
+	  with-scsh-sighandlers
 
 	  (with-enabled-interrupts :syntax)
 	  with-enabled-interrupts*
@@ -1111,16 +1037,14 @@
 	  interrupt/xfsz))
 
 (define-interface scsh-events-interface
-  (export most-recent-event
+  (export most-recent-sigevent
-	  	  
+	  sigevent?
-	  event?
+	  next-sigevent
-	  next-event
+	  next-sigevent-set
-	  event-type
+	  next-sigevent/no-wait
-	  
+	  next-sigevent-set/no-wait
-	  wait-interrupt
+	  sigevent-type))
-	  wait-interrupt-set
+
-	  maybe-wait-interrupt
-	  maybe-wait-interrupt-set))
 
 (define-interface low-interrupt-interface
   (export number-of-interrupts
@@ -1160,15 +1084,15 @@
 (define-interface syslog-interface
   (export openlog
 	  syslog
+	  syslog-w/id
 	  closelog
 	  syslog-option/default
-	  syslog-option/cons
+	  syslog-option/console-on-error
-	  syslog-option/ndelay
+	  syslog-option/open-now
-	  syslog-option/pid
+	  syslog-option/include-pid
-	  syslog-facility/default
+	  syslog-facility/authorisation
-	  syslog-facility/auth
 	  syslog-facility/daemon
-	  syslog-facility/kern
+	  syslog-facility/kernel
 	  syslog-facility/local0
 	  syslog-facility/local1
 	  syslog-facility/local2
@@ -1181,10 +1105,10 @@
 	  syslog-facility/mail
 	  syslog-facility/user
 	  syslog-level/default
-	  syslog-level/emerg
+	  syslog-level/emergency
 	  syslog-level/alert
-	  syslog-level/crit
+	  syslog-level/critical
-	  syslog-level/err
+	  syslog-level/error
 	  syslog-level/warning
 	  syslog-level/notice
 	  syslog-level/info

scsh/scsh-package.scm

@@ -61,16 +61,6 @@
   )
 
 
-(define-structure char-set-package char-set-interface  
-  (open error-package
-	ascii
-	define-record-types	; JAR's record macro.
-	scsh-utilities		; For DEPRECATED-PROC
-	scheme)
-  (files char-set)
-;  (optimize auto-integrate)
-  )
-
 
 (define-structures ((tty-flags tty-flags-interface)
 		    (scsh-internal-tty-flags scsh-internal-tty-flags-interface))
@@ -142,7 +132,7 @@
 ;   (scsh-regexp-package scsh-regexp-interface)
 )
   (for-syntax (open scsh-syntax-helpers scheme))
-  (access events scsh-events)
+  (access sigevents scsh-events)
   (open enumerated
 	defenum-package
 	external-calls           ;JMG new FFI
@@ -150,6 +140,7 @@
 	cig-aux
 	receiving
 	defrec-package
+	define-record-types
 	define-foreign-syntax
 	formats
 	os-dependent		; OS dependent stuff
@@ -169,9 +160,10 @@
 	fluids
 	weak
 
+	scsh-char-set-low-level-lib         ; rdelim.scm needs it.
 ;	scsh-regexp-package
 ;	scsh-regexp-internals
-	char-set-package
+	char-set-lib
 	scsh-version
 	tty-flags
 	scsh-internal-tty-flags	; Not exported
@@ -291,7 +283,6 @@
 					   repl )
   (open command-processor
 	command-levels          ; with-new-session
-	char-set-package
 	ensures-loaded
 	environments
 	error-package
@@ -319,18 +310,21 @@
 
 
 (define-structure field-reader-package scsh-field-reader-interface
-  (open receiving		; receive
+  (open receiving             ; receive
-	char-set-package
+	scsh-utilities          ; nth
-	scsh-utilities		; nth
 	error-package		; error
+	string-lib		; string-join for obsolete join-strings
 	scsh-level-0		; delimited readers
 ;	scsh-regexp-package
 	re-exports
-	string-lib		; join-strings
 	let-opt			; optional-arg parsing & defaulting
 	scheme
 	)
-  (files fr))
+  (files fr)
+  ;; Handle a little bit of backwards compatibility.
+  (begin (define join-strings (deprecated-proc string-join 'join-strings
+					       "Use SRFI-13 STRING-JOIN.")))
+  )
 
 
 (define-structures
@@ -375,9 +369,12 @@
 ;		      scsh-dbm-interface
 		      (export repl)
 		      awk-interface
+		      char-set-predicates-interface; Urk -- Some of this is R5RS!
+		      obsolete-char-set-interface
 		      )
 
   (open structure-refs
+	obsolete-char-set-lib
 	scsh-level-0
 	scsh-level-0-internals
 	re-exports
@@ -387,6 +384,7 @@
 ;	dbm
 	awk-package
 	field-reader-package
+	char-set-predicates-lib	; Urk -- Some of this is R5RS!
 	dot-locking
 	scheme)
 
@@ -408,7 +406,7 @@
 	scheme
 	structure-refs
 	low-interrupt
-	events)
+	sigevents)
   (files event))
 
 (define-structure simple-syntax (export define-simple-syntax)