[Scsh-checkins] CVS: scsh-0.6/c external.c,1.5,1.6 scheme48.h.in,1.5,1.6

[Martin Gasbichler <mainzelm@users.sourceforge.net>]

Update of /cvsroot/scsh/scsh-0.6/c
In directory usw-pr-cvs1:/tmp/cvs-serv4474

Modified Files:
        external.c scheme48.h.in 
Log Message:
Added s48_{enter,extract}_unsigned_integer.


Index: external.c
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/c/external.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -r1.5 -r1.6
*** external.c  2001/01/01 18:02:51     1.5
--- external.c  2001/04/02 14:55:55     1.6
***************
*** 733,736 ****
--- 733,752 ----
  }
  
+ s48_value
+ s48_enter_unsigned_integer(unsigned long value)
+ {
+   if (value <= S48_MAX_FIXNUM_VALUE)
+     return S48_UNSAFE_ENTER_FIXNUM(value);
+   else {
+     S48_SHARED_BINDING_CHECK(long_to_bignum_binding);
+ 
+     return s48_call_scheme(S48_SHARED_BINDING_REF(long_to_bignum_binding),
+                          3,
+                          S48_TRUE,
+                          S48_UNSAFE_ENTER_FIXNUM((- value) >> 16),
+                          S48_UNSAFE_ENTER_FIXNUM((- value) & 0xFFFF));
+   }
+ }
+ 
  /*
   * If we have a fixnum we just extract it.  Bignums require a call back into
***************
*** 778,781 ****
--- 794,840 ----
        return pos_p ? - magnitude : magnitude;
        }
+     }
+   }
+ }
+ 
+ unsigned long
+ s48_extract_unsigned_integer(s48_value value)
+ {
+   long temp;
+   if (S48_FIXNUM_P(value)){
+     temp = S48_UNSAFE_EXTRACT_FIXNUM(value);
+     if (temp < 0)
+       s48_raise_argtype_error(value);
+     else return (unsigned long) temp;
+   }
+   else {
+     s48_value stuff;
+     S48_DECLARE_GC_PROTECT(1);
+ 
+     S48_GC_PROTECT_1(value);
+ 
+     S48_SHARED_BINDING_CHECK(bignum_to_long_binding);
+ 
+     stuff = s48_call_scheme(S48_SHARED_BINDING_REF(bignum_to_long_binding),
+                           1,
+                           value);
+ 
+     S48_GC_UNPROTECT();
+ 
+     if (stuff == S48_FALSE)
+       s48_raise_argtype_error(value);
+ 
+     /* The first VECTOR_REF does the type checking for the rest. */
+     {
+       long low  = S48_UNSAFE_EXTRACT_FIXNUM(S48_VECTOR_REF(stuff, 2));
+       s48_value boxed_high = S48_UNSAFE_VECTOR_REF(stuff, 1);
+       long high = S48_UNSAFE_EXTRACT_FIXNUM(boxed_high);
+       int pos_p = S48_EXTRACT_BOOLEAN(S48_UNSAFE_VECTOR_REF(stuff, 0));
+       
+       if ((!pos_p) || 
+         (! S48_FIXNUM_P(boxed_high)) ||
+         (high >  0xFFFF)) 
+       s48_raise_argtype_error(value);
+       else return (- (((- high) << 16) - low));
      }
    }

Index: scheme48.h.in
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/c/scheme48.h.in,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -r1.5 -r1.6
*** scheme48.h.in       2001/01/02 09:31:27     1.5
--- scheme48.h.in       2001/04/02 14:55:55     1.6
***************
*** 39,42 ****
--- 39,44 ----
  extern s48_value      s48_enter_integer(long);
  extern long           s48_extract_integer(s48_value);
+ extern s48_value      s48_enter_unsigned_integer(unsigned long);
+ extern unsigned long  s48_extract_unsigned_integer(s48_value);
  extern s48_value      s48_enter_double(double);
  extern double         s48_extract_double(s48_value);