Compare commits
2 commits
109d400f00
...
69b199fecd
| Author | SHA1 | Date | |
|---|---|---|---|
| 69b199fecd | |||
| 54a99b6796 |
5 changed files with 28 additions and 22 deletions
|
|
@ -454,7 +454,7 @@ int main( int argc, char *argv[] ) {
|
|||
&lisp_print );
|
||||
bind_function( L"println",
|
||||
L"`(println stream)`: Print a new line character to `stream`, if specified, else to `*out*`.",
|
||||
&lisp_print );
|
||||
&lisp_println );
|
||||
bind_function( L"put!", L"", lisp_hashmap_put );
|
||||
bind_function( L"put-all!",
|
||||
L"`(put-all! dest source)`: If `dest` is a namespace and is writable, copies all key-value pairs from `source` into `dest`.",
|
||||
|
|
|
|||
|
|
@ -350,8 +350,6 @@ lisp_println( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
|||
output = pointer2cell( out_stream ).payload.stream.stream;
|
||||
|
||||
println( output );
|
||||
|
||||
free( output );
|
||||
}
|
||||
|
||||
return NIL;
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@ uint32_t stack_limit = 0;
|
|||
* because that way we can be sure the inc_ref happens!
|
||||
*/
|
||||
void set_reg( struct stack_frame *frame, int reg, struct cons_pointer value ) {
|
||||
debug_printf( DEBUG_STACK, L"Setting register %d to ", reg );
|
||||
debug_printf( DEBUG_STACK, L"\tSetting register %d to ", reg );
|
||||
debug_print_object( value, DEBUG_STACK );
|
||||
debug_println( DEBUG_STACK );
|
||||
dec_ref( frame->arg[reg] ); /* if there was anything in that slot
|
||||
|
|
@ -63,10 +63,10 @@ struct stack_frame *get_stack_frame( struct cons_pointer pointer ) {
|
|||
|
||||
if ( vectorpointp( pointer ) && stackframep( vso ) ) {
|
||||
result = ( struct stack_frame * ) &( vso->payload );
|
||||
debug_printf( DEBUG_STACK,
|
||||
L"get_stack_frame: all good, returning %p\n", result );
|
||||
// debug_printf( DEBUG_STACK,
|
||||
// L"\nget_stack_frame: all good, returning %p\n", result );
|
||||
} else {
|
||||
debug_print( L"get_stack_frame: fail, returning NULL\n", DEBUG_STACK );
|
||||
debug_print( L"\nget_stack_frame: fail, returning NULL\n", DEBUG_STACK );
|
||||
}
|
||||
|
||||
return result;
|
||||
|
|
@ -97,8 +97,8 @@ struct cons_pointer in_make_empty_frame( struct cons_pointer previous,
|
|||
frame->depth = depth;
|
||||
|
||||
/*
|
||||
* clearing the frame with memset would probably be slightly quicker, but
|
||||
* this is clear.
|
||||
* The frame has already been cleared with memset in make_vso, but our
|
||||
* NIL is not the same as C's NULL.
|
||||
*/
|
||||
frame->more = NIL;
|
||||
frame->function = NIL;
|
||||
|
|
@ -133,6 +133,8 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
|
|||
if ( stack_limit == 0 || stack_limit > depth ) {
|
||||
result = in_make_empty_frame( previous, depth );
|
||||
} else {
|
||||
debug_printf( DEBUG_STACK,
|
||||
L"WARNING: Exceeded stack limit of %d\n", stack_limit);
|
||||
result =
|
||||
make_exception( c_string_to_lisp_string
|
||||
( L"Stack limit exceeded." ), previous );
|
||||
|
|
@ -182,9 +184,10 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous,
|
|||
result = val;
|
||||
break;
|
||||
} else {
|
||||
debug_printf( DEBUG_STACK, L"Setting argument %d to ",
|
||||
debug_printf( DEBUG_STACK, L"\tSetting argument %d to ",
|
||||
frame->args );
|
||||
debug_print_object( cell.payload.cons.car, DEBUG_STACK );
|
||||
debug_print(L"\n", DEBUG_STACK);
|
||||
set_reg( frame, frame->args, val );
|
||||
}
|
||||
|
||||
|
|
@ -325,7 +328,7 @@ void dump_frame( URL_FILE *output, struct cons_pointer frame_pointer ) {
|
|||
for ( int arg = 0; arg < frame->args; arg++ ) {
|
||||
struct cons_space_object cell = pointer2cell( frame->arg[arg] );
|
||||
|
||||
url_fwprintf( output, L"Arg %d:\t%4.4s\tcount: %10u\tvalue: ",
|
||||
url_fwprintf( output, L"\tArg %d:\t%4.4s\tcount: %10u\tvalue: ",
|
||||
arg, cell.tag.bytes, cell.count );
|
||||
|
||||
print( output, frame->arg[arg] );
|
||||
|
|
|
|||
|
|
@ -1261,11 +1261,15 @@ struct cons_pointer eval_cond_clause( struct cons_pointer clause,
|
|||
env ) );
|
||||
|
||||
#ifdef DEBUG
|
||||
debug_print( L"\n\t\tclause succeeded; returning: ", DEBUG_EVAL );
|
||||
debug_print( L"\n\t\tCond clause ", DEBUG_EVAL);
|
||||
debug_print_object( clause, DEBUG_EVAL);
|
||||
debug_print( L" succeeded; returning: ", DEBUG_EVAL );
|
||||
debug_print_object( result, DEBUG_EVAL );
|
||||
debug_println( DEBUG_EVAL );
|
||||
} else {
|
||||
debug_print( L"\n\t\tclause failed.\n", DEBUG_EVAL );
|
||||
debug_print( L"\n\t\tCond clause ", DEBUG_EVAL);
|
||||
debug_print_object( clause, DEBUG_EVAL);
|
||||
debug_print( L" failed.\n", DEBUG_EVAL );
|
||||
#endif
|
||||
}
|
||||
} else {
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
result=0
|
||||
|
||||
expected='t'
|
||||
output=`target/psse <<EOF
|
||||
output=`target/psse $1 <<EOF
|
||||
(progn
|
||||
(set! nil? (lambda (o) (= (type o) "NIL ")))
|
||||
(set! member?
|
||||
|
|
@ -17,7 +17,7 @@ output=`target/psse <<EOF
|
|||
EOF`
|
||||
actual=`echo $output | tail -1`
|
||||
|
||||
echo -n "$?: (member? 1 '(1 2 3 4))... "
|
||||
echo -n "$0 $1: (member? 1 '(1 2 3 4))... "
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
|
|
@ -28,7 +28,7 @@ else
|
|||
fi
|
||||
|
||||
expected='t'
|
||||
output=`target/psse <<EOF
|
||||
output=`target/psse $1 <<EOF
|
||||
(progn
|
||||
(set! nil? (lambda (o) (= (type o) "NIL ")))
|
||||
(set! member?
|
||||
|
|
@ -42,7 +42,7 @@ output=`target/psse <<EOF
|
|||
EOF`
|
||||
actual=`echo $output | tail -1`
|
||||
|
||||
echo -n "$?: (member? 4 '(1 2 3 4))... "
|
||||
echo -n "$0: (member? 4 '(1 2 3 4))... "
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
|
|
@ -54,12 +54,13 @@ fi
|
|||
|
||||
|
||||
expected='nil'
|
||||
output=`target/psse <<EOF
|
||||
output=`target/psse $1 <<EOF
|
||||
(progn
|
||||
(set! nil? (lambda (o) (= (type o) "NIL ")))
|
||||
(set! member?
|
||||
(lambda
|
||||
(item collection)
|
||||
(progn (print (list "In member; collection is:" collection)) (println))
|
||||
(cond
|
||||
((nil? collection) nil)
|
||||
((= item (car collection)) t)
|
||||
|
|
@ -68,7 +69,7 @@ output=`target/psse <<EOF
|
|||
EOF`
|
||||
actual=`echo $output | tail -1`
|
||||
|
||||
echo -n "$?: (member? 5 '(1 2 3 4))... "
|
||||
echo -n "$0: (member? 5 '(1 2 3 4))... "
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
|
|
@ -79,13 +80,13 @@ else
|
|||
fi
|
||||
|
||||
expected='nil'
|
||||
output=`target/psse -s100<<EOF
|
||||
output=`target/psse $1 -s100<<EOF
|
||||
(progn
|
||||
(set! nil? (lambda (o) (= (type o) "NIL ")))
|
||||
(set! member?
|
||||
(lambda
|
||||
(item collection)
|
||||
(print (list "in member?: " 'item item 'collection collection))
|
||||
;; (print (list "in member?: " 'item item 'collection collection))
|
||||
(cond
|
||||
((nil? collection) nil)
|
||||
((= item (car collection)) t)
|
||||
|
|
@ -94,7 +95,7 @@ output=`target/psse -s100<<EOF
|
|||
EOF`
|
||||
actual=`echo $output | tail -1`
|
||||
|
||||
echo -n "$?: (member? 5 '(1 2 3 4)) with stack limit... "
|
||||
echo -n "$0: (member? 5 '(1 2 3 4)) with stack limit... "
|
||||
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue