[LispM-Hackers] Re: Microcode ...
Andreas Eder
Andreas.Eder@t-online.de
Sat Apr 20 05:44:00 2002
--c3a2QGSSr/
Content-Type: text/plain; charset=us-ascii
Content-Description: message body text
Content-Transfer-Encoding: 7bit
Ok, here is the code. But remember it is just a quick hack. So it
isn#t as polished as it should be - but then it works, and that is
what i wanted.
--c3a2QGSSr/
Content-Type: text/plain; charset=us-ascii
Content-Description: mcr dumper
Content-Disposition: inline;
filename="band-tools.lisp"
Content-Transfer-Encoding: 7bit
;;; just a few tools to inspect a band
(defvar *the-band* nil "holds the contents of the load-band")
(defvar *the-mcr* nil "holds the contents of the micro-load-band")
(defvar *cdr-code-names*
#("<CDR-NORMAL>" "<CDR-ERROR>" "<CDR-NIL>" "<CDR-NEXT>"))
(defvar *dtp-names*
#("<DTP-Trap>" ;0
;; user visible types
"<DTP-List>" ;1
"<Dtp-Stack-List>" ;2
"<DTP-Symbol>" ;3
"<DTP-Array>" ;4
"<DTP-Fix>" ;5
"<DTP-Character>" ;6
"<DTP-Single-Float>" ;7
"<DTP-Short-Float>" ;8
"<DTP-Instance>" ;9
"<DTP-Extended-Number>" ;10
"<DTP-Locative>" ;11
"<DTP-Function>" ;12
"<DTP-Closure>" ;13
"<DTP-Lexical-Closure>" ;14
"<DTP-U-Entry>" ;15
"<DTP-STACK-GROUP>" ;16
;; forwards
"<DTP-GC-Forward>" ;17
"<DTP-External-Value-Cell-Pointer>" ;18
"<DTP-One-Q-Forward>" ;19
"<DTP-Header-Forward>" ;20
"<DTP-Body-Forward>" ;21
;; headers
"<DTP-Symbol-Header>" ;22
"<DTP-Header>" ;23
"<DTP-Array-Header>" ;24
"<DTP-Instance-Header>" ;25
"<DTP-FEF-Header>" ;26
;; special purpose
"<DTP-Self-Ref-Pointer>" ;27
"<DTP-GC-YOUNG-POINTER>" ;28
;; errors
"<DTP-Free>" ;29
"<DTP-Null>" ;30
"<DTP-ONES-TRAP>" ;31
))
;;; accessors to the three fields of a storage cell (a Q)
;;;
;;; 31 30 29 25 24 0
;;; +--------------------------------------------------+
;;; | CC | DTP | POINTER |
;;; +--------------------------------------------------+
;;;
;;; POINTER <0:24> = Pointer field. Contains immediate
;;; data or pointer to actual storage.
;;; DTP <25:29> = Data Type field.
;;; CC <30:31> = Cdr Code field.
(defconstant %%q-cdr-code (byte 2 29))
(defconstant %%q-data-type (byte 5 25))
(defconstant %%q-pointer (byte 25 0))
(defun dump-typed-q (q &key (base 8))
(format t "~&<~A ~A ~VR>"
(aref *cdr-code-names* (ldb %%q-cdr-code q))
(aref *dtp-names* (ldb %%q-data-type q))
base
(ldb %%q-pointer q)))
(defun cdr-code (word)
(ldb %%q-cdr-code word))
(defun data-type (word)
(ldb %%q-data-type word))
(defun pointer-field (word)
(ldb %%q-pointer word))
(defun read-band (bandname)
"read in the load-band"
(with-open-file (in bandname :direction :input
:if-does-not-exist :error
:element-type '(unsigned-byte 32))
(let ((buf (make-array (file-length in)
:element-type '(unsigned-byte 32))))
(read-sequence buf in)
(setq *the-band* buf))))
(defun dump-band (address &key (length 16) (base 8))
"dump out contents of the band starting at given address"
(dotimes (i length)
(let* ((addr (+ address i))
(q (aref *the-band* addr)))
(format t "~&~VR : <~A ~A ~VR>"
base addr
(aref *cdr-code-names* (ldb %%q-cdr-code q))
(aref *dtp-names* (ldb %%q-data-type q))
base (ldb %%q-pointer q)))))
(defun read-mcr (mcrname)
"read in the microcode-band"
(with-open-file (in mcrname :direction :input
:if-does-not-exist :error
:element-type '(unsigned-byte 32))
(let ((buf (make-array (file-length in)
:element-type '(unsigned-byte 32))))
(read-sequence buf in)
(setq *the-mcr* buf))))
(defun dump-mcr ()
"dump out contents of the microcode-band"
(do ((address 0 (dump-section address))) ;; each dump-section returns
((eql -1 address)))) ;; the next start-address
(defun dump-section (addr)
(ecase (aref *the-mcr* addr) ;; switch on section ID number
(#x0 (dump-partition-header (1+ addr)))
(#x1 (dump-instruction-memory (1+ addr)))
(#x2 (dump-dispatch-section (1+ addr)))
(#x3 (dump-A&M-section (1+ addr)))
(#x4 (dump-tag-section (1+ addr)))
(#x5 (dump-I/O-space-initialization (1+ addr)))
(#x6 (dump-I/O-space-data (1+ addr)))
(#x7 (dump-main-memory-section (1+ addr)))
(#xA (dump-aux-data-section (1+ addr)))
(#xE0F (dump-entry-data-section (1+ addr)))
))
(defun dump-partition-header (addr)
(progn
(format t "~%~% Microcode Partition Header")
(format t "~& Processor ID ~D"
(ldb (byte 16 0) (aref *the-mcr* addr)))
(incf addr)
(format t "~& Version Number ~D" (aref *the-mcr* addr))
(incf addr)
(format t "~& Active Length #x~X ('ffffffff' means no checksum)"
(aref *the-mcr* addr))
(incf addr)
(format t "~& Checksum ~X" (aref *the-mcr* addr))
(incf addr)))
(defun dump-instruction-memory (addr)
(progn
(format t "~%~% Instruction Memory Section")
(let ((wcs (aref *the-mcr* addr))
(n (aref *the-mcr* (1+ addr))))
(format t "~& WCS Address #x~X" wcs)
(format t "~& Number of words ~D" n)
(incf addr 2)
(dotimes (i n)
(format t "~& #x~4,'0X : #x~16,'0,X"
(+ wcs i)
(+ (ash (aref *the-mcr* (1+ addr)) 32)
(aref *the-mcr* addr)))
(incf addr 2)))
addr))
(defun dump-dispatch-section (addr)
(progn
(format t "~%~% Dispatch Section")
(let ((dispa (aref *the-mcr* addr))
(n (aref *the-mcr* (1+ addr))))
(format t "~& Dispatch Address #o~O" dispa)
(format t "~& Number of words ~D" n)
(incf addr 2)
(dotimes (i n)
(format t "~& #o~O : #o~6,'0,O" (+ dispa i)
(ldb (byte 18 0) (aref *the-mcr* addr)))
(incf addr)))
addr))
(defun dump-A&M-section (addr)
(progn
(format t "~%~% A&M Memory Section")
(let ((mema (aref *the-mcr* addr))
(n (aref *the-mcr* (1+ addr))))
(format t "~& A&M Address #x~X" mema)
(format t "~& Number of words ~D" n)
(incf addr 2)
(dotimes (i n)
(format t "~& #x~3,'0X : #x~8,'0,X"
(+ mema i) (aref *the-mcr* addr))
(incf addr)))
addr))
(defun dump-tag-section (addr)
(progn
(format t "~%~% Tag Classifier Section")
(let ((start (aref *the-mcr* addr))
(n (aref *the-mcr* (1+ addr))))
(format t "~& Startin Tag Class #x~X" start)
(format t "~& Number of Classes ~D" n)
(incf addr 2)
(dotimes (i n)
(let ((q0 (ldb (byte 16 16) (aref *the-mcr* addr)))
(q1 (ldb (byte 16 16) (aref *the-mcr* (1+ addr))))
(q2 (ldb (byte 16 16) (aref *the-mcr* (+ addr 2))))
(q3 (ldb (byte 16 16) (aref *the-mcr* (+ addr 3)))))
(format t "~& #x~X : #x~16,'0,X"
(+ start i)
(+ (ash q3 48) (ash q2 32) (ash q1 16) q0)))
(incf addr 4)))
addr))
(defun dump-I/O-space-initialization (addr)
(progn
(format t "~%~% I/O Space Initialization Section")
(format t "~& Starting Address #x~8,'0X" (aref *the-mcr* addr))
(incf addr)
(format t "~& Number of Words #x~4,'0X" (aref *the-mcr* addr))
(incf addr)
(format t "~& Initial Data #x~8,'0X" (aref *the-mcr* addr))
(incf addr)
(format t "~& Insert Memory Offset: enable insertion ~D rotation length #x~X rotation count #x~X"
(ldb (byte 1 31) (aref *the-mcr* addr))
(ldb (byte 5 5) (aref *the-mcr* addr))
(ldb (byte 4 0) (aref *the-mcr* addr)))
(incf addr)
(format t "~& Data Increment #x~8,'0X" (aref *the-mcr* addr))
(incf addr)
(format t "~& Address Increment #x~8,'0X" (aref *the-mcr* addr))
(incf addr)))
(defun dump-I/O-space-data (addr)
(progn
(format t "~%~% I/O Space Data Section")
(let ((start (aref *the-mcr* addr))
(n (aref *the-mcr* (1+ addr)))
(incr (aref *the-mcr* (+ 2 addr))))
(format t "~& Starting Address #x~X" start)
(format t "~& Number of words ~D" n)
(format t "~& Address Increment #x~X" incr)
(incf addr 3)
(dotimes (i n)
(format t "~& #x~8,'0X : #x~8,'0,X"
(+ start i) (aref *the-mcr* addr))
(incf addr)))
addr))
(defun dump-main-memory-section (addr)
(progn
(format t "~%~% Main Memory Data Section")
(let ((start (aref *the-mcr* addr))
(n (aref *the-mcr* (1+ addr))))
(format t "~& Destination Address #x~X" start)
(format t "~& Number of words ~D" n)
(incf addr 2)
(dotimes (i n)
(format t "~& #x~8,'0X : #x~8,'0,X"
(+ start i) (aref *the-mcr* addr))
(incf addr)))
addr))
(defun dump-aux-data-section (addr)
(progn
(format t "~%~% Auxiliary Data Section")
(let ((sub-id (aref *the-mcr* addr))
(n (aref *the-mcr* (1+ addr))))
(format t "~& Sub ID #x~X" sub-id)
(format t "~& Number of words ~D" n)
(incf addr 2)
(dotimes (i n)
(format t "~& #x~8,'0X : #x~8,'0,X" i (aref *the-mcr* addr))
(incf addr)))
addr))
(defun dump-entry-data-section (addr)
(progn
(format t "~%~% Entry Data Section")
(format t "~& Micro PC #x~8,'0,X" (aref *the-mcr* addr))
(format t "~& MCR #x~8,'0,X" (aref *the-mcr* (1+ addr)))
-1)) ; the end
--c3a2QGSSr/
Content-Type: text/plain; charset=iso-8859-1
Content-Description: message body text
Content-Transfer-Encoding: quoted-printable
'Andreas
--=20
Wherever I lay my .emacs, there=B4s my $HOME.
--c3a2QGSSr/--