;;; -*- Mode:LISP; Package:SYSTEM-INTERNALS; Readtable:CL; Lowercase:YES; Base:10 -*-


(defvar *my-area*
	(make-area :name '*my-area* :gc :fixed))

(defun init-my-area ()
  (when (minusp (%area-region-list *my-area*))
    (%make-region *my-area* (area-region-bits *my-area*) #o40000))
  (%use-up-region (area-region-list *my-area*))
  (%wire-area *my-area* t))

(defun area-bounds (area)
  (let ((region (%area-region-list area)))
    (or (minusp (%region-list-thread region)) ;last region in area
	(ferror "area ~a has more than one region" (area-name area)))
    (let ((start (%region-origin region)))
      (values start (+ start (%region-length region))))))

(defvar *my-area-start* (area-bounds *my-area*))

(defun virtual-address (pointer)
  (error "We cannot determine the local physical address #o~O."
	 pointer))

(defun store-nubus-address (pointer vadr)
  (let* ((padr (%physical-address vadr))
	 (nubus (%nubus-physical-address (ldb (byte 22. 8) padr)))
	 (tag (ldb (byte 7 15) nubus))
	 (bottom1 (ldb (byte 15 0) nubus))
	 (bottom2 (ldb (byte 8 0) padr))
	 (bottom (%logdpb bottom1 (byte 15 10)
			  (%logdpb bottom2 (byte 8 2) 0))))
    (%p-store-tag-and-pointer pointer tag bottom)))

(defsetf virtual-address store-nubus-address)


(defvar *screen-pointer* (...))

(defmacro master-table-screen (pointer)
  (virtual-address (%pointer-plus pointer 4)))

(setf (master-table-screen *master-table-pointer*) *screen-pointer*)