The CALL-NORMAL location in the compiler now remembers the type of its output (needed by wt-coerce-loc)

src/cmp/cmpcall.lsp

@@ -127,7 +127,7 @@
                  (and (null fun)
                       (setf fun (find fname *global-funs* :test #'same-fname-p
 				      :key #'fun-name)))))
-    (return-from call-global-loc (call-loc fname fun args)))
+    (return-from call-global-loc (call-loc fname fun args return-type)))
 
   ;; Call to a global (SETF ...) function
   (when (not (symbolp fname))
@@ -143,21 +143,24 @@
 	  (return-from call-global-loc
 	    (call-exported-function-loc
 	     fname args fd minarg maxarg
-	     (member fname *in-all-symbols-functions*)))))))
+	     (member fname *in-all-symbols-functions*)
+	     return-type))))))
 
   (multiple-value-bind (found fd minarg maxarg)
       (si::mangle-name fname t)
     (when found
       (return-from call-global-loc
-        (call-exported-function-loc fname args fd minarg maxarg t))))
+        (call-exported-function-loc fname args fd minarg maxarg t
+				    return-type))))
 
   (call-unknown-global-loc fname nil args))
 
-(defun call-loc (fname fun args)
+(defun call-loc (fname fun args type)
   (declare (ignore fname))
-  `(CALL-NORMAL ,fun ,(coerce-locs args)))
+  `(CALL-NORMAL ,fun ,(coerce-locs args) ,type))
 
-(defun call-exported-function-loc (fname args fun-c-name minarg maxarg in-core)
+(defun call-exported-function-loc (fname args fun-c-name minarg maxarg in-core
+				   return-type)
   (unless in-core
     ;; We only write declarations for functions which are not in lisp_external.h
     (multiple-value-bind (val declared)
@@ -180,7 +183,7 @@
 	(setf (gethash fun-c-name *compiler-declared-globals*) 1))))
   (let ((fun (make-fun :name fname :global t :cfun fun-c-name :lambda 'NIL
 		       :minarg minarg :maxarg maxarg)))
-    (call-loc fname fun args)))
+    (call-loc fname fun args return-type)))
 
 ;;;
 ;;; call-unknown-global-loc
@@ -252,7 +255,7 @@
     (wt ")")
     (when fname (wt-comment fname))))
 
-(defun wt-call-normal (fun args)
+(defun wt-call-normal (fun args type)
   (unless (fun-cfun fun)
     (baboon "Function without a C name: ~A" (fun-name fun)))
   (let* ((minarg (fun-minarg fun))

src/cmp/cmpffi.lsp

@@ -288,6 +288,7 @@
 	   (BIND (var-type (second loc)))
 	   (LCL (or (third loc) T))
 	   (THE (second loc))
+	   (CALL-NORMAL (fourth loc))
 	   (otherwise T)))))
 
 (defun loc-representation-type (loc)

src/cmp/cmpflet.lsp

@@ -263,5 +263,6 @@
   (unless (c2try-tail-recursive-call fun args)
     (let ((*inline-blocks* 0)
           (*temp* *temp*))
-      (unwind-exit (list 'CALL-NORMAL fun (coerce-locs (inline-args args))))
+      (unwind-exit (call-loc (fun-name fun) fun (inline-args args)
+			     (c1form-primary-type c1form)))
       (close-inline-blocks))))

src/cmp/cmploc.lsp

@@ -29,7 +29,7 @@
 ;;;	( 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
+;;;	( CALL-NORMAL fun locs 1st-type ) similar as CALL, but number of arguments is fixed
 ;;;	( CALL-INDIRECT fun narg args)	similar as CALL, but unknown function
 ;;;	( C-INLINE output-type fun/string locs side-effects output-var )
 ;;;	( COERCE-LOC representation-type location)