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

;(export '(
  ;	  *clusters-in-physical-block*
  ;	  *clusters-in-quantum*
  ;	  *blocks-of-physical-memory*
  ;	  *number-of-quanta*
  ;	  *number-of-virtual-clusters*
  ;	  *physical-memory-max-clusters*
  ;	  *qs-in-cluster*
  ;	  *qs-in-quantum*

  ;	  %%byte-position
  ;	  %%byte-size
  ;	  %%cluster-number
  ;	  %%data-type
  ;	  %%fixnum-field
  ;	  %%fixnum-sign-bit
  ;	  %%offset-in-cluster
  ;	  %%pointer
  ;	  %%quantum-number

  ;	  $$dtc-both-character
  ;	  $$dtc-both-fixnum
  ;	  $$dtc-both-fixnum-with-overflow
  ;	  $$dtc-hairy-number
  ;	  $$dtc-none
  ;	  $$dtc-right-array-and-left-structure
  ;	  $$dtc-right-list
  ;	  $$dtc-spare1

  ;	  $$gc-write-test
  ;	  $$no-gc-write-test
  ;	  $$transporter-mode-normal
  ;	  $$transport-type-no-transport
  ;	  $$transport-type-transport
  ;	  $$transport-type-visible-evcp
  ;	  $$transport-type-write


  ;	  field-maximum))

;;; This file has the software definitions that are firmly
;;; based on the hardware.  It isn't that the hardware
;;; determines these per se, but that the hardware was designed
;;; with these in mind.  It should be possible to change these
;;; without making ECO's, but it wasn't intended.

;;;;;;;;;;;;;;;;;;
;;; Field maximum
;;;;;;;;;;;;;;;;;;
(global:pkg-goto 'prims () global:*package*)

(vinc:proclaim '(lisp::declaration cool-for-constants))

(vinc:proclaim '(cool-for-constants vinc:field-maximum))

(global:pkg-goto 'vinc:vinc () global:*package*)

(defun field-maximum (byte-specifier)
  (lisp::expt 2. (byte-size byte-specifier)))

;;;;;;;;;;;;;;;;;;;;
;;; Physical memory
;;;;;;;;;;;;;;;;;;;;

(defconstant *clusters-in-physical-block* (field-maximum hw:%%physical-address-block-cluster-offset))
(defconstant *blocks-of-physical-memory*  (field-maximum hw:%%cluster-physical-address-block))

;;;;;;;;;;;;;;;;;;;
;;; Boxed Q Format
;;;;;;;;;;;;;;;;;;;

;;; Each boxed Q has a pointer field and a data field.
;;; The pointer field cannot extend beyond the mapped
;;; vma byte, and if it is made shorter, the map software
;;; must be made to fill both halves of the map.

;;; The data type cannot extend beyond the byte that
;;; is used to address the transporter ram in the MD.

(defconstant %%pointer   (byte 26. 0.))
(defconstant %%data-type hw:%%transporter-ram-md-byte)

;;;;;;;;;;;;;;;;;;;
;;; Pointer Format
;;;;;;;;;;;;;;;;;;;

;;; Since the bottom bits of the vma do not get
;;; mapped, the map has a granularity greater than
;;; one q.  Paging must be done on a granularity at
;;; least as large as this.  We choose to make it the
;;; same.

;;; The granularity is called a cluster.

(defconstant %%cluster-number    hw:%%mapped-vma-byte)
(defconstant %%offset-in-cluster hw:%%unmapped-vma-byte)

(defconstant *qs-in-cluster*              (field-maximum %%offset-in-cluster))
(defconstant *number-of-virtual-clusters* (field-maximum %%cluster-number))

;;; Since the bottom bits of the MD are not used in
;;; addressing the GC ram, the GC ram has a granularity
;;; greater than one q.  Garbage collection must be
;;; done on a granularity at least as large as this.  We
;;; choose to make it the same.

;;; This granularity is called a quantum.

(defconstant %%quantum-number hw:%%gc-ram-md-byte)

(defconstant *number-of-quanta*    (field-maximum %%quantum-number))
(defconstant *clusters-in-quantum* (lisp::expt 2. (- (byte-position %%quantum-number)
						     (byte-position %%cluster-number))))
(defconstant *qs-in-quantum*       (lisp::* *qs-in-cluster* *clusters-in-quantum*))

;;; The physical memory is limited by the number of wires
;;; coming out of the map.

(defconstant *physical-memory-max-clusters* (field-maximum hw:%%map-on-board-address))

;;;;;;;;;;;;;;;;;;
;;; Fixnum format
;;;;;;;;;;;;;;;;;;

;;; Surprise, the fixnums are smaller than pointers.
;;; We are so lucky that this isn't a screw.

(defconstant %%fixnum-field    (byte 24. 0.))

(defconstant %%fixnum-sign-bit (byte 1. 23.))

;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Byte Specifier Format
;;;;;;;;;;;;;;;;;;;;;;;;;;

(defconstant %%byte-position hw:%%alu-status-internal-position-register)
(defconstant %%byte-size     hw:%%alu-status-internal-width-register)


;;;;;;;;;;;;;;;;;;
;;; GC Trap types
;;;;;;;;;;;;;;;;;;

(defconstant $$no-gc-write-test 0.)
(defconstant $$gc-write-test    1.)

;;;;;;;;;;;;;;;;;;;;;;
;;; Transporter types
;;;;;;;;;;;;;;;;;;;;;;

(defconstant $$transport-type-no-transport 0.)
(defconstant $$transport-type-transport    1.)
(defconstant $$transport-type-visible-evcp 2.)
(defconstant $$transport-type-write        3.)

;;;;;;;;;;;;;;;;;;;;;;
;;; Transporter modes
;;;;;;;;;;;;;;;;;;;;;;

(defconstant $$transporter-mode-normal 0.)
;;; three others unused

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Datatype check codes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defconstant $$dtc-none 		          0.)
(defconstant $$dtc-spare1		          1.)
(defconstant $$dtc-hairy-number		          2.)
(defconstant $$dtc-both-character	          3.)
(defconstant $$dtc-right-array-and-left-structure 4.)
(defconstant $$dtc-right-list		          5.)
(defconstant $$dtc-both-fixnum 		          6.)
(defconstant $$dtc-both-fixnum-with-overflow      7.)