;;; -*- Mode:LISP; Package:SYSTEM-INTERNALS; Cold-Load:T; Readtable:ZL; Base:10 -*-

;;; Cold load side of a simple bi-directional stream called COLD-BI-STREAM.
;;;

(DEFVAR *COLD-SHARED-MEMORY-SIZE*)
(DEFVAR *COLD-SHARED-MEMORY-8*)
(DEFVAR *COLD-SHARED-MEMORY-16*)

(DEFUN %COLD-SYS-CONF (INDEX)
  (DPB (%P-LDB (BYTE 16 16) (+ (%LAMBDA-SYS-CONF-VIRTUAL-ADR) INDEX))
       (BYTE 16 16)
       (%P-LDB (BYTE 16 0) (+ (%LAMBDA-SYS-CONF-VIRTUAL-ADR) INDEX))))

(DEFUN COLD-SDU-PHYS-TO-VIRTUAL (SDU-PHYS)
  (%lambda-sys-conf-phys-to-virtual 
    (if (= (%lambda-sdu-quad-slot) #xff)
	sdu-phys
      (logxor #x10000000 sdu-phys))))

(DEFUN SETUP-COLD-SHARED-MEMORY (&OPTIONAL RESET)
  (WHEN (OR RESET
	    (NOT (BOUNDP '*COLD-SHARED-MEMORY-SIZE*))
	    (NOT *COLD-SHARED-MEMORY-SIZE*))
    (LET ((SIZE (%COLD-SYS-CONF %SYSTEM-CONFIGURATION-GLOBAL-SHARED-SIZE))
	  (START (COLD-SDU-PHYS-TO-VIRTUAL
		   (%COLD-SYS-CONF %SYSTEM-CONFIGURATION-GLOBAL-SHARED-BASE))))
      (SETQ *COLD-SHARED-MEMORY-SIZE* SIZE)
      (setq *COLD-shared-memory-8*
	    (make-array SIZE
			:type :art-8b
			:displaced-to START))
      (setq *COLD-shared-memory-16*
	    (make-array (// SIZE 2)
			:type :art-16b
			:displaced-to START)))))
      

(DEFVAR *COLD-BI-STREAM-INPUT-SECTION* 0)
(DEFVAR *COLD-BI-STREAM-OUTPUT-SECTION* 2048)

;; FORMAT OF A SECTION IS [OWNER][TYPE][OFFSET][LIMIT]{DATA....}
;; OWNER = 0, owned by COLD side, 1 = owned by regular side.
;; TYPE = 0: CHARACTER DATA.
;; TYPE = 1: 16-BIT BINARY DATA.
;; OFFSET is index into data section of first available datum.
;; LIMIT is index into data section of END of data.
;;  When OFFSET=LIMIT then there is no data.


(DEFUN COLD-BI-STREAM-INPUT-WAIT ()
  (LET ((A *COLD-SHARED-MEMORY-16*)
	(B *COLD-BI-STREAM-INPUT-SECTION*))
    (COND ((ZEROP (AREF A B)))
	  ('ELSE
	   (PROCESS-WAIT "shared input"
			 #'(LAMBDA (A B)
			     (ZEROP (AREF A B)))
			 A
			 B)))))


(DEFUN COLD-BI-STREAM-OUTPUT-WAIT ()
  (LET ((A *COLD-SHARED-MEMORY-16*)
	(B *COLD-BI-STREAM-OUTPUT-SECTION*))
    (COND ((ZEROP (AREF A B)))
	  ('ELSE
	   (PROCESS-WAIT "shared output"
			 #'(LAMBDA (A B)
			     (ZEROP (AREF A B)))
			 A
			 B)))))

(DEFPROP COLD-BI-STREAM T IO-STREAM-P)

(DEFVAR *COLD-BI-STREAM-TYIPEEK-P* NIL)
(DEFVAR *COLD-BI-STREAM-TYIPEEK-CHAR* NIL)

(DEFUN COLD-BI-STREAM (OP &OPTIONAL ARG1 &REST ARGS)
  (SELECTQ-WITH-WHICH-OPERATIONS OP
    (:LISTEN
      (OR *COLD-BI-STREAM-TYIPEEK-P*
	  (ZEROP (AREF *COLD-SHARED-MEMORY-16* *COLD-BI-STREAM-INPUT-SECTION*))))
    (:TYI
      (COND (*COLD-BI-STREAM-TYIPEEK-P*
	     (PROG1 *COLD-BI-STREAM-TYIPEEK-CHAR*
		    (SETQ *COLD-BI-STREAM-TYIPEEK-P* NIL)))
	    ('ELSE
	     (COLD-BI-STREAM-TYI))))
    (:UNTYI
      (SETQ *COLD-BI-STREAM-TYIPEEK-P* T)
      (SETQ *COLD-BI-STREAM-TYIPEEK-CHAR* ARG1))
    (:TYIPEEK
      (COND (*COLD-BI-STREAM-TYIPEEK-P*
	     *COLD-BI-STREAM-TYIPEEK-CHAR*)
	    ('ELSE
	     (SETQ *COLD-BI-STREAM-TYIPEEK-P* T)
	     (SETQ *COLD-BI-STREAM-TYIPEEK-CHAR* (COLD-BI-STREAM-TYI)))))
    (:READ-INPUT-BUFFER
      (COLD-BI-STREAM-READ-INPUT-BUFFER))
    (:GET-INPUT-BUFFER
      (COLD-BI-STREAM-GET-INPUT-BUFFER))
    (:ADVANCE-INPUT-BUFFER
      (COLD-BI-STREAM-ADVANCE-INPUT-BUFFER))
    (:TYO
      (COLD-BI-STREAM-TYO ARG1))
    (:EOF
      (COLD-BI-STREAM-EOF))
    (:STRING-OUT
      (COLD-BI-STREAM-STRING-OUT ARG1 (CAR ARGS) (CADR ARGS)))
    (:BYTE-SIZE
      (ECASE (AREF *COLD-SHARED-MEMORY-16* (+ *COLD-BI-STREAM-INPUT-SECTION* 1))
	(0 8)
	(1 16)))
    (:CHARACTERS
      (ECASE (AREF *COLD-SHARED-MEMORY-16* (+ *COLD-BI-STREAM-INPUT-SECTION* 1))
	(0 T)
	(1 NIL)))
    (:DIRECTION :BIDIRECTIONAL)
    (:PATHNAME
      (IF (BOUNDP 'MINI-FASLOAD-FILENAME) (SYMEVAL 'MINI-FASLOAD-FILENAME)))
    (:GENERIC-PATHNAME 'MINI-PLIST-RECEIVER)
    (:INFO
      (IF (BOUNDP 'MINI-FILE-ID) (SYMEVAL 'MINI-FILE-ID)))
    (:CLOSE
      (SETF (AREF *COLD-SHARED-MEMORY-16* *COLD-BI-STREAM-INPUT-SECTION*) 1))
    (T
      (stream-default-handler 'cold-bi-stream op arg1 args))))
  
(DEFUN COLD-BI-STREAM-TYI ()
  (COLD-BI-STREAM-INPUT-WAIT)
  (LET ((OFFSET (AREF *COLD-SHARED-MEMORY-16* (+ *COLD-BI-STREAM-INPUT-SECTION* 2)))
	(LIMIT (AREF *COLD-SHARED-MEMORY-16* (+ *COLD-BI-STREAM-INPUT-SECTION* 3))))
    (COND ((= OFFSET LIMIT)
	   (SETF (AREF *COLD-SHARED-MEMORY-16* *COLD-BI-STREAM-INPUT-SECTION*) 1)
	   ())
	  ('ELSE
	   (PROG1 (ECASE (AREF *COLD-SHARED-MEMORY-16* (+ *COLD-BI-STREAM-INPUT-SECTION* 1))
		    (0
		     (AREF *COLD-SHARED-MEMORY-8* (+ (* *COLD-BI-STREAM-INPUT-SECTION* 2)
						     OFFSET 8)))
		    (1
		     (AREF *COLD-SHARED-MEMORY-16* (+ *COLD-BI-STREAM-INPUT-SECTION* OFFSET 4))))
		  (INCF OFFSET)
		  (SETF (AREF *COLD-SHARED-MEMORY-16* (+ *COLD-BI-STREAM-INPUT-SECTION* 2))
			OFFSET)
		  (WHEN (= OFFSET LIMIT)
		    (SETF (AREF *COLD-SHARED-MEMORY-16* *COLD-BI-STREAM-INPUT-SECTION*) 1)))))))

      

(DEFUN COLD-BI-STREAM-READ-INPUT-BUFFER ()
  (COLD-BI-STREAM-INPUT-WAIT)
  (LET ((OFFSET (AREF *COLD-SHARED-MEMORY-16* (+ *COLD-BI-STREAM-INPUT-SECTION* 2)))
	(LIMIT (AREF *COLD-SHARED-MEMORY-16* (+ *COLD-BI-STREAM-INPUT-SECTION* 3))))
    (COND ((= OFFSET LIMIT)
	   (SETF (AREF *COLD-SHARED-MEMORY-16* *COLD-BI-STREAM-INPUT-SECTION*) 1)
	   ())
	  ('ELSE
	   (ECASE (AREF *COLD-SHARED-MEMORY-16* (+ *COLD-BI-STREAM-INPUT-SECTION* 1))
	     (0
	      (VALUES *COLD-SHARED-MEMORY-8*
		      (+ (* 2 *COLD-BI-STREAM-INPUT-SECTION*) OFFSET 8)
		      (+ (* 2 *COLD-BI-STREAM-INPUT-SECTION*) LIMIT 8)))
	     (1
	      (VALUES *COLD-SHARED-MEMORY-16*
		      (+ *COLD-BI-STREAM-INPUT-SECTION* OFFSET 4)
		      (+ *COLD-BI-STREAM-INPUT-SECTION* LIMIT 4))))))))


(DEFUN COLD-BI-STREAM-GET-INPUT-BUFFER ()
  (COLD-BI-STREAM-INPUT-WAIT)
  (LET ((OFFSET (AREF *COLD-SHARED-MEMORY-16* (+ *COLD-BI-STREAM-INPUT-SECTION* 2)))
	(LIMIT (AREF *COLD-SHARED-MEMORY-16* (+ *COLD-BI-STREAM-INPUT-SECTION* 3))))
    (COND ((= OFFSET LIMIT)
	   (SETF (AREF *COLD-SHARED-MEMORY-16* *COLD-BI-STREAM-INPUT-SECTION*) 1)
	   ())
	  ('ELSE
	   (ECASE (AREF *COLD-SHARED-MEMORY-16* (+ *COLD-BI-STREAM-INPUT-SECTION* 1))
	     (0
	      (VALUES *COLD-SHARED-MEMORY-8*
		      (+ (* *COLD-BI-STREAM-INPUT-SECTION* 2) OFFSET 8)
		      (- LIMIT OFFSET)))
	     
	     (1
	      (VALUES *COLD-SHARED-MEMORY-16*
		      (+ *COLD-BI-STREAM-INPUT-SECTION* OFFSET 4)
		      (- LIMIT OFFSET))))))))

(DEFUN COLD-BI-STREAM-ADVANCE-INPUT-BUFFER ()
  (SETF (AREF *COLD-SHARED-MEMORY-16* *COLD-BI-STREAM-INPUT-SECTION*) 1))

(DEFUN COLD-BI-STREAM-TYO (CHAR)
  (COLD-BI-STREAM-OUTPUT-WAIT)
  (SETF (AREF *COLD-SHARED-MEMORY-16* (+ *COLD-BI-STREAM-OUTPUT-SECTION* 2)) 0)
  (SETF (AREF *COLD-SHARED-MEMORY-16* (+ *COLD-BI-STREAM-OUTPUT-SECTION* 3)) 1)
  (SETF (AREF *COLD-SHARED-MEMORY-8* (+ (* 2 *COLD-BI-STREAM-OUTPUT-SECTION*) 8)) CHAR)
  (SETF (AREF *COLD-SHARED-MEMORY-16* *COLD-BI-STREAM-OUTPUT-SECTION*) 1))

(DEFUN COLD-BI-STREAM-EOF ()
  (COLD-BI-STREAM-OUTPUT-WAIT)
  (SETF (AREF *COLD-SHARED-MEMORY-16* (+ *COLD-BI-STREAM-OUTPUT-SECTION* 2)) 0)
  (SETF (AREF *COLD-SHARED-MEMORY-16* (+ *COLD-BI-STREAM-OUTPUT-SECTION* 3)) 0)
  (SETF (AREF *COLD-SHARED-MEMORY-16* *COLD-BI-STREAM-OUTPUT-SECTION*) 1))

(DEFUN COLD-BI-STREAM-STRING-OUT (STRING START END)
  (OR START (SETQ START 0))
  (OR END (SETQ END (LENGTH STRING)))
  (UNLESS (= START END)
    (COLD-BI-STREAM-OUTPUT-WAIT)
    (SETF (AREF *COLD-SHARED-MEMORY-16* (+ *COLD-BI-STREAM-OUTPUT-SECTION* 2)) 0)
    (SETF (AREF *COLD-SHARED-MEMORY-16* (+ *COLD-BI-STREAM-OUTPUT-SECTION* 3)) (- END START))
    (COPY-ARRAY-PORTION STRING START END
			*COLD-SHARED-MEMORY-8*
			(+ (* 2 *COLD-BI-STREAM-OUTPUT-SECTION*) 8)
			(+ (* 2 *COLD-BI-STREAM-OUTPUT-SECTION*) 8 (- END START)))
    (SETF (AREF *COLD-SHARED-MEMORY-16* *COLD-BI-STREAM-OUTPUT-SECTION*) 1)))


(DEFUN COLD-BI-STREAM-DESCRIBE ()
  (DOLIST (S '(*COLD-BI-STREAM-INPUT-SECTION* *COLD-BI-STREAM-OUTPUT-SECTION*))
    (FORMAT T "~&~S~%" S)
    (LET ((OWNER (AREF *GLOBAL-SHARED-MEMORY-16* (SYMEVAL S)))
	  (TYPE (AREF *GLOBAL-SHARED-MEMORY-16* (+ 1 (SYMEVAL S))))
	  (OFFSET (AREF *GLOBAL-SHARED-MEMORY-16* (+ 2 (SYMEVAL S))))
	  (LIMIT (AREF *GLOBAL-SHARED-MEMORY-16* (+ 3 (SYMEVAL S)))))
      (FORMAT t "  OWNER  = ~S~%  TYPE   = ~S~%  OFFSET = ~S~%  LIMIT  = ~D~%"
	      (or (cadr (assq owner '((0 "cold side") (1 "server side")))) owner)
	      (or (cadr (assq type '((0 "character data") (1 "binary data")))) type)
	      offset limit))))