Moving core exception handler code from C to Scheme

This commit is contained in:
Justin Ethier 2015-03-21 22:01:14 -04:00
parent a46b5f18f8
commit 582524af81
3 changed files with 90 additions and 77 deletions

View file

@ -434,10 +434,7 @@
((eq? p 'apply) "apply") ((eq? p 'apply) "apply")
((eq? p '%halt) "__halt") ((eq? p '%halt) "__halt")
((eq? p 'exit) "__halt") ((eq? p 'exit) "__halt")
((eq? p 'Cyc-current-exception-handler) "Cyc_current_exception_handler") ((eq? p 'Cyc-default-exception-handler) "Cyc_default_exception_handler")
((eq? p 'Cyc-add-exception-handler) "Cyc_add_exception_handler")
((eq? p 'Cyc-remove-exception-handler) "Cyc_remove_exception_handler")
((eq? p 'error) "Cyc_error")
((eq? p 'current-input-port) "Cyc_io_current_input_port") ((eq? p 'current-input-port) "Cyc_io_current_input_port")
((eq? p 'open-input-file) "Cyc_io_open_input_file") ((eq? p 'open-input-file) "Cyc_io_open_input_file")
((eq? p 'close-input-port) "Cyc_io_close_input_port") ((eq? p 'close-input-port) "Cyc_io_close_input_port")

145
runtime.h
View file

@ -330,9 +330,9 @@ static void Cyc_apply(int argc, closure cont, object prim, ...);
static void dispatch_string_91append(int argc, object clo, object cont, object str1, ...); static void dispatch_string_91append(int argc, object clo, object cont, object str1, ...);
static string_type Cyc_string_append(int argc, object str1, ...); static string_type Cyc_string_append(int argc, object str1, ...);
static string_type Cyc_string_append_va_list(int, object, va_list); static string_type Cyc_string_append_va_list(int, object, va_list);
static void dispatch_error(int argc, object clo, object cont, object obj1, ...); //static void dispatch_error(int argc, object clo, object cont, object obj1, ...);
static object Cyc_error(int count, object obj1, ...); //static object Cyc_error(int count, object obj1, ...);
static object Cyc_error_va(int count, object obj1, va_list ap); //static object Cyc_error_va(int count, object obj1, va_list ap);
static list mcons(object,object); static list mcons(object,object);
static object terpri(void); static object terpri(void);
static object Cyc_display(object); static object Cyc_display(object);
@ -468,11 +468,12 @@ notes:
*/ */
list exception_handler_stack = nil; list exception_handler_stack = nil;
static void default_exception_handler(int argc, closure _, /*object k,*/ object err) { static object Cyc_default_exception_handler(int argc, closure _, /*object k,*/ object err) {
printf("Error: "); printf("Error: ");
Cyc_display(err); Cyc_display(err);
printf("\n"); printf("\n");
exit(1); exit(1);
return nil;
} }
// TODO: does this cause GC problems? for example, what if handler is on the stack?? // TODO: does this cause GC problems? for example, what if handler is on the stack??
@ -480,30 +481,30 @@ static void default_exception_handler(int argc, closure _, /*object k,*/ object
// //
// TODO: not sure this is the best approach, may be able to do this in // TODO: not sure this is the best approach, may be able to do this in
// Scheme code, but for now do add/remove this way: // Scheme code, but for now do add/remove this way:
static object Cyc_add_exception_handler(object handler) { // static object Cyc_add_exception_handler(object handler) {
printf("DEBUG: add ex handler\n"); // printf("DEBUG: add ex handler\n");
// TODO: error checking on handler? // // TODO: error checking on handler?
exception_handler_stack = mcons(handler, exception_handler_stack); // exception_handler_stack = mcons(handler, exception_handler_stack);
return handler; // return handler;
} // }
static object Cyc_remove_exception_handler(){ // static object Cyc_remove_exception_handler(){
object old_cons = exception_handler_stack; // object old_cons = exception_handler_stack;
printf("DEBUG: remove ex handler\n"); // printf("DEBUG: remove ex handler\n");
//
if (nullp(exception_handler_stack)) { // if (nullp(exception_handler_stack)) {
printf("Internal error, no exception handler to remove\n"); // printf("Internal error, no exception handler to remove\n");
exit(1); // exit(1);
} // }
exception_handler_stack = cdr(exception_handler_stack); // exception_handler_stack = cdr(exception_handler_stack);
free(old_cons); // free(old_cons);
return exception_handler_stack; // return exception_handler_stack;
} // }
// END TODO // // END TODO
//
static object Cyc_current_exception_handler() { // static object Cyc_current_exception_handler() {
return car(exception_handler_stack); // return car(exception_handler_stack);
} // }
//
/* END exception handler */ /* END exception handler */
/* Global variables. */ /* Global variables. */
@ -1008,41 +1009,41 @@ static void my_exit(env) closure env; {
#endif #endif
exit(0);} exit(0);}
static void dispatch_error(int argc, object clo, object cont, object obj1, ...) { //static void dispatch_error(int argc, object clo, object cont, object obj1, ...) {
va_list ap; // va_list ap;
va_start(ap, obj1); // va_start(ap, obj1);
Cyc_error_va(argc, obj1, ap); // Cyc_error_va(argc, obj1, ap);
va_end(ap); // Never get this far // va_end(ap); // Never get this far
} //}
//
static object Cyc_error(int count, object obj1, ...) { //static object Cyc_error(int count, object obj1, ...) {
va_list ap; // va_list ap;
va_start(ap, obj1); // va_start(ap, obj1);
Cyc_error_va(count, obj1, ap); // Cyc_error_va(count, obj1, ap);
va_end(ap); // va_end(ap);
} //}
//
static object Cyc_error_va(int count, object obj1, va_list ap) { //static object Cyc_error_va(int count, object obj1, va_list ap) {
closure ex = (closure)car(Cyc_current_exception_handler()); // closure ex = (closure)car(Cyc_current_exception_handler());
object tmp; // object tmp;
int i; // int i;
//
printf("Error: "); // printf("Error: ");
Cyc_display(obj1); // Cyc_display(obj1);
printf("\n"); // printf("\n");
//
for (i = 1; i < count; i++) { // for (i = 1; i < count; i++) {
tmp = va_arg(ap, object); // tmp = va_arg(ap, object);
Cyc_display(tmp); // Cyc_display(tmp);
printf("\n"); // printf("\n");
} // }
//
//exit(1); // //exit(1);
//// TODO: Cyc_raise(obj1); // //// TODO: Cyc_raise(obj1);
// TODO: make closure // // TODO: make closure
(ex->fn)(1, ex, obj1); // (ex->fn)(1, ex, obj1);
return boolean_f; // return boolean_f;
} //}
static object __halt(object obj) { static object __halt(object obj) {
#if DEBUG_SHOW_DIAG #if DEBUG_SHOW_DIAG
@ -1270,9 +1271,13 @@ static void _integer_91_125char(object cont, object args) {
static void _string_91_125number(object cont, object args) { static void _string_91_125number(object cont, object args) {
integer_type i = Cyc_string2number(car(args)); integer_type i = Cyc_string2number(car(args));
return_funcall1(cont, &i);} return_funcall1(cont, &i);}
static void _error(object cont, object args) { //static void _error(object cont, object args) {
integer_type argc = Cyc_length(args); // integer_type argc = Cyc_length(args);
dispatch_va(argc.value, dispatch_error, cont, cont, args); } // dispatch_va(argc.value, dispatch_error, cont, cont, args); }
static void _Cyc_91default_91exception_91handler(object cont, object args) {
// TODO: this is a quick-and-dirty implementation, may be a better way to write this
Cyc_default_exception_handler(1, args, car(args));
}
static void _string_91append(object cont, object args) { static void _string_91append(object cont, object args) {
integer_type argc = Cyc_length(args); integer_type argc = Cyc_length(args);
dispatch_va(argc.value, dispatch_string_91append, cont, cont, args); } dispatch_va(argc.value, dispatch_string_91append, cont, cont, args); }
@ -1325,7 +1330,11 @@ defprimitive(_121_123, <=, &__121_123); /* <= */
defprimitive(apply, apply, &_apply); /* apply */ defprimitive(apply, apply, &_apply); /* apply */
defprimitive(_75halt, %halt, &__75halt); /* %halt */ defprimitive(_75halt, %halt, &__75halt); /* %halt */
defprimitive(exit, exit, &_cyc_exit); /* exit */ defprimitive(exit, exit, &_cyc_exit); /* exit */
defprimitive(error, error, &_error); /* error */ //defprimitive(error, error, &_error); /* error */
defprimitive(
Cyc_91default_91exception_91handler,
Cyc_default_exception_handler,
&_Cyc_91default_91exception_91handler); /* Cyc-default-exception-handler */
defprimitive(cons, cons, &_cons); /* cons */ defprimitive(cons, cons, &_cons); /* cons */
defprimitive(cell_91get, cell-get, &_cell_91get); /* cell-get */ defprimitive(cell_91get, cell-get, &_cell_91get); /* cell-get */
defprimitive(set_91global_67, set-global!, &_set_91global_67); /* set-global! */ defprimitive(set_91global_67, set-global!, &_set_91global_67); /* set-global! */
@ -1982,10 +1991,8 @@ static void main_main (stack_size,heap_size,stack_base)
/* Create closure for the test function. */ /* Create closure for the test function. */
mclosure0(run_test,&c_entry_pt); mclosure0(run_test,&c_entry_pt);
mclosure0(default_ex, &default_exception_handler);
gc_cont = &run_test; gc_cont = &run_test;
/* Initialize constant expressions for the test runs. */ /* Initialize constant expressions for the test runs. */
Cyc_add_exception_handler(&default_ex);
/* Allocate heap area for second generation. */ /* Allocate heap area for second generation. */
/* Use calloc instead of malloc to assure pages are in main memory. */ /* Use calloc instead of malloc to assure pages are in main memory. */

View file

@ -69,6 +69,8 @@
(foldr (lambda (x y) (cons (func x) y)) '() lst)) (foldr (lambda (x y) (cons (func x) y)) '() lst))
(define (not x) (if x #f #t)) (define (not x) (if x #f #t))
(define (reverse lst) (foldl cons '() lst)) (define (reverse lst) (foldl cons '() lst))
(define (error msg . args)
(raise (cons msg args)))
(define (raise obj) (define (raise obj)
((Cyc-current-exception-handler) (list 'raised obj))) ((Cyc-current-exception-handler) (list 'raised obj)))
(define (raise-continuable obj) (define (raise-continuable obj)
@ -98,6 +100,16 @@
;; Only reached if no ex raised ;; Only reached if no ex raised
(Cyc-remove-exception-handler) (Cyc-remove-exception-handler)
result)) result))
(define *exception-handler-stack* '())
(define (Cyc-add-exception-handler h)
(set! *exception-handler-stack* (cons h *exception-handler-stack*)))
(define (Cyc-remove-exception-handler)
(if (not (null? *exception-handler-stack*))
(set! *exception-handler-stack* (cdr *exception-handler-stack*))))
(define (Cyc-current-exception-handler)
(if (null? *exception-handler-stack*)
Cyc-default-exception-handler
(car *exception-handler-stack*)))
)) ))
;; Built-in macros ;; Built-in macros
@ -545,11 +557,8 @@
<= <=
apply apply
%halt %halt
error
exit exit
Cyc-current-exception-handler Cyc-default-exception-handler
Cyc-add-exception-handler
Cyc-remove-exception-handler
cons cons
cell-get cell-get
set-global! set-global!