;;; **********************************************************************
;;; This code was written as part of the Spice Lisp project at
;;; Carnegie-Mellon University, and has been placed in the public domain.
;;; Spice Lisp is currently incomplete and under active development.
;;; If you want to use this code or any part of Spice Lisp, please contact
;;; Scott Fahlman (FAHLMAN@CMUC). 
;;; **********************************************************************
;;;
;;; Spice Lisp interface to sesame, the accent file system.
;;; 
;;; Written by Jim Large
;;;   Modified by Dan Aronson
;;;
;;; **********************************************************************

(declare (special null-port	  ;reply port when we don't want a reply.
		  *sesame-port*	  ;port to send sesame messages to.
		  ))

(defvar sesame-reply-port ())	  ;reply port when we do want a reply
;;; Sub-Read-File

;;; The global special to-sub-read-file stores an alien structure of type
;;;  to-sub-read-file.  This structure holds the message sent to sesame by
;;;  the sub-read-file function.  to-sub-read-file is initialized by 
;;;  sesame-init.

(defvar to-sub-read-file ())
(def-alien-structure to-sub-read-file
  (msg-simplep (selection () t) 0 2 :constant T)
  (msg-size unsigned-integer 2 6 :constant 290)
  (msg-type (selection 'normal-message 'emergency-message)
	    6 10
	    :constant 'normal-message)
  (msg-local-port port 10 14 :constant sesame-reply-port)
  (msg-remote-port port 14 18 :constant *sesame-port*)
  (msg-id unsigned-integer 18 22 :constant 1200)
  (name-hak1 unsigned-integer 24 26 :constant 12288)
  (name-hak2 unsigned-integer 26 28 :constant 12)
  (name-hak3 unsigned-integer 28 30 :constant 2048)
  (name-hak4 unsigned-integer 30 34 :constant 1)
  (name perq-string 34 288))

(defvar from-sub-read-file ())
(def-alien-structure from-sub-read-file
  (msg-size unsigned-integer 2 6 :constant 44)
  (msg-local-port port 10 14 :constant sesame-reply-port)
  (return-code unsigned-integer 26 28)
  (size unsigned-integer 36 40)
  (data unsigned-integer 40 44))


;;; Sub-read-file maps the file named by the string NAME into this 
;;;  process's address space.  NAME is the absolute pathname of the file
;;;  to be read.
;;;
;;; Returns the return code, the virtual address of the file data in our 
;;;  address space, and the number of 8 bit bytes read as multiple values.

(defun sub-read-file (name)
  (setf (to-sub-read-file-name to-sub-read-file) name)
  (simple-send to-sub-read-file)
  (simple-receive from-sub-read-file)
  (values (from-sub-read-file-return-code from-sub-read-file)
	  (from-sub-read-file-data from-sub-read-file)
	  (from-sub-read-file-size from-sub-read-file)))
;;; Sub-Write-File

(defvar to-sub-write-file ())
(def-alien-structure to-sub-write-file
  (msg-simplep (selection () t) 0 2 :constant ())
  (msg-size unsigned-integer 2 6 :constant 314)
  (msg-type (selection 'normal-message 'emergency-message)
	    6 10
	    :constant 'normal-message)
  (msg-local-port port 10 14 :constant sesame-reply-port)
  (msg-remote-port port 14 18 :constant *sesame-port*)
  (msg-id unsigned-integer 18 22 :constant 1202)
  
  (name-hak1 unsigned-integer 24 26 :constant 12288)
  (name-hak2 unsigned-integer 26 28 :constant 12)
  (name-hak3 unsigned-integer 28 30 :constant 2048)
  (name-hak4 unsigned-integer 30 34 :constant 1)
  (name perq-string 34 288)

  (data-hak1 unsigned-integer 292 294 :constant 8192)
  (data-hak2 unsigned-integer 294 296 :constant 9)
  (data-hak3 unsigned-integer 296 298 :constant 8)
  (size unsigned-integer 298 302)
  (data unsigned-integer 302 306)

  (fmt-hak1 unsigned-integer 306 308 :constant 8194)
  (fmt-hak2 unsigned-integer 308 310 :constant 4097)
  (format unsigned-integer 310 314))

(defvar from-sub-write-file ())
(def-alien-structure from-sub-write-file
  (msg-size unsigned-integer 2 6 :constant 306)
  (msg-local-port port 10 14 :constant sesame-reply-port)
  (return-code unsigned-integer 26 28)
  (true-name perq-string 40 296)
  (create-date unsigned-integer 300 304)
  (create-second unsigned-integer 304 306))


;;; Sub-Write-File maps data from our address space into the named file 
;;;  creating the file if it does not already exist.
;;;
;;;  FILE-NAME -- the full path name of the file to write, a string.
;;;  FILE-DATA -- the virtual address of the data block to write.
;;;  FILE-COUNT -- the number of 8 bit bytes in the file
;;;  FILE-TYPE -- one of the defined file type constants

(defun sub-write-file (file-name file-data file-size file-type)
  (setf (to-sub-write-file-name to-sub-write-file) file-name)
  (setf (to-sub-write-file-data to-sub-write-file) file-data)
  (setf (to-sub-write-file-size to-sub-write-file) file-size)
  (setf (to-sub-write-file-format to-sub-write-file) file-type)
  (simple-send to-sub-write-file)
  (simple-receive from-sub-write-file)

  (values (from-sub-write-file-return-code from-sub-write-file)
	  (from-sub-write-file-true-name from-sub-write-file)))


;;;SES-SCAN-NAMES
(defvar to-ses-scan-names)
(def-alien-structure to-ses-scan-names
  (msg-simplep (selection () t) 0 2 :constant t)
  (msg-size unsigned-integer 2 6 :constant 302)
  (msg-type (selection 'normal-message 'emergency-message)
	    6 10 :constant 'normal-message)
  (msg-local-port port 10 14 :constant sesame-reply-port)
  (msg-remote-port port 14 18 :default *sesame-port*)
  (msg-id unsigned-integer 18 22 :constant 1210)
  (tt2-1 unsigned-integer 22 24 :constant 0)
  (Tt2-2 unsigned-integer 24 26 :constant 12288)
  (tt2-3 unsigned-integer 26 28 :constant 12)
  (tt2-4 unsigned-integer 28 30 :constant 2048)
  (tt2-5 unsigned-integer 30 34 :constant 1)
  (wildapathname perq-string 34 290)
  (tt3-1 unsigned-integer 290 292 :constant 4097)
  (tt3-2 unsigned-integer 292 294 :constant 4097)
  (nameflags unsigned-integer 294 296)
  (tt4-1 unsigned-integer 296 298 :constant 4097)
  (tt4-2 unsigned-integer 298 300 :constant 4097)
  (entrytype unsigned-integer 300 302)
  )

(defvar from-ses-scan-names)
(def-alien-structure from-ses-scan-names
  (msg-size unsigned-integer 2 6 :constant 312)
  (msg-local-port port 10 14 :constant sesame-reply-port)
  (rc unsigned-integer 26 28 :direction read)
  (directory-name perq-string 40 296 :direction read)
  (entry-list-cnt unsigned-integer 304 308 :direction read)
  (entry-list unsigned-integer 308 312)
  )

;;; SES-SCAN-NAMES takes a pathname (may contain wildcards), and returns a list
;;; of names matching that prefix.

(defun ses-scan-names (name)
  "SES-SCAN-NAMES takes a pathname (may contain wildcards), and returns a list
    of names matching that prefix."
  (setf (to-ses-scan-names-wildapathname to-ses-scan-names) name)
  (simple-send to-ses-scan-names)
  (simple-receive from-ses-scan-names)
  (if (/= rc-success (from-ses-scan-names-rc from-ses-scan-names))
      (error "Error in Ses-scan-names.  RC = ~s"
	     (from-ses-scan-names-rc from-ses-scan-names)))
  (values (from-ses-scan-names-entry-list from-ses-scan-names)
	  (from-ses-scan-names-entry-list-cnt from-ses-scan-names)))

;;; Sesame-init
;;;
;;; Sesame-init constructs the alien structures which hold messages and stores
;;;  them in global specials.

(defun sesame-init ()
  "Initializes global variables used by sesame functions."

  (setq sesame-reply-port (allocate-port 0))

  ;; create the message blocks.
  (setq to-sub-read-file (make-to-sub-read-file))
  (setq from-sub-read-file (make-from-sub-read-file))
  (setq to-sub-write-file (make-to-sub-write-file))
  (setq from-sub-write-file (make-from-sub-write-file))
  (setq to-ses-scan-names (make-to-ses-scan-names))
  (setq from-ses-scan-names (make-from-ses-scan-names))
  )