;;; -*- Mode:Lisp; Readtable:T; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 126.63
;;; Reason:
;;;  UNFASL-FILE now handles FBIN files !! 
;;;  Please use it.
;;;  Coming soon ... disassembled K code as well.
;;;  --pfc
;;; Written 22-Aug-88 18:04:05 by PFC (Peter F. Cerrato) at site Gigamos Cambridge
;;; while running on Death from band 3
;;; with Experimental System 126.61, ZWEI 125.19, 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/17/88.



; From modified file DJ: L.SYS2; UNFASL.LISP#25 at 22-Aug-88 18:04:06
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; UNFASL  "

(defun unfasl-op-version-info ()
  (let ((machine (unfasl-next-value))
	(version (unfasl-next-value)))
    (enter-unfasl-table ())))

))

; From modified file DJ: L.SYS2; UNFASL.LISP#25 at 22-Aug-88 18:04:21
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; UNFASL  "

(defun unfasl-make-vector (size)
  (make-array size))

(defun unfasl-op-k-compiled-function ()
  (let ((length   (ash fasl-group-length -2))
	(function (nc::make-ncompiled-function)))
    
    (setf (nc:ncompiled-function-code function)
	  (unfasl-k-function-instructions length))
    
    (let ((name         (unfasl-next-value))
	  (local-refs   (unfasl-next-value))
	  (refs         (unfasl-next-value))
	  (entry-points (unfasl-next-value)))
      (setf (nc::ncompiled-function-name         function) name)
      (setf (nc::ncompiled-function-length       function) length)
      (setf (nc::ncompiled-function-local-refs   function) local-refs)
      (setf (nc::ncompiled-function-refs         function) refs)
      (setf (nc::ncompiled-function-entry-points function) entry-points))
    
    (setf (nc:ncompiled-function-immediates function)
	  (unfasl-k-function-immediates))
    (setf (nc:ncompiled-function-load-time-evals function)
	  (unfasl-k-function-load-time-evals))
    
    ;; Now we've got it all hooked up, let's put it into the UNFASL table.
    (enter-unfasl-table function)

    (when *unfasl-print*
      (unfasl-terpri)
      (describe function))

    ;; FASL-OP-STOREIN-FUNCTION-CELL
    (unfasl-group)
    ))


(defun unfasl-read-k-instruction ()
  (let ((1st (unfasl-next-nibble))
	(2nd (unfasl-next-nibble))
	(3rd (unfasl-next-nibble))
	(4th (unfasl-next-nibble)))
    (dpb 4th (byte 16. 48.)
	 (dpb 3rd (byte 16. 32.)
	      (dpb 2nd (byte 16. 16.)
		   (dpb 1st (byte 16. 0.) 0))))))

(defun unfasl-k-function-instructions (length)
  (let ((code '()))
    (dotimes (i length)
      (push (unfasl-read-k-instruction) code))
    (nreverse code)))


(defun unfasl-op-k-local-refs ()
  (let ((locals (unfasl-next-value)))
    (do ((i 0 (+ i 2))
	 (locs (unfasl-make-vector (* 2 locals))))
	((>= i (* 2 locals))
	 (enter-unfasl-table locs))
      (setf (aref locs i) (unfasl-next-value))
      (setf (aref locs (1+ i)) (unfasl-next-value)))))

(defun unfasl-op-k-refs ()
  (let ((k-refs (unfasl-next-value)))
    (do ((i 0 (+ i 3))
	 (refs (unfasl-make-vector (* 3 k-refs))))
	((>= i (* 3 k-refs))
	 (enter-unfasl-table refs))
      (setf (aref refs i) (unfasl-next-value))
      (setf (aref refs (1+ i)) (unfasl-next-value))
      (setf (aref refs (+ 2 i)) (unfasl-next-value)))))

(defun unfasl-op-k-entry-points ()
  (let ((entries (unfasl-next-value)))
    (do ((i 0 (+ i 2))
	 (ents (unfasl-make-vector (* 2 entries))))
	((>= i (* 2 entries))
	 (enter-unfasl-table ents))
      (setf (aref ents i) (unfasl-next-value))
      (setf (aref ents (1+ i)) (unfasl-next-value)))))

(defun unfasl-k-function-immediates ()
  (let ((immeds (unfasl-next-value)))
    (do ((i 0 (+ i 2))
	 (imms (unfasl-make-vector (* 2 immeds))))
	((>= i (* 2 immeds))
	 imms)
      (setf (aref imms i) (unfasl-next-value))
      (setf (aref imms (1+ i)) (unfasl-next-value)))))

(defun unfasl-k-function-load-time-evals ()
  (let ((number-of-evals (unfasl-next-value)))
    (do ((i 0 (+ i 2))
	 (evals (unfasl-make-vector (* 2 number-of-evals))))
	((>= i (* 2 number-of-evals))
	 evals)
      (setf (aref evals i) (unfasl-next-value))
      (setf (aref evals (1+ i)) (unfasl-next-value)))))


(INITIALIZE-UNFASL-ENVIRONMENT)
))