From: ssmith <ssmith>
Date: Wed, 11 Jan 1995 21:58:54 +0000 (+0000)
Subject: Added invocations.
X-Git-Tag: 20090517-FFI~6763
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a0e89bb6fa292c72aeef0b016b9a8514ca6c807b;p=mit-scheme.git

Added invocations.
---

diff --git a/v8/src/compiler/machines/i386/rules3.scm b/v8/src/compiler/machines/i386/rules3.scm
index a811833e9..e4fdd1efa 100644
--- a/v8/src/compiler/machines/i386/rules3.scm
+++ b/v8/src/compiler/machines/i386/rules3.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rules3.scm,v 1.3 1995/01/11 20:42:52 ssmith Exp $
+$Id: rules3.scm,v 1.4 1995/01/11 21:58:54 ssmith Exp $
 
 Copyright (c) 1992-1993 Massachusetts Institute of Technology
 
@@ -938,6 +938,76 @@ MIT in each case. |#
 	  (else
 	   (LAP)))))
 
+
+;; Invocation rules
+
+;; Jumps to the location stored in the register
+(define-rule statement
+  (INVOCATION:REGISTER 0 #F (REGISTER (? reg))
+		       #F (MACHINE-CONSTANT (? nregs)))
+  nregs					; ignored
+  (profile-info/add 'INVOCATION:REGISTER)
+  (let ((addr (standard-source! reg)))
+    (LAP ,@(clear-map!)
+	 (JMP (@R ,addr)))))
+
+;; NOTE for this procedure, we may need to alter the return address
+;; that's pushed onto the stack...  I'm not sure what the best way to
+;; do that is.  Potential bug.
+(define-rule statement
+  (INVOCATION:PROCEDURE 0 (? continuation) (? destination)
+			(MACHINE-CONSTANT (? nregs)))
+  nregs					; ignored
+  (profile-info/add 'INVOCATION:PROCEDURE)
+  (LAP ,@(clear-map!)
+       ,@(if (not continuation)
+	     (LAP (JMP (@PCR ,destination)))
+	     (LAP (CALL (@PCR ,destination))))))
+
+(define-rule statement
+  (INVOCATION:NEW-APPLY (? frame-size) (? continuation)
+			(REGISTER (? dest)) (MACHINE-CONSTANT (? nregs)))
+  ;; *** For now, ignore nregs and use frame-size ***
+  nregs
+  (profile-info/add 'INVOCATION:NEW-APPLY)
+  (let* ((obj (register-alias dest (register-type dest)))
+	 (prefix (if obj
+		     (LAP)
+		     (%load-machine-register! dest regnum:first-arg
+					      delete-dead-registers!)))
+	 (obj* (or obj regnum:first-arg)))
+    (need-register! obj*)
+    (if continuation
+	(need-register! 19))
+    (let ((addr (if untagged-entries? obj* (standard-temporary!)))
+	  (temp (standard-temporary!))
+	  (label (generate-label))
+	  (load-continuation
+	   (if continuation
+	       (load-pc-relative-address continuation 19 'CODE)
+	       '())))
+      (LAP ,@prefix
+	   ,@(clear-map!)
+	   ,@load-continuation
+	   ,@(object->type obj* temp)
+	   ,@(let ((tag (ucode-type compiled-entry)))
+	       (LAP (CMP W ,temp (& ,tag))
+		    (JNE (@PCR ,label))))
+	   ,@(if untagged-entries?
+		 (LAP)
+		 (LAP (MOV W (R ,addr) (R ,obj*))
+		      ,@(adjust-type (ucode-type compiled-entry)
+				     quad-mask-value
+				     addr)))
+	   (CMP B (@RO B ,addr -3) 0)
+	   ;; This is ugly - oh well
+	   (JNE (@PCR ,label)
+	   (JMP (@R ,addr))
+	   (LABEL ,label)
+	   ,@(copy obj* regnum:first-arg)
+	   ,@(%invocation:apply frame-size)))))
+
+
 
 ;;; Local Variables: ***
 ;;; eval: (put 'declare-constants 'scheme-indent-hook 2) ***