mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-29 07:58:28 +00:00
Code Issues Releases Activity

varset support 5 test passing

Browse Source
This commit is contained in:
Andrea Corallo 2019-07-13 15:48:02 +02:00 committed by Andrea Corallo
parent 973a7b149f
commit 73cb29c3fb
3 changed files with 83 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
lisp/emacs-lisp/comp.el
View File

@ -20,6 +20,10 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; 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

79
src/comp.c
View File

@ -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))
{

26
test/src/comp-tests.el
View File

@ -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."