diff --git a/src/cmp/cmpcall.lsp b/src/cmp/cmpcall.lsp index 531fc1703..d590188bc 100644 --- a/src/cmp/cmpcall.lsp +++ b/src/cmp/cmpcall.lsp @@ -258,7 +258,20 @@ (progn (cmpnote "Emiting FDEFINITION for ~S" fname) (setq loc (list 'FDEFINITION fname)))))) - `(CALL "funcall" (,(1+ (length args)) ,loc ,@(coerce-locs args)) ,fname)) + (do ((i 0 (1+ i)) + (l args (cdr l))) + ((endp l) + (progn + (cond ((> i *max-stack*) + (setf *max-stack* i)) + ((zerop *max-stack*) + (setf *max-stack* 1))) + (wt-nl +ecl-local-stack-frame-variable+ ".top = " + +ecl-local-stack-variable+ "+" i ";") + `(CALL "ecl_apply_from_stack_frame" ((LOCAL-FRAME NIL) ,loc) ,fname))) + (wt-nl +ecl-local-stack-variable+ "[" i "]=") + (wt-coerce-loc :object (second (first l))) + (wt ";"))) ;;; Functions that use MAYBE-SAVE-VALUE should rebind *temp*. (defun maybe-save-value (value &optional (other-forms nil other-forms-flag)) diff --git a/src/cmp/cmpenv.lsp b/src/cmp/cmpenv.lsp index 27d4403f0..b5cc935c5 100644 --- a/src/cmp/cmpenv.lsp +++ b/src/cmp/cmpenv.lsp @@ -21,6 +21,7 @@ (defun init-env () (setq *compiler-phase* 't1) (setq *callbacks* nil) + (setq *max-stack* 0) (setq *max-temp* 0) (setq *temp* 0) (setq *next-cmacro* 0) diff --git a/src/cmp/cmploc.lsp b/src/cmp/cmploc.lsp index d4572cb0a..b6bdef197 100644 --- a/src/cmp/cmploc.lsp +++ b/src/cmp/cmploc.lsp @@ -26,6 +26,7 @@ ;;; ( VV-temp vv-index ) ;;; ( LCL lcl [representation-type]) local variable, type unboxed ;;; ( TEMP temp ) local variable, type object +;;; ( FRAME ndx ) variable in local frame stack ;;; ( CALL c-fun-name args fname ) locs are locations containing the arguments ;;; ( CALL-NORMAL fun locs) similar as CALL, but number of arguments is fixed ;;; ( C-INLINE output-type fun/string locs side-effects output-var ) @@ -182,8 +183,14 @@ (defun values-loc (n) (list 'VALUE n)) +(defun wt-local-frame (n) + (if n + (wt +ecl-local-stack-variable+ "[" n "]") + (wt "((cl_object)&" +ecl-local-stack-frame-variable+ ")"))) + ;;; ----------------------------------------------------------------- +(put-sysprop 'LOCAL-FRAME 'WT-LOC #'wt-local-frame) (put-sysprop 'TEMP 'WT-LOC #'wt-temp) (put-sysprop 'LCL 'WT-LOC #'wt-lcl-loc) (put-sysprop 'VV 'WT-LOC #'wt-vv) diff --git a/src/cmp/cmpstack.lsp b/src/cmp/cmpstack.lsp index a42ac904d..ebf458515 100644 --- a/src/cmp/cmpstack.lsp +++ b/src/cmp/cmpstack.lsp @@ -22,6 +22,12 @@ (in-package "COMPILER") +(defconstant +ecl-stack-frame-variable+ "_ecl_inner_frame") + +(defconstant +ecl-local-stack-frame-variable+ "__frame") + +(defconstant +ecl-local-stack-variable+ "__frame_sp") + (defun c1with-stack (forms) (let* ((var (pop forms)) (body (c1expr `(let ((,var (innermost-stack-frame))) ,@forms)))) @@ -29,8 +35,6 @@ :type (c1form-type body) :args body))) -(defvar +ecl-stack-frame-variable+ "_ecl_inner_frame") - (defun c2with-stack (body) (let* ((new-destination (tmp-destination *destination*)) (*temp* *temp*)) diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp index 5d64c00e0..c32fc872c 100644 --- a/src/cmp/cmptop.lsp +++ b/src/cmp/cmptop.lsp @@ -113,6 +113,7 @@ (wt-nl-h "#include ")) ;;; Initialization function. (let* ((*lcl* 0) (*lex* 0) (*max-lex* 0) (*max-env* 0) (*max-temp* 0) + (*max-stack* 0) (*reservation-cmacro* (next-cmacro)) (c-output-file *compiler-output1*) (*compiler-output1* (make-string-output-stream)) @@ -124,8 +125,10 @@ (wt-nl1 "extern \"C\"") (wt-nl1 "#endif") (wt-nl1 "ECL_DLLEXPORT void " name "(cl_object flag)") - (wt-nl1 "{ VT" *reservation-cmacro* " VLEX" *reservation-cmacro* - " CLSR" *reservation-cmacro*) + (wt-nl1 "{ VT" *reservation-cmacro* + " VLEX" *reservation-cmacro* + " CLSR" *reservation-cmacro* + " STCK" *reservation-cmacro*) (wt-nl "cl_object value0;") (wt-nl "cl_object *VVtemp;") (when shared-data @@ -334,7 +337,8 @@ (defun wt-function-prolog (&optional sp local-entry) (wt " VT" *reservation-cmacro* " VLEX" *reservation-cmacro* - " CLSR" *reservation-cmacro*) + " CLSR" *reservation-cmacro* + " STCK" *reservation-cmacro*) (wt-nl "cl_object value0;") (when sp (wt-nl "bds_check;")) ; (when (compiler-push-events) (wt-nl "ihs_check;")) @@ -359,6 +363,11 @@ (when (plusp *max-lex*) (wt-h " volatile cl_object lex" *level* "[" *max-lex* "];")) (wt-nl-h "#define CLSR" *reservation-cmacro*) + (wt-nl-h "#define STCK" *reservation-cmacro*) + (unless (zerop *max-stack*) + (wt-h " cl_object " +ecl-local-stack-variable+ "[" *max-stack* "]; " + "struct ecl_stack_frame " +ecl-local-stack-frame-variable+ + " = { t_frame, 0, 0, 0, " +ecl-local-stack-variable+ ", 0, 0 };")) (when (plusp *max-env*) (unless (eq closure-type 'CLOSURE) (wt-h " cl_object " *volatile* "env0;")) @@ -567,7 +576,8 @@ (wt-nl1 "{") (wt " VT" *reservation-cmacro* " VLEX" *reservation-cmacro* - " CLSR" *reservation-cmacro*) + " CLSR" *reservation-cmacro* + " STCK" *reservation-cmacro*) (wt-nl *volatile* "cl_object value0;") (when (>= (fun-debug fun) 2) (wt-nl "struct ihs_frame ihs;"))