From 73cb29c3fb6d56f32f77ec201f9b61ac77e57290 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 13 Jul 2019 15:48:02 +0200 Subject: [PATCH] varset support 5 test passing --- lisp/emacs-lisp/comp.el | 14 ++++++-- src/comp.c | 79 ++++++++++++++++++++++++++++++----------- test/src/comp-tests.el | 26 +++++++------- 3 files changed, 83 insertions(+), 36 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 68bc770ff95..05f17e43d64 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -20,6 +20,10 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . +;;; Commentary: +;; This code is an attempt to make a Carrera out of a turbocharged VW Bug. +;; Or, to put it another way to make the pig fly. + ;;; Code: (require 'bytecomp) @@ -260,8 +264,12 @@ VAL is known at compile time." (comp-push-call `(call Fsymbol_value ,(make-comp-mvar :const-vld t :constant (cadr inst))))) - ;; ('byte-varset - ;; (comp-emit-call `(call Fsymbol_value ,(cadr inst)))) + ('byte-varset + (comp-emit-call `(call set_internal + ,(make-comp-mvar + :const-vld t + :constant (cadr inst)) + ,(comp-slot)))) ('byte-constant (comp-push-const (cadr inst))) ('byte-stack-ref @@ -280,6 +288,8 @@ VAL is known at compile time." (comp-emit-call `(call Fcar_safe ,(comp-slot)))) ('byte-cdr-safe (comp-emit-call `(call Fcdr_safe ,(comp-slot)))) + ('byte-length + (comp-emit-call `(call Flength ,(comp-slot)))) ('byte-list1 (comp-limplify-listn 1)) ('byte-list2 diff --git a/src/comp.c b/src/comp.c index cbbc5f03782..25598aa20c1 100644 --- a/src/comp.c +++ b/src/comp.c @@ -966,6 +966,58 @@ emit_mvar_val (Lisp_Object mvar) return emit_lisp_obj_from_ptr (FUNCALL1 (comp-mvar-constant, mvar)); } +static gcc_jit_rvalue * +emit_limple_call (Lisp_Object arg1) +{ + char *calle = (char *) SDATA (SYMBOL_NAME (SECOND (arg1))); + Lisp_Object call_args = XCDR (XCDR (arg1)); + int i = 0; + + if (calle[0] == 'F') + { + /* + Ex: (= #s(comp-mvar 6 1 nil nil nil) + (call Fcar #s(comp-mvar 4 0 nil nil nil))) + + Ex: (= #s(comp-mvar 5 0 nil nil cons) + (call Fcons #s(comp-mvar 3 0 t 1 nil) + #s(comp-mvar 4 nil t nil nil))) + */ + + ptrdiff_t nargs = list_length (call_args); + gcc_jit_rvalue *gcc_args[nargs]; + FOR_EACH_TAIL (call_args) + gcc_args[i++] = emit_mvar_val (XCAR (call_args)); + + return emit_call (calle, comp.lisp_obj_type, nargs, gcc_args); + } + else if (!strcmp (calle, "set_internal")) + { + /* + Ex: (set #s(comp-mvar 8 1 nil nil nil) + (call set_internal + #s(comp-mvar 7 nil t xxx nil) + #s(comp-mvar 6 1 t 3 nil))) + */ + /* TODO: Inline the most common case. */ + eassert (list_length (call_args) == 2); + gcc_jit_rvalue *gcc_args[4]; + FOR_EACH_TAIL (call_args) + gcc_args[i++] = emit_mvar_val (XCAR (call_args)); + gcc_args[2] = emit_lisp_obj_from_ptr (Qnil); + gcc_args[3] = gcc_jit_context_new_rvalue_from_int (comp.ctxt, + comp.int_type, + SET_INTERNAL_SET); + gcc_jit_block_add_eval ( + comp.block, + NULL, + emit_call ("set_internal", comp.void_type , 4, gcc_args)); + + return NULL; + } + error ("LIMPLE inconsiste call"); +} + static void emit_limple_inst (Lisp_Object inst) { @@ -1000,23 +1052,7 @@ emit_limple_inst (Lisp_Object inst) } else if (EQ (FIRST (arg1), Qcall)) { - /* - Ex: (= #s(comp-mvar 6 1 nil nil nil) - (call Fcar #s(comp-mvar 4 0 nil nil nil))) - - Ex: (= #s(comp-mvar 5 0 nil nil cons) - (call Fcons #s(comp-mvar 3 0 t 1 nil) - #s(comp-mvar 4 nil t nil nil))) - */ - - char *calle = (char *) SDATA (SYMBOL_NAME (SECOND (arg1))); - Lisp_Object call_args = XCDR (XCDR (arg1)); - ptrdiff_t nargs = list_length (call_args); - gcc_jit_rvalue *gcc_args[nargs]; - int i = 0; - FOR_EACH_TAIL (call_args) - gcc_args[i++] = emit_mvar_val (XCAR (call_args)); - res = emit_call (calle, comp.lisp_obj_type, nargs, gcc_args); + res = emit_limple_call (arg1); } else if (EQ (FIRST (arg1), Qcallref)) { @@ -1038,10 +1074,11 @@ emit_limple_inst (Lisp_Object inst) { error ("LIMPLE inconsistent arg1 for op ="); } - gcc_jit_block_add_assignment (comp.block, - NULL, - comp.frame[slot_n], - res); + if (res) + gcc_jit_block_add_assignment (comp.block, + NULL, + comp.frame[slot_n], + res); } else if (EQ (op, Qsetpar)) { diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 0aea66f974b..64edddf4c04 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -95,23 +95,23 @@ (should (= (comp-tests-cons-car-f) 1)) (should (= (comp-tests-cons-cdr-f 3) 3))) -;; (ert-deftest comp-tests-varset () -;; "Testing varset." -;; (defun comp-tests-varset-f () -;; (setq comp-tests-var1 55)) -;; (native-compile #'comp-tests-varset-f) +(ert-deftest comp-tests-varset () + "Testing varset." + (defun comp-tests-varset-f () + (setq comp-tests-var1 55)) + (native-compile #'comp-tests-varset-f) -;; (comp-tests-varset-f) + (comp-tests-varset-f) -;; (should (= comp-tests-var1 55))) + (should (= comp-tests-var1 55))) -;; (ert-deftest comp-tests-length () -;; "Testing length." -;; (defun comp-tests-length-f () -;; (length '(1 2 3))) -;; (native-compile #'comp-tests-length-f) +(ert-deftest comp-tests-length () + "Testing length." + (defun comp-tests-length-f () + (length '(1 2 3))) + (native-compile #'comp-tests-length-f) -;; (should (= (comp-tests-length-f) 3))) + (should (= (comp-tests-length-f) 3))) ;; (ert-deftest comp-tests-aref-aset () ;; "Testing aref and aset." -- 2.39.5