mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-09 15:50:40 -08:00
Code Issues Projects Releases Wiki Activity

move out comp-limplify-listn

Browse source
This commit is contained in:
Andrea Corallo 2019-07-08 09:15:09 +02:00 • committed by Andrea Corallo
parent a4ea174a37
commit f745b498ad
1 changed files with 39 additions and 38 deletions
Download patch file Download diff file Expand all files Collapse all files

77
lisp/emacs-lisp/comp.el
View file

@ -168,47 +168,48 @@ VAL is known at compile time."
"Pop N elements from the meta-stack."
(cl-decf (comp-sp) n))
(defun comp-limplify-listn (n)
(comp-pop 1)
(comp-push-call `(call Fcons ,(comp-slot-next) nil))
(dotimes (_ (1- n))
(comp-pop 2)
(comp-push-call `(call Fcons
,(comp-slot-next)
,(comp-slot-n (+ 2 (comp-sp)))))))
(defun comp-limplify-lap-inst (inst)
"Limplify LAP instruction INST in current frame accumulating in `comp-limple'
for current `func'."
(cl-flet ((do-list (n)
(comp-pop 1)
(comp-push-call `(call Fcons ,(comp-slot-next) nil))
(dotimes (_ (1- n))
(comp-pop 2)
(comp-push-call `(call Fcons
,(comp-slot-next)
,(comp-slot-n (+ 2 (comp-sp))))))))
(let ((op (car inst)))
(pcase op
('byte-dup
(comp-push-slot-n (comp-sp)))
('byte-varref
(comp-push-call `(call Fsymbol_value ,(second inst))))
('byte-constant
(comp-push-const (second inst)))
('byte-stack-ref
(comp-push-slot-n (- (comp-sp) (cdr inst))))
('byte-plus
(comp-pop 2)
(comp-push-call `(callref Fplus 2 ,(comp-sp))))
('byte-car
(comp-pop 1)
(comp-push-call `(call Fcar ,(comp-sp))))
('byte-cdr
(comp-pop 1)
(comp-push-call `(call Fcdr ,(comp-sp))))
('byte-list1
(do-list 1))
('byte-list2
(do-list 2))
('byte-list3
(do-list 3))
('byte-list4
(do-list 4))
('byte-return
`(return ,(comp-slot)))
(_ (error "Unexpected LAP op %s" (symbol-name op)))))))
(let ((op (car inst)))
(pcase op
('byte-dup
(comp-push-slot-n (comp-sp)))
('byte-varref
(comp-push-call `(call Fsymbol_value ,(second inst))))
('byte-constant
(comp-push-const (second inst)))
('byte-stack-ref
(comp-push-slot-n (- (comp-sp) (cdr inst))))
('byte-plus
(comp-pop 2)
(comp-push-call `(callref Fplus 2 ,(comp-sp))))
('byte-car
(comp-pop 1)
(comp-push-call `(call Fcar ,(comp-sp))))
('byte-cdr
(comp-pop 1)
(comp-push-call `(call Fcdr ,(comp-sp))))
('byte-list1
(comp-limplify-listn 1))
('byte-list2
(comp-limplify-listn 2))
('byte-list3
(comp-limplify-listn 3))
('byte-list4
(comp-limplify-listn 4))
('byte-return
`(return ,(comp-slot)))
(_ (error "Unexpected LAP op %s" (symbol-name op))))))
(defun comp-limplify (func)
"Given FUNC and return LIMPLE."