(* ;;-*-LISP-*- KEEP EMACS HAPPY ********************************
*
*     FLOPPY
*
****************************************************************)

(DEFEXPR (\FLOPPY.DRIVEEXISTSP)
  (* Machine has a floppy drive? *)
  (EQ \MACHINETYPE \DANDELION))

(DEFEXPR (\FLOPPY.INIT)
  (PROG ()
    (SETQ FLOPPYCSB (\ADDBASE \IOPAGE 111Q))
    (* 16 quad aligned words needed for IOCB in the first 64K *) 
    (* \IOCBPAGE located at 400Q *)
    (SETQ FLOPPYIOCBADDR (+ 400Q 240))
    (SETQ FLOPPYIOCB (\ADDBASE \IOCBPAGE 240))
    (SETQ FLOPPYRESULT (\ADDBASE FLOPPYIOCB 8))
    (COND (FLOPPYFDEV (\FLOPPY.CLOSE FLOPPYFDEV)))
    (\FLOPPY.CREATE.FDEV)
    (\DEFINEDEVICE (FDEV.DEVICENAME FLOPPYFDEV) FLOPPYFDEV)
    (COND ((\FLOPPY.DRIVEEXISTSP) (\FLOPPY.INITIALIZE)))
))

(* Change NODIRECTORIES to NIL *)
(DEFVAR FLOPPYFDEV)
(DEFEXPR (\FLOPPY.CREATE.FDEV)
  (PROG ()
    (SETQ FLOPPYFDEV
	  (CREATE FDEV
		  DEVICENAME _ 'FLOPPY
		  DEVICEINFO _ (CREATE FDEVINFO)
		  RESETABLE _ T
		  RANDOMACCESSP _ T
		  NODIRECTORIES _ T
		  PAGEMAPPED _ T
		  CLOSEFILE _ (FUNCTION \FLOPPY.CLOSEFILE)
		  DELETEFILE _ (FUNCTION \FLOPPY.DELETEFILE)
		  GETFILEINFO _ (FUNCTION \FLOPPY.GETFILEINFO)
		  GETFILENAME _ (FUNCTION \FLOPPY.GETFILENAME)
		  OPENFILE _ (FUNCTION \FLOPPY.OPENFILE)
		  READPAGES _ (FUNCTION \FLOPPY.READPAGES)
		  SETFILEINFO _ (FUNCTION \FLOPPY.SETFILEINFO)
		  TRUNCATEFILE _ (FUNCTION \FLOPPY.TRUNCATEFILE)
		  WRITEPAGES _ (FUNCTION \FLOPPY.WRITEPAGES)
		  REOPENFILE _ (FUNCTION \FLOPPY.OPENFILE)
		  GENERATEFILES _ (FUNCTION \FLOPPY.GENERATEFILES)
		  EVENTFN _ (FUNCTION \FLOPPY.EVENTFN)
		  DIRECTORYNAMEP _ (FUNCTION TRUE)
		  HOSTNAMEP _ (FUNCTION \FLOPPY.HOSTNAMEP)
		  BIN _ (FUNCTION \PAGEDBIN)
		  BOUT _ (FUNCTION \PAGEDBOUT)
		  PEEKBIN _ (FUNCTION \PAGEDPEEKBIN)
		  READP _ (FUNCTION \PAGEDREADP)
		  BACKFILEPTR _ (FUNCTION \PAGEDBACKFILEPTR)
		  SETFILEPTR _ (FUNCTION \PAGEDSETFILEPTR)
		  GETFILEPTR _ (FUNCTION \PAGEDGETFILEPTR)
		  GETEOFPTR _ (FUNCTION \PAGEDGETEOFPTR)
		  EOFP _ (FUNCTION \PAGEDEOFP)
		  BLOCKIN _ (FUNCTION \PAGEDBINS)
		  BLOCKOUT _ (FUNCTION \PAGEDBOUTS)))
))

(DEFDATATYPE VOLUMEINFO
  (FILELIST DIR SECTOR9 BADPAGEMAP))
(DEFEXPR (PRETTY-VOLUMEINFO VOLUMEINFO)
  (CONS NIL (FORMAT NIL "<~A>"
		    (VOLUMEINFO.IDENTITY VOLUMEINFO)
)))

(DEFDATATYPE FDEVINFO
  (VOLUMEINFO))
(DEFEXPR (PRETTY.FDEVINFO FDEVINFO)
  (CONS NIL (FORMAT NIL "<~A>"
		    (FDEVINFO.IDENTITY FDEVINFO))))

(DEFEXPR (\FLOPPY.CLOSEFILE STREAM)
  (PROG ()
    (* NOP *)))

(DEFEXPR (\FLOPPY.DELETEFILE FILE FDEV)
  (\FLOPPY.BREAK "UNIMPLEMENTED"))

(DEFEXPR (\FLOPPY.GETFILEINFO FILE ATTRIBUTE FDEV)
  (PROG (STREAM LP FLE ANSWER)
    (SETQ STREAM (\FLOPPY.ASSURESTREAM FILE))
    (SETQ LP (FLOPPYSTREAM.LP STREAM))
    (SETQ FLE (FLOPPYSTREAM.FLE STREAM))
    (SETQ ANSWER 
	  (SELECTQ ATTRIBUTE
	    (WRITEDATE (LP.WRITEDATE LP))
	    (READDATE (LP.READDATE LP))
	    (CREATIONDATE (LP.CREATIONDATE LP))
	    (IWRITEDATE (LP.IWRITEDATE LP))
	    (IREADDATE (LP.IREADDATE LP))
	    (ICREATIONDATE (LP.ICREATIONDATE LP))
	    (LENGTH (LP.LENGTH LP))
	    (MESATYPE (FLE.TYPE FLE))
	    NIL))
    (RETURN ANSWER)
))

(DEFEXPR (\FLOPPY.GETFILENAME FILE RECOG FDEV)
  (COND ((TYPE? STREAM FILE)
	 (STREAM.FULLFILENAME FILE))
	(T FILE)))

(OR (RECLOOK 'FILEGENOBJ)
    (LOADFNS NIL '{PHYLUM}<LISPCORE>SOURCES>FILEIO NIL 'FILEGENOBJ))
(DEFDATATYPE FILEGENOBJ)

(RECORD GENFILESTATE (FILES DEVICENAME))
(DEFDATATYPE GENFILESTATE)

(DEFEXPR (\FLOPPY.GENERATEFILES FDEV PATTERN)
  (PROG (FDEVINFO VOLUMEINFO FILES GENFILESTATE FILEGENOBJ)
    (\FLOPPY.DOORCHECK FDEV)
    (SETQ FDEVINFO (FDEV.DEVICEINFO FDEV))
    (SETQ VOLUMEINFO (FDEVINFO.VOLUMEINFO FDEVINFO))
    (* Figure out better test than NCHARS here *)
    (SETQ FILES (SORT (FOR BUCKET IN (VOLUMEINFO.DIR VOLUMEINFO)
		       WHEN (> (NCHARS (CAR BUCKET)) 0)
		       COLLECT (CAR BUCKET))))
    (SETQ GENFILESTATE
	  (CREATE GENFILESTATE
		  FILES _ FILES
		  DEVICENAME _ (FDEV.DEVICENAME FDEV)))
    (SETQ FILEGENOBJ
	  (CREATE FILEGENOBJ
		  NEXTFILEFN _ (FUNCTION \FLOPPY.NEXTFILEFN)
		  GENFILESTATE _ GENFILESTATE))
    (RETURN FILEGENOBJ)))

(DEFEXPR (\FLOPPY.NEXTFILEFN GENFILESTATE SCRATCHLIST NOVERSION HOST/DIR)
  (* Passes back list of char codes naming file in SCRATCHLIST and
     updates GENFILESTATE *)
  (* KLUGE ALERT: DIR bug forces me to add version number and dot to
     file names--what a mess *) 
  (PROG (FILES FILE DEVICENAME ANSWER)
    (SETQ FILES (GENFILESTATE.FILES GENFILESTATE))
    (COND ((NULL FILES)(RETURN)))
    (SETQ FILE (U-CASE (POP FILES)))
    (COND ((NULL (STRPOS "." FILE))
	   (* This only works because right now versions do not exist *)
	   (SETQ FILE (PACK* FILE "."))))
    (SETQ DEVICENAME (GENFILESTATE.DEVICENAME GENFILESTATE))
    (SETQ ANSWER
	  (SCRATCHLIST SCRATCHLIST
	     (COND (HOST/DIR (ADDTOSCRATCHLIST (CHARCODE {))
			     (FOR C IN (CHCON DEVICENAME)
			      DO (ADDTOSCRATCHLIST C))
			     (ADDTOSCRATCHLIST (CHARCODE }))))
	     (FOR C IN (CHCON FILE)
	      DO (ADDTOSCRATCHLIST C))
	     (COND ((NOT NOVERSION)
		    (* Hack%! *)
		    (ADDTOSCRATCHLIST (CHARCODE ";"))
		    (ADDTOSCRATCHLIST (CHARCODE 1))))))
    (SETF (GENFILESTATE.FILES GENFILESTATE) FILES)
    (RETURN ANSWER)
))

(DEFEXPR (\FLOPPY.EVENTFN FDEV EVENT)
  (PROG ()
    (COND ((NOT (\FLOPPY.DRIVEEXISTSP)) (RETURN)))
    (SELECTQ EVENT
      ((AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS AFTERSAVEVM RESTART)
       (\FLOPPY.INITIALIZE))
      (* NOP *))
))

(DEFEXPR (\FLOPPY.HOSTNAMEP NAME FDEV)
  (AND (TYPE? FDEV FDEV)
       (EQ NAME (FDEV.DEVICENAME FDEV))))

(DEFEXPR (\FLOPPY.OPENFILE FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM)
  (PROG (STREAM)
    (COND ((NOT (TYPE? STREAM FILE))
	   (SETQ STREAM
		 (\FLOPPY.GETFILEHANDLE FILE RECOG FDEV
				       (NOT (EQ ACCESS 'INPUT)))))
	  (T (SETQ STREAM FILE)))
    (COND ((EQ ACESS 'OUTPUT)
	   (* File is EMPTY even if it is old *)
	   (SETF (STREAM.EPAGE STREAM) 0)
	   (SETF (STREAM.EOFFSET STREAM) 0)))
    (RETURN STREAM)
))

(ACCESSFNS FLOPPYSTREAM
  ((FLE (STREAM.F1 DATUM)
	(SETF (STREAM.F1 DATUM) NEWVALUE))
   (LP (STREAM.F2 DATUM)
       (SETF (STREAM.F2 DATUM) NEWVALUE))
   (VOLUMEINFO (STREAM.F3 DATUM)
	       (SETF (STREAM.F3 DATUM) NEWVALUE))))
(DEFDATATYPE FLOPPYSTREAM)

(DEFEXPR (\FLOPPY.GETFILEHANDLE FILE RECOG FDEV CREATEFLG)
  (PROG (NAME EXTENSION FDEVINFO VOLUMEINFO DIRENTRY FLE LP STREAM)
    (\FLOPPY.OPEN FDEV)
    (SETQ NAME (\FLOPPY.ASSUREFILENAME FILE))
    (SETQ FDEVINFO (FDEV.DEVICEINFO FDEV))
    (SETQ VOLUMEINFO (FDEVINFO.VOLUMEINFO FDEVINFO))
    (SETQ DIRENTRY (GETA (VOLUMEINFO.DIR VOLUMEINFO) NAME))
    (COND ((NULL DIRENTRY)(RETURN NIL)))
    (SETQ FLE (DIRENTRY.FLE DIRENTRY))
    (SETQ LP (DIRENTRY.LP DIRENTRY))
    (SETQ STREAM (CREATE STREAM
			 DEVICE _ FDEV
			 FULLFILENAME _ FILE
			 EPAGE _ (/ (LP.LENGTH LP) 512)
			 EOFFSET _ (\ (LP.LENGTH LP) 512)))
    (SETF (FLOPPYSTREAM.FLE STREAM) FLE)
    (SETF (FLOPPYSTREAM.LP STREAM) LP)
    (SETF (FLOPPYSTREAM.VOLUMEINFO STREAM) VOLUMEINFO)
    (RETURN STREAM)))

(DEFEXPR (\FLOPPY.ASSUREFILENAME FILE)
  (PROG (NAME)
    (COND ((TYPE? STREAM FILE)
	   (SETQ NAME (STREAM.FULLFILENAME STREAM))))
    (SETQ NAME (SUBATOM FILE (1+ (OR (STRPOS "}" FILE) 0))
			(1- (OR (STRPOS ";" FILE)
				(1+ (NCHARS FILE))))))
    (RETURN NAME)
))

(DEFEXPR (\FLOPPY.ASSURESTREAM STREAM)
  (PROG ()
    (COND ((TYPE? STREAM STREAM)
	   (RETURN STREAM))
	  (T (SETQ STREAM 
		   (\FLOPPY.GETFILEHANDLE STREAM 'OLD FLOPPYFDEV NIL))))
    (RETURN STREAM)
))

(DEFEXPR (\FLOPPY.READPAGES STREAM FIRSTPAGE# BUFFERS)
  (PROG (FLE PAGENO)
    (SETQ FLE (FLOPPYSTREAM.FLE STREAM))
    (SETQ PAGENO (+ (FLE.LOCATION FLE) 1 FIRSTPAGE#))
    (\FLOPPY.READPAGENO PAGENO BUFFERS)))

(DEFEXPR (\FLOPPY.SETFILEINFO FHANDLE STREAM ATTRIBUTE VALUE)
  (\FLOPPY.BREAK "UNIMPLEMENTED"))

(DEFEXPR (\FLOPPY.TRUNCATEFILE STREAM LP LO UPDATENOW)
  (\FLOPPY.BREAK "UNIMPLEMENTED"))

(* Leader Page *)
(DATATYPE LP
  ((VERSIONID WORD)
   (DIR WORD)
   (* DIRINFO to be figured out *)
   (DIRTYPE BITS 8)
   (DELETEPROTECT FLAG)
   (READPROTECT FLAG)
   (WRITEPROTECT FLAG)
   (DIRPROTECT FLAG)
   (NIL BITS 4)
   (* Offset 6 *)
   (@CREATIONDATELO WORD)
   (@CREATIONDATEHI WORD)
   (@WRITEDATELO WORD)
   (@WRITEDATEHI WORD)
   (@READDATELO WORD)
   (@READDATEHI WORD)
   (NIL 4 WORD)
   (@LENGTHLO WORD)
   (@LENGTHHI WORD)
   (NIL BITS 8)
   (NAMELENGTH BITS 8)
   (NIL BITS 8)
   (NAMEMAXLENGTH BITS 8)
   (* Offset 17 *)
   (NIL 50 WORD)
   (* Offset 67 *)
   (GKW 4 WORD)
   (NIL 184 WORD))
  (ACCESSFNS
   (($NAME (CREATE STRINGP
		   BASE _ (LP.*NAME DATUM)
		   LENGTH _ (LP.NAMELENGTH DATUM)))
    (*NAME (\ADDBASE DATUM 17))
    (LENGTH (+ (x 65536 (LP.@LENGTHHI DATUM))
	       (LP.@LENGTHLO DATUM)))
    (CREATIONDATE (GDATE (LP.ICREATIONDATE DATUM)))
    (ICREATIONDATE (+ (x 65536 (LOGXOR (LP.@CREATIONDATEHI DATUM)
				       100000Q))
		      (LP.@CREATIONDATELO DATUM)))
    (WRITEDATE (GDATE (LP.IWRITEDATE DATUM)))
    (IWRITEDATE (+ (x 65536 (LOGXOR (LP.@WRITEDATEHI DATUM)
				    100000Q))
		   (LP.@WRITEDATELO DATUM)))
    (READDATE (GDATE (LP.IREADDATE DATUM)))
    (IREADDATE (+ (x 65536 (LOGXOR (LP.@READDATEHI DATUM)
				   100000Q))
		  (LP.@READDATELO DATUM)))
    ($DIRTYPE (SELECT (LP.DIRTYPE DATUM)
		(0 'UNKNOWN)
		(1 'TEXT)
		(2 'BINARY)
		(3 'DIRECTORY)
		(255 'NULL)
		'?))
    (*VALUE DATUM
	    (\MOVEWORDS NEWVALUE 0 DATUM 0 256))))
  NAMEMAXLENGTH _ 100)
(DEFDATATYPE LP)

(RECORD DIRENTRY
  (FLE LP))
(DEFDATATYPE DIRENTRY)

(DEFVAR FLOPPYVOLUMEINFO)
(DEFVAR FLOPPYSECTOR9)
(DEFEXPR (\FLOPPY.OPEN FDEV)
  (PROG (FDEVINFO)
    (COND ((NOT (\FLOPPY.DRIVEEXISTSP))
	   (\FLOPPY.BREAK "No floppy drive on this machine")))
    (SETQ FDEVINFO (FDEV.DEVICEINFO FDEV))
    (COND ((FDEVINFO.VOLUMEINFO FDEVINFO)
	   (* Already open *)
	   (RETURN)))
    (\FLOPPY.INITIALIZE)
    (\FLOPPY.RECALIBRATE)
    (SETQ FLOPPYVOLUMEINFO (CREATE VOLUMEINFO))
    (\FLOPPY.OPEN.SECTOR9 FLOPPYVOLUMEINFO)
    (\FLOPPY.OPEN.FILELIST FLOPPYVOLUMEINFO)
    (SETF (FDEVINFO.VOLUMEINFO FDEVINFO) FLOPPYVOLUMEINFO)
    (RETURN FLOPPYVOLUMEINFO)
))

(DEFEXPR (\FLOPPY.CLOSE FDEV)
  (PROG (FDEVINFO)
    (SETQ FDEVINFO (FDEV.DEVICEINFO FDEV))
    (SETF (FDEVINFO.VOLUMEINFO FDEVINFO) NIL)
    (FOR STREAM IN \OPENFILES
     WHEN (EQ (STREAM.DEVICE STREAM) FDEV)
     DO (CLOSEF STREAM))
))

(DEFEXPR (\FLOPPY.REOPEN FDEV)
  (PROG ()
    (\FLOPPY.CLOSE FDEV)
    (\FLOPPY.OPEN FDEV)
))

(DEFEXPR (\FLOPPY.DOORCHECK FDEV)
  (PROG ()
    (\FLOPPY.NOP)
    (COND ((RESULT.DOOROPENED FLOPPYRESULT)
	   (\FLOPPY.CLOSE FDEV)))
    (\FLOPPY.OPEN FDEV)
))

(DEFEXPR (\FLOPPY.OPEN.SECTOR9 VOLUMEINFO)
  (PROG ()
    (DO (SETQ FLOPPYSECTOR9
	      (\FLOPPY.READSECTOR (CREATE DISKADDRESS
							   SECTOR _ 9)
					      (CREATE SECTOR9)))
	(COND ((EQ (SECTOR9.$SEAL FLOPPYSECTOR9) 'INTACT)
	       (RETURN)))
        (\FLOPPY.BREAK "Not a pilot volume"))
    (SETF (VOLUMEINFO.SECTOR9 VOLUMEINFO) FLOPPYSECTOR9)))

(DEFEXPR (\FLOPPY.OPEN.FILELIST VOLUMEINFO)
  (PROG (SECTOR9 FILELIST FLES LPS FILENAME DIR)
    (SETQ SECTOR9 (VOLUMEINFO.SECTOR9 VOLUMEINFO))
    (* Need to change to handles fileslists longer than one page *)
    (SETQ FILELIST (\FLOPPY.READPAGENO (SECTOR9.FILELIST SECTOR9)))
    (SETF (VOLUMEINFO.FILELIST FLOPPYVOLUMEINFO) FILELIST)
    (SETQ FLES
	  (FOR I FROM 0 TO (1- (FILELIST.COUNT FILELIST))
	   COLLECT (CREATE FLE
			   *VALUE _
			   (\ADDBASE (FILELIST.*FILES FILELIST)
				     (x 5 I)))))
    (SETQ LPS
	  (FOR FLE IN FLES
        COLLECT (\FLOPPY.READPAGENO (FLE.LOCATION FLE)
							(CREATE LP))))
    (FOR FLE IN FLES
     AS LP IN LPS
     DO (COND ((>= (LP.NAMELENGTH LP) 128)
	       (* Figure this out sometime *)
	       (SETQ FILENAME (GENSYM)))
	      (T (SETQ FILENAME (MKATOM (LP.$NAME LP)))))
     (PUSH DIR (CONS FILENAME
		     (CREATE DIRENTRY
			     FLE _ FLE
			     LP _ LP))))
    (SETF (VOLUMEINFO.DIR VOLUMEINFO)
	  DIR)))

(DEFEXPR (\FLOPPY.PAGENOTODISKADDRESS PAGENO)
  (PROG (TRACKSPERCYLINDER SECTORSPERTRACK QUOTIENT CYLINDER HEAD
			   SECTOR DISKADDRESS)
    (SETQ TRACKSPERCYLINDER 2)
    (SETQ SECTORSPERTRACK 15)
    (SETQ SECTOR (1+ (\ (1- PAGENO) SECTORSPERTRACK)))
    (SETQ QUOTIENT (/ (1- PAGENO) SECTORSPERTRACK))
    (SETQ HEAD (\ QUOTIENT TRACKSPERCYLINDER))
    (SETQ CYLINDER (/ QUOTIENT TRACKSPERCYLINDER))
    (SETQ DISKADDRESS
	  (CREATE DISKADDRESS
		  SECTOR _ SECTOR
		  HEAD _ HEAD
		  CYLINDER _ CYLINDER))
    (RETURN DISKADDRESS)
))

(DEFEXPR (\FLOPPY.DISKADDRESSTOPAGENO DISKADDRESS)
  (PROG (TRACKSPERCYLINDER SECTORSPERTRACKPAGENO)
    (SETQ TRACKSPERCYLINDER 2)
    (SETQ SECTORSPERTRACK 15)
    (SETQ PAGENO
	  (+ (DISKADDRESS.SECTOR DISKADDRESS)
	     (x SECTORSPERTRACK
		(+ (DISKADDRESS.HEAD DISKADDRESS)
		   (x (DISKADDRESS.CYLINDER DISKADDRESS))))))
    (RETURN PAGENO)))

(DEFEXPR (\FLOPPY.WRITEPAGENO PAGENO PAGE)
  (\FLOPPY.WRITESECTOR (\FLOPPY.PAGENOTODISKADDRESS PAGENO) PAGE))

(DEFEXPR (\FLOPPY.READPAGENO PAGENO (OPTIONAL PAGE))
  (\FLOPPY.READSECTOR (\FLOPPY.PAGENOTODISKADDRESS PAGENO) PAGE))

STOP