simon/post-scarcity
1
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

Better exceptions, investigation on failure to read/print wide chars.

Browse source
This commit is contained in:
Simon Brooke 2018-12-25 15:32:45 +00:00
parent 9ff2f14c7d
commit ae8ba67ed7
13 changed files with 217 additions and 183 deletions
Download patch file Download diff file Expand all files Collapse all files

8
src/arith/peano.c
View file

@ -130,7 +130,7 @@ struct cons_pointer add_2( struct stack_frame *frame, struct cons_pointer arg1,
print( stderr, arg1 );
fputws( L"; arg2 = ", stderr );
print( stderr, arg2 );
fputws( L")\n", stderr);
fputws( L")\n", stderr );
#endif
if ( zerop( arg1 ) ) {
@ -264,7 +264,7 @@ struct cons_pointer multiply_2( struct stack_frame *frame,
print( stderr, arg1 );
fputws( L"; arg2 = ", stderr );
print( stderr, arg2 );
fputws( L")\n", stderr);
fputws( L")\n", stderr );
#endif
if ( zerop( arg1 ) ) {
@ -406,8 +406,8 @@ struct cons_pointer inverse( struct stack_frame *frame,
case RATIOTV:
result = make_ratio( frame,
make_integer( 0 -
to_long_int( cell.payload.
ratio.dividend ) ),
to_long_int( cell.payload.ratio.
dividend ) ),
cell.payload.ratio.divisor );
break;
case REALTV:

240
src/arith/ratio.c
View file

@ -58,27 +58,28 @@ struct cons_pointer simplify_ratio( struct stack_frame *frame,
struct cons_pointer arg ) {
struct cons_pointer result = arg;
if (ratiop(arg)) {
int64_t ddrv =
pointer2cell( pointer2cell( arg ).payload.ratio.dividend ).
payload.integer.value, drrv =
pointer2cell( pointer2cell( arg ).payload.ratio.divisor ).
payload.integer.value, gcd = greatest_common_divisor( ddrv, drrv );
if ( ratiop( arg ) ) {
int64_t ddrv =
pointer2cell( pointer2cell( arg ).payload.ratio.dividend ).payload.
integer.value, drrv =
pointer2cell( pointer2cell( arg ).payload.ratio.divisor ).payload.
integer.value, gcd = greatest_common_divisor( ddrv, drrv );
if ( gcd > 1 ) {
if ( drrv / gcd == 1 ) {
result = make_integer( ddrv / gcd );
} else {
result =
make_ratio( frame, make_integer( ddrv / gcd ),
make_integer( drrv / gcd ) );
if ( gcd > 1 ) {
if ( drrv / gcd == 1 ) {
result = make_integer( ddrv / gcd );
} else {
result =
make_ratio( frame, make_integer( ddrv / gcd ),
make_integer( drrv / gcd ) );
}
}
} else {
result =
lisp_throw( make_cons( c_string_to_lisp_string
( "Shouldn't happen: bad arg to simplify_ratio" ),
arg ), frame );
}
} else {
result = lisp_throw(
c_string_to_lisp_string( "Shouldn't happen: bad arg to simplify_ratio" ),
frame );
}
return result;
}
@ -100,58 +101,61 @@ struct cons_pointer add_ratio_ratio( struct stack_frame *frame,
print( stderr, arg1 );
fputws( L"; arg2 = ", stderr );
print( stderr, arg2 );
fputws( L")\n", stderr);
fputws( L")\n", stderr );
#endif
if ( ratiop(arg1) && ratiop(arg2)) {
struct cons_space_object cell1 = pointer2cell( arg1 );
struct cons_space_object cell2 = pointer2cell( arg2 );
int64_t dd1v =
pointer2cell( cell1.payload.ratio.dividend ).payload.integer.value,
dd2v =
pointer2cell( cell2.payload.ratio.dividend ).payload.integer.value,
dr1v =
pointer2cell( cell1.payload.ratio.divisor ).payload.integer.value,
dr2v =
pointer2cell( cell2.payload.ratio.divisor ).payload.integer.value,
lcm = least_common_multiple( dr1v, dr2v ),
m1 = lcm / dr1v, m2 = lcm / dr2v;
if ( ratiop( arg1 ) && ratiop( arg2 ) ) {
struct cons_space_object cell1 = pointer2cell( arg1 );
struct cons_space_object cell2 = pointer2cell( arg2 );
int64_t dd1v =
pointer2cell( cell1.payload.ratio.dividend ).payload.integer.value,
dd2v =
pointer2cell( cell2.payload.ratio.dividend ).payload.integer.value,
dr1v =
pointer2cell( cell1.payload.ratio.divisor ).payload.integer.value,
dr2v =
pointer2cell( cell2.payload.ratio.divisor ).payload.integer.value,
lcm = least_common_multiple( dr1v, dr2v ),
m1 = lcm / dr1v, m2 = lcm / dr2v;
#ifdef DEBUG
fwprintf( stderr, L"); lcm = %ld; m1 = %ld; m2 = %ld", lcm, m1, m2 );
fwprintf( stderr, L"); lcm = %ld; m1 = %ld; m2 = %ld", lcm, m1, m2 );
#endif
if ( dr1v == dr2v ) {
r = make_ratio( frame,
make_integer( dd1v + dd2v ),
cell1.payload.ratio.divisor );
if ( dr1v == dr2v ) {
r = make_ratio( frame,
make_integer( dd1v + dd2v ),
cell1.payload.ratio.divisor );
} else {
struct cons_pointer dd1vm = make_integer( dd1v * m1 ),
dr1vm = make_integer( dr1v * m1 ),
dd2vm = make_integer( dd2v * m2 ),
dr2vm = make_integer( dr2v * m2 ),
r1 = make_ratio( frame, dd1vm, dr1vm ),
r2 = make_ratio( frame, dd2vm, dr2vm );
r = add_ratio_ratio( frame, r1, r2 );
/* because the references on dd1vm, dr1vm, dd2vm and dr2vm were
* never incremented except when making r1 and r2, decrementing
* r1 and r2 should be enought to garbage collect them. */
dec_ref( r1 );
dec_ref( r2 );
}
result = simplify_ratio( frame, r );
if ( !eq( r, result ) ) {
dec_ref( r );
}
} else {
struct cons_pointer dd1vm = make_integer( dd1v * m1 ),
dr1vm = make_integer( dr1v * m1 ),
dd2vm = make_integer( dd2v * m2 ),
dr2vm = make_integer( dr2v * m2 ),
r1 = make_ratio( frame, dd1vm, dr1vm ),
r2 = make_ratio( frame, dd2vm, dr2vm );
r = add_ratio_ratio( frame, r1, r2 );
/* because the references on dd1vm, dr1vm, dd2vm and dr2vm were
* never incremented except when making r1 and r2, decrementing
* r1 and r2 should be enought to garbage collect them. */
dec_ref( r1 );
dec_ref( r2 );
result =
lisp_throw( make_cons( c_string_to_lisp_string
( "Shouldn't happen: bad arg to add_ratio_ratio" ),
make_cons( arg1,
make_cons( arg2, NIL ) ) ),
frame );
}
result = simplify_ratio( frame, r );
if ( !eq( r, result ) ) {
dec_ref( r );
}
} else {
result = lisp_throw(
c_string_to_lisp_string( "Shouldn't happen: bad arg to add_ratio_ratio" ),
frame );
}
#ifdef DEBUG
fputws( L" => ", stderr );
print( stderr, result );
@ -170,23 +174,26 @@ struct cons_pointer add_ratio_ratio( struct stack_frame *frame,
struct cons_pointer add_integer_ratio( struct stack_frame *frame,
struct cons_pointer intarg,
struct cons_pointer ratarg ) {
struct cons_pointer result;
struct cons_pointer result;
if (integerp(intarg) && ratiop(ratarg)) {
struct cons_pointer one = make_integer( 1 ),
ratio = make_ratio( frame, intarg, one );
if ( integerp( intarg ) && ratiop( ratarg ) ) {
struct cons_pointer one = make_integer( 1 ),
ratio = make_ratio( frame, intarg, one );
result = add_ratio_ratio( frame, ratio, ratarg );
result = add_ratio_ratio( frame, ratio, ratarg );
dec_ref( one );
dec_ref( ratio );
} else {
result = lisp_throw(
c_string_to_lisp_string( "Shouldn't happen: bad arg to add_integer_ratio" ),
frame );
}
dec_ref( one );
dec_ref( ratio );
} else {
result =
lisp_throw( make_cons( c_string_to_lisp_string
( "Shouldn't happen: bad arg to add_integer_ratio" ),
make_cons( intarg,
make_cons( ratarg, NIL ) ) ),
frame );
}
return result;
return result;
}
/**
@ -198,10 +205,10 @@ struct cons_pointer divide_ratio_ratio( struct stack_frame *frame,
struct cons_pointer arg1,
struct cons_pointer arg2 ) {
struct cons_pointer i = make_ratio( frame,
pointer2cell( arg2 ).payload.
ratio.divisor,
pointer2cell( arg2 ).payload.
ratio.dividend ), result =
pointer2cell( arg2 ).payload.ratio.
divisor,
pointer2cell( arg2 ).payload.ratio.
dividend ), result =
multiply_ratio_ratio( frame, arg1, i );
dec_ref( i );
@ -226,33 +233,35 @@ struct cons_pointer multiply_ratio_ratio( struct
print( stderr, arg1 );
fputws( L"; arg2 = ", stderr );
print( stderr, arg2 );
fputws( L")\n", stderr);
fputws( L")\n", stderr );
#endif
if ( ratiop(arg1) && ratiop(arg2)) {
struct cons_space_object cell1 = pointer2cell( arg1 );
struct cons_space_object cell2 = pointer2cell( arg2 );
int64_t dd1v =
pointer2cell( cell1.payload.ratio.dividend ).payload.integer.value,
dd2v =
pointer2cell( cell2.payload.ratio.dividend ).payload.integer.value,
dr1v =
pointer2cell( cell1.payload.ratio.divisor ).payload.integer.value,
dr2v =
pointer2cell( cell2.payload.ratio.divisor ).payload.integer.value,
ddrv = dd1v * dd2v, drrv = dr1v * dr2v;
if ( ratiop( arg1 ) && ratiop( arg2 ) ) {
struct cons_space_object cell1 = pointer2cell( arg1 );
struct cons_space_object cell2 = pointer2cell( arg2 );
int64_t dd1v =
pointer2cell( cell1.payload.ratio.dividend ).payload.integer.value,
dd2v =
pointer2cell( cell2.payload.ratio.dividend ).payload.integer.value,
dr1v =
pointer2cell( cell1.payload.ratio.divisor ).payload.integer.value,
dr2v =
pointer2cell( cell2.payload.ratio.divisor ).payload.integer.value,
ddrv = dd1v * dd2v, drrv = dr1v * dr2v;
struct cons_pointer unsimplified = make_ratio( frame, make_integer( ddrv ),
make_integer( drrv ) );
result = simplify_ratio( frame, unsimplified );
struct cons_pointer unsimplified =
make_ratio( frame, make_integer( ddrv ),
make_integer( drrv ) );
result = simplify_ratio( frame, unsimplified );
if ( !eq( unsimplified, result ) ) {
dec_ref( unsimplified );
if ( !eq( unsimplified, result ) ) {
dec_ref( unsimplified );
}
} else {
result =
lisp_throw( c_string_to_lisp_string
( "Shouldn't happen: bad arg to multiply_ratio_ratio" ),
frame );
}
} else {
result = lisp_throw(
c_string_to_lisp_string( "Shouldn't happen: bad arg to multiply_ratio_ratio" ),
frame );
}
return result;
}
@ -265,20 +274,21 @@ struct cons_pointer multiply_ratio_ratio( struct
struct cons_pointer multiply_integer_ratio( struct stack_frame *frame,
struct cons_pointer intarg,
struct cons_pointer ratarg ) {
struct cons_pointer result;
struct cons_pointer result;
if (integerp(intarg) && ratiop(ratarg)) {
struct cons_pointer one = make_integer( 1 ),
ratio = make_ratio( frame, intarg, one );
result = multiply_ratio_ratio( frame, ratio, ratarg );
if ( integerp( intarg ) && ratiop( ratarg ) ) {
struct cons_pointer one = make_integer( 1 ),
ratio = make_ratio( frame, intarg, one );
result = multiply_ratio_ratio( frame, ratio, ratarg );
dec_ref( one );
dec_ref( ratio );
} else {
result = lisp_throw(
c_string_to_lisp_string( "Shouldn't happen: bad arg to multiply_integer_ratio" ),
frame );
}
dec_ref( one );
dec_ref( ratio );
} else {
result =
lisp_throw( c_string_to_lisp_string
( "Shouldn't happen: bad arg to multiply_integer_ratio" ),
frame );
}
return result;
}
@ -319,8 +329,8 @@ struct cons_pointer make_ratio( struct stack_frame *frame,
} else {
result =
lisp_throw( c_string_to_lisp_string
( "Dividend and divisor of a ratio must be integers" ),
frame );
( "Dividend and divisor of a ratio must be integers" ),
frame );
}
#ifdef DEBUG
dump_object( stderr, result );

16
src/arith/ratio.h
View file

@ -12,37 +12,37 @@
#define __ratio_h
struct cons_pointer simplify_ratio( struct stack_frame *frame,
struct cons_pointer arg ) ;
struct cons_pointer arg );
struct cons_pointer add_ratio_ratio( struct stack_frame *frame,
struct cons_pointer arg1,
struct cons_pointer arg2 ) ;
struct cons_pointer arg2 );
struct cons_pointer add_integer_ratio( struct stack_frame *frame,
struct cons_pointer intarg,
struct cons_pointer ratarg ) ;
struct cons_pointer ratarg );
struct cons_pointer divide_ratio_ratio( struct stack_frame *frame,
struct cons_pointer arg1,
struct cons_pointer arg2 ) ;
struct cons_pointer arg2 );
struct cons_pointer multiply_ratio_ratio( struct
stack_frame
*frame, struct
cons_pointer arg1, struct
cons_pointer arg2 ) ;
cons_pointer arg2 );
struct cons_pointer multiply_integer_ratio( struct stack_frame *frame,
struct cons_pointer intarg,
struct cons_pointer ratarg ) ;
struct cons_pointer ratarg );
struct cons_pointer subtract_ratio_ratio( struct stack_frame *frame,
struct cons_pointer arg1,
struct cons_pointer arg2 ) ;
struct cons_pointer arg2 );
struct cons_pointer make_ratio( struct stack_frame *frame,
struct cons_pointer dividend,
struct cons_pointer divisor ) ;
struct cons_pointer divisor );
#endif

2
src/arith/real.c
View file

@ -26,5 +26,5 @@ struct cons_pointer make_real( long double value ) {
dump_object( stderr, result );
#endif
return result;
return result;
}