Various refactorings around bignum arithmetic

src/arith/integer.c

@@ -36,7 +36,7 @@
 /**
  * hexadecimal digits for printing numbers.
  */
-const wchar_t hex_digits[16] = L"0123456789ABCDEF";
+const char * hex_digits = "0123456789ABCDEF";
 
 /*
  * Doctrine from here on in is that ALL integers are bignums, it's just
@@ -133,13 +133,24 @@ struct cons_pointer operate_on_integers( struct cons_pointer a,
 
           switch (op) {
             case '*':
-          rv = ( av * bv ) + carry;
+            rv = av * bv * ((carry == 0) ? 1 : carry);
             break;
             case '+':
             rv = av + bv + carry;
             break;
           }
 
+          debug_printf( DEBUG_ARITH, L"operate_on_integers: op = '%c'; av = ", op);
+          debug_print_128bit( av, DEBUG_ARITH);
+          debug_print( L"; bv = ",  DEBUG_ARITH);
+          debug_print_128bit( bv, DEBUG_ARITH);
+          debug_print( L"; carry = ",  DEBUG_ARITH);
+          debug_print_128bit( carry, DEBUG_ARITH);
+          debug_print( L"; rv = ",  DEBUG_ARITH);
+          debug_print_128bit( rv, DEBUG_ARITH);
+          debug_print( L"\n",  DEBUG_ARITH);
+
+
             if ( MAX_INTEGER >= rv ) {
               carry = 0;
             } else {
@@ -206,7 +217,7 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
 struct cons_pointer integer_to_string_add_digit( int digit, int digits,
                                                  struct cons_pointer tail ) {
     digits++;
-    wint_t character = ( wint_t ) hex_digits[digit];
+    wint_t character = btowc(hex_digits[digit]);
     return ( digits % 3 == 0 ) ?
         make_string( L',', make_string( character,
                                         tail ) ) :
@@ -247,13 +258,14 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
                           L"integer_to_string: accumulator is %ld\n:",
                           accumulator );
             do {
+              int offset = (int)(accumulator % base);
                 debug_printf( DEBUG_IO,
-                              L"integer_to_string: digit is %ld, hexadecimal is %C\n:",
+                              L"integer_to_string: digit is %ld, hexadecimal is %c\n:",
-                              accumulator % base,
+                              offset,
-                              btowc(hex_digits[accumulator % base] ));
+                              hex_digits[offset] );
 
                 result =
-                    integer_to_string_add_digit( accumulator % base, digits++,
+                    integer_to_string_add_digit( offset, digits++,
                                                  result );
                 accumulator = accumulator / base;
             } while ( accumulator > base );

src/arith/peano.c

@@ -41,7 +41,8 @@ bool zerop( struct cons_pointer arg ) {
 
     switch ( cell.tag.value ) {
         case INTEGERTV:
-            result = cell.payload.integer.value == 0;
+            result = cell.payload.integer.value == 0 &&
+              nilp(cell.payload.integer.more);
             break;
         case RATIOTV:
             result = zerop( cell.payload.ratio.dividend );
@@ -134,9 +135,9 @@ struct cons_pointer add_2( struct stack_frame *frame,
     struct cons_space_object cell2 = pointer2cell( arg2 );
 
     debug_print( L"add_2( arg1 = ", DEBUG_ARITH );
-    debug_print_object( arg1, DEBUG_ARITH );
+    debug_dump_object( arg1, DEBUG_ARITH );
     debug_print( L"; arg2 = ", DEBUG_ARITH );
-    debug_print_object( arg2, DEBUG_ARITH );
+    debug_dump_object( arg2, DEBUG_ARITH );
     debug_print( L"\n", DEBUG_ARITH );
 
     if ( zerop( arg1 ) ) {

src/debug.c

@@ -42,6 +42,29 @@ void debug_print( wchar_t *message, int level ) {
 #endif
 }
 
+/**
+ * stolen from https://stackoverflow.com/questions/11656241/how-to-print-uint128-t-number-using-gcc
+ */
+void debug_print_128bit( __int128_t n, int level ) {
+  #ifdef DEBUG
+  if ( level & verbosity ) {
+    if (n == 0) {
+      fwprintf(stderr, L"0");
+    } else {
+      char str[40] = {0}; // log10(1 << 128) + '\0'
+      char *s = str + sizeof(str) - 1; // start at the end
+      while (n != 0) {
+        if (s == str) return; // never happens
+
+        *--s = "0123456789"[n % 10]; // save last digit
+        n /= 10;                     // drop it
+      }
+      fwprintf(stderr, L"%s", s);
+    }
+  }
+  #endif
+}
+
 /**
  * print a line feed to stderr, if `verbosity` matches `level`.
  * `verbosity is a set of flags, see debug_print.h; so you can

src/debug.h

@@ -26,6 +26,7 @@
 extern int verbosity;
 
 void debug_print( wchar_t *message, int level );
+void debug_print_128bit( __int128_t n, int level );
 void debug_println( int level );
 void debug_printf( int level, wchar_t *format, ... );
 void debug_print_object( struct cons_pointer pointer, int level );

src/ops/lispops.c

@@ -1133,7 +1133,6 @@ struct cons_pointer lisp_source( struct stack_frame *frame,
 struct cons_pointer lisp_inspect( struct stack_frame *frame, struct cons_pointer frame_pointer,
             struct cons_pointer env ) {
     debug_print( L"Entering print\n", DEBUG_IO );
-    struct cons_pointer result = frame->arg[0];
     FILE *output = stdout;
     struct cons_pointer out_stream = writep( frame->arg[1] ) ?
         frame->arg[1] : get_default_stream( false, env );
@@ -1150,5 +1149,5 @@ struct cons_pointer lisp_inspect( struct stack_frame *frame, struct cons_pointer
         dec_ref( out_stream );
     }
 
-    return result;
+    return frame->arg[0];
 }

src/ops/read.c

@@ -180,33 +180,41 @@ struct cons_pointer read_number( struct stack_frame *frame,
 
   for ( c = initial; iswdigit( c )
        || c == L'.' || c == L'/' || c == L','; c = fgetwc( input ) ) {
-        if ( c == btowc( '.' ) ) {
+    switch (c) {
+      case L'.':
       if ( seen_period || !nilp( dividend ) ) {
         return throw_exception( c_string_to_lisp_string
                                ( L"Malformed number: too many periods" ),
                                frame_pointer );
       } else {
+        debug_print(L"read_number: decimal point seen\n", DEBUG_IO);
         seen_period = true;
       }
-        } else if ( c == btowc( '/' ) ) {
+      break;
+      case L'/':
       if ( seen_period || !nilp( dividend ) ) {
         return throw_exception( c_string_to_lisp_string
                                ( L"Malformed number: dividend of rational must be integer" ),
                                frame_pointer );
       } else {
+        debug_print(L"read_number: ratio slash seen\n", DEBUG_IO);
         dividend = result;
 
         result = make_integer( 0, NIL );
       }
-        } else if ( c == L',' ) {
+      break;
+      case L',' :
       // silently ignore it.
-        } else {
+      break;
+      default:
       result = add_integers( multiply_integers( result, base ),
                             make_integer( ( int ) c - ( int ) '0',
                                          NIL ) );
 
       debug_printf( DEBUG_IO,
-                          L"Added character %c, result now %ld\n", c, result );
+                   L"read_number: added character %c, result now ", c );
+      debug_print_object( result, DEBUG_IO);
+      debug_print( L"\n", DEBUG_IO);
 
       if ( seen_period ) {
         places_of_decimals++;
@@ -218,7 +226,9 @@ struct cons_pointer read_number( struct stack_frame *frame,
      * push back the character read which was not a digit
      */
   ungetwc( c, input );
+
   if ( seen_period ) {
+    debug_print(L"read_number: converting result to real\n", DEBUG_IO);
     struct cons_pointer div = make_ratio( frame_pointer, result,
                                          make_integer( powl
                                                       ( to_long_double
@@ -231,10 +241,13 @@ struct cons_pointer read_number( struct stack_frame *frame,
 
     dec_ref( div );
   } else if ( integerp( dividend ) ) {
+    debug_print(L"read_number: converting result to ratio\n", DEBUG_IO);
     result = make_ratio( frame_pointer, dividend, result );
   }
 
   if ( neg ) {
+    debug_print(L"read_number: converting result to negative\n", DEBUG_IO);
+
     result = negative( frame_pointer, result );
   }