Speed up calling unknown functions by having a local frame that we reuse

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))

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)

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)

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*))

src/cmp/cmptop.lsp

@@ -113,6 +113,7 @@
     (wt-nl-h "#include <string.h>"))
   ;;; 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;"))