diff --git a/scheme/ikarus.boot.orig b/scheme/ikarus.boot.orig index beac4d9..e7300bd 100644 Binary files a/scheme/ikarus.boot.orig and b/scheme/ikarus.boot.orig differ diff --git a/scheme/ikarus.cafe.ss b/scheme/ikarus.cafe.ss index d2cef9f..154d9ac 100644 --- a/scheme/ikarus.cafe.ss +++ b/scheme/ikarus.cafe.ss @@ -25,23 +25,11 @@ description: (library (ikarus cafe) (export new-cafe) (import + (only (rnrs) with-exception-handler) + (only (ikarus exceptions) print-condition) (only (psyntax expander) eval-top-level) (except (ikarus) new-cafe)) - (define with-error-handler - (lambda (p thunk) - (let ([old-error-handler (error-handler)]) - (dynamic-wind - (lambda () - (error-handler - (lambda args - (error-handler old-error-handler) - (apply p args) - (apply error args)))) - thunk - (lambda () - (error-handler old-error-handler)))))) - (define eval-depth 0) (define display-prompt @@ -66,10 +54,11 @@ description: (lambda (eval-proc escape-k) (call/cc (lambda (k) - (with-error-handler - (lambda args + (with-exception-handler + (lambda (con) (reset-input-port! (console-input-port)) - (apply print-error args) + (flush-output-port (console-output-port)) + (print-condition con) (k (void))) (lambda () (display-prompt 0) diff --git a/scheme/ikarus.exceptions.ss b/scheme/ikarus.exceptions.ss index 905c92e..e60b6c6 100644 --- a/scheme/ikarus.exceptions.ss +++ b/scheme/ikarus.exceptions.ss @@ -1,11 +1,13 @@ (library (ikarus exceptions) - (export with-exception-handler raise raise-continuable) + (export with-exception-handler raise raise-continuable error + print-condition) (import (only (rnrs) condition make-non-continuable-violation - make-message-condition) + make-message-condition make-error make-who-condition + make-irritants-condition) (except (ikarus) - with-exception-handler raise raise-continuable)) + with-exception-handler raise raise-continuable error)) (define (print-condition x) (printf "CONDITION: ~s\n" x)) @@ -43,5 +45,22 @@ (condition (make-non-continuable-violation) (make-message-condition "handler returned"))))))) + + (define (error who msg . irritants) + (unless (string? msg) + (error 'error "message ~s is not a string" msg)) + (raise + (if who + (condition + (make-error) + (make-who-condition who) + (make-message-condition msg) + (make-irritants-condition irritants)) + (condition + (make-error) + (make-message-condition msg) + (make-irritants-condition irritants))))) + + ) diff --git a/scheme/ikarus.intel-assembler.ss b/scheme/ikarus.intel-assembler.ss index e1b31ea..5da9d7c 100644 --- a/scheme/ikarus.intel-assembler.ss +++ b/scheme/ikarus.intel-assembler.ss @@ -296,6 +296,8 @@ (let ([d i1] [v (cadr i2)]) (cons (reloc-word+ v d) ac))] [(and (int? i2) (obj? i1)) (IMM32*2 i2 i1 ac)] + [(and (int? i1) (int? i2)) + (IMM32 i1 (IMM32 i2 ac))] [else (error 'assemble "IMM32*2 ~s ~s" i1 i2)]))) (define CODErd diff --git a/scheme/ikarus.writer.ss b/scheme/ikarus.writer.ss index 2dd4ca6..f8ac89d 100644 --- a/scheme/ikarus.writer.ss +++ b/scheme/ikarus.writer.ss @@ -1,7 +1,6 @@ (library (ikarus writer) - (export write display format printf print-error error-handler - error print-unicode print-graph) + (export write display format printf print-error print-unicode print-graph) (import (rnrs hashtables) (ikarus system $chars) @@ -13,8 +12,7 @@ (ikarus system $bytevectors) (ikarus system $transcoders) (only (ikarus unicode-data) unicode-printable-char?) - (except (ikarus) write display format printf print-error - error-handler error print-unicode print-graph)) + (except (ikarus) write display format printf print-error print-unicode print-graph)) (define print-unicode (make-parameter #t)) @@ -740,18 +738,5 @@ (lambda (who fmt . args) (display-error "Warning" who fmt args))) - (define error-handler - (make-parameter - (lambda args - (apply print-error args) - (flush-output-port (console-output-port)) - (exit -1)) - (lambda (x) - (if (procedure? x) - x - (error 'error-handler "~s is not a procedure" x))))) - - (define error - (lambda args - (apply (error-handler) args)))) + ) diff --git a/scheme/makefile.ss b/scheme/makefile.ss index 9cafa8e..54e925e 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -336,7 +336,6 @@ [make-parameter i parameters] [call/cf i] [print-error i] - [error-handler i] [interrupt-handler i] [assembler-output i] [new-cafe i]