mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-04 02:51:31 -08:00
Code Issues Projects Releases Wiki Activity

first limple

Browse source
This commit is contained in:
Andrea Corallo 2019-07-07 18:42:55 +02:00 • committed by Andrea Corallo
parent 8d0ae21c48
commit 83d1a34ef9
1 changed files with 32 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -91,24 +91,28 @@
"Current stack pointer." "Current stack pointer."
'(comp-limple-frame-sp frame)) '(comp-limple-frame-sp frame))
(defmacro comp-slot-n (n)
"Slot N into the meta-stack."
`(aref (comp-limple-frame-frame frame) ,n))
(defmacro comp-slot () (defmacro comp-slot ()
"Current slot into the meta-stack pointed by sp." "Current slot into the meta-stack pointed by sp."
'(aref (comp-limple-frame-frame frame) (comp-sp))) '(comp-slot-n (comp-sp)))
(defmacro comp-push (n) (defmacro comp-push (x)
"Push slot number N into frame." "Push X into frame."
`(progn `(progn
(cl-incf (comp-sp)) (cl-incf (comp-sp))
(list '= (comp-slot) ,n))) (list '= (comp-slot) ,x)))
(defmacro comp-push-slot (n) (defmacro comp-push-slot-n (n)
"Push slot number N into frame." "Push slot number N into frame."
`(let ((src-slot (aref (comp-limple-frame-frame frame) ,n))) `(let ((src-slot (comp-slot-n ,n)))
(cl-incf (comp-sp)) (cl-incf (comp-sp))
(setf (comp-slot) (setf (comp-slot)
(copy-sequence src-slot)) (copy-sequence src-slot))
(setf (comp-meta-var-slot (comp-slot)) (comp-sp)) (setf (comp-meta-var-slot (comp-slot)) (comp-sp))
(list '= (comp-slot) src-slot))) (list '=slot (comp-slot) src-slot)))
(defmacro comp-push-const (x) (defmacro comp-push-const (x)
"Push X into frame. "Push X into frame.
@ -118,7 +122,7 @@ X value is known at compile time."
(setf (comp-slot) (make-comp-meta-var :slot (comp-sp) (setf (comp-slot) (make-comp-meta-var :slot (comp-sp)
:const-vld t :const-vld t
:constant ,x)) :constant ,x))
(list '= (comp-slot) ,x))) (list '=const (comp-slot) ,x)))
(defmacro comp-pop (n) (defmacro comp-pop (n)
"Pop N elements from the meta-stack." "Pop N elements from the meta-stack."
@ -128,32 +132,44 @@ X value is known at compile time."
"Limplify LAP instruction INST in current FRAME." "Limplify LAP instruction INST in current FRAME."
(let ((op (car inst))) (let ((op (car inst)))
(pcase op (pcase op
('byte-dup
(comp-push-slot-n (comp-sp)))
('byte-varref ('byte-varref
(comp-push `(call Fsymbol_value ,(second inst)))) (comp-push `(call Fsymbol_value ,(second inst))))
('byte-constant ('byte-constant
(comp-push-const (second inst))) (comp-push-const (second inst)))
('byte-stack-ref ('byte-stack-ref
(comp-push-slot (- (comp-sp) (cdr inst)))) (comp-push-slot-n (- (comp-sp) (cdr inst))))
('byte-plus ('byte-plus
(comp-pop 2) (comp-pop 2)
(comp-push `(callref Fplus 2 ,(comp-sp)))) (comp-push `(callref Fplus 2 ,(comp-sp))))
('byte-car
(comp-pop 1)
(comp-push `(Fcar ,(comp-sp))))
('byte-return ('byte-return
`(return ,(comp-sp))) `(return ,(comp-slot)))
(_ 'xxx)))) (_ 'xxx))))
(defun comp-limplify (ir) (defun comp-limplify (ir)
"Take IR and return LIMPLE." "Given IR and return LIMPLE."
(let* ((frame-size (aref (comp-func-byte-func ir) 3)) (let* ((frame-size (aref (comp-func-byte-func ir) 3))
(frame (make-comp-limple-frame (frame (make-comp-limple-frame
:sp (1- (comp-args-mandatory (comp-func-args ir))) :sp -1
:frame (let ((v (make-vector frame-size nil))) :frame (let ((v (make-vector frame-size nil)))
(cl-loop for i below frame-size (cl-loop for i below frame-size
do (aset v i (make-comp-meta-var :slot i))) do (aset v i (make-comp-meta-var :slot i)))
v))) v)))
(limple-ir (limple-ir ()))
(cl-loop ;; Prologue
for inst in (comp-func-ir ir) (push '(BLOCK prologue) limple-ir)
collect (comp-limplify-lap-inst inst frame)))) (cl-loop for i below (comp-args-mandatory (comp-func-args ir))
do (progn
(cl-incf (comp-sp))
(push `(=par ,(comp-slot) ,i) limple-ir)))
(push '(BLOCK body) limple-ir)
(cl-loop for inst in (comp-func-ir ir)
do (push (comp-limplify-lap-inst inst frame) limple-ir))
(setq limple-ir (reverse limple-ir))
(setf (comp-func-ir ir) limple-ir) (setf (comp-func-ir ir) limple-ir)
(when comp-debug (when comp-debug
(cl-prettyprint (comp-func-ir ir))) (cl-prettyprint (comp-func-ir ir)))