scsh-checkins
[Top] [All Lists]

[Scsh-checkins] CVS: scsh-0.6/scsh scsh-interfaces.scm,1.27,1.28 scsh-pa

To: scsh-checkins@lists.sourceforge.net
Subject: [Scsh-checkins] CVS: scsh-0.6/scsh scsh-interfaces.scm,1.27,1.28 scsh-package.scm,1.29,1.30 syslog.scm,1.8,1.9 syslog1.c,1.3,1.4
From: Mike Sperber <sperber@users.sourceforge.net>
Date: Mon Dec 3 07:22:15 2001
List-id: <scsh-checkins.lists.sourceforge.net>
Sender: scsh-checkins-admin@lists.sourceforge.net
Update of /cvsroot/scsh/scsh-0.6/scsh
In directory usw-pr-cvs1:/tmp/cvs-serv3825/scsh

Modified Files:
        scsh-interfaces.scm scsh-package.scm syslog.scm syslog1.c 
Log Message:
New implementation of (no-inheritance) thread-local cells and thread
fluids.

New implementation of syslog.

Both are to be compatible with what's actually probably going into
Scheme 48.


Index: scsh-interfaces.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/scsh-interfaces.scm,v
retrieving revision 1.27
retrieving revision 1.28
diff -C2 -r1.27 -r1.28
*** scsh-interfaces.scm 2001/11/27 11:08:30     1.27
--- scsh-interfaces.scm 2001/12/03 15:21:46     1.28
***************
*** 1089,1120 ****
  (define-interface syslog-interface
    (export (syslog-option :syntax)
          make-syslog-options
-         syslog-options->list
          syslog-options?
          (syslog-options :syntax)
-         syslog-options-on?
-         syslog-options=?
  
          (syslog-facility :syntax)
          syslog-facility?
-         syslog-facility=?
  
          (syslog-level :syntax)
          syslog-level?
-         syslog-level=?
  
!         levels->syslog-mask
          (syslog-mask :syntax)
-         syslog-mask->levels
          syslog-mask-all
          syslog-mask-upto
-         syslog-mask-levels-on?
-         syslog-mask?
-         syslog-mask=?
- 
-         open-syslog-channel
-         close-syslog-channel
  
          with-syslog-destination
          syslog))
  
--- 1089,1120 ----
  (define-interface syslog-interface
    (export (syslog-option :syntax)
+         syslog-option?
+ 
          make-syslog-options
          syslog-options?
          (syslog-options :syntax)
  
          (syslog-facility :syntax)
          syslog-facility?
  
          (syslog-level :syntax)
          syslog-level?
  
!         make-syslog-mask
!         syslog-mask?
          (syslog-mask :syntax)
          syslog-mask-all
          syslog-mask-upto
  
          with-syslog-destination
+         set-syslog-destination!
+ 
          syslog))
+ 
+ (define-interface syslog-channels-interface
+   (export open-syslog-channel
+         close-syslog-channel
+         set-syslog-channel!
+         with-syslog-channel))
+ 
  

Index: scsh-package.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/scsh-package.scm,v
retrieving revision 1.29
retrieving revision 1.30
diff -C2 -r1.29 -r1.30
*** scsh-package.scm    2001/11/27 18:11:38     1.29
--- scsh-package.scm    2001/12/03 15:21:46     1.30
***************
*** 465,473 ****
    (files dot-locking)) 
  
! (define-structure syslog syslog-interface
!   (open scheme define-record-types finite-types
        locks thread-fluids
        external-calls
-       scsh-utilities
        bitwise)
    (files syslog))
--- 465,475 ----
    (files dot-locking)) 
  
! (define-structures ((syslog syslog-interface)
!                   (syslog-channels syslog-channels-interface))
!   (open scheme
!       define-record-types finite-types enum-sets
        locks thread-fluids
        external-calls
        bitwise)
    (files syslog))
+ 

Index: syslog.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/syslog.scm,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -r1.8 -r1.9
*** syslog.scm  2001/07/11 11:21:18     1.8
--- syslog.scm  2001/12/03 15:21:46     1.9
***************
*** 3,64 ****
  ;; Options for openlog
  
! (define-finite-type syslog-option :syslog-option
!   (mask)
    syslog-option?
    the-syslog-options
    syslog-option-name
    syslog-option-index
!   (mask syslog-option-mask)
!   ;; These values are known to the C code.
!   ((console           #o01)
!    (delay             #o02)
!    (no-delay          #o04)
!    (log-pid           #o10)))
  
! (define-record-type syslog-options :syslog-options
!   (really-make-syslog-options value)
!   syslog-options?
!   (value syslog-options-value))
  
! (define syslog-options=? eq?)
  
! (define-exported-binding "syslog-options-type" :syslog-options)
  
! (define (syslog-options-on? options0 options1)
!   (= 0 (bitwise-and (syslog-options-value options1)
!                   (bitwise-not (syslog-options-value options0)))))
! 
! (define (make-syslog-options options)
!   (really-make-syslog-options
!    (apply bitwise-ior (map syslog-option-mask options))))
! 
! (define default-syslog-options (make-syslog-options '()))
! 
! (define (make-mask-record->list get-value get-mask record-vector)
!   (lambda (mask-record)
!     (let ((value (get-value mask-record))
!         (n-syslog-options (vector-length record-vector)))
!       (let loop ((i 0) (list '()))
!       (cond
!        ((>= i n-syslog-options)
!         list)
!        ((zero? (bitwise-and value
!                             (get-mask (vector-ref record-vector i))))
!         (loop (+ 1 i) list))
!        (else
!         (loop (+ 1 i) (cons (vector-ref record-vector i)
!                             list))))))))
! 
! (define syslog-options->list
!   (make-mask-record->list syslog-options-value
!                         syslog-option-mask
!                         the-syslog-options))
! 
! ; Simplifying syntax, e.g. (syslog-options delay console)
! 
! (define-syntax syslog-options
!   (syntax-rules ()
!     ((syslog-options name ...)
!      (make-syslog-options (list (syslog-option name) ...)))))
  
  (define-enumerated-type syslog-facility :syslog-facility
--- 3,31 ----
  ;; Options for openlog
  
! (define-enumerated-type syslog-option :syslog-option
    syslog-option?
    the-syslog-options
    syslog-option-name
    syslog-option-index
!   ;; The order of these is known to the C code.
!   (console
!    delay
!    no-delay
!    log-pid))
  
! (define-exported-binding "syslog-options" the-syslog-options)
  
! (define-enum-set-type syslog-options :syslog-options
!   syslog-options?
!   make-syslog-options
!   
!   syslog-option
!   syslog-option?
!   the-syslog-options
!   syslog-option-index)
  
! (define-exported-binding "syslog-options?" syslog-options?)
  
! (define default-syslog-options (syslog-options))
  
  (define-enumerated-type syslog-facility :syslog-facility
***************
*** 80,85 ****
     local0 local1 local2 local3 local4 local5 local6 local7))
  
- (define syslog-facility=? eq?)
- 
  (define default-syslog-facility (syslog-facility user))
  
--- 47,50 ----
***************
*** 87,150 ****
  (define-exported-binding "syslog-facilities" syslog-facilities)
  
! (define-finite-type syslog-level :syslog-level
!   (mask)
    syslog-level?
    syslog-levels
    syslog-level-name
    syslog-level-index
!   (mask syslog-level-mask)
!   ;; Options for syslog
!   ;; The order and the values of these is known to the C code.
!   ((emergency #o001)
!    (alert     #o002)
!    (critical  #o004)
!    (error     #o010)
!    (warning   #o020)
!    (notice    #o040)
!    (info      #o100)
!    (debug     #o200)))
! 
! (define syslog-level=? eq?)
  
  (define-exported-binding "syslog-level-type" :syslog-level)
  (define-exported-binding "syslog-levels" syslog-levels)
  
! (define-record-type syslog-mask :syslog-mask
!   (make-syslog-mask value)
    syslog-mask?
!   (value syslog-mask-value))
  
! (define (syslog-mask=? mask-1 mask-2)
!   (= (syslog-mask-value mask-1)
!      (syslog-mask-value mask-2)))
! 
! (define-exported-binding "syslog-mask-type" :syslog-mask)
! 
! (define (syslog-mask-levels-on? mask-1 mask-2)
!   (= 0 (bitwise-and (syslog-mask-value mask-2)
!                   (bitwise-not (syslog-mask-value mask-1)))))
! 
! (define (levels->syslog-mask levels)
!   (make-syslog-mask
!    (apply bitwise-ior
!         (map syslog-level-mask levels))))
! 
! (define syslog-mask->levels
!   (make-mask-record->list syslog-mask-value
!                         syslog-level-mask
!                         syslog-levels))
! 
! (define-syntax syslog-mask
!   (syntax-rules ()
!     ((syslog-mask name ...)
!      (levels->syslog-mask (list (syslog-level name) ...)))))
  
  (define (syslog-mask-upto level)
    (let loop ((index (syslog-level-index level)) (levels '()))
      (if (< index 0)
!       (levels->syslog-mask levels)
!       (loop (- index 1) (cons index levels)))))
  
! (define syslog-mask-all (levels->syslog-mask (vector->list syslog-levels)))
  
  (define default-syslog-mask syslog-mask-all)
--- 52,94 ----
  (define-exported-binding "syslog-facilities" syslog-facilities)
  
! (define-enumerated-type syslog-level :syslog-level
    syslog-level?
    syslog-levels
    syslog-level-name
    syslog-level-index
!   ;; The order of these is known to the C code.
!   (emergency  
!    alert      
!    critical   
!    error      
!    warning    
!    notice     
!    info       
!    debug))
  
  (define-exported-binding "syslog-level-type" :syslog-level)
  (define-exported-binding "syslog-levels" syslog-levels)
  
! (define-enum-set-type syslog-mask :syslog-mask
    syslog-mask?
!   make-syslog-mask
  
!   syslog-level
!   syslog-level?
!   syslog-levels
!   syslog-level-index)
! 
! (define-exported-binding "syslog-mask?" syslog-mask?)
! (define-exported-binding ":syslog-mask" :syslog-mask)
  
  (define (syslog-mask-upto level)
    (let loop ((index (syslog-level-index level)) (levels '()))
      (if (< index 0)
!       (make-syslog-mask levels)
!       (loop (- index 1)
!             (cons (vector-ref syslog-levels index)
!                   levels)))))
  
! (define syslog-mask-all (make-syslog-mask (vector->list syslog-levels)))
  
  (define default-syslog-mask syslog-mask-all)
***************
*** 170,178 ****
    (and (string=? (syslog-channel-ident channel-1)
                 (syslog-channel-ident channel-2))
!        (syslog-options=? (syslog-channel-options channel-1)
!                        (syslog-channel-options channel-2))
         ;; facility can be specified with each syslog-write
!        (syslog-mask=? (syslog-channel-mask channel-1)
!                     (syslog-channel-mask channel-2))))
  
  (define current-syslog-channel 'unitinialized)
--- 114,122 ----
    (and (string=? (syslog-channel-ident channel-1)
                 (syslog-channel-ident channel-2))
!        (enum-set=? (syslog-channel-options channel-1)
!                  (syslog-channel-options channel-2))
         ;; facility can be specified with each syslog-write
!        (enum-set=? (syslog-channel-mask channel-1)
!                  (syslog-channel-mask channel-2))))
  
  (define current-syslog-channel 'unitinialized)
***************
*** 192,213 ****
    (release-lock current-syslog-channel-lock))
  
- ;; THUNK must not escape
  (define (with-syslog-channel channel thunk)
!   (obtain-lock current-syslog-channel-lock)
!   (if (or (not current-syslog-channel)
!         (not (syslog-channel-equivalent? channel
!                                          current-syslog-channel)))
!       (begin
!       (if current-syslog-channel
!           (closelog))
!       (openlog (syslog-channel-ident channel)
!                (syslog-channel-options channel)
!                (syslog-channel-facility channel))
!       (if (not (syslog-mask=? (syslog-channel-mask channel)
                                default-syslog-mask))
!           (setlogmask! (syslog-channel-mask channel)))
!       (set! current-syslog-channel channel)))
!   (thunk)
!   (release-lock current-syslog-channel-lock))
  
  (define (syslog-write level message channel)
--- 136,160 ----
    (release-lock current-syslog-channel-lock))
  
  (define (with-syslog-channel channel thunk)
!   (dynamic-wind
!    (lambda ()
!      (obtain-lock current-syslog-channel-lock))
!    (lambda ()
!      (if (or (not current-syslog-channel)
!            (not (syslog-channel-equivalent? channel
!                                             current-syslog-channel)))
!        (begin
!          (if current-syslog-channel
!              (closelog))
!          (openlog (syslog-channel-ident channel)
!                   (syslog-channel-options channel)
!                   (syslog-channel-facility channel))
!          (if (not (enum-set=? (syslog-channel-mask channel)
                                default-syslog-mask))
!              (setlogmask! (syslog-channel-mask channel)))
!          (set! current-syslog-channel channel)))
!      (thunk))
!    (lambda ()
!      (release-lock current-syslog-channel-lock))))
  
  (define (syslog-write level message channel)
***************
*** 217,244 ****
       (unix-syslog level (syslog-channel-facility channel) message))))
  
! (define (list-ref-carefully list n default)
!   (cond
!    ((null? list) default)
!    ((zero? n) (car list))
!    (else
!     (list-ref-carefully (cdr list) (- n 1) default))))
! 
! (define (change-syslog-channel channel . rest)
!   (let ((ident (list-ref-carefully rest 0 #f))
!       (options (list-ref-carefully rest 1 #f))
!       (facility (list-ref-carefully rest 2 #f))
!       (mask (list-ref-carefully rest 3 #f)))
!     (make-syslog-channel (or ident
!                            (syslog-channel-ident channel))
!                        (or options
!                            (syslog-channel-options channel))
!                        (or facility
!                            (syslog-channel-facility channel))
!                        (or mask
!                            (syslog-channel-mask channel)))))
  
  (define dynamic-syslog-channel
!   (make-thread-fluid
!    (make-syslog-channel "scheme48"
                        default-syslog-options
                        default-syslog-facility
--- 164,180 ----
       (unix-syslog level (syslog-channel-facility channel) message))))
  
! (define (change-syslog-channel channel ident options facility mask)
!   (make-syslog-channel (or ident
!                          (syslog-channel-ident channel))
!                      (or options
!                          (syslog-channel-options channel))
!                      (or facility
!                          (syslog-channel-facility channel))
!                      (or mask
!                          (syslog-channel-mask channel))))
  
  (define dynamic-syslog-channel
!   (make-preserved-thread-fluid
!    (make-syslog-channel "scsh"
                        default-syslog-options
                        default-syslog-facility
***************
*** 247,258 ****
  (define (syslog level message . rest)
    (syslog-write level message
!               (if (and (not (null? rest))
!                        (null? (cdr rest))
!                        (syslog-channel? (car rest)))
!                   (car rest)
!                   ;; this might be a little excessive allocation
!                   (apply change-syslog-channel
!                          (thread-fluid dynamic-syslog-channel)
!                          rest))))
  
  (define (with-syslog-destination ident options facility mask thunk)
--- 183,197 ----
  (define (syslog level message . rest)
    (syslog-write level message
!               (cond
!                ((null? rest)
!                 (thread-fluid dynamic-syslog-channel))
!                ((and (null? (cdr rest))
!                      (syslog-channel? (car rest)))
!                 (car rest))
!                (else
!                 ;; this might be a little excessive allocation
!                 (apply change-syslog-channel
!                        (thread-fluid dynamic-syslog-channel)
!                        (append rest '(#f)))))))
  
  (define (with-syslog-destination ident options facility mask thunk)
***************
*** 262,265 ****
--- 201,214 ----
                     ident options facility mask)
                    thunk))
+ 
+ (define (set-syslog-channel! channel)
+   (set-thread-fluid! dynamic-syslog-channel
+                   channel))
+ 
+ (define (set-syslog-destination! ident options facility mask)
+   (set-thread-fluid! dynamic-syslog-channel
+                    (change-syslog-channel
+                     (thread-fluid dynamic-syslog-channel)
+                     ident options facility mask)))
  
  ;----------------

Index: syslog1.c
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/syslog1.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
*** syslog1.c   2001/07/10 12:56:25     1.3
--- syslog1.c   2001/12/03 15:21:46     1.4
***************
*** 17,27 ****
   * Record types imported from Scheme.
   */
! static s48_value      syslog_options_type_binding = S48_FALSE;
  static s48_value      syslog_facility_type_binding = S48_FALSE;
  static s48_value      syslog_facilities_binding = S48_FALSE;
  static s48_value      syslog_level_type_binding = S48_FALSE;
  static s48_value      syslog_levels_binding = S48_FALSE;
  static s48_value      syslog_mask_type_binding = S48_FALSE;
  
  /*
   * Install all exported functions in Scheme 48.
--- 17,32 ----
   * Record types imported from Scheme.
   */
! static s48_value      is_syslog_options_binding = S48_FALSE;
  static s48_value      syslog_facility_type_binding = S48_FALSE;
  static s48_value      syslog_facilities_binding = S48_FALSE;
  static s48_value      syslog_level_type_binding = S48_FALSE;
  static s48_value      syslog_levels_binding = S48_FALSE;
+ static s48_value      is_syslog_mask_binding = S48_FALSE;
  static s48_value      syslog_mask_type_binding = S48_FALSE;
  
+ static s48_value      is_enum_set_binding = S48_FALSE;
+ static s48_value      enum_set2integer_binding = S48_FALSE;
+ static s48_value      integer2enum_set_binding = S48_FALSE;
+ 
  /*
   * Install all exported functions in Scheme 48.
***************
*** 35,41 ****
    S48_EXPORT_FUNCTION(sch_closelog);
  
!   S48_GC_PROTECT_GLOBAL(syslog_options_type_binding);
!   syslog_options_type_binding =
!     s48_get_imported_binding("syslog-options-type");
  
    S48_GC_PROTECT_GLOBAL(syslog_facility_type_binding);
--- 40,46 ----
    S48_EXPORT_FUNCTION(sch_closelog);
  
!   S48_GC_PROTECT_GLOBAL(is_syslog_options_binding);
!   is_syslog_options_binding =
!     s48_get_imported_binding("syslog-options?");
  
    S48_GC_PROTECT_GLOBAL(syslog_facility_type_binding);
***************
*** 53,59 ****
      s48_get_imported_binding("syslog-levels");
  
    S48_GC_PROTECT_GLOBAL(syslog_mask_type_binding);
    syslog_mask_type_binding =
!     s48_get_imported_binding("syslog-mask-type");
  }
  
--- 58,126 ----
      s48_get_imported_binding("syslog-levels");
  
+   S48_GC_PROTECT_GLOBAL(is_syslog_mask_binding);
+   is_syslog_mask_binding =
+     s48_get_imported_binding("syslog-mask?");
+ 
    S48_GC_PROTECT_GLOBAL(syslog_mask_type_binding);
    syslog_mask_type_binding =
!     s48_get_imported_binding(":syslog-mask");
! 
!   S48_GC_PROTECT_GLOBAL(is_enum_set_binding);
!   is_enum_set_binding =
!     s48_get_imported_binding("enum-set?");
! 
!   S48_GC_PROTECT_GLOBAL(enum_set2integer_binding);
!   enum_set2integer_binding =
!     s48_get_imported_binding("enum-set->integer");
! 
!   S48_GC_PROTECT_GLOBAL(integer2enum_set_binding);
!   integer2enum_set_binding =
!     s48_get_imported_binding("integer->enum-set");
! }
! 
! /* ************************************************************
!  * General procedures
!  */
! 
! static int
! is_enum_set(s48_value sch_thing)
! {
!   S48_SHARED_BINDING_CHECK(is_enum_set_binding);
! 
!   return !S48_FALSE_P
!     (s48_call_scheme(S48_SHARED_BINDING_REF(is_enum_set_binding),
!                    1,
!                    sch_thing));
! }
! 
! static void
! check_enum_set(s48_value sch_thing)
! {
!   if (!is_enum_set(sch_thing))
!     s48_raise_argument_type_error(sch_thing);
! }
! 
! static long
! enum_set2integer(s48_value sch_enum_set)
! {
!   check_enum_set(sch_enum_set);
! 
!   S48_SHARED_BINDING_CHECK(enum_set2integer_binding);
! 
!   return s48_extract_fixnum
!     (s48_call_scheme(S48_SHARED_BINDING_REF(enum_set2integer_binding),
!                    1,
!                    sch_enum_set));
! }
! 
! static s48_value
! integer2enum_set(s48_value sch_enum_type, long mask)
! {
!   S48_SHARED_BINDING_CHECK(integer2enum_set_binding);
! 
!   return s48_call_scheme(S48_SHARED_BINDING_REF(integer2enum_set_binding),
!                        2,
!                        sch_enum_type,
!                        s48_enter_fixnum(mask));
  }
  
***************
*** 61,83 ****
  /* Syslog options.
   *
!  * We translate the local bits into our own bits and vice versa.
   */
  
! static s48_value
! s48_enter_syslog_options(int syslog_options)
  {
!   s48_value   sch_syslog_options;
!   int         my_syslog_options;
  
!   my_syslog_options =
!     (LOG_CONS    & syslog_options ? 00001 : 0) |
!     (LOG_ODELAY  & syslog_options ? 00002 : 0) |
!     (LOG_NDELAY  & syslog_options ? 00004 : 0) |
!     (LOG_PID     & syslog_options ? 00010 : 0);
! 
!   sch_syslog_options = s48_make_record(syslog_options_type_binding);
!   S48_UNSAFE_RECORD_SET(sch_syslog_options, 0, 
s48_enter_fixnum(my_syslog_options));
  
!   return sch_syslog_options;
  }
  
--- 128,150 ----
  /* Syslog options.
   *
!  * We translate the our own bits into local bits
   */
  
! static int
! is_syslog_options(s48_value sch_thing)
  {
!   S48_SHARED_BINDING_CHECK(is_syslog_options_binding);
  
!   return !S48_FALSE_P
!     (s48_call_scheme(S48_SHARED_BINDING_REF(is_syslog_options_binding),
!                    1,
!                    sch_thing));
! }
  
! static void
! check_syslog_options(s48_value sch_thing)
! {
!   if (!is_syslog_options(sch_thing))
!     s48_raise_argument_type_error(sch_thing);
  }
  
***************
*** 86,95 ****
  {
    int c_syslog_options;
!   int syslog_options;
  
!   s48_check_record_type(sch_syslog_options, syslog_options_type_binding);
  
!   syslog_options =
!     s48_extract_fixnum(S48_UNSAFE_RECORD_REF(sch_syslog_options, 0));
  
    c_syslog_options =
--- 153,161 ----
  {
    int c_syslog_options;
!   long        syslog_options;
  
!   check_syslog_options(sch_syslog_options);
  
!   syslog_options = enum_set2integer(sch_syslog_options);
  
    c_syslog_options =
***************
*** 125,148 ****
  
  static s48_value
- s48_enter_syslog_facility(int syslog_facility)
- {
-   s48_value   sch_syslog_facility;
-   int         my_syslog_facility;
- 
-   for (my_syslog_facility = 0;
-        my_syslog_facility < (sizeof(syslog_facilities) / sizeof(int));
-        ++my_syslog_facility) {
-     if (syslog_facility == my_syslog_facility)
-       break;
-   }
- 
-   sch_syslog_facility =
-     S48_VECTOR_REF(S48_SHARED_BINDING_REF(syslog_facilities_binding),
-                  my_syslog_facility);
- 
-   return sch_syslog_facility;
- }
- 
- static s48_value
  s48_extract_syslog_facility(s48_value sch_syslog_facility)
  {
--- 191,194 ----
***************
*** 181,204 ****
  
  static s48_value
- s48_enter_syslog_level(int syslog_level)
- {
-   s48_value   sch_syslog_level;
-   int         my_syslog_level;
- 
-   for (my_syslog_level = 0;
-        my_syslog_level < (sizeof(syslog_levels) / sizeof(int));
-        ++my_syslog_level) {
-     if (syslog_level == my_syslog_level)
-       break;
-   }
- 
-   sch_syslog_level =
-     S48_VECTOR_REF(S48_SHARED_BINDING_REF(syslog_levels_binding),
-                  my_syslog_level);
- 
-   return sch_syslog_level;
- }
- 
- static s48_value
  s48_extract_syslog_level(s48_value sch_syslog_level)
  {
--- 227,230 ----
***************
*** 225,229 ****
  s48_enter_syslog_mask(int syslog_mask)
  {
-   s48_value   sch_syslog_mask;
    int         my_syslog_mask;
  
--- 251,254 ----
***************
*** 238,258 ****
      (LOG_MASK(LOG_DEBUG)   & syslog_mask ? 00200 : 0);
  
-   sch_syslog_mask = s48_make_record(syslog_mask_type_binding);
-   S48_UNSAFE_RECORD_SET(sch_syslog_mask, 0, s48_enter_fixnum(my_syslog_mask));
  
!   return sch_syslog_mask;
  }
  
  static int
  s48_extract_syslog_mask(s48_value sch_syslog_mask)
  {
    int c_syslog_mask;
    int syslog_mask;
- 
-   s48_check_record_type(sch_syslog_mask, syslog_mask_type_binding);
  
!   syslog_mask =
!     s48_extract_fixnum(S48_UNSAFE_RECORD_REF(sch_syslog_mask, 0));
  
    c_syslog_mask =
      (00001 & syslog_mask ? LOG_MASK(LOG_EMERG)   : 0) |
--- 263,300 ----
      (LOG_MASK(LOG_DEBUG)   & syslog_mask ? 00200 : 0);
  
  
!   return integer2enum_set
!     (S48_SHARED_BINDING_REF(syslog_mask_type_binding),
!      my_syslog_mask);
  }
  
  static int
+ is_syslog_mask(s48_value sch_thing)
+ {
+   S48_SHARED_BINDING_CHECK(is_enum_set_binding);
+ 
+   return !S48_FALSE_P
+     (s48_call_scheme(S48_SHARED_BINDING_REF(is_syslog_mask_binding),
+                                           1,
+                                           sch_thing));
+ }
+ 
+ static void
+ check_syslog_mask(s48_value sch_thing)
+ {
+   if (!is_syslog_mask(sch_thing))
+     s48_raise_argument_type_error(sch_thing);
+ }
+ 
+ static int
  s48_extract_syslog_mask(s48_value sch_syslog_mask)
  {
    int c_syslog_mask;
    int syslog_mask;
  
!   check_syslog_mask(sch_syslog_mask);
  
+   syslog_mask = enum_set2integer(sch_syslog_mask);
+    
    c_syslog_mask =
      (00001 & syslog_mask ? LOG_MASK(LOG_EMERG)   : 0) |
***************
*** 288,292 ****
      s48_raise_string_os_error("syslog is already open");
  
- 
    /* sch_ident may be copied to a different location by GC,
       and openlog doesn't copy the input string, at least not
--- 330,333 ----
***************
*** 302,306 ****
  
    openlog(syslog_ident, 
!         s48_extract_syslog_options(sch_options), 
          s48_extract_syslog_facility(sch_facility));
    syslog_open = 1;
--- 343,347 ----
  
    openlog(syslog_ident, 
!         s48_extract_syslog_options(sch_options),
          s48_extract_syslog_facility(sch_facility));
    syslog_open = 1;
***************
*** 335,339 ****
  sch_closelog(void)
  {
- 
    if (!syslog_open)
      s48_raise_string_os_error("syslog isn't open");
--- 376,379 ----
***************
*** 342,343 ****
--- 382,384 ----
    return S48_UNSPECIFIC;
  }
+ 



<Prev in Thread] Current Thread [Next in Thread>
  • [Scsh-checkins] CVS: scsh-0.6/scsh scsh-interfaces.scm,1.27,1.28 scsh-package.scm,1.29,1.30 syslog.scm,1.8,1.9 syslog1.c,1.3,1.4, Mike Sperber <=