(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)

(FILECREATED "17-May-90 16:13:16" |{DSK}<usr>local>lde>lispcore>sources>VANILLADISK.;2|
 5292   

      |changes| |to:|  (VARS VANILLADISKCOMS)

      |previous| |date:| " 7-Apr-88 17:53:38" |{DSK}<usr>local>lde>lispcore>sources>VANILLADISK.;1|
)


; Copyright (c) 1985, 1986, 1988, 1990 by Venue & Xerox Corporation.  All rights reserved.

(PRETTYCOMPRINT VANILLADISKCOMS)

(RPAQQ VANILLADISKCOMS
 ((FNS \\VANILLADISKINIT \\VANILLAHOSTNAMEP \\VANILLAEVENTFN)
                            (INITVARS (\\PSEUDODSK))
                            (GLOBALVARS \\PSEUDODSK \\DISKNAMECASEARRAY)
                            (DECLARE\: DONTEVAL@LOAD (P (\\VANILLADISKINIT)))
                            (LOCALVARS . T)))
(DEFINEQ

(\\vanilladiskinit

  (lambda nil
                                            (* |bvm:| "30-Jan-85 21:43")

    (prog ((arr (copyarray uppercasearray)))
          (* * |Set| |up| |array| |that| |maps| |illegal| |filename| |chars| |to| 0 

        |and| |synonymous| |characters| |to| \a |canonical| |char|)

          (|for|
 i |from|
 0 |to|
 (sub1 (charcode 0)) |do|
 (setcasearray arr i 0))
                                                             (* |Non-printing| |characters| 

                                                           |verboten|)

          (|for|
 i |from|
 (add1 (charcode 9)) |to|
 (sub1 (charcode a))
             |do|
 (setcasearray arr i 0))
          (|for|
 i |from|
 (add1 (charcode z)) |to|
 (sub1 (charcode \a))
             |do|
 (setcasearray arr i 0))
          (|for|
 i |from|
 (add1 (charcode \z)) |to|
 \\maxchar
             |do|
 (setcasearray arr i 0))
          (setcasearray arr (charcode \;)
                 (charcode \;))
          (setcasearray arr (charcode !)
                 (charcode \;))
          (setcasearray arr (charcode *
)
                 (charcode *
))
          (setcasearray arr (charcode escape)
                 (charcode *
))
          (setcasearray arr (charcode ?)
                 (charcode \#))
          (setcasearray arr (charcode \.)
                 (charcode \.))
          (setcasearray arr (charcode -
)
                 (charcode -
))
          (setcasearray arr (charcode +)
                 (charcode +))
          (setcasearray arr (charcode $)
                 (charcode $))
          (setq \\disknamecasearray arr))
          (* * |Define| \a |device| |whose| |sole| |purpose| |is| |to| |select| |the| 

        |appropriate| dsk |device| |depending| |on| |which| |machine| |you're| |on|)

    (\\definedevice nil (|create|
 fdev
                               devicename _ "VANILLADISK"
                               eventfn _ (function nill)
                               hostnamep _ (function \\vanillahostnamep)))))

(\\vanillahostnamep

  (lambda (name)
                                     (* \; "Edited  7-Apr-88 17:20 by masinter")


                                                             (* |bvm:| "30-Jan-85 21:57")

(* |;;;| "Fires up the appropriate file system for the machine you're running on")


    (selectq (machinetype)
        ((dandelion dove) 
(* |;;;| "If there is a valid Lisp directory on the disk, use that;  otherwise use the pseudo-disk coredevice")


             (cond
                ((neq name 'dsk)                             (* \; 

                                                           "Not interested in any other names")

                 nil)
                ((and (getd '|\\LFOpenDevice|)
                      (|\\LFOpenDevice|)))
                (t 
(* |;;;| "Define the PSEUDO-DSK device, if it hasn't been defined yet, and make DSK synonymous with it.  On LOGOUT, the name DSK is disassociated with this device, but the device remains")


                   (cond
                      ((not \\pseudodsk)
                       (coredevice 'pseudo-dsk)
                       (setq \\pseudodsk (\\getdevicefromname 'pseudo-dsk))
                       (|replace|
 (fdev eventfn) |of|
 \\pseudodsk
                          |with|
 (function \\vanillaeventfn))))
                   (\\definedevice 'dsk \\pseudodsk)
                   \\pseudodsk)))
        (maiko (selectq name
                   (unix (|\\UFSOpenDevice|))
                   (dsk (|\\DSKOpenDevice|))
                   nil))
        ((dolphin dorado) 
             (\\m44hostnamep name))
        nil)))

(\\vanillaeventfn

  (lambda (fdev event)
                                   (* |bvm:| "30-Jan-85 21:54")

          (* * |Disassociates| |the| |name| dsk |from| |the| |pseudo| |disk,| |in| 

        |case| |there's| \a |real| |disk| |on| |the| |machine| |now|)

    (selectq event
        ((afterlogout aftersysout aftermakesys aftersavevm) 
             (\\removedevice.names fdev 'dsk))
        nil)))
)

(RPAQ? \\PSEUDODSK
 )
(DECLARE\: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \\PSEUDODSK \\DISKNAMECASEARRAY)
)
(DECLARE\: DONTEVAL@LOAD 

(\\VANILLADISKINIT
)
)
(DECLARE\: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
(PUTPROPS VANILLADISK COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1988 1990))
(DECLARE\: DONTCOPY
  (FILEMAP (NIL (784 4970 (\\VANILLADISKINIT 794 . 2901) (\\VANILLAHOSTNAMEP 2903 . 4547) (
\\VANILLAEVENTFN 4549 . 4968)))))
STOP