;;;-*- Mode:LISP; Package:K2; Base:10; Readtable:CL; -*-

;(export '(
;	  kbug-base-addr

;	  kbug-command-addr
;	  kbug-status-addr
;	  kbug-parameter-addr
;	  kbug-internal-storage-addr
;	  kbug-pc-addr
;	  kbug-flag-addr
;	  kbug-left-addr
;	  kbug-right-addr
;	  kbug-alu-status-addr
;	  kbug-left-boxed-addr
;	  kbug-right-boxed-addr
;	  kbug-vma-addr
;	  kbug-md-addr
;	  kbug-vma-boxed-addr
;	  kbug-md-boxed-addr
;	  kbug-mstat-addr
;	  kbug-breakpoint-address-addr
;	  kbug-breakpoint-data-addr
;	  kbug-data-transfer-area-addr

;	  ;;; kbug-flag bit definitions
;	  %%kbug-trace-flag
;	  %%kbug-entered-flag

;	  %%command-byte
;	  kbug-command-idle
;	  kbug-command-continue
;	  kbug-command-read-register-frame
;	  kbug-command-read-call-stack
;	  kbug-command-read-map
;	  kbug-command-read-pc
;	  kbug-command-write-pc
;	  kbug-command-write-step-mode
;	  kbug-command-read-memory
;	  kbug-command-write-memory
;	  kbug-command-make-string
;	  kbug-command-intern
;	  kbug-command-load-cold-info
;	  kbug-command-fasl-stream
;	  kbug-command-pc-to-function
;	  kbug-command-read-misc
;    	   %%misc-command-byte
;	  kbug-command-write-misc
;	  kbug-command-write-register-frame
;	  kbug-command-last-command

;	  kbug-k-output-stream
;	  kbug-k-input-fasl-stream
;	  kbug-k-input-character-stream

;	  kbug-output-stream-base
;	  kbug-stream-buffer-size
;	  kbug-input-fasl-stream-base
;	  kbug-input-character-stream-base

;	  ;;; status code definitions
;	  kbug-status-busy
;	  kbug-status-done
;	  kbug-status-bad-command
;	  kbug-status-bad-parameter
;	  kbug-status-bad-address

;	  ;; Simple streams
;	  kbug-stream-flags
;	  kbug-stream-base
;	  kbug-stream-end
;	  kbug-stream-in-pointer
;	  kbug-stream-out-pointer

;	  set-kbug-stream-flags
;	  set-kbug-stream-base
;	  set-kbug-stream-end
;	  set-kbug-stream-in-pointer
;	  set-kbug-stream-out-pointer

;	  %%kbug-stream-flags-direction
;	  $$kbug-stream-flags-direction-to-k
;	  $$kbug-stream-flags-direction-from-k

;	  ))

;--------------------- debug communication cluster layout -------------------
; 000     - command
; 001     - status
; 002-009 - command parameters 0-7
; 00A-0EF - internal debug storage
; 0F0-0F4 - K output stream
; 0F5-0F9 - K input fasl stream
; 0FA-0FE - K input character stream (one word per character though)
;   0FF   - unused
; 100-1FF - data transfer area
; 200-3FF - stream buffers

;---------------------- status codes ----------------------------------------
; 0 - busy
; 1 - done - ok
; 2 - unknown command
; 3 - bad parameters
; 4-F - TBD

;---------------------- command codes ----------------------------------------
; 00 - idle
; 01 - continue
; 02 - read register frame
; 03 - read call stack
; 04 - read map
;
; 08 - read virtual memory
; 09 - write virtual memory
; 0a - make string
; 0b - intern symbol
; 0A-0F spare

(defconstant kbug-base-addr #x000800)

;;; Use *magic-garbage-location*
;(defconstant new-math:magic-safe-memory-loc 41.)

(defconstant kbug-command-addr	 	 	(+ kbug-base-addr #x000))
(defconstant kbug-status-addr			(+ kbug-base-addr #x001))
(defconstant kbug-parameter-addr		(+ kbug-base-addr #x002))
(defconstant kbug-internal-storage-addr	 	(+ kbug-base-addr #x00A))
(defconstant kbug-pc-addr			(+ kbug-base-addr #x00A))
(defconstant kbug-flag-addr			(+ kbug-base-addr #x00B))
(defconstant kbug-left-addr			(+ kbug-base-addr #x00C))
(defconstant kbug-right-addr			(+ kbug-base-addr #x00D))
(defconstant kbug-alu-status-addr		(+ kbug-base-addr #x00E))
(defconstant kbug-left-boxed-addr		(+ kbug-base-addr #x00F))
(defconstant kbug-right-boxed-addr		(+ kbug-base-addr #x010))
(defconstant kbug-vma-addr			(+ kbug-base-addr #x011))
(defconstant kbug-vma-boxed-addr		(+ kbug-base-addr #x012))
(defconstant kbug-md-addr			(+ kbug-base-addr #x013))
(defconstant kbug-md-boxed-addr			(+ kbug-base-addr #x014))
(defconstant kbug-mstat-addr			(+ kbug-base-addr #x015))
(defconstant kbug-data-transfer-area-addr 	(+ kbug-base-addr #x100))

;;; These are offsets in the KBUG communication area
(defconstant kbug-k-output-stream		#x0F0)
(defconstant kbug-k-input-fasl-stream		#x0F5)
(defconstant kbug-k-input-character-stream	#x0FA)

(defconstant kbug-stream-buffer-size          #x40)
(defconstant kbug-output-stream-base          #x200)
(defconstant kbug-input-fasl-stream-base      (+ kbug-output-stream-base kbug-stream-buffer-size))
(defconstant kbug-input-character-stream-base (+ kbug-input-fasl-stream-base kbug-stream-buffer-size))

;;; kbug-flag bit definitions
(defconstant %%kbug-trace-flag (byte 1. 0.))
(defconstant %%kbug-entered-flag (byte 1. 1.))

(defconstant %%command-byte             (byte 5. 0.))
(defconstant kbug-command-idle			#x00)
(defconstant kbug-command-continue		#x01)
(defconstant kbug-command-read-register-frame	#x02)
(defconstant kbug-command-read-call-stack	#x03)
(defconstant kbug-command-read-map		#x04)
(defconstant kbug-command-read-pc		#x05) ;gone
(defconstant kbug-command-write-pc		#x06) ;gone
(defconstant kbug-command-write-step-mode	#x07) ;gone
(defconstant kbug-command-read-memory		#x08)
(defconstant kbug-command-write-memory		#x09)
(defconstant kbug-command-make-string		#x0A)	; length in param 0, characters in data area
(defconstant kbug-command-intern		#x0B)	; param0 package, param1 name
(defconstant kbug-command-load-cold-info	#x0C)	; warm-download-cold-info
(defconstant kbug-command-fasl-stream		#x0D)	; mini-fasl
(defconstant kbug-command-pc-to-function        #x0E)   ; get function & symbol from PC
(defconstant kbug-command-read-misc		#x0F)
   (defconstant %%misc-command-byte (byte 5. 0))
(defconstant kbug-command-write-misc		#x10)
(defconstant kbug-command-write-register-frame  #x11)
(defconstant kbug-command-last-command          #x12)

(defconstant kbug-status-busy			#x00)
(defconstant kbug-status-done			#x01)
(defconstant kbug-status-bad-command		#x02)
(defconstant kbug-status-bad-parameter		#x03)
(defconstant kbug-status-bad-address            #x04)


;;; Each kbug stream contains five words for book-keeping
;;; independent of their buffers.  The things that point to or into buffers are offsets
;;; from the base of the KBUG communication area.
(defconstant kbug-stream-flags		0)
(defconstant kbug-stream-base		1
  "Offset in communication area of the first word of this stream's buffer.")
(defconstant kbug-stream-end		2
  "One more than the offset in the communication area of the last word stream's buffer.")
(defconstant kbug-stream-in-pointer	3
  "Location in buffer where next character to be written to stream is put.")
(defconstant kbug-stream-out-pointer	4
  "Location in buffer from which next character from stream is read.")

;(defconstant kbug-stream-datum		3
;  "Next character to be written to the stream is written here before this is incremented.")
;(defconstant kbug-stream-semaphore	4
;  "Next character to be read from stream is here.  Read this then increment.")

(defconstant %%kbug-stream-flags-direction	(byte 1 0))
(defconstant $$kbug-stream-flags-direction-to-k	  0)
(defconstant $$kbug-stream-flags-direction-from-k 1)


;;; A stream is represented by an offset into the KBUG communication area where the
;;; information about the stream lives.  This will be one of KBUG-K-OUTPUT-STREAM,
;;; KBUG-K-INPUT-FASL-STREAM or KBUG-K-INPUT-CHARACTER-STREAM.

;;; Since the LAMBDA can write into these streams, the appropriate thing to do here
;;; is read the word unboxed, and then stuff it into a boxed fixnum.

(defun kbug-get-comm-word (location)
  (select-processor
    (:k
      (if (and (<= 0 location)
	       (< location #x400))
	  (progn
	    (hw:vma-start-read-no-transport-vma-unboxed-md-unboxed (+ kbug-base-addr location))
	    (hw:dpb (hw:read-md) vinc:%%fixnum-field 0))
	(li:error "location not in kbug communication area" location)))
    (:lambda
      (lisp:if (lisp:<= 0 location (lisp:1- #x400))
	  (lisp::ldb (byte 24. 0.)
		     (lisp:let ((loc (lisp:ash (lisp:+ location kbug-base-addr)
					       2)))
		       (lam:k-mem-read loc)))
	(user:ferror nil "location not in kbug communication area")))))

(defun kbug-set-comm-word (location value)
  (select-processor
    (:k
      (if (and (<= 0 location)
	       (< location #x400))
	  (progn (hw:write-md-unboxed value)
		 (hw:vma-start-write-no-gc-trap-unboxed (+ location kbug-base-addr))
		 (hw:nop))
	(li:error "location not in kbug communication area" location)))
    (:lambda
      (lisp:if (lisp:<= 0 location (lisp:1- #x400))
	  (lam:k-mem-write (lisp:ash (lisp:+ location kbug-base-addr) 2) value)
	(user:ferror nil "location not in kbug communication area")))))

;;; Accessing the KBUG communication area
;;; The actual data buffer for the stream is allocated at the end of the KBUG communication area.

(prims::defmacro define-kbug-stream-slot (accessor setter lisp:&optional (offset accessor))
  `(PROGN (DEFUN ,accessor (STREAM)
	    (KBUG-GET-COMM-WORD (+ STREAM ,offset)))
	  (DEFUN ,setter (STREAM VALUE)
	    (KBUG-SET-COMM-WORD (+ STREAM ,offset) VALUE))
	  (DEFSETF ,accessor ,setter)))
  
(define-kbug-stream-slot kbug-stream-flags 		set-kbug-stream-flags)
(define-kbug-stream-slot kbug-stream-base  		set-kbug-stream-base)
(define-kbug-stream-slot kbug-stream-end		set-kbug-stream-end)
(define-kbug-stream-slot kbug-stream-in-pointer    	set-kbug-stream-in-pointer)
(define-kbug-stream-slot kbug-stream-out-pointer	set-kbug-stream-out-pointer)
;(define-kbug-stream-slot kbug-stream-datum              set-kbug-stream-datum)
;(define-kbug-stream-slot kbug-stream-semaphore          set-kbug-stream-semaphore)