Now safely detecting (but not dealing with) integer overflow.

src/arith/integer.c

@@ -12,6 +12,12 @@
 #include <math.h>
 #include <stdio.h>
 #include <stdlib.h>
+/* safe_iop, as available in the Ubuntu repository, is this one:
+ * https://code.google.com/archive/p/safe-iop/wikis/README.wiki
+ * which is installed as `libsafe-iop-dev`. There is an alternate
+ * implementation here: https://github.com/redpig/safe-iop/
+ * which shares the same version number but is not compatible. */
+#include <safe_iop.h>
 /*
  * wide characters
  */
@@ -107,16 +113,18 @@ struct cons_pointer add_integers( struct cons_pointer a,
             int64_t bv =
                 integerp( b ) ? pointer2cell( b ).payload.integer.value : 0;
 
-            __int128_t rv = av + bv + carry;
+            int64_t rv = 0;
 
-            if ( rv > LONG_MAX || rv < LONG_MIN ) {
+            if ( safe_add( &rv, av, bv ) ) {
+                carry = 0;
+            } else {
+                // TODO: we're correctly detecting overflow, but not yet correctly
+                // handling it.
                 debug_printf( DEBUG_ARITH,
                               L"add_integers: 64 bit overflow; setting carry to %ld\n",
                               carry );
                 carry = llabs( rv / LONG_MAX );
                 rv = rv % LONG_MAX;
-            } else {
-                carry = 0;
             }
 
             result = make_integer( rv, result );
@@ -153,16 +161,18 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
             int64_t bv =
                 integerp( b ) ? pointer2cell( b ).payload.integer.value : 1;
 
-            __int128_t rv = ( av * bv ) + carry;
+            int64_t rv = 0;
 
-            if ( rv > LONG_MAX || rv < LONG_MIN ) {
+            if ( safe_mul( &rv, av, bv ) ) {
+                carry = 0;
+            } else {
+                // TODO: we're correctly detecting overflow, but not yet correctly
+                // handling it.
                 debug_printf( DEBUG_ARITH,
                               L"multiply_integers: 64 bit overflow; setting carry to %ld\n",
                               carry );
                 carry = llabs( rv / LONG_MAX );
                 rv = rv % LONG_MAX;
-            } else {
-                carry = 0;
             }
 
             result = make_integer( rv, result );
@@ -177,6 +187,19 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
     return result;
 }
 
+/**
+ * don't use; private to integer_to_string, and somewaht dodgy.
+ */
+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];
+    return ( digits % 3 == 0 ) ?
+        make_string( L',', make_string( character,
+                                        tail ) ) :
+        make_string( character, tail );
+}
+
 /**
  * The general principle of printing a bignum is that you print the least
  * significant digit in whatever base you're dealing with, divide through
@@ -195,23 +218,23 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
     int64_t accumulator = integer.payload.integer.value;
     bool is_negative = accumulator < 0;
     accumulator = llabs( accumulator );
+    int digits = 0;
 
     if ( accumulator == 0 ) {
         result = c_string_to_lisp_string( L"0" );
     } else {
         while ( accumulator > 0 ) {
-            debug_printf( DEBUG_ARITH,
+            debug_printf( DEBUG_IO,
                           L"integer_to_string: accumulator is %ld\n:",
                           accumulator );
             do {
-                debug_printf( DEBUG_ARITH,
+                debug_printf( DEBUG_IO,
                               L"integer_to_string: digit is %ld, hexadecimal is %lc\n:",
                               accumulator % base,
                               hex_digits[accumulator % base] );
-                wint_t digit = ( wint_t ) hex_digits[accumulator % base];
 
                 result =
-                    make_string( ( wint_t ) hex_digits[accumulator % base],
+                    integer_to_string_add_digit( accumulator % base, digits++,
                                                  result );
                 accumulator = accumulator / base;
             } while ( accumulator > base );
@@ -223,7 +246,7 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
                 /* TODO: I don't believe it's as simple as this! */
                 accumulator += ( base * ( i % base ) );
                 result =
-                    make_string( ( wint_t ) hex_digits[accumulator % base],
+                    integer_to_string_add_digit( accumulator % base, digits++,
                                                  result );
                 accumulator += ( base * ( i / base ) );
             }

src/ops/lispops.c

@@ -359,8 +359,9 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         result = next_pointer;
                     } else {
                         result =
-                            ( *fn_cell.payload.special.
+                            ( *fn_cell.payload.
-                              executable ) ( get_stack_frame( next_pointer ),
+                              special.executable ) ( get_stack_frame
+                                                     ( next_pointer ),
                                                      next_pointer, env );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
@@ -1015,7 +1016,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
     struct cons_pointer prompt_name = c_string_to_lisp_symbol( L"*prompt*" );
     struct cons_pointer old_oblist = oblist;
     struct cons_pointer new_env = env;
-    inc_ref(env);
+    inc_ref( env );
 
     inc_ref( input );
     inc_ref( output );
@@ -1047,8 +1048,8 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
                 debug_println( DEBUG_REPL );
 
                 new_env = make_cons( c_car( cursor ), new_env );
-                inc_ref( new_env);
+                inc_ref( new_env );
-                dec_ref( old_new_env);
+                dec_ref( old_new_env );
                 cursor = c_cdr( cursor );
             }
             old_oblist = oblist;

src/ops/read.c

@@ -175,7 +175,7 @@ struct cons_pointer read_number( struct stack_frame *frame,
                   initial );
 
     for ( c = initial; iswdigit( c )
-          || c == btowc( '.' ) || c == btowc( '/' ); c = fgetwc( input ) ) {
+          || c == L'.' || c == L'/' || c == L','; c = fgetwc( input ) ) {
         if ( c == btowc( '.' ) ) {
             if ( seen_period || dividend != 0 ) {
                 return throw_exception( c_string_to_lisp_string
@@ -194,6 +194,8 @@ struct cons_pointer read_number( struct stack_frame *frame,
 
                 accumulator = 0;
             }
+        } else if ( c == L',' ) {
+            // silently ignore it.
         } else {
             accumulator = accumulator * 10 + ( ( int ) c - ( int ) '0' );