diff --git a/assembly/assemfile.lisp b/assembly/assemfile.lisp
index 2d6d33c30b5a1f614d39dabdc34b83b56d2050fe..fbf0f1863f6c09b9c19308b7b9683472b8355a42 100644
--- a/assembly/assemfile.lisp
+++ b/assembly/assemfile.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/assemfile.lisp,v 1.19 1990/10/23 02:22:30 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/assemfile.lisp,v 1.20 1990/10/28 05:59:54 wlott Exp $
 ;;;
 ;;; This file contains the extra code necessary to feed an entire file of
 ;;; assembly code to the assembler.
@@ -27,7 +27,7 @@
 (defun assemble-file (name &key
 			   (output-file
 			    (make-pathname :defaults name
-					   :type "mips-fasl"))
+					   :type "assem"))
 			   trace-file)
   (let* ((*do-assembly* t)
 	 (name (pathname name))
@@ -98,7 +98,7 @@
     reg))
 
 
-(defun emit-assemble (name regs code)
+(defun emit-assemble (name options regs code)
   (let* ((labels nil)
 	 (insts (mapcar #'(lambda (inst)
 			    (cond ((symbolp inst)
@@ -106,7 +106,8 @@
 				   `(emit-label ,inst))
 				  (t
 				   inst)))
-			code)))
+			code))
+	 (return-style (or (cadr (assoc :return-style options)) :raw)))
     `(let ((,name (gen-label))
 	   ,@(mapcar #'(lambda (label)
 			 `(,label (gen-label)))
@@ -123,8 +124,19 @@
 			 :offset ,(reg-spec-offset reg))))
 		  regs))
 	   ,@insts
-	   (inst j lip-tn)
-	   (inst nop)))
+	   ,@(ecase vm:target-fasl-file-implementation
+	       (#.vm:pmax-fasl-file-implementation
+		(ecase return-style
+		  (:raw
+		   `((inst j lip-tn)
+		     (inst nop)))
+		  (:full-call
+		   `((lisp-return (make-random-tn :kind :normal
+						  :sc (sc-or-lose
+						       'descriptor-reg)
+						  :offset lra-offset)
+				  lip-tn :offset 2)))
+		  (:none))))))
        (format *error-output* "~S assembled~%" ',name))))
 
 (defun arg-or-res-spec (reg)
@@ -139,7 +151,15 @@
   (let* ((args (remove :arg vars :key #'reg-spec-kind :test-not #'eq))
 	 (temps (remove :temp vars :key #'reg-spec-kind :test-not #'eq))
 	 (results (remove :res vars :key #'reg-spec-kind :test-not #'eq))
-	 (lip (make-symbol "LIP")))
+	 (return-style (or (cadr (assoc :return-style options)) :raw))
+	 (cost (or (cadr (assoc :cost options)) 247))
+	 (lip (make-symbol "LIP"))
+	 (lra (make-symbol "LRA"))
+	 (temp (make-symbol "TEMP"))
+	 (vop (make-symbol "VOP"))
+	 (nfp-save (make-symbol "NFP-SAVE")))
+    (unless (member return-style '(:raw :full-call :none))
+      (error "Unknown return-style for ~S: ~S" name return-style))
     `(define-vop ,(if (atom name) (list name) name)
        (:args ,@(mapcar #'arg-or-res-spec args))
        ,@(let ((index -1))
@@ -160,6 +180,15 @@
        (:temporary (:scs (interior-reg) :type interior
 			 :from (:eval 0) :to (:eval 1))
 		   ,lip)
+       ,@(when (eq return-style :full-call)
+	   `((:temporary (:sc descriptor-reg :offset lra-offset
+			      :from (:eval 0) :to (:eval 1))
+			 ,lra)
+	     (:temporary (:scs (non-descriptor-reg)
+			       :from (:eval 0) :to (:eval 1))
+			 ,temp)
+	     (:temporary (:sc control-stack :offset nfp-save-offset) ,nfp-save)
+	     (:vop-var ,vop)))
        ,@(let ((index -1))
 	   (mapcar #'(lambda (res)
 		       `(:temporary (:sc ,(reg-spec-sc res)
@@ -171,22 +200,55 @@
 		   results))
        (:results ,@(mapcar #'arg-or-res-spec results))
        (:ignore ,lip ,@(mapcar #'reg-spec-name temps))
-       ,@options
-       (:generator 247
+       ,@(remove-if #'(lambda (x)
+			(member x '(:return-style :cost)))
+		    options
+		    :key #'car)
+       (:generator ,cost
 	 ,@(mapcar #'(lambda (arg)
 		       `(move ,(reg-spec-temp arg)
 			      ,(reg-spec-name arg)))
 		   args)
-	 (inst jal (make-fixup ',name :assembly-routine))
-	 (inst nop)
-	 
+	 ,@(ecase vm:target-fasl-file-implementation
+	     (#.vm:pmax-fasl-file-implementation
+	      (ecase return-style
+		(:raw
+		 `((inst jal (make-fixup ',name :assembly-routine))
+		   (inst nop)))
+		(:full-call
+		 (when (> (length results) 1)
+		   (error "Can't use :full-call in an assembly-routine for ~
+		           more than one return value."))
+		 `((let ((lra-label (gen-label))
+			 (cur-nfp (current-nfp-tn ,vop)))
+		     (when cur-nfp
+		       (store-stack-tn ,nfp-save cur-nfp))
+		     (inst compute-lra-from-code ,lra code-tn lra-label ,temp)
+		     (inst j (make-fixup ',name :assembly-routine))
+		     (inst nop)
+		     (emit-return-pc lra-label)
+		     (note-this-location ,vop :unknown-return)
+		     (move csp-tn old-fp-tn)
+		     (inst nop)
+		     (inst compute-code-from-lra code-tn code-tn
+			   lra-label ,temp)
+		     (when cur-nfp
+		       (load-stack-tn cur-nfp ,nfp-save)))))
+		(:none
+		 `((inst j (make-fixup ',name :assembly-routine))
+		   (inst nop))))))
 	 ,@(mapcar #'(lambda (res)
 		       `(move ,(reg-spec-name res)
 			      ,(reg-spec-temp res)))
 		   results)))))
 
-(defmacro define-assembly-routine ((name options &rest vars) &rest code)
-  (let* ((regs (mapcar #'(lambda (var) (apply #'parse-reg-spec var)) vars)))
-    (if *do-assembly*
-	(emit-assemble (if (atom name) name (car name)) regs code)
-	(emit-vop name options regs))))
+(defmacro define-assembly-routine (name&options vars &rest code)
+  (multiple-value-bind (name options)
+		       (if (atom name&options)
+			   (values name&options nil)
+			   (values (car name&options)
+				   (cdr name&options)))
+    (let* ((regs (mapcar #'(lambda (var) (apply #'parse-reg-spec var)) vars)))
+      (if *do-assembly*
+	  (emit-assemble name options regs code)
+	  (emit-vop name options regs)))))