;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 126.126
;;; Reason:
;;;  BYTE-spec-ify QFASL functions.
;;; Written 22-Oct-88 05:20:56 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Johannes Brahms from band 1
;;; with Experimental System 126.123, Experimental ZWEI 126.21, Experimental ZMail 74.9, Experimental Local-File 76.0, Experimental File-Server 25.0, Experimental Lambda-Diag 18.0, Experimental Unix-Interface 15.0, Experimental Tape 26.4, Microcode 1762, SDU Boot Tape 3.14, SDU ROM 103, 10/17.



; From modified file DJ: L.SYS; QFASL.LISP#518 at 22-Oct-88 05:21:04
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QFASL  "


(DEFUN FASL-OP-LARGE-INDEX ()
 (DPB (FASL-NEXT-NIBBLE) (BYTE 8. 16.) (FASL-NEXT-NIBBLE)))

))

; From modified file DJ: L.SYS; QFASL.LISP#518 at 22-Oct-88 05:21:09
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QFASL  "


(DEFUN FASL-OP-FLOAT-SMALL-FLOAT NIL
  (LET ((AS-FIXNUM (%LOGDPB (FASL-NEXT-NIBBLE) (BYTE 8. 16.) (FASL-NEXT-NIBBLE))))
    ;; Change exponent from excess #o100 to excess #o200.
    (SETQ AS-FIXNUM (IF (ZEROP AS-FIXNUM) 0 (%POINTER-PLUS AS-FIXNUM #o40000000)))
    (ENTER-FASL-TABLE (%MAKE-POINTER DTP-SMALL-FLONUM AS-FIXNUM))))

))

; From modified file DJ: L.SYS; QFASL.LISP#518 at 22-Oct-88 05:21:13
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QFASL  "


(DEFUN FASL-OP-FLOAT-FLOAT ()
  (LET ((ANS (FLOAT 0))
	(TEM))
    (%P-DPB-OFFSET (FASL-NEXT-NIBBLE) (BYTE 11. 8.) ANS 0)
    (SETQ TEM (FASL-NEXT-NIBBLE))
    (%P-DPB-OFFSET (LDB (BYTE 8. 8.) TEM) (BYTE 8. 0.) ANS 0)
    (%P-DPB-OFFSET (%LOGDPB TEM (BYTE 8. 16.) (FASL-NEXT-NIBBLE)) (BYTE 24. 0.) ANS 1)
    (ENTER-FASL-TABLE ANS)))

;;; hair squared

))

; From modified file DJ: L.SYS; QFASL.LISP#518 at 22-Oct-88 05:21:24
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QFASL  "

(DEFUN FEF-CONVERT-DESTINATIONS (FEF &AUX ILEN LIM-PC)
  (SETQ LIM-PC (FEF-LIMIT-PC FEF))
  (DO ((PC (FEF-INITIAL-PC FEF) (+ PC ILEN)))
      (( PC LIM-PC))
    (LET* ((INSN (FEF-INSTRUCTION FEF PC))
	   (OP (LDB (BYTE 4. 9.) INSN)))
      (IF (OR (< OP 11) (= OP #o15))
	  (LET ((DEST (LDB (BYTE 3. 13.) INSN)))
	    (IF (< 0 DEST 4)
		(SETF (FEF-INSTRUCTION FEF PC)
		      (DPB (* 2 DEST) (BYTE 3. 13.) INSN))))))
    (SETQ ILEN (FEF-INSTRUCTION-LENGTH FEF PC))))

;;; Used to be called DISASSEMBLE-INSTRUCTION-LENGTH

))

; From modified file DJ: L.SYS; QFASL.LISP#518 at 22-Oct-88 05:21:28
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QFASL  "

(DEFUN FEF-INSTRUCTION-LENGTH (FEF PC)
  "Return the length in halfwords of the instruction at PC in FEF."
  (LET* ((WD (FEF-INSTRUCTION FEF PC))
	 (OP (LDB (BYTE 4. 9.) WD))
	 (DISP (LDB (BYTE 9. 0.) WD)))
    (COND ((AND (= OP #o14) (= DISP #o777)) 2)
	  ((AND (< OP #o14) (= DISP #o776)) 2)
	  (T 1))))

))