mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-18 23:32:17 -08:00
Code Issues Projects Releases Packages Wiki Activity

cmp: exit manager: remove the dead code for typed return locations

Browse source 
We never bind *EXIT* to returns other than 'RETURN.
This commit is contained in:
Daniel Kochmański 2023-11-15 08:28:11 +01:00
parent 2e941b417c
commit b8528d0d1c
3 changed files with 12 additions and 46 deletions
Download patch file Download diff file Expand all files Collapse all files

10
src/cmp/cmpbackend-cxx/cmpc-util.lsp
View file

@ -45,13 +45,11 @@
;;; --cmpexit.lsp--
;;;
;;; *exit* holds an 'exit', which is
;; LABEL instance or one of RETURNs (i.e. RETURN, RETURN-FIXNUM,
;; RETURN-CHARACTER, RETURN-LONG-FLOAT, RETURN-DOUBLE-FLOAT, RETURN-SINGLE-FLOAT,
;; RETURN-CSFLOAT, RETURN-CDFLOAT, RETURN-CLFLOAT or RETURN-OBJECT).
;; LABEL instance or RETURN.
;;; *unwind-exit* holds a list consisting of:
;; LABEL instance, one of RETURNs, TAIL-RECURSION-MARK, FRAME,
;; JUMP, BDS-BIND (each pushed for a single special binding), or a
;; LCL (which holds the bind stack pointer used to unbind).
;; LABEL instance, RETURN, TAIL-RECURSION-MARK, FRAME, JUMP, BDS-BIND (each
;; pushed for a single special binding), or a LCL (which holds the bind
;; stack pointer used to unbind).
;;;
(defvar *exit*)

4
src/cmp/cmpbackend-cxx/cmppass2-call.lsp
View file

@ -90,9 +90,7 @@
(t (baboon :format-control "tail-recursion-possible: unexpected situation.")))))
(defun last-call-p ()
(member *exit*
'(RETURN RETURN-FIXNUM RETURN-CHARACTER RETURN-SINGLE-FLOAT
RETURN-DOUBLE-FLOAT RETURN-LONG-FLOAT RETURN-OBJECT)))
(eq *exit* 'RETURN))
(defun c2try-tail-recursive-call (fun args)
(when (and *tail-recursion-info*

44
src/cmp/cmpbackend-cxx/cmppass2-exit.lsp
View file

@ -38,12 +38,8 @@
;;; (LCL n) -> n local variables
;;; (STACK n) -> n elements pushed in stack
;;; TAIL-RECURSION-MARK -> TTL: label created
;;; RETURN -> outermost location (*)
;;;
;;; (*) also RETURN-{FIXNUM,CHARACTER,OBJECT}
;;; RETURN-{SINGLE-FLOAT,DOUBLE-FLOAT,LONG-FLOAT}
;;; RETURN-{CSFLOAT,CDFLOAT,CLFLOAT}
;;;
;;; RETURN -> outermost location
(defun unwind-bds (bds-lcl bds-bind stack-frame ihs-p)
(declare (fixnum bds-bind))
(let ((some nil))
@ -124,6 +120,11 @@
(IHS (setf ihs-p ue))
(IHS-ENV (setf ihs-p (or ihs-p ue)))
(BDS-BIND (incf bds-bind))
(FRAME
(let ((*destination* (tmp-destination *destination*)))
(set-loc loc)
(setq loc *destination*))
(wt-nl "ecl_frs_pop(cl_env_copy);"))
(RETURN
(unless (eq *exit* 'RETURN)
(baboon-unwind-exit ue))
@ -142,37 +143,6 @@
(unwind-bds bds-lcl bds-bind stack-frame ihs-p)
(wt-nl "return value0;")))
(return))
((RETURN-FIXNUM RETURN-CHARACTER RETURN-OBJECT
RETURN-DOUBLE-FLOAT RETURN-SINGLE-FLOAT RETURN-LONG-FLOAT
RETURN-CSFLOAT RETURN-CDFLOAT RETURN-CLFLOAT)
(when (eq *exit* ue)
;; *destination* must be RETURN-FIXNUM
(setq loc (list 'COERCE-LOC
(getf '(RETURN-FIXNUM :fixnum
RETURN-CHARACTER :char
RETURN-SINGLE-FLOAT :float
RETURN-DOUBLE-FLOAT :double
RETURN-CSFLOAT :csfloat
RETURN-CDFLOAT :cdfloat
RETURN-CLFLOAT :clfloat
RETURN-OBJECT :object)
ue)
loc))
(if (or bds-lcl (plusp bds-bind))
(let ((lcl (make-lcl-var :type (second loc))))
(wt-nl-open-brace)
(wt-nl "cl_fixnum " lcl "= " loc ";")
(unwind-bds bds-lcl bds-bind stack-frame ihs-p)
(wt-nl "return(" lcl ");")
(wt-nl-close-brace))
(progn
(wt-nl "return(" loc ");")))
(return)))
(FRAME
(let ((*destination* (tmp-destination *destination*)))
(set-loc loc)
(setq loc *destination*))
(wt-nl "ecl_frs_pop(cl_env_copy);"))
(TAIL-RECURSION-MARK)
(t (baboon-unwind-exit ue))))))
;;; Never reached