Merge branch 'feature/all-integers-are-bignums' into develop

src/arith/integer.c

@@ -216,20 +216,44 @@ struct cons_pointer base_partial( int depth ) {
     return result;
 }
 
+/**
+ * destructively modify this `partial` by appending this `digit`.
+ */
+struct cons_pointer append_digit( struct cons_pointer partial, struct cons_pointer digit) {
+    struct cons_pointer c = partial;
+    struct cons_pointer result = partial;
+
+    if (nilp( partial)) {
+        result = digit;
+    } else {
+        while ( !nilp( pointer2cell(c).payload.integer.more)) {
+            c = pointer2cell(c).payload.integer.more;
+        }
+
+        (&pointer2cell(c))->payload.integer.more = digit;
+    }
+    return result;
+}
+
+
+
 /**
  * Return a pointer to an integer representing the product of the integers
  * pointed to by `a` and `b`. If either isn't an integer, will return nil.
- * \todo it is MUCH more complicated than this!
+ *
+ * Yes, this is one of Muhammad ibn Musa al-Khwarizmi's original recipes, so
+ * you'd think it would be easy; the reason that each step is documented is
+ * because I did not find it so.
  *
  * @param a an integer;
  * @param b an integer.
  */
 struct cons_pointer multiply_integers( struct cons_pointer a,
                                       struct cons_pointer b ) {
-    struct cons_pointer result = NIL;
+    struct cons_pointer result = make_integer( 0, NIL);
     bool neg = is_negative( a ) != is_negative( b );
     bool is_first_b = true;
-    int oom = -1;
+    int i = 0;
 
     debug_print( L"multiply_integers: a = ", DEBUG_ARITH );
     debug_print_object( a, DEBUG_ARITH );
@@ -238,60 +262,54 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
     debug_println( DEBUG_ARITH );
 
     if ( integerp( a ) && integerp( b ) ) {
-        while ( !nilp( b ) ) {
+        /* for each digit in a, starting with the least significant (ai) */
-            bool is_first_d = true;
+
-            struct cons_pointer d = a;
+        for ( struct cons_pointer ai = a; !nilp( ai );
-            struct cons_pointer partial = base_partial( ++oom );
+             ai = pointer2cell(ai).payload.integer.more) {
+            /* set carry to 0 */
             __int128_t carry = 0;
 
-            while ( !nilp( d ) || carry != 0 ) {
+            /* set least significant digits for result ri for this iteration
-                partial = make_integer( 0, partial );
+             * to i zeros */
-                struct cons_pointer new = NIL;
+            struct cons_pointer ri = base_partial( i++ );
-                __int128_t dv = cell_value( d, '+', is_first_d );
-                __int128_t bv = cell_value( b, '+', is_first_b );
 
-                __int128_t rv = ( dv * bv ) + carry;
+            /* for each digit in b, starting with the least significant (bj) */
+            for ( struct cons_pointer bj = b; !nilp( bj );
+                 bj = pointer2cell(bj).payload.integer.more) {
 
-                debug_print( L"multiply_integers: d = ", DEBUG_ARITH );
+                debug_printf( DEBUG_ARITH,
-                debug_print_object( d, DEBUG_ARITH );
+                             L"multiply_integers: a[i] = %Ld, b[j] = %Ld, i = %d\n",
-                debug_print( L"; dv = ", DEBUG_ARITH );
+                             pointer2cell(ai).payload.integer.value,
-                debug_print_128bit( dv, DEBUG_ARITH );
+                             pointer2cell(bj).payload.integer.value, i);
-                debug_print( L"; bv = ", DEBUG_ARITH );
+
-                debug_print_128bit( bv, DEBUG_ARITH );
+                /* multiply ai with bj and add the carry, resulting in a
-                debug_print( L"; carry = ", DEBUG_ARITH );
+                 * value xj which may exceed one digit */
-                debug_print_128bit( carry, DEBUG_ARITH );
+                __int128_t xj = pointer2cell(ai).payload.integer.value *
-                debug_print( L"; rv = ", DEBUG_ARITH );
+                    pointer2cell(bj).payload.integer.value;
-                debug_print_128bit( rv, DEBUG_ARITH );
+                xj += carry;
-                debug_print( L"; acc = ", DEBUG_ARITH );
+
+                /* if xj exceeds one digit, break it into the digit dj and
+                 * the carry */
+                carry = xj >> 60;
+                struct cons_pointer dj = make_integer( xj & MAX_INTEGER, NIL);
+
+                /* destructively modify ri by appending dj */
+                ri = append_digit( ri, dj);
+            } /* end for bj */
+
+            /* if carry is not equal to zero, append it as a final digit
+             * to ri */
+            if (carry != 0) {
+                ri = append_digit( ri, make_integer( carry, NIL));
+            }
+
+            /* add ri to result */
+            result = add_integers( result, ri);
+
+            debug_print( L"multiply_integers: result is ", DEBUG_ARITH );
             debug_print_object( result, DEBUG_ARITH );
-                debug_print( L"; partial = ", DEBUG_ARITH );
+            debug_println( DEBUG_ARITH );
-                debug_print_object( partial, DEBUG_ARITH );
+        } /* end for ai */
-                debug_print( L"\n", DEBUG_ARITH );
-
-                new = make_integer_128( rv, base_partial( oom ) );
-
-                if ( zerop( partial ) ) {
-                    partial = new;
-                } else {
-                    partial = add_integers( partial, new );
-                }
-
-                d = integerp( d ) ? pointer2cell( d ).payload.integer.
-                    more : NIL;
-                is_first_d = false;
-            }
-
-            if ( nilp( result ) || zerop( result ) ) {
-                result = partial;
-            } else {
-                struct cons_pointer old = result;
-                result = add_integers( partial, result );
-                //if (!eq(result, old)) dec_ref(old);
-                //if (!eq(result, partial)) dec_ref(partial);
-            }
-            b = pointer2cell( b ).payload.integer.more;
-            is_first_b = false;
-        }
     }
 
     debug_print( L"multiply_integers returning: ", DEBUG_ARITH );
@@ -324,34 +342,24 @@ struct cons_pointer integer_to_string_add_digit( int digit, int digits,
  * when we get to the last digit from one integer cell, we have potentially
  * to be looking to the next. H'mmmm.
  */
-/*
- * \todo this blows up when printing three-cell integers, but works fine
- * for two-cell. What's happening is that when we cross the barrier we
- * SHOULD print 2^120, but what we actually print is 2^117. H'mmm.
- */
 struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
                                       int base ) {
     struct cons_pointer result = NIL;
-    struct cons_space_object integer = pointer2cell( int_pointer );
+
-    __int128_t accumulator = llabs( integer.payload.integer.value );
+    if ( integerp( int_pointer ) ) {
-    bool is_negative = integer.payload.integer.value < 0;
+        struct cons_pointer next = pointer2cell( int_pointer ).payload.integer.more;
+        __int128_t accumulator = llabs( pointer2cell( int_pointer ).payload.integer.value );
+        bool is_negative = pointer2cell( int_pointer ).payload.integer.value < 0;
         int digits = 0;
 
-    if ( accumulator == 0 && nilp( integer.payload.integer.more ) ) {
+        if ( accumulator == 0 && nilp( next ) ) {
             result = c_string_to_lisp_string( L"0" );
         } else {
-        while ( accumulator > 0 || !nilp( integer.payload.integer.more ) ) {
+            while ( accumulator > 0 || !nilp( next ) ) {
-            if ( !nilp( integer.payload.integer.more ) ) {
+                if ( accumulator < MAX_INTEGER && !nilp( next ) ) {
-                integer = pointer2cell( integer.payload.integer.more );
+                    accumulator += (pointer2cell(next).payload.integer.value << 60);
-                accumulator += integer.payload.integer.value;
+                    next = pointer2cell(next).payload.integer.more;
-                debug_print
-                    ( L"integer_to_string: crossing cell boundary, accumulator is: ",
-                      DEBUG_IO );
-                debug_print_128bit( accumulator, DEBUG_IO );
-                debug_println( DEBUG_IO );
                 }
-
-            do {
                 int offset = ( int ) ( accumulator % base );
                 debug_printf( DEBUG_IO,
                              L"integer_to_string: digit is %ld, hexadecimal is %c, accumulator is: ",
@@ -364,22 +372,21 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
                 result =
                     integer_to_string_add_digit( offset, ++digits, result );
                 accumulator = accumulator / base;
-            } while ( accumulator > base );
             }
 
             if ( stringp( result )
                 && pointer2cell( result ).payload.string.character == L',' ) {
                 /* if the number of digits in the string is divisible by 3, there will be
                  * an unwanted comma on the front. */
-            struct cons_pointer tmp = result;
                 result = pointer2cell( result ).payload.string.cdr;
-            //dec_ref( tmp );
             }
 
+
             if ( is_negative ) {
                 result = make_string( L'-', result );
             }
         }
+    }
 
     return result;
 }

src/init.c

@@ -84,6 +84,33 @@ void bind_value( wchar_t *name, struct cons_pointer value ) {
     dec_ref( n );
 }
 
+void print_banner() {
+    fwprintf(stdout, L"Post-Scarcity Software Environment version %s\n\n", VERSION);
+}
+
+/**
+ * Print command line options to this `stream`.
+ * 
+ * @stream the stream to print to.
+ */
+void print_options(FILE* stream) {
+    fwprintf(stream, L"Expected options are:\n");
+    fwprintf(stream, L"\t-d\tDump memory to standard out at end of run (copious!);\n");
+    fwprintf(stream, L"\t-h\tPrint this message and exit;\n");
+    fwprintf(stream, L"\t-p\tShow a prompt (default is no prompt);\n");
+    fwprintf(stream, L"\t-v LEVEL\n\t\tSet verbosity to the specified level (0...512)\n");
+    fwprintf(stream, L"\t\tWhere bits are interpreted as follows:\n");
+    fwprintf(stream, L"\t\t1\tALLOC;\n");
+    fwprintf(stream, L"\t\t2\tARITH;\n");
+    fwprintf(stream, L"\t\t4\tBIND;\n");
+    fwprintf(stream, L"\t\t8\tBOOTSTRAP;\n");
+    fwprintf(stream, L"\t\t16\tEVAL;\n");
+    fwprintf(stream, L"\t\t32\tINPUT/OUTPUT;\n");
+    fwprintf(stream, L"\t\t64\tLAMBDA;\n");
+    fwprintf(stream, L"\t\t128\tREPL;\n");
+    fwprintf(stream, L"\t\t256\tSTACK.\n");
+}
+
 /**
  * main entry point; parse command line arguments, initialise the environment,
  * and enter the read-eval-print loop.
@@ -99,11 +126,16 @@ int main( int argc, char *argv[] ) {
         exit( 1 );
     }
 
-    while ( ( option = getopt( argc, argv, "pdv:" ) ) != -1 ) {
+    while ( ( option = getopt( argc, argv, "phdv:" ) ) != -1 ) {
         switch ( option ) {
             case 'd':
                 dump_at_end = true;
                 break;
+            case 'h':
+                print_banner();
+                print_options(stdout);
+                exit( 0 );
+                break;
             case 'p':
                 show_prompt = true;
                 break;
@@ -112,14 +144,14 @@ int main( int argc, char *argv[] ) {
                 break;
             default:
                 fwprintf( stderr, L"Unexpected option %c\n", option );
+                print_options(stderr);
+                exit( 1 );
                 break;
         }
     }
 
     if ( show_prompt ) {
-        fwprintf( stdout,
+        print_banner();
-                  L"Post scarcity software environment version %s\n\n",
-                  VERSION );
     }
 
     debug_print( L"About to initialise cons pages\n", DEBUG_BOOTSTRAP );

src/io/print.c

@@ -163,7 +163,7 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
             print_list( output, pointer );
             break;
         case EXCEPTIONTV:
-            url_fwuts( L"\nException: ", output );
+            url_fputws( L"\nException: ", output );
             dump_stack_trace( output, pointer );
             break;
         case FUNCTIONTV: