From: Taylor R Campbell <campbell@mumble.net>
Date: Sat, 5 Jan 2019 15:53:23 +0000 (+0000)
Subject: Open-code WITH-STACK-MARKER too.
X-Git-Tag: mit-scheme-pucked-10.1.20~11^2~80^2~5
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a222965506ae3415774b4171683b05d8a0882578;p=mit-scheme.git

Open-code WITH-STACK-MARKER too.

Saves a trip through reflect-to-interface, which would break the
return address branch target prediction stack.
---

diff --git a/src/compiler/machines/x86-64/rules3.scm b/src/compiler/machines/x86-64/rules3.scm
index 08dc73caf..8bd085953 100644
--- a/src/compiler/machines/x86-64/rules3.scm
+++ b/src/compiler/machines/x86-64/rules3.scm
@@ -249,6 +249,63 @@ USA.
 	 ;; interrupts that may be enabled now.
 	 ,@suffix)))
 
+(define-rule statement
+  (INVOCATION:PRIMITIVE (? frame-size) (? continuation) (? primitive))
+  (QUALIFIER (eq? primitive (ucode-primitive with-stack-marker 3)))
+  continuation
+  (assert (= frame-size 4))		;primitive, procedure, type, instance
+  (let* ((prefix (clear-map!))
+	 (pushed (generate-label 'PUSHED))
+	 (pop-pop-return (generate-label 'POP-POP-RETURN))
+	 (tag-continuation
+	  (affix-type (INST-EA (@R ,rsp))
+		      type-code:compiled-return
+		      (lambda () rax)))
+	 (suffix (pop-return/interrupt-check)))
+    (LAP ,@prefix
+	 ;; Stack initially looks like:
+	 ;;
+	 ;;	rsp[0] = procedure
+	 ;;	rsp[1] = type
+	 ;;	rsp[2] = instance
+	 ;;	rsp[3] = continuation*
+	 ;;
+	 ;; We want:
+	 ;;
+	 ;;	rsp[0] = continuation that pops it all
+	 ;;	rsp[1] = reflect-to-interface
+	 ;;	rsp[2] = fixnum reflect-code:stack-marker
+	 ;;	rsp[3] = type
+	 ;;	rsp[4] = instance
+	 ;;	rsp[5] = continuation*
+	 ;;
+	 (POP Q (R ,rbx))		;procedure
+	 (MOV Q (R ,rcx) (&U ,(make-non-pointer-literal (ucode-type fixnum) 0)))
+	 (OR Q (R ,rcx) (& ,reflect-code:stack-marker))
+	 (PUSH Q (R ,rcx))
+	 (PUSH Q ,reg:reflect-to-interface)
+	 ;; Push a continuation onto the stack.
+	 (CALL (@PCR ,pushed))
+	 (JMP (@PCR ,pop-pop-return))
+	(LABEL ,pushed)
+	 ,@tag-continuation
+	 ;; Inovke rbx.  One procedure, zero arguments: frame size 1.
+	 ,@(invoke-hook/subroutine entry:compiler-apply-setup-size-1)
+	 (JMP (R ,rax))
+	 ,@(make-external-label (continuation-code-word #f) pop-pop-return)
+	 ;; Return value is in rax, so don't overwrite it.  Stack now looks
+	 ;; like:
+	 ;;
+	 ;;	rsp[0] = reflect-to-interface
+	 ;;	rsp[1] = fixnum reflect-code:stack-marker
+	 ;;	rsp[2] = type
+	 ;;	rsp[3] = instance
+	 ;;	rsp[4] = continuation*
+	 ;;
+	 ;; Pop it all off and return.
+	 (ADD Q (R ,rsp) (& ,(* 4 address-units-per-object)))
+	 ,@suffix)))
+
 (define-rule statement
   (INVOCATION:PRIMITIVE (? frame-size) (? continuation) (? primitive))
   (QUALIFIER