;;; **********************************************************************
;;; 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))
)