;;; -*- Mode: Common-Lisp; Package: Compiler2; Base: 10.; Cold-Load: T -*-

;;;                           RESTRICTED RIGHTS LEGEND
;;;
;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151
;;;
;;; Copyright (C) 1986-1989 Texas Instruments Incorporated. All rights reserved.

;;;;   *-----------------------------------------------------------*
;;;;   |           --  TI Explorer Lisp Compiler  --               |
;;;;   |  This file is compiled and included in a cold band        |
;;;;   |  to define certain symbol values and properties that are  |
;;;;   |  needed by the disassembler and that originally came from |
;;;;   |  the DEFOP or DEFOP-AUX file.				   |
;;;;   *-----------------------------------------------------------*

;;;  4/2/86 - Original.
;;;  4/4/86 - Add handling for NO-REG and DEST properties.
;;;  4/5/86 - Add values for register names.
;;; 6/25/86 - Dummy definition for MODULE-OP-NAME-ARRAY so not unbound.
;;; 7/14/86 - Initialize MODULE-OP-NAME-ARRAY to array of NILs instead of NIL so
;;;		that DEF-MODULE still works.
;;;11/11/86 - Change GLOBAL:COMPILE to LISP:COMPILE; include the module op table.
;;; 04/12/89 jlm Changed (putprop ... usage to (setf (get ...

#+Elroy
(progn

;;;    Tables of instruction names

(set 'INSTRUCTION-DECODE-ARRAY '#.(INSTRUCTION-DECODE-TABLE))

(set 'MISC-OP-NAME-ARRAY '#.(MISC-OP-NAME-TABLE))

(set 'AUX-OP-NAME-ARRAY '#.(AUX-OP-NAME-TABLE))

(set 'MODULE-OP-NAME-ARRAY '#.(MODULE-OP-NAME-TABLE))

;;;   Main-op instruction classes

(eval-when ( lisp:compile )
(defmacro set-disassembler-symbol-properties ()
  (let (( table (INSTRUCTION-DECODE-TABLE) )
	( forms nil )
	( last-name nil ))
    (dotimes ( i (length table) )
      (let (( name (aref table i) ))
	(unless (or (null name)
		    (eq name last-name))
	  (let (( no-reg (get-for-target name 'NO-REG) )
		( dest (get-for-target name 'DEST) ))
	    (unless (null no-reg)
	      (push
		;;`(putprop ',name ',no-reg 'no-reg)	; jlm 4/12/89
		`(setf (get ',name 'no-reg) ',no-reg)
		    forms) )
	    (when (and dest
		       (or no-reg
			   (eq dest 'D-STORE)))
	      (push
		;;`(putprop ',name ',dest 'dest)	; jlm 4/12/89
		`(setf (get ',name 'dest) ',dest)
		    forms) )
	    )
	  (setq last-name name) )))
    `(progn . ,forms) ))
)

(set-disassembler-symbol-properties)


;;;   Names for register field values

(defprop FEF		#.(LAP-VALUE 'FEF)	QLVAL)
(defprop LOCBLOCK	#.(LAP-VALUE 'LOCBLOCK)	QLVAL)
(defprop ARG		#.(LAP-VALUE 'ARG)	QLVAL)
(defprop SELF-UNMAPPED	#.(LAP-VALUE 'SELF-UNMAPPED) QLVAL)
(defprop SELF-MAP	#.(LAP-VALUE 'SELF-MAP)	QLVAL)
(defprop PDL-POP	#.(LAP-VALUE 'PDL-POP)	QLVAL)
(defprop PDL-PUSH	#.(LAP-VALUE 'PDL-PUSH)	QLVAL)

)