;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 126.48
;;; Reason:
;;;  Take my debugging print statement of FASD-K-COMPILED-FUNCTION, sigh.
;;; Reason:
;;;  Take my debugging FASD-K-COMPILED-FUNCTION out, sigh.
;;; Written 12-Aug-88 10:32:34 by RWK at site Gigamos Cambridge
;;; while running on Love from band 2
;;; with Experimental System 126.44, ZWEI 125.15, ZMail 73.2, Local-File 75.2, File-Server 24.1, Unix-Interface 13.0, Tape 24.2, Lambda-Diag 17.0, microcode 1762, SDU Boot Tape 3.13, SDU ROM 102, Kcold Loaded -- 8/3/88.



; From file DJ: L.SYS; QCFASD.LISP#266 at 12-Aug-88 10:32:35
#8R COMPILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: SYS; QCFASD  "

(defun fasd-k-compiled-function (function &optional (function-type 'function))
  ;; On the Lambda, of course, FUNCTION can never be anything but a symbol
  ;; or an NCOMPILED-FUNCTION. On the K, however, we'd like FASD-CONSTANT to dump
  ;; them, so we could make NC::GET-NCOMPILED-FUNCTION construnct an NCOMPILED-FUNCTION
  ;; from the actual function. This *IS* possible, I *THINK*. --RWK
  (let* ((fcn (nc::get-ncompiled-function function))
	 (fcn-name (nc::ncompiled-function-name fcn)))
    (fasd-k-function-info
      fcn-name
      (nc::ncompiled-function-local-refs fcn)
      (nc::ncompiled-function-refs fcn)
      (nc::ncompiled-function-immediates fcn)
      (nc::ncompiled-function-entry-points fcn)
      (nc::ncompiled-function-code fcn)
      (nc::ncompiled-function-load-time-evals fcn))
    ;; Now that we have the function put together, put it into the FASD table.
    (let ((fcn-index (fasd-table-add function)))
      (ecase function-type
	((function))
	((macro)
	 ;; It's a macro; macroify the cell before storing.
	 (FASD-START-GROUP T 1 FASL-OP-LIST)
	 (FASD-NIBBLE 2)
	 (FASD-CONSTANT 'MACRO)
	 (FASD-START-GROUP NIL 1 FASL-OP-INDEX)
	 (FASD-NIBBLE fcn-index)
	 ;; OK, now arrange to store THIS entry in the function cell,
	 ;; instead of the function itself.
	 (SETQ fcn-index (FASD-TABLE-ADD `(macro ,function)))))
       (if (null fcn-name)
	   (fasd-constant nil)			;Placeholder
      ;; Store the function we allocated a fasl-table entry for
      ;; earlier, into its proper home.
	 (FASD-STORE-FUNCTION-CELL FCN-NAME fcn-index)))))

))