Exceptions!!!

src/print.c

@@ -15,9 +15,9 @@ DEFVAR(print_base_upper, "print-base-upper", "", Qt);
 DEFVAR(print_precision, "print-precision", "", MAKE_FIXNUM(6));
 DEFVAR(print_quoted, "print-quoted", "", Qt);
 
-DEFUN(write_byte, "write-byte", (LispVal * ch), "(ch)", "") {
+static void lisp_fputc(LispVal *ch, FILE *file) {
     if (NILP(ch)) {
-        fflush(stdout);
+        fflush(file);
     }
     CHECK_TYPE(ch, TYPE_FIXNUM);
     fixnum_t f = XFIXNUM(ch);
@@ -25,7 +25,16 @@ DEFUN(write_byte, "write-byte", (LispVal * ch), "(ch)", "") {
         // TODO error
         abort();
     }
-    fputc(f, stdout);
+    fputc(f, file);
+}
+
+DEFUN(write_byte, "write-byte", (LispVal * ch), "(ch)", "") {
+    lisp_fputc(ch, stdout);
+    return Qnil;
+}
+
+DEFUN(error_write_byte, "error-write-byte", (LispVal * ch), "(ch)", "") {
+    lisp_fputc(ch, stderr);
     return Qnil;
 }
 
@@ -392,6 +401,24 @@ DEFUN(prin1, "prin1", (LispVal * val, LispVal *print_char_fun),
     return Qnil;
 }
 
+DEFUN(print_condition, "print-condition",
+      (LispVal * name, LispVal *data, LispVal *print_char_fun),
+      "(name data &optional print-char-fun)", "") {
+    if (NILP(Fcondition_class_p(name))) {
+        // TODO type error
+        abort();
+    }
+    LispVal *printer = Fcondition_printer(name);
+    if (NILP(printer)) {
+        // default format
+        Fprinc(CONS(name, data), print_char_fun);
+    } else {
+        // custom format
+        CALL(printer, data, print_char_fun);
+    }
+    return Qnil;
+}
+
 void debug_print(FILE *file, LispVal *obj) {
     switch (TYPE_OF(obj)) {
     case TYPE_FIXNUM: