From: Andrea Corallo Date: Sun, 7 Jul 2019 10:30:03 +0000 (+0200) Subject: working on comp.el X-Git-Tag: emacs-28.0.90~2727^2~1394 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=8d0ae21c4847e5b78d3dd19325821414095c2756;p=emacs.git working on comp.el --- diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 6a49c60099d..fedbd61ffd1 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -597,4 +597,6 @@ Otherwise, return nil. For internal use only." (make-obsolete 'macro-declaration-function 'macro-declarations-alist "24.3") +(provide 'byte-run) + ;;; byte-run.el ends here diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 2617142c622..fa3f5a7f9b9 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -124,6 +124,7 @@ (require 'backquote) (require 'macroexp) (require 'cconv) +(require 'byte-run) (eval-when-compile (require 'compile)) ;; Refrain from using cl-lib at run-time here, since it otherwise prevents ;; us from emitting warnings when compiling files which use cl-lib without diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index d72127a6eb1..9b3bb98e39a 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -22,27 +22,156 @@ ;;; Code: -(require 'disass) +(require 'bytecomp) (eval-when-compile (require 'cl-lib)) (defgroup comp nil "Emacs Lisp native compiler." :group 'lisp) -(defun comp-recuparate-lap (fun) - "Compile FUN if necessary and recuparate its LAP rapresentation." - (byte-compile-close-variables - (byte-compile-top-level (byte-compile-preprocess fun)) - byte-compile-lap-output)) +(defconst comp-debug t) -(defun comp-compute-blocks (obj) - "Split OBJ in basic blocks." - obj) +(defconst comp-passes '(comp-recuparate-lap + comp-limplify) + "Passes to be executed in order.") + +(cl-defstruct comp-args + mandatory nonrest rest) + +(cl-defstruct (comp-func (:copier nil)) + "Internal rapresentation for a function." + (symbol-name nil + :documentation "Function symbol's name") + (func nil + :documentation "Original form") + (byte-func nil + :documentation "Byte compiled version") + (ir nil + :documentation "Current intermediate rappresentation") + (args nil :type 'comp-args)) + +(cl-defstruct (comp-meta-var (:copier nil)) + "A frame slot into the meta-stack." + (slot nil :type fixnum + :documentation "Slot position into the meta-stack") + (const-vld nil + :documentation "Valid for the following slot") + (constant nil + :documentation "When const-vld non nil this is used for constant + propagation") + (type nil + :documentation "When non nil is used for type propagation")) + +(cl-defstruct (comp-limple-frame (:copier nil)) + "A LIMPLE func." + (sp 0 :type 'fixnum + :documentation "Current stack pointer") + (frame nil :type 'vector + :documentation "Meta-stack used to flat LAP")) + +(defun comp-decrypt-lambda-list (x) + "Decript lambda list X." + (make-comp-args :rest (not (= (logand x 128) 0)) + :mandatory (logand x 127) + :nonrest (ash x -8))) + +(defun comp-recuparate-lap (ir) + "Byte compile and recuparate LAP rapresentation for IR." + ;; FIXME block timers here, otherwise we could spill the wrong LAP. + (setf (comp-func-byte-func ir) + (byte-compile (comp-func-symbol-name ir))) + (when comp-debug + (cl-prettyprint byte-compile-lap-output)) + (setf (comp-func-args ir) + (comp-decrypt-lambda-list (aref (comp-func-byte-func ir) 0))) + (setf (comp-func-ir ir) byte-compile-lap-output) + ir) + +(defmacro comp-sp () + "Current stack pointer." + '(comp-limple-frame-sp frame)) + +(defmacro comp-slot () + "Current slot into the meta-stack pointed by sp." + '(aref (comp-limple-frame-frame frame) (comp-sp))) + +(defmacro comp-push (n) + "Push slot number N into frame." + `(progn + (cl-incf (comp-sp)) + (list '= (comp-slot) ,n))) + +(defmacro comp-push-slot (n) + "Push slot number N into frame." + `(let ((src-slot (aref (comp-limple-frame-frame frame) ,n))) + (cl-incf (comp-sp)) + (setf (comp-slot) + (copy-sequence src-slot)) + (setf (comp-meta-var-slot (comp-slot)) (comp-sp)) + (list '= (comp-slot) src-slot))) + +(defmacro comp-push-const (x) + "Push X into frame. +X value is known at compile time." + `(progn + (cl-incf (comp-sp)) + (setf (comp-slot) (make-comp-meta-var :slot (comp-sp) + :const-vld t + :constant ,x)) + (list '= (comp-slot) ,x))) + +(defmacro comp-pop (n) + "Pop N elements from the meta-stack." + `(cl-decf (comp-sp) ,n)) + +(defun comp-limplify-lap-inst (inst frame) + "Limplify LAP instruction INST in current FRAME." + (let ((op (car inst))) + (pcase op + ('byte-varref + (comp-push `(call Fsymbol_value ,(second inst)))) + ('byte-constant + (comp-push-const (second inst))) + ('byte-stack-ref + (comp-push-slot (- (comp-sp) (cdr inst)))) + ('byte-plus + (comp-pop 2) + (comp-push `(callref Fplus 2 ,(comp-sp)))) + ('byte-return + `(return ,(comp-sp))) + (_ 'xxx)))) + +(defun comp-limplify (ir) + "Take IR and return LIMPLE." + (let* ((frame-size (aref (comp-func-byte-func ir) 3)) + (frame (make-comp-limple-frame + :sp (1- (comp-args-mandatory (comp-func-args ir))) + :frame (let ((v (make-vector frame-size nil))) + (cl-loop for i below frame-size + do (aset v i (make-comp-meta-var :slot i))) + v))) + (limple-ir + (cl-loop + for inst in (comp-func-ir ir) + collect (comp-limplify-lap-inst inst frame)))) + (setf (comp-func-ir ir) limple-ir) + (when comp-debug + (cl-prettyprint (comp-func-ir ir))) + ir)) (defun native-compile (fun) "FUN is the function definition to be compiled to native code." + (unless lexical-binding + (error "Can't compile a non lexical binded function")) (if-let ((f (symbol-function fun))) - (comp-recuparate-lap f) + (progn + (when (byte-code-function-p f) + (error "Can't native compile an already bytecompiled function")) + (cl-loop with ir = (make-comp-func :symbol-name fun + :func f) + for pass in comp-passes + do (funcall pass ir) + finally return ir)) (error "Trying to native compile not a function"))) (provide 'comp)