OK, my idea that long multiplication is like long addition is wrong.

It's still broken, but it's broken because of fundamental misunderstanding which tinkering won't solve.
This commit is contained in:
Simon Brooke 2019-01-20 23:34:46 +00:00
parent 22fa7314d6
commit 64fc43e9fc
6 changed files with 56 additions and 14 deletions

View file

@ -45,4 +45,4 @@
(inspect (set! z (+ y y y y y y y y y y))) (inspect (set! z (+ y y y y y y y y y y)))
"This blows up: 10^37, which is a three cell bignum." "This blows up: 10^37, which is a three cell bignum."
(inspect (+ z z z z z z z z z z)) (inspect (set! final (+ z z z z z z z z z z)))

View file

@ -81,4 +81,5 @@
(inspect (inspect
(set! z (+ y y y y y y y y))) (set! z (+ y y y y y y y y)))
(inspect (+ z z z z z z z z)) (inspect
(set! final (+ z z z z z z z z)))

View file

@ -27,6 +27,7 @@
#include "conspage.h" #include "conspage.h"
#include "consspaceobject.h" #include "consspaceobject.h"
#include "debug.h" #include "debug.h"
#include "lispops.h"
/* /*
* The maximum value we will allow in an integer cell. * The maximum value we will allow in an integer cell.
@ -104,14 +105,20 @@ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
* \see operate_on_integers * \see operate_on_integers
*/ */
__int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) { __int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) {
long int val = nilp( c ) ? 0 : pointer2cell( c ).payload.integer.value; long int val = nilp( c ) ?
0 :
pointer2cell( c ).payload.integer.value;
long int carry = is_first_cell ? 0 : ( MAX_INTEGER + 1 ); long int carry = is_first_cell ? 0 : ( MAX_INTEGER + 1 );
__int128_t result = ( __int128_t ) integerp( c ) ? __int128_t result = ( __int128_t ) integerp( c ) ?
( val == 0 ) ? carry : val : op == '*' ? 1 : 0; ( val == 0 ) ?
carry :
val :
0;
debug_printf( DEBUG_ARITH, debug_printf( DEBUG_ARITH,
L"cell_value: raw value is %ld, op = '%c', is_first_cell = %s; returning ", L"cell_value: raw value is %ld, op = '%c', is_first_cell = %s; %4.4s; returning ",
val, op, is_first_cell ? "true" : "false" ); val, op, is_first_cell ? "true" : "false", pointer2cell(c).tag.bytes);
debug_print_128bit( result, DEBUG_ARITH ); debug_print_128bit( result, DEBUG_ARITH );
debug_println( DEBUG_ARITH ); debug_println( DEBUG_ARITH );
@ -139,6 +146,7 @@ struct cons_pointer operate_on_integers( struct cons_pointer a,
struct cons_pointer b, char op ) { struct cons_pointer b, char op ) {
struct cons_pointer result = NIL; struct cons_pointer result = NIL;
struct cons_pointer cursor = NIL; struct cons_pointer cursor = NIL;
__int128_t carry = 0; __int128_t carry = 0;
bool is_first_cell = true; bool is_first_cell = true;
@ -163,7 +171,7 @@ struct cons_pointer operate_on_integers( struct cons_pointer a,
switch ( op ) { switch ( op ) {
case '*': case '*':
rv = av * ( bv + carry ); rv = (av * bv) + carry;
break; break;
case '+': case '+':
rv = av + bv + carry; rv = av + bv + carry;

View file

@ -136,7 +136,12 @@ struct cons_pointer eval_forms( struct stack_frame *frame,
/** /**
* Return the object list (root namespace). * Return the object list (root namespace).
* *
* (oblist) * * (oblist)
*
* @param frame the stack frame in which the expression is to be interpreted;
* @param frame_pointer a pointer to my stack_frame.
* @param env my environment (ignored).
* @return the root namespace.
*/ */
struct cons_pointer struct cons_pointer
lisp_oblist( struct stack_frame *frame, struct cons_pointer frame_pointer, lisp_oblist( struct stack_frame *frame, struct cons_pointer frame_pointer,
@ -165,12 +170,15 @@ struct cons_pointer compose_body( struct stack_frame *frame ) {
} }
/** /**
* Construct an interpretable function. * Construct an interpretable function. *NOTE* that if `args` is a single symbol
* rather than a list, a varargs function will be created.
* *
* (lambda args body) * (lambda args body)
* *
* @param frame the stack frame in which the expression is to be interpreted; * @param frame the stack frame in which the expression is to be interpreted;
* @param frame_pointer a pointer to my stack_frame.
* @param env the environment in which it is to be intepreted. * @param env the environment in which it is to be intepreted.
* @return an interpretable function with these `args` and this `body`.
*/ */
struct cons_pointer struct cons_pointer
lisp_lambda( struct stack_frame *frame, struct cons_pointer frame_pointer, lisp_lambda( struct stack_frame *frame, struct cons_pointer frame_pointer,
@ -179,12 +187,15 @@ lisp_lambda( struct stack_frame *frame, struct cons_pointer frame_pointer,
} }
/** /**
* Construct an interpretable special form. * Construct an interpretable special form. *NOTE* that if `args` is a single symbol
* rather than a list, a varargs special form will be created.
* *
* (nlambda args body) * (nlambda args body)
* *
* @param frame the stack frame in which the expression is to be interpreted; * @param frame the stack frame in which the expression is to be interpreted;
* @param frame_pointer a pointer to my stack_frame.
* @param env the environment in which it is to be intepreted. * @param env the environment in which it is to be intepreted.
* @return an interpretable special form with these `args` and this `body`.
*/ */
struct cons_pointer struct cons_pointer
lisp_nlambda( struct stack_frame *frame, struct cons_pointer frame_pointer, lisp_nlambda( struct stack_frame *frame, struct cons_pointer frame_pointer,
@ -612,6 +623,16 @@ lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer,
return result; return result;
} }
/**
* @return true if `arg` represents an end of string, else false.
* \todo candidate for moving to a memory/string.c file
*/
bool end_of_stringp(struct cons_pointer arg) {
return nilp(arg) ||
( stringp( arg ) &&
pointer2cell(arg).payload.string.character == (wint_t)'\0');
}
/** /**
* Function; * Function;
* returns a cell constructed from a and b. If a is of type string but its * returns a cell constructed from a and b. If a is of type string but its
@ -634,7 +655,8 @@ lisp_cons( struct stack_frame *frame, struct cons_pointer frame_pointer,
if ( nilp( car ) && nilp( cdr ) ) { if ( nilp( car ) && nilp( cdr ) ) {
return NIL; return NIL;
} else if ( stringp( car ) && stringp( cdr )) { } else if ( stringp( car ) && stringp( cdr ) &&
end_of_stringp( c_cdr( car)) ) {
// \todo check that car is of length 1 // \todo check that car is of length 1
result = result =
make_string( pointer2cell( car ).payload.string.character, cdr ); make_string( pointer2cell( car ).payload.string.character, cdr );
@ -1084,7 +1106,7 @@ throw_exception( struct cons_pointer message,
* normally return. A function which detects a problem it cannot resolve * normally return. A function which detects a problem it cannot resolve
* *should* return an exception. * *should* return an exception.
* *
* * (exception <message> <frame>) * * (exception message frame)
* *
* @param frame my stack frame. * @param frame my stack frame.
* @param frame_pointer a pointer to my stack_frame. * @param frame_pointer a pointer to my stack_frame.

View file

@ -1,6 +1,6 @@
#!/bin/bash #!/bin/bash
expected='(Special form)' expected='<Special form>'
actual=`echo "(eval 'cond)" | target/psse | tail -1` actual=`echo "(eval 'cond)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]

View file

@ -6,7 +6,18 @@ actual=`echo "(+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ] if [ "${expected}" = "${actual}" ]
then then
echo "OK" echo "OK"
exit 0 else
echo "Fail: expected '${expected}', got '${actual}'"
exit 1
fi
# check that all the args are actually being evaluated...
expected="120"
actual=`echo "(+ (+ 0 1) (+ 0 2) (+ 0 3) (+ 0 4) (+ 0 5) (+ 0 6) (+ 0 7) (+ 0 8) (+ 0 9) (+ 0 10) (+ 0 11) (+ 0 12) (+ 0 13) (+ 0 14 ) (+ 0 15))" | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else else
echo "Fail: expected '${expected}', got '${actual}'" echo "Fail: expected '${expected}', got '${actual}'"
exit 1 exit 1