procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

stackset

Browse source
This commit is contained in:
Andrea Corallo 2019-07-20 19:26:30 +02:00 • committed by Andrea Corallo
parent 80826b8220
commit d025ce26f8
1 changed files with 22 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -280,15 +280,17 @@ If C-FUN-NAME is nil it will be guessed from SUBR-NAME."
collect (comp-slot-n (+ i (comp-sp)))))) collect (comp-slot-n (+ i (comp-sp))))))
(comp-emit-set-call `(call ,c-fun-name ,@slots))))))) (comp-emit-set-call `(call ,c-fun-name ,@slots)))))))
(defun comp-copy-slot-n (n) (defun comp-copy-slot (src-n &optional dst-n)
"Set current slot with slot number N as source." "Set slot number DST-N to slot number SRC-N as source.
(let ((src-slot (comp-slot-n n))) If DST-N is specified use it otherwise assume it to be the current slot."
(comp-with-sp (if dst-n dst-n (comp-sp))
(let ((src-slot (comp-slot-n src-n)))
(cl-assert src-slot) (cl-assert src-slot)
;; FIXME id should encrease here. ;; FIXME id should encrease here.
(setf (comp-slot) (setf (comp-slot)
(copy-sequence src-slot)) (copy-sequence src-slot))
(setf (comp-mvar-slot (comp-slot)) (comp-sp)) (setf (comp-mvar-slot (comp-slot)) (comp-sp))
(comp-emit (list 'set (comp-slot) src-slot)))) (comp-emit (list 'set (comp-slot) src-slot)))))
(defun comp-emit-annotation (str) (defun comp-emit-annotation (str)
"Emit annotation STR." "Emit annotation STR."
@ -440,7 +442,7 @@ the annotation emission."
(TAG (TAG
(comp-emit-block (comp-lap-to-limple-bb arg))) (comp-emit-block (comp-lap-to-limple-bb arg)))
(byte-stack-ref (byte-stack-ref
(comp-copy-slot-n (- (comp-sp) (cdr inst) 1))) (comp-copy-slot (- (comp-sp) arg 1)))
(byte-varref (byte-varref
(comp-emit-set-call `(call Fsymbol_value ,(make-comp-mvar (comp-emit-set-call `(call Fsymbol_value ,(make-comp-mvar
:const-vld t :const-vld t
@ -569,7 +571,7 @@ the annotation emission."
(comp-mark-block-closed)) (comp-mark-block-closed))
(byte-discard 'pass) (byte-discard 'pass)
(byte-dup (byte-dup
(comp-copy-slot-n (1- (comp-sp)))) (comp-copy-slot (1- (comp-sp))))
(byte-save-excursion) (byte-save-excursion)
(byte-save-window-excursion-OBSOLETE) (byte-save-window-excursion-OBSOLETE)
(byte-save-restriction) (byte-save-restriction)
@ -602,23 +604,26 @@ the annotation emission."
(byte-numberp auto) (byte-numberp auto)
(byte-integerp auto) (byte-integerp auto)
(byte-listN (byte-listN
(comp-stack-adjust (- (1- arg))) (comp-stack-adjust (- 1 arg))
(comp-emit-set-call `(callref Flist ,arg ,(comp-sp)))) (comp-emit-set-call `(callref Flist ,arg ,(comp-sp))))
(byte-concatN (byte-concatN
(comp-stack-adjust (- (1- arg))) (comp-stack-adjust (- 1 arg))
(comp-emit-set-call `(callref Fconcat ,arg ,(comp-sp)))) (comp-emit-set-call `(callref Fconcat ,arg ,(comp-sp))))
(byte-insertN (byte-insertN
(comp-stack-adjust (- (1- arg))) (comp-stack-adjust (- 1 arg))
(comp-emit-set-call `(callref Finsert ,arg ,(comp-sp)))) (comp-emit-set-call `(callref Finsert ,arg ,(comp-sp))))
(byte-stack-set) (byte-stack-set
(comp-with-sp (1+ (comp-sp))
(comp-copy-slot (comp-sp) (- (comp-sp) arg))))
(byte-stack-set2) (byte-stack-set2)
(byte-discardN) (byte-discardN
(comp-stack-adjust (- arg)))
(byte-switch) (byte-switch)
(byte-constant (byte-constant
(comp-emit-set-const arg)) (comp-emit-set-const arg))
(byte-discardN-preserve-tos (byte-discardN-preserve-tos
(comp-stack-adjust (- arg)) (comp-stack-adjust (- arg))
(comp-copy-slot-n (+ arg (comp-sp))))))) (comp-copy-slot (+ arg (comp-sp)))))))
(defun comp-limplify (func) (defun comp-limplify (func)
"Given FUNC compute its LIMPLE ir." "Given FUNC compute its LIMPLE ir."