;;;QFASL FILE DISASSEMBLER  -*-LISP-*-
;	** (c) Copyright 1980 Massachusetts Institute of Technology **
 ;FOR BEST RESULTS, RUN THIS INSIDE A CC

(DECLARE (FIXNUM (LOGLDB-FROM-FIXNUM FIXNUM FIXNUM)
		 (LOGDPB-INTO-FIXNUM FIXNUM FIXNUM FIXNUM)))

(DECLARE (FIXNUM (UNFASL-NEXT-NIBBLE)
		 (UNFASL-NIBBLE)
		 (ENTER-UNFASL-TABLE NOTYPE)))

;SYMBOLS FROM QCOM

(DECLARE (SPECIAL %%ARRAY-TYPE-FIELD %%ARRAY-LEADER-BIT %%ARRAY-DISPLACED-BIT
		  %%ARRAY-FLAG-BIT %%ARRAY-NUMBER-DIMENSIONS %%ARRAY-LONG-LENGTH-FLAG
		  %%ARRAY-INDEX-LENGTH-IF-SHORT ARRAY-TYPES ARRAY-ELEMENTS-PER-Q
		  DTP-TRAP DTP-NULL DTP-FREE 
		  DTP-SYMBOL DTP-FIX DTP-EXTENDED-NUMBER 
		  DTP-GC-FORWARD DTP-EXTERNAL-VALUE-CELL-POINTER DTP-ONE-Q-FORWARD DTP-FORWARD 
		  DTP-LOCATIVE  
		  DTP-LIST  
		  DTP-U-ENTRY  
		  DTP-FEF-POINTER DTP-ARRAY-POINTER DTP-ARRAY-HEADER 
		  DTP-STACK-GROUP DTP-CLOSURE
		  CDR-NIL CDR-NEXT AREA-LIST
))

;FASLOAD TYPE SYMBOLS FROM QCOM OR QDEFS OR SOMEPLACE.

(DECLARE (SPECIAL LENGTH-OF-FASL-TABLE FASL-TABLE-WORKING-OFFSET FASL-OPS
		  FASL-SYMBOL-HEAD-AREA FASL-SYMBOL-STRING-AREA
		  FASL-OBARRAY-POINTER FASL-ARRAY-AREA FASL-FRAME-AREA
		  FASL-LIST-AREA FASL-TEMP-LIST-AREA 
		  FASL-MICRO-CODE-EXIT-AREA FASL-RETURN-FLAG
		  FASL-GROUP-FLAG FASL-GROUP-BITS FASL-GROUP-TYPE FASL-GROUP-LENGTH
		  %FASL-GROUP-CHECK %FASL-GROUP-FLAG %%FASL-GROUP-LENGTH
		  %FASL-GROUP-TYPE LENGTH-OF-ATOM-HEAD
		  %ARRAY-LEADER-LENGTH %%ARRAY-INDEX-LENGTH-IF-SHORT
))

(SETQ LENGTH-OF-FASL-TABLE 4000)	;SUITABLY BIG SO NO LOSSAGES

;FIXNUM BOOLEAN FUNCTIONS

(DEFUN LOGAND MACRO (X)
  (CONS 'BOOLE (CONS 1 (CDR X))))

(DEFUN LOGIOR MACRO (X)
  (CONS 'BOOLE (CONS 7 (CDR X))))

(DEFUN LOGXOR MACRO (X)
  (CONS 'BOOLE (CONS 6 (CDR X))))

;FIXNUM LOGLDB WITH CONSTANT 1ST ARG, IN-LINE
(DEFUN LOGLDB* MACRO (X)
  ((LAMBDA (P S W)
    (LIST 'BOOLE 1 (1- (LSH 1 S))
	(LIST 'LSH W (- P))))
   (LSH (CADR X) -6)
   (BOOLE 1 (CADR X) 77)
   (CADDR X)))

;FIXNUM LOGDPB WITH CONSTANT 2ND ARG, IN-LINE
(DEFUN LOGDPB* MACRO (X)
  ((LAMBDA (P S D W)
    ((LAMBDA (M)
	(LIST 'BOOLE 7 (LIST 'BOOLE 1 (BOOLE 6 -1 (LSH M P)) W)
		       (LIST 'LSH (LIST 'BOOLE 1 M D) P)))
     (1- (LSH 1 S))))
   (LSH (CADDR X) -6)
   (BOOLE 1 (CADDR X) 77)
   (CADR X)
   (CADDDR X)))

;IN THIS FILE, ONLY FIXNUM VERSIONS OF LOGLDB, LOGDPB USED.
(DEFUN LOGLDB MACRO (X)
  (RPLACA X 'LOGLDB-FROM-FIXNUM))

;(DEFUN LOGDPB MACRO (X)	;NOT TRUE ANYMORE.  MOST ARE LOGDPB* S ANYWAY
;  (RPLACA X 'LOGDPB-INTO-FIXNUM))

(DEFPROP LOGLDB-FROM-FIXNUM (UTIL1 FASL DSK LISPM) AUTOLOAD)

(DECLARE (SPECIAL FASL-TABLE FASL-TABLE-FILL-POINTER
		  UNFASL-INDENTATION
		  UNFASL-GROUP-DISPATCH UNFASL-GROUP-DISPATCH-FAST UNFASL-GROUP-DISPATCH-SIZE))

(DECLARE (SPECIAL UNFASL-FILE UNFASL-WORD)) 
(MAKUNBOUND 'UNFASL-GROUP-DISPATCH) ;SO DON'T GET SCREWED IF RELOAD IT

(DEFUN UNFASL FEXPR (FILESPEC)	;USER CALLS THIS
       (OR (BOUNDP 'UNFASL-GROUP-DISPATCH) (INITIALIZE-UNFASL-ENVIRONMENT))
       (SETQ FILESPEC (MERGEF FILESPEC '|DSK:LISPM;* QFASL|))
       (SETQ UNFASL-WORD NIL)
       (SETQ UNFASL-FILE (OPEN FILESPEC '(IN BLOCK FIXNUM)))
       (OR (AND (= (UNFASL-NIBBLE) 143150)		;CHECK MAGIC ID
		(= (UNFASL-NIBBLE) 71660))
	   (ERROR '|NOT A QFASL FILE| UNFASL-FILE))
       (DO ((^R T)
	    (OUTFILES (LIST (OPEN (MERGEF '|* UNFASL| FILESPEC) '(OUT BLOCK)))))
	   ()
	 (UNFASL-TOP-LEVEL)
	 (CLOSE (CAR OUTFILES)))
       (CLOSE UNFASL-FILE))

(DEFUN UNFASL-NIBBLE ()
  (COND ((NULL UNFASL-WORD)
	 ((LAMBDA (TEM)
	      (DECLARE (FIXNUM TEM))
	      (SETQ UNFASL-WORD (LOGLDB-FROM-FIXNUM 0420 TEM))
	      (LOGLDB-FROM-FIXNUM 2420 TEM))
	  (IN UNFASL-FILE)))
	(T (PROG2 NIL UNFASL-WORD (SETQ UNFASL-WORD NIL)))))

(DEFUN AR-1 MACRO (X)	;JUST TO SAVE TYPING (ONLY USED FOR FASL-TABLE)
  (LIST 'ARRAYCALL T (CADR X) (CADDR X)))

(DEFUN AS-1 MACRO (X)	;JUST TO SAVE TYPING
  (LIST 'STORE (LIST 'ARRAYCALL T (CADDR X) (CADDDR X)) (CADR X)))

(DEFUN UNFASL-TOP-LEVEL NIL 
  (PROG NIL 
   L	(COND ((EQ (UNFASL-WHACK) 'EOF) (RETURN T)))
	(GO L)))

(DEFUN UNFASL-WHACK NIL 
  (PROG (FASL-TABLE FASL-RETURN-FLAG UNFASL-INDENTATION)
	(SETQ UNFASL-INDENTATION 0)
;	(SETQ FASL-TABLE (MAKE-ARRAY 'FASL-TABLE-AREA 
;					   'ART-Q-LIST 
;					   (LIST LENGTH-OF-FASL-TABLE)
;					   NIL 
;					   (LIST FASL-TABLE-WORKING-OFFSET)))
;							;LEADER FOR FILLING
	(SETQ FASL-TABLE (*ARRAY NIL T LENGTH-OF-FASL-TABLE))
		;CONTENTS IS A NUMBER WHICH IS A LISP MACHINE Q.
	(SETQ FASL-TABLE-FILL-POINTER FASL-TABLE-WORKING-OFFSET)
	(INITIALIZE-UNFASL-TABLE)
;	(FASL-SET-MESA-EXIT-BASE)
  L	(UNFASL-GROUP)
	(COND (FASL-RETURN-FLAG 
;		(ADJUST-ARRAY-SIZE FASL-TABLE 0)
		(*REARRAY FASL-TABLE)
		(RETURN FASL-RETURN-FLAG)))
	(GO L)
))

(DEFUN INITIALIZE-UNFASL-TABLE NIL 
	(AS-1 'NR-SYM FASL-TABLE FASL-SYMBOL-HEAD-AREA)
	(AS-1 'P-N-STRING FASL-TABLE FASL-SYMBOL-STRING-AREA)
;	(AS-1 OBARRAY FASL-TABLE FASL-OBARRAY-POINTER)
	(AS-1 'USER-ARRAY-AREA FASL-TABLE FASL-ARRAY-AREA)
	(AS-1 'MACRO-COMPILED-PROGRAM FASL-TABLE FASL-FRAME-AREA)
	(AS-1 'USER-INITIAL-LIST-AREA FASL-TABLE FASL-LIST-AREA)
	(AS-1 'FASL-TEMP-AREA FASL-TABLE FASL-TEMP-LIST-AREA)
	(AS-1 'MICRO-CODE-EXIT-AREA FASL-TABLE FASL-MICRO-CODE-EXIT-AREA)
)

(DEFUN UNFASL-GROUP NIL 
  (PROG (FASL-GROUP-FLAG FASL-GROUP-BITS FASL-GROUP-TYPE FASL-GROUP-LENGTH)
	(SETQ FASL-GROUP-BITS (UNFASL-NIBBLE))
	(COND ((= 0 (LOGAND FASL-GROUP-BITS %FASL-GROUP-CHECK))
		(PRINT 'FASL-GROUP-NIBBLE-WITHOUT-CHECK-BIT) (PRINT FASL-GROUP-BITS)))
	(SETQ FASL-GROUP-FLAG (NOT (= 0 (LOGAND FASL-GROUP-BITS 
						  %FASL-GROUP-FLAG))))
	(SETQ FASL-GROUP-LENGTH (LOGLDB %%FASL-GROUP-LENGTH FASL-GROUP-BITS))
	(AND (= FASL-GROUP-LENGTH 377)
	     (SETQ FASL-GROUP-LENGTH (UNFASL-NIBBLE)))
	(SETQ FASL-GROUP-TYPE (LOGAND FASL-GROUP-BITS %FASL-GROUP-TYPE))
	(OR (< FASL-GROUP-TYPE UNFASL-GROUP-DISPATCH-SIZE)
	    (ERROR '|ERRONEOUS FASL GROUP TYPE| FASL-GROUP-TYPE 'FAIL-ACT))
	(UNFASL-TERPRI)
	(PRIN1 (NTH FASL-GROUP-TYPE FASL-OPS))
	(RETURN
	 (PROG2 NIL 
	  (COND	(NOUUO
		 (FUNCALL (ARRAYCALL T UNFASL-GROUP-DISPATCH FASL-GROUP-TYPE)))
		(T
		 (SUBRCALL NIL (ARRAYCALL T UNFASL-GROUP-DISPATCH-FAST FASL-GROUP-TYPE))))
	  (COND ((NOT (ZEROP FASL-GROUP-LENGTH))
		 (TERPRI) (PRINC '|FASL-GROUP-COUNT wrong; |)
		 (PRIN1 FASL-GROUP-LENGTH) (PRINC '| nibbles left over|)
		 (TERPRI)))
	  ))))

(DEFUN UNFASL-TERPRI NIL 
  (TERPRI)
  (DO I UNFASL-INDENTATION (1- I) (NOT (> I 0))
    (TYO 40)))

(DEFUN UNFASL-NEXT-NIBBLE NIL 
	(COND ((= 0 FASL-GROUP-LENGTH) (ERROR 'FASL-GROUP-OVERFLOW NIL 'FAIL-ACT))
	      (T (SETQ FASL-GROUP-LENGTH (1- FASL-GROUP-LENGTH))
		 (UNFASL-NIBBLE))))

(DEFUN UNFASL-NEXT-NIBBLE-PR NIL
  ((LAMBDA (NIBBLE)
     (PRINC '| [|)
     (PRIN1 NIBBLE)
     (PRINC '|]|)
     NIBBLE)
   (UNFASL-NEXT-NIBBLE)))

(DEFUN UNFASL-NEXT-VALUE NIL 
  ((LAMBDA (UNFASL-INDENTATION)
	(AR-1 FASL-TABLE (UNFASL-GROUP)))
   (+ 3 UNFASL-INDENTATION)))

(DEFUN ENTER-UNFASL-TABLE (V)
  (COND ((NOT (< FASL-TABLE-FILL-POINTER LENGTH-OF-FASL-TABLE))
	 (ERROR '|FASL TABLE OVERFLOW| V 'FAIL-ACT))
	(T
	 (AS-1 V FASL-TABLE FASL-TABLE-FILL-POINTER)
	 (PRINC '|  --> |) (PRIN1 FASL-TABLE-FILL-POINTER)
	 (PROG2 NIL FASL-TABLE-FILL-POINTER
		    (SETQ FASL-TABLE-FILL-POINTER (1+ FASL-TABLE-FILL-POINTER))))))

;--FASL OPS

(DEFUN UNFASL-OP-ERR NIL
  (PRINC '| NOT HANDLED|)
  (COND ((NOT (ZEROP FASL-GROUP-LENGTH))
	 (PRINC '| - FOLLOWING NIBBLES: |)
	 (DO I FASL-GROUP-LENGTH (1- I) (= I 0)
	     (UNFASL-NEXT-NIBBLE-PR)))))

(DEFUN UNFASL-OP-INDEX NIL
  (PROG (TEM)
    (SETQ TEM (UNFASL-NEXT-NIBBLE-PR))
    (TYO 40)
    (TYO 173)
    (PRINC (AR-1 FASL-TABLE TEM))
    (TYO 175)
    (RETURN TEM)))

(DEFUN UNFASL-OP-NOOP NIL
  T)

(DEFUN UNFASL-OP-STRING NIL
  (UNFASL-OP-SYMBOL1 T))

(DEFUN UNFASL-OP-SYMBOL NIL 
  (AND FASL-GROUP-FLAG (PRINC '| UNINTERNED|))
  (UNFASL-OP-SYMBOL1 NIL))

(DEFUN UNFASL-OP-SYMBOL1 (STRING-FLAG)
  (PROG (TEM LST)
	(AND STRING-FLAG (SETQ LST (LIST 42)))
   LP	(COND ((= 0 FASL-GROUP-LENGTH) (GO X)))
	(SETQ TEM (UNFASL-NEXT-NIBBLE))
	;; TEM contains two 8-bit Lisp Machine characters.  200 is a null character.
	(SETQ LST (CONS (LOGAND TEM 177) LST))
	(COND ((= (SETQ TEM (LSH TEM -8)) 200)
		(GO X)))
	(SETQ LST (CONS (LOGAND TEM 177) LST))
	(GO LP)
   X	(TYO 40)
	(AND STRING-FLAG
	     (SETQ LST (CONS 42 LST)))
	(MAPC (FUNCTION TYO)
	      (SETQ LST (NREVERSE LST)))
        (RETURN (ENTER-UNFASL-TABLE (MAKNAM LST)))))

(DEFUN UNFASL-OP-PACKAGE-SYMBOL ()
  (PROG (LEN LST)
	(SETQ LEN (1- (UNFASL-NEXT-NIBBLE)))
	(DO I 0 (1+ I) (NOT (< I LEN))
	  (SETQ LST (CONS (UNFASL-NEXT-VALUE) LST))	;Will print out with double quotes,
	  (TYO 72)					;  too bad.
	  )						;72 is a colon.
	(RETURN
	 (ENTER-UNFASL-TABLE				;Is this reasonable?
	  (CONS '**PACKAGE**
	        (NREVERSE (CONS (UNFASL-NEXT-VALUE) LST)))))))
		
(DEFUN UNFASL-OP-LIST NIL
  (UNFASL-OP-LIST1 (AR-1 FASL-TABLE FASL-LIST-AREA)))

(DEFUN UNFASL-OP-LIST1 (AREA)
  (DECLARE (FIXNUM LIST-LENGTH))
  (PROG (LIST-LENGTH)
	(SETQ LIST-LENGTH (UNFASL-NEXT-NIBBLE-PR))
	(PRINC '| AREA=|)
	(PRIN1 AREA)
	(AND FASL-GROUP-FLAG (PRINC '| (DOTIFY)|))
  L	(COND ((= 0 LIST-LENGTH)
		(GO X)))
        (UNFASL-NEXT-VALUE)
	(SETQ LIST-LENGTH (1- LIST-LENGTH))
	(GO L)
  X	(RETURN (ENTER-UNFASL-TABLE 'LIST))
))

(DEFUN UNFASL-OP-TEMP-LIST NIL 
  (UNFASL-OP-LIST1 (AR-1 FASL-TABLE FASL-TEMP-LIST-AREA)))

;(DEFUN UNFASL-OP-FIXED NIL 
;  (PROG (ANS)
;	(DECLARE (FIXNUM ANS))
;	(SETQ ANS 0)
;  L	(COND ((= 0 FASL-GROUP-LENGTH)
;		(GO X)))
;	(SETQ ANS (+ (LSH ANS 20) (UNFASL-NEXT-NIBBLE)))
;	(GO L)
;  X	(COND (FASL-GROUP-FLAG (SETQ ANS (MINUS ANS))))
;        (TYO 40)
;	(PRIN1 ANS)
;	(RETURN (ENTER-UNFASL-TABLE ANS))))

;Generate a FIXNUM (or BIGNUM) value.
(DEFUN UNFASL-OP-FIXED NIL 
  (DO ((POS (* (1- FASL-GROUP-LENGTH) 20) (- POS 20))
       (C FASL-GROUP-LENGTH (1- C))
       (ANS 0))
      ((ZEROP C) (COND (FASL-GROUP-FLAG (SETQ ANS (MINUS ANS))))
		 (TYO 40)
		 (PRIN1 ANS)
		 (ENTER-UNFASL-TABLE ANS))
    (DECLARE (FIXNUM POS C))
    (SETQ ANS (LOGDPB (UNFASL-NEXT-NIBBLE) (+ (LSH POS 6) 20) ANS))))

(DEFUN UNFASL-OP-ARRAY NIL 
 ((LAMBDA (FLAG)
   (UNFASL-NEXT-VALUE)
   (PRINC '| =AREA|)
   (UNFASL-NEXT-VALUE)
   (PRINC '| =TYPE|)
   (UNFASL-NEXT-VALUE)
   (PRINC '| =DIMLIST|)
   (UNFASL-NEXT-VALUE)
   (PRINC '| =DISPLACED-P|)
   (UNFASL-NEXT-VALUE)
   (PRINC '| =LEADER|)
   (UNFASL-NEXT-VALUE)
   (PRINC '| =INDEX-OFFSET|)
   (COND (FLAG
	  (UNFASL-NEXT-VALUE)
	  (PRINC '| =NAMED-STRUCTURE|)))
   (ENTER-UNFASL-TABLE 'ARRAY))
  FASL-GROUP-FLAG))

(DEFUN UNFASL-OP-MOVE NIL 
 (PROG (FROM TO)
	(SETQ FROM (UNFASL-NEXT-NIBBLE-PR))
	(SETQ TO (UNFASL-NEXT-NIBBLE-PR))
	(COND ((= TO 177777) (RETURN (ENTER-UNFASL-TABLE (AR-1 FASL-TABLE FROM))))
	      (T (AS-1 (AR-1 FASL-TABLE FROM) FASL-TABLE TO)
		 (RETURN TO)))))

(DEFUN UNFASL-OP-FRAME NIL 
  (DECLARE (FIXNUM Q-COUNT UNBOXED-COUNT TEM))
  (PROG (Q-COUNT UNBOXED-COUNT TEM)
	(SETQ Q-COUNT (UNFASL-NEXT-NIBBLE))
	(SETQ UNBOXED-COUNT (UNFASL-NEXT-NIBBLE))
	(SETQ FASL-GROUP-LENGTH (UNFASL-NEXT-NIBBLE))
	(PRINC '| Q-COUNT=|) (PRIN1 Q-COUNT)
	(PRINC '| UNBOXED-COUNT=|) (PRIN1 UNBOXED-COUNT)
	(PRINC '| GROUP-LENGTH=|) (PRIN1 FASL-GROUP-LENGTH)
   L1	(COND ((= 0 Q-COUNT) (GO L2)))
	(UNFASL-NEXT-VALUE)
	(SETQ TEM (UNFASL-NEXT-NIBBLE))
	(PRINC '| CDRC=|) (PRIN1 (LSH TEM -6))
	(OR (= 0 (LOGAND 1 (LSH TEM -5))) (PRINC '| FLAGB|))
	(OR (= 0 (LOGAND 20 TEM)) (PRINC '| E-V-C-P|))
	(OR (= 0 (LOGAND 400 TEM)) (PRINC '| LOCATIVE|))
	(OR (= 0 (SETQ TEM (LOGAND TEM 17)))
	    (PROGN (PRINC '| OFFSET=|) (PRIN1 TEM)))
	(SETQ Q-COUNT (1- Q-COUNT))
	(GO L1)
  L2 
  L3	(COND ((= 0 UNBOXED-COUNT) (GO L4)))
        (UNFASL-TERPRI)
	(PRINC '|   UNBOXED |)
	(PRIN1 (LOGIOR (UNFASL-NEXT-NIBBLE) (LSH (UNFASL-NEXT-NIBBLE) 20)))
	(SETQ UNBOXED-COUNT (1- UNBOXED-COUNT))
	(GO L3)
  L4	(RETURN (ENTER-UNFASL-TABLE 'FEF))
))

(DEFUN UNFASL-OP-ARRAY-PUSH NIL 
  (UNFASL-NEXT-VALUE)
  (UNFASL-NEXT-VALUE))

(DEFUN UNFASL-OP-FILE-PROPERTY-LIST ()
  (UNFASL-NEXT-VALUE))

(DEFUN UNFASL-OP-STOREIN-SYMBOL-VALUE NIL 
  (UNFASL-OP-INDEX)
  (UNFASL-NEXT-VALUE))

(DEFUN UNFASL-OP-STOREIN-FUNCTION-CELL NIL 
  (UNFASL-OP-INDEX)
  (UNFASL-NEXT-VALUE))

(DEFUN UNFASL-OP-STOREIN-PROPERTY-CELL NIL 
  (UNFASL-OP-INDEX)
  (UNFASL-NEXT-VALUE))

(DEFUN UNFASL-OP-STOREIN-ARRAY-LEADER NIL
  (PRINC '| ARRAY|) (UNFASL-OP-INDEX) 
  (PRINC '| SUBSCR|) (UNFASL-OP-INDEX)
  (PRINC '| VALUE|) (UNFASL-OP-INDEX))

(DEFUN UNFASL-OP-FETCH-SYMBOL-VALUE NIL 
  (ENTER-UNFASL-TABLE (UNFASL-NEXT-VALUE)))

(DEFUN UNFASL-OP-FETCH-FUNCTION-CELL NIL 
  (ENTER-UNFASL-TABLE (UNFASL-NEXT-VALUE)))

(DEFUN UNFASL-OP-FETCH-PROPERTY-CELL NIL 
  (ENTER-UNFASL-TABLE (UNFASL-NEXT-VALUE)))

(DEFUN UNFASL-OP-END-OF-WHACK NIL 
  (SETQ FASL-RETURN-FLAG 'END-OF-WHACK)
  0)

(DEFUN UNFASL-OP-END-OF-FILE NIL 
  (SETQ FASL-RETURN-FLAG 'EOF)
  0)

(DEFUN UNFASL-OP-SOAK NIL 
  (PROG (COUNT)
	(SETQ COUNT (UNFASL-NEXT-NIBBLE-PR))
 L	(COND ((= 0 COUNT) (RETURN (UNFASL-GROUP))))
	(UNFASL-NEXT-VALUE)
	(SETQ COUNT (1- COUNT))
	(GO L)))

(DEFUN UNFASL-OP-FUNCTION-HEADER NIL		;WHAT?  COPIED DIRECT FROM QFASL, THOUGH
  (PROG (FCTN F-SXH)
	(SETQ FCTN (UNFASL-NEXT-VALUE))
	(SETQ F-SXH (UNFASL-NEXT-VALUE))
	(RETURN 0)))

(DEFUN UNFASL-OP-FUNCTION-END NIL
	0)

(DEFUN UNFASL-OP-SET-PARAMETER NIL 
  (PROG (FROM TO)
	(SETQ TO (UNFASL-NEXT-VALUE)) (PRINC '| =TO|)
	;(SETQ FROM (UNFASL-GROUP)) (PRINC '| =FROM|)
	(SETQ FROM (UNFASL-NEXT-VALUE)) (PRINC '| =FROM|)
	(RETURN 0)))

(DEFUN UNFASL-OP-INITIALIZE-ARRAY NIL
  (PROG (ARRAYP NUM)
	(SETQ ARRAYP (UNFASL-NEXT-VALUE))
	(SETQ NUM (UNFASL-NEXT-VALUE))	;# OF VALS TO INITIALIZE
	(DO IDX 0 (1+ IDX) (= IDX NUM)
	  (UNFASL-NEXT-VALUE))
	(RETURN 0)))

(DEFUN UNFASL-OP-INITIALIZE-NUMERIC-ARRAY NIL
  (PROG (ARRAYP NUM)
	(SETQ ARRAYP (UNFASL-NEXT-VALUE))
	(SETQ NUM (UNFASL-NEXT-VALUE))	;# OF VALS TO INITIALIZE
	(SETQ FASL-GROUP-LENGTH NUM)
	(DO IDX 0 (1+ IDX) (= IDX NUM)
	  (UNFASL-NEXT-NIBBLE))
	(RETURN 0)))

(DEFUN UNFASL-OP-MAKE-MICRO-CODE-ENTRY NIL 
  (PROG NIL 
	(PRINC '| FCTN|) (UNFASL-NEXT-VALUE)
	(PRINC '| ARGDESC|) (UNFASL-NEXT-VALUE)
	(PRINC '| ENTRY-INDEX|) (UNFASL-NEXT-NIBBLE-PR)
	(COND ((NOT FASL-GROUP-FLAG) (PRINC '| -> FUNCTION-CELL|)))
	(RETURN (ENTER-UNFASL-TABLE 0))))

(DEFUN UNFASL-OP-SAVE-ENTRY-POINT NIL 
  (PROG NIL 
	(RETURN (ENTER-UNFASL-TABLE 0))))

;UNFASL-OP-MICRO-CODE-SYMBOL  WINS AS MUCH AS IT CAN ANYWAY

(DEFUN UNFASL-OP-MICRO-TO-MICRO-LINK NIL 
	(UNFASL-NEXT-VALUE)
	0)

(DEFUN UNFASL-OP-QUOTE-POINTER NIL 
	(UNFASL-NEXT-VALUE)
	0)

(DEFUN UNFASL-OP-S-V-CELL NIL 
	(UNFASL-NEXT-VALUE)
	0)

(DEFUN UNFASL-OP-FUNCELL NIL 
	(UNFASL-NEXT-VALUE)
	0)

(DEFUN UNFASL-OP-CONST-PAGE NIL 
	(UNFASL-NEXT-NIBBLE-PR)
	0)


(DEFUN INITIALIZE-UNFASL-ENVIRONMENT NIL
  (COND ((NOT (BOUNDP 'FASL-OPS))
	 (PRINC '|; READING IN QDEFS |)
	 (READFILE '(QDEFS > DSK LISPM))
	 (TERPRI)))
  (SETQ UNFASL-GROUP-DISPATCH-SIZE (LENGTH FASL-OPS))
  (SETQ UNFASL-GROUP-DISPATCH (*ARRAY NIL T UNFASL-GROUP-DISPATCH-SIZE))
  (SETQ UNFASL-GROUP-DISPATCH-FAST (*ARRAY NIL T UNFASL-GROUP-DISPATCH-SIZE))
  ;(FILLARRAY UNFASL-GROUP-DISPATCH FASL-OPS)
  (DO ((I 0 (1+ I))
       (L FASL-OPS (CDR L)))
      ((NULL L))
    (STORE (ARRAYCALL T UNFASL-GROUP-DISPATCH I)
	   (IMPLODE (CONS 'U (CONS 'N (EXPLODE (CAR L)))))))
  (DO ((I 0 (1+ I))
       (TEM))
      ((= I UNFASL-GROUP-DISPATCH-SIZE))
    (COND ((SETQ TEM (GET (ARRAYCALL T UNFASL-GROUP-DISPATCH I) 'SUBR))
	   (STORE (ARRAYCALL T UNFASL-GROUP-DISPATCH-FAST I) TEM))
	  (T
	   (STORE (ARRAYCALL T UNFASL-GROUP-DISPATCH-FAST I) (GET 'UNFASL-OP-ERR 'SUBR))
	   (OR (GET (ARRAYCALL T UNFASL-GROUP-DISPATCH I) 'EXPR)
	       (STORE (ARRAYCALL T UNFASL-GROUP-DISPATCH I) 'UNFASL-OP-ERR)) )))
)