From b5b0e63bbc23a6584e5aaa49861a37b832a0def3 Mon Sep 17 00:00:00 2001
From: Andrea Corallo <andrea_corallo@yahoo.it>
Date: Sun, 30 Jun 2019 10:11:39 +0200
Subject: [PATCH] fix setcar

---
 src/comp.c             | 36 +++++++++++++++++++++++++++---------
 test/src/comp-tests.el |  7 ++++++-
 2 files changed, 33 insertions(+), 10 deletions(-)

diff --git a/src/comp.c b/src/comp.c
index 4973a517d6f..538169c0b2a 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -657,7 +657,7 @@ emit_VECTORLIKEP (gcc_jit_rvalue *obj)
 static gcc_jit_rvalue *
 emit_CONSP (gcc_jit_rvalue *obj)
 {
- emit_comment ("CONSP");
+  emit_comment ("CONSP");
 
   return emit_TAGGEDP (obj, Lisp_Cons);
 }
@@ -928,11 +928,14 @@ emit_CHECK_CONS (gcc_jit_rvalue *x)
       emit_lisp_obj_from_ptr (Qconsp),
       x };
 
-  gcc_jit_context_new_call (comp.ctxt,
-			    NULL,
-			    comp.check_type,
-			    3,
-			    args);
+  gcc_jit_block_add_eval (
+    comp.block->gcc_bb,
+    NULL,
+    gcc_jit_context_new_call (comp.ctxt,
+			      NULL,
+			      comp.check_type,
+			      3,
+			      args));
 }
 
 static gcc_jit_rvalue *
@@ -1497,11 +1500,28 @@ define_setcar (void)
   comp.block = init_block;
   comp.func = comp.setcar;
 
+  /* CHECK_CONS (cell); */
   emit_CHECK_CONS (gcc_jit_param_as_rvalue (cell));
 
+  /* CHECK_IMPURE (cell, XCONS (cell)); */
+  gcc_jit_rvalue *args[] =
+    { gcc_jit_param_as_rvalue (cell),
+      emit_XCONS (gcc_jit_param_as_rvalue (cell)) };
+
+  gcc_jit_block_add_eval (
+    init_block->gcc_bb,
+    NULL,
+    gcc_jit_context_new_call (comp.ctxt,
+			      NULL,
+			      comp.check_impure,
+			      2,
+			      args));
+
+  /* XSETCAR (cell, newcar); */
   emit_XSETCAR (gcc_jit_param_as_rvalue (cell),
 	        gcc_jit_param_as_rvalue (new_car));
 
+  /* return newcar; */
   gcc_jit_block_end_with_return (init_block->gcc_bb,
 				 NULL,
 				 gcc_jit_param_as_rvalue (new_car));
@@ -1600,9 +1620,7 @@ define_CHECK_IMPURE (void)
     comp.block = init_block;
     comp.func = comp.check_impure;
 
-    emit_cond_jump (
-      emit_cast (comp.bool_type,
-		 emit_PURE_P (gcc_jit_param_as_rvalue (param[0]))), /* FIXME */
+    emit_cond_jump (emit_PURE_P (gcc_jit_param_as_rvalue (param[0])), /* FIXME */
       err_block,
       ok_block);
     gcc_jit_block_end_with_void_return (ok_block->gcc_bb, NULL);
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 8fd3ca2e197..47c61c82bdd 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -284,7 +284,12 @@
   (native-compile #'comp-tests-setcdr-f)
 
   (should (equal (comp-tests-setcar-f '(10 . 10) 3) '(3 . 10)))
-  (should (equal (comp-tests-setcdr-f '(10 . 10) 3) '(10 . 3))))
+  (should (equal (comp-tests-setcdr-f '(10 . 10) 3) '(10 . 3)))
+  (should (equal (condition-case
+                     err
+                     (comp-tests-setcar-f 3 10)
+                   (error err))
+                 '(wrong-type-argument consp 3))))
 
 (defun comp-bubble-sort ()
   "Run bubble sort."
-- 
2.39.5