;;; -*- Mode:LISP; Package:USER; Base:10 -*-


;;; SHOW BUG IN DISPLACED ARRAYS.
;;; if you run this via CHAOSNET file access it will win, (input buffer is not displaced)
;;; but if you run it on local file you will lose. (input buffer is displaced).

(DEFVAR *F* NIL)
(DEFVAR *B* NIL)
(DEFVAR *START* NIL)
(DEFVAR *END* NIL)
(DEFVAR *S* NIL)

(DEFUN SETUP-STUFF ()
  (CLOSE-STUFF)
  (SETQ *F* (OPEN (send (si:get-source-file-name 'setup-stuff) :new-type "QFASL")
		  :DIRECTION :INPUT :BYTE-SIZE 16 :CHARACTERS NIL))
  (MULTIPLE-VALUE (*B* *START* *END*) (SEND *F* :READ-INPUT-BUFFER))
  (SETQ *S* (MAKE-ARRAY (* (- *END* *START*) 2)
			:TYPE 'ART-STRING
			:DISPLACED-TO *B*
			:DISPLACED-INDEX-OFFSET (* *START* 2)))
  (FORMAT T "~& (AREF *B* *START*) = #x~4,'0X~%" (aref *b* *start*))
  (format t "(AREF *S* 1),(AREF *S* 0) = #x~2,'0X,~2,'0X~%"
	  (aref *s* 1) (aref *s* 0)))

(DEFUN CLOSE-STUFF ()
  (AND *F* (CLOSE (PROG1 *F* (SETQ *F* NIL)))))