(FILECREATED "13-Jun-86 14:29:00" {DSK}<LISPFILES>VPCDISK.;2 111994
changes to: (FNS \VPCF.GETNEXTBUFFER \VPCF.EOFP)
previous date: "12-Jun-86 17:25:02" {ERINYES}<BLUM>SOURCES>VPCDISK.;27)
(* Copyright (c) 1986, 1900 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT VPCDISKCOMS)
(RPAQQ VPCDISKCOMS ((* * Implements a LISP file system, so lisp can use files on virtual IBM-PC
format floppy and hard disks.)
(DECLARE: DONTCOPY (RECORDS VPCDISK VPCFDIRENTRY VPCFFILE VPCDIR
VPCGENERATEDFILEINFO)
(CONSTANTS (VPCF.BYTES.PER.SECTOR 512)
(VPCF.DIR.ENTRY.LEN 32)
(VPCF.SECTORS.PER.CYLINDER 68))
(* * Directory file attribute-byte bit meanings)
(CONSTANTS (ATTR.READONLY 1)
(ATTR.HIDDEN 2)
(ATTR.SYSFILE 4)
(ATTR.VOLLABEL 8)
(ATTR.DIR 16)
(ATTR.ARCHIVE 32))
(* * Media-type byte meanings (first byte of the FAT))
(CONSTANTS (DISK.8SEC2SIDE 255)
(DISK.8SEC1SIDE 254)
(DISK.9SEC2SIDE 253)
(DISK.9SEC1SIDE 252)
(DISK.15SEC2SIDE 249)
(DISK.FDISK 248)
(VPCF.EOF 4088)
(* 12-bit EOF value))
(MACROS \SWIN \DSWIN \SWOUT \DSWOUT))
(INITRECORDS VPCDISK VPCFDIRENTRY VPCFFILE)
(COMS (FNS PRINDIRSTR STR2INT \VPCF.READPAGES))
(COMS (* DEVICE and FLOPPY initialization and copying)
(FNS VPCDISK.FLOPPY.TO.FILE VPCDISK.FILE.TO.FLOPPY VPCDISK.INSTALL
VPCDISK.CREATE.DEVICE \VPCDISK.CREATE.FLOPPY VPCDISK.DELETE.DEVICE
VPCDISK.FREEPAGES VPCDISK.GETPARTITION# VPCDISK.CHANGE.PARTITION.TYPE
\VPCF.INITIALIZE.DISK))
(COMS (* Directory Manipulation)
(FNS \VPCF.FIND.DIR.ENTRY \VPCF.DIR.LOOKUP \VPCF.SEARCH.DIR
\VPCF.READ.DIR.ENTRY \VPCF.FIND.FREE.DIR.ENTRY \VPCF.WRITE.DIR.ENTRY
\VPCF.READ.FILE.DATE \VPCF.WRITE.FILE.DATE \VPCF.ROOTDIRECTORY
\VPCF.NEXT.DIR.CLUSTER \VPCF.CLUSTER.TO.FILEPOS \VPCF.MAPDIR
\VPCF.READ.FAT.CHAIN)
(FNS \VPCF.GENERATEFILES \VPCF.FILEMATCH \VPCF.FILEMATCH1 \VPCF.NEXTFILEFN
\VPCF.FILEINFOFN)
(FNS \VPCF.GETFILEINFO \VPCF.SETFILEINFO \VPCF.OPEN.BACKING.STREAM
\VPCF.CLOSE.BACKING.STREAM))
(COMS (* FILEPTR Manipulation)
(FNS \VPCF.EOFP \VPCF.SETFILEPTR \VPCF.GETFILEPTR \VPCF.SETEOFPTR
\VPCF.GETEOFPTR \VPCF.UPDATEOF))
(FNS \VPCF.OPENFILE \VPCF.OPEN.FOR.INPUT \VPCF.OPEN.FOR.OUTPUT
\VPCF.OPEN.FOR.BOTH \VPCF.OPEN.FOR.APPEND \VPCF.REOPENFILE \VPCF.CLOSEFILE
\VPCF.DELETEFILE \VPCF.SEARCHOFDS \VPCF.DELETEOFD \VPCF.ADDOFD)
(FNS \VPCF.PARSENAME \VPCF.GETFILENAME \VPCF.GET.DISK \VPCF.GETNEXTBUFFER
\VPCF.READ.CLUSTER \VPCF.WRITE.CLUSTER \VPCF.GET.NEXT.CLUSTER
\VPCF.ALLOCATE.CLUSTERS \VPCF.ALLOCATE.CLUSTER \VPCF.DEALLOCATE.CLUSTERS
\VPCF.MARK.THE.FAT \VPCF.PRINT.FATS \VPCF.GET.CLUSTER.CHAIN \VPCF.DIRTEST)
(VARS (\VPCF.OPENFILES NIL))
(INITVARS (PC.TEXTFILE.EXTENSIONS NIL))
(P (VPCDISK.INSTALL))))
(* * Implements a LISP file system, so lisp can use files on virtual IBM-PC format floppy and
hard disks.)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(DATATYPE VPCDISK ((VPCDEVICE POINTER) (* The name of the device)
(RIGIDDISK FLAG) (* If T implies a Rigid Disk, else
FLOPPY)
(* * The following fields are for rigid disks only)
(PARTITION# BYTE) (* Partition number for rigid disk
(1 thru 4))
(START.HEAD BYTE) (* Starting Head number for this rigid
partition)
(START.CYLINDER INTEGER) (* Starting Cylinder for this rigid
partition)
(START.SECTOR INTEGER) (* Starting sector for this partition)
(END.HEAD BYTE) (* Ending Head)
(END.CYLINDER INTEGER) (* Ending cylinder)
(END.SECTOR INTEGER) (* Ending sector)
(* * The following fields apply to either floppy or rigid)
(REL.SECTORS INTEGER) (* Number of sectors preceding this
partition)
(#SECTORS INTEGER) (* Number of sectors in this partition)
(SIDES INTEGER) (* # of sides on the floppy --
1 or 2)
(SECT.PER.TRACK INTEGER) (* # of sectors per track on the
floppy)
(FATS BYTE) (* Number of FATS per disk)
(FAT.SIZE INTEGER) (* # of sectors in the File Allocation
Table (FAT))
(FAT.OFFSET1 INTEGER) (* First byte of the first FAT)
(FAT.OFFSET2 INTEGER) (* First byte of the second FAT)
(DIR.SIZE INTEGER) (* # of sectors in the root directory
on this floppy)
(DIR.OFFSET INTEGER) (* First byte of the directory)
(DATA.OFFSET INTEGER) (* first byte of data area)
(BYTES.PER.CLUSTER INTEGER)
FILENAME FILEINUSE MONITORLOCK DIR)
MONITORLOCK ← (CREATE.MONITORLOCK (QUOTE PCDISK)))
(DATATYPE VPCFDIRENTRY (
(* * The directory entry for a file on a virtual floppy or hard disk)
NAME (* File name -- 8 chars)
EXTENSION (* File extension --
3 chars)
(ATTRIBUTE BYTE) (* File attributes, e.g.
read-only, invisible, system-file)
(IDATE INTEGER) (* Write date)
(START WORD) (* first cluster number ;
the FAT is used to find subsequent
sectors)
(SIZE INTEGER) (* File's length, in bytes)
DIRENTRYFPOS (* The filepos of this directory entry
in the underlying "floppy" stream)
))
(DATATYPE VPCFFILE (
(* * Description of an open file on an emulated floppy or hard disk)
(DISK POINTER) (* The floppy this file resides on)
(DIRENTRY POINTER)
(CURCLUSTER WORD) (* The cluster # currently in the
buffer)
(CLUSTER WORD) (* The NEXT sequential cluster to be
read)
(BYTE INTEGER) (* current byte)
(VPCFULLNAME POINTER)
FATCHAIN (* List of cluster numbers that this
file occupies)
)
CURCLUSTER ← 0)
(RECORD VPCDIR (
(* * Description of a directory, as starting filepos and ending filepos)
DIRSTART (* Filepos in the floppy that this
directory starts at)
DIREND (* Filepos where it ends, too.)
DIRCLUSTER (* The current cluster number.
NIL => this is the root directory, and
we should search no farther)
ROOTDIR (* T If this is the root directory)
))
(RECORD VPCGENERATEDFILEINFO (
(* * Hold the information about 1 file in the directory generator state--the
full file name and its VPCDIRENTRY.)
VNAME . VDIRENTRY))
]
(/DECLAREDATATYPE (QUOTE VPCDISK)
(QUOTE (POINTER FLAG BYTE BYTE FIXP FIXP BYTE FIXP FIXP FIXP FIXP FIXP FIXP BYTE FIXP FIXP
FIXP FIXP FIXP FIXP FIXP POINTER POINTER POINTER POINTER))
(QUOTE ((VPCDISK 0 POINTER)
(VPCDISK 0 (FLAGBITS . 0))
(VPCDISK 2 (BITS . 7))
(VPCDISK 2 (BITS . 135))
(VPCDISK 3 FIXP)
(VPCDISK 5 FIXP)
(VPCDISK 7 (BITS . 7))
(VPCDISK 8 FIXP)
(VPCDISK 10 FIXP)
(VPCDISK 12 FIXP)
(VPCDISK 14 FIXP)
(VPCDISK 16 FIXP)
(VPCDISK 18 FIXP)
(VPCDISK 7 (BITS . 135))
(VPCDISK 20 FIXP)
(VPCDISK 22 FIXP)
(VPCDISK 24 FIXP)
(VPCDISK 26 FIXP)
(VPCDISK 28 FIXP)
(VPCDISK 30 FIXP)
(VPCDISK 32 FIXP)
(VPCDISK 34 POINTER)
(VPCDISK 36 POINTER)
(VPCDISK 38 POINTER)
(VPCDISK 40 POINTER)))
(QUOTE 42))
(/DECLAREDATATYPE (QUOTE VPCFDIRENTRY)
(QUOTE (POINTER POINTER BYTE FIXP WORD FIXP POINTER))
(QUOTE ((VPCFDIRENTRY 0 POINTER)
(VPCFDIRENTRY 2 POINTER)
(VPCFDIRENTRY 2 (BITS . 7))
(VPCFDIRENTRY 4 FIXP)
(VPCFDIRENTRY 6 (BITS . 15))
(VPCFDIRENTRY 7 FIXP)
(VPCFDIRENTRY 10 POINTER)))
(QUOTE 12))
(/DECLAREDATATYPE (QUOTE VPCFFILE)
(QUOTE (POINTER POINTER WORD WORD FIXP POINTER POINTER))
(QUOTE ((VPCFFILE 0 POINTER)
(VPCFFILE 2 POINTER)
(VPCFFILE 4 (BITS . 15))
(VPCFFILE 5 (BITS . 15))
(VPCFFILE 6 FIXP)
(VPCFFILE 8 POINTER)
(VPCFFILE 10 POINTER)))
(QUOTE 12))
(DECLARE: EVAL@COMPILE
(RPAQQ VPCF.BYTES.PER.SECTOR 512)
(RPAQQ VPCF.DIR.ENTRY.LEN 32)
(RPAQQ VPCF.SECTORS.PER.CYLINDER 68)
(CONSTANTS (VPCF.BYTES.PER.SECTOR 512)
(VPCF.DIR.ENTRY.LEN 32)
(VPCF.SECTORS.PER.CYLINDER 68))
)
(DECLARE: EVAL@COMPILE
(RPAQQ ATTR.READONLY 1)
(RPAQQ ATTR.HIDDEN 2)
(RPAQQ ATTR.SYSFILE 4)
(RPAQQ ATTR.VOLLABEL 8)
(RPAQQ ATTR.DIR 16)
(RPAQQ ATTR.ARCHIVE 32)
(CONSTANTS (ATTR.READONLY 1)
(ATTR.HIDDEN 2)
(ATTR.SYSFILE 4)
(ATTR.VOLLABEL 8)
(ATTR.DIR 16)
(ATTR.ARCHIVE 32))
)
(DECLARE: EVAL@COMPILE
(RPAQQ DISK.8SEC2SIDE 255)
(RPAQQ DISK.8SEC1SIDE 254)
(RPAQQ DISK.9SEC2SIDE 253)
(RPAQQ DISK.9SEC1SIDE 252)
(RPAQQ DISK.15SEC2SIDE 249)
(RPAQQ DISK.FDISK 248)
(RPAQQ VPCF.EOF 4088)
(CONSTANTS (DISK.8SEC2SIDE 255)
(DISK.8SEC1SIDE 254)
(DISK.9SEC2SIDE 253)
(DISK.9SEC1SIDE 252)
(DISK.15SEC2SIDE 249)
(DISK.FDISK 248)
(VPCF.EOF 4088))
)
(DECLARE: EVAL@COMPILE
[PUTPROPS \SWIN MACRO (OPENLAMBDA (STREAM)
(* * Reads a byte-swapped word from STREAM)
(IPLUS (BIN STREAM)
(LLSH (BIN STREAM)
8]
[PUTPROPS \DSWIN MACRO (OPENLAMBDA (STREAM)
(* * Reads a byte-swapped, word-swapped double word from STREAM)
(IPLUS (\SWIN STREAM)
(LLSH (\SWIN STREAM)
16]
[PUTPROPS \SWOUT MACRO (OPENLAMBDA (STREAM WORD)
(* * Writes a byte-swapped word to STREAM)
(BOUT STREAM (LOGAND WORD 255))
(BOUT STREAM (LOGAND 255 (LRSH WORD 8]
[PUTPROPS \DSWOUT MACRO (OPENLAMBDA (STREAM DBLWORD)
(* * Writes a byte-swapped, word-swapped double word to STREAM)
(\SWOUT STREAM (LOGAND DBLWORD 65535))
(\SWOUT STREAM (LOGAND 65535 (LRSH DBLWORD 16]
)
)
(/DECLAREDATATYPE (QUOTE VPCDISK)
(QUOTE (POINTER FLAG BYTE BYTE FIXP FIXP BYTE FIXP FIXP FIXP FIXP FIXP FIXP BYTE FIXP FIXP
FIXP FIXP FIXP FIXP FIXP POINTER POINTER POINTER POINTER))
(QUOTE ((VPCDISK 0 POINTER)
(VPCDISK 0 (FLAGBITS . 0))
(VPCDISK 2 (BITS . 7))
(VPCDISK 2 (BITS . 135))
(VPCDISK 3 FIXP)
(VPCDISK 5 FIXP)
(VPCDISK 7 (BITS . 7))
(VPCDISK 8 FIXP)
(VPCDISK 10 FIXP)
(VPCDISK 12 FIXP)
(VPCDISK 14 FIXP)
(VPCDISK 16 FIXP)
(VPCDISK 18 FIXP)
(VPCDISK 7 (BITS . 135))
(VPCDISK 20 FIXP)
(VPCDISK 22 FIXP)
(VPCDISK 24 FIXP)
(VPCDISK 26 FIXP)
(VPCDISK 28 FIXP)
(VPCDISK 30 FIXP)
(VPCDISK 32 FIXP)
(VPCDISK 34 POINTER)
(VPCDISK 36 POINTER)
(VPCDISK 38 POINTER)
(VPCDISK 40 POINTER)))
(QUOTE 42))
(/DECLAREDATATYPE (QUOTE VPCFDIRENTRY)
(QUOTE (POINTER POINTER BYTE FIXP WORD FIXP POINTER))
(QUOTE ((VPCFDIRENTRY 0 POINTER)
(VPCFDIRENTRY 2 POINTER)
(VPCFDIRENTRY 2 (BITS . 7))
(VPCFDIRENTRY 4 FIXP)
(VPCFDIRENTRY 6 (BITS . 15))
(VPCFDIRENTRY 7 FIXP)
(VPCFDIRENTRY 10 POINTER)))
(QUOTE 12))
(/DECLAREDATATYPE (QUOTE VPCFFILE)
(QUOTE (POINTER POINTER WORD WORD FIXP POINTER POINTER))
(QUOTE ((VPCFFILE 0 POINTER)
(VPCFFILE 2 POINTER)
(VPCFFILE 4 (BITS . 15))
(VPCFFILE 5 (BITS . 15))
(VPCFFILE 6 FIXP)
(VPCFFILE 8 POINTER)
(VPCFFILE 10 POINTER)))
(QUOTE 12))
(DEFINEQ
(PRINDIRSTR
[LAMBDA (NAME X STREAM) (* AJB "28-Feb-86 20:25")
(COND
((GREATERP (NCHARS NAME)
X)
(PRIN3 (SUBSTRING NAME 1 X)
STREAM))
(T (PRIN3 NAME STREAM)
(RPTQ (DIFFERENCE X (NCHARS NAME))
(BOUT STREAM (CHARCODE SPACE])
(STR2INT
[LAMBDA (STR POS) (* AJB " 6-Mar-86 11:14")
(PROG [(CH1 (GNC (SUBSTRING STR POS POS)))
(CH2 (GNC (SUBSTRING STR (ADD1 POS)
(ADD1 POS]
[COND
((EQ (QUOTE % )
CH1)
(SETQ CH1 (QUOTE 0]
(RETURN (IPLUS (ITIMES CH1 10)
CH2])
(\VPCF.READPAGES
[LAMBDA (STREAM WHATFOR NOERRORFLG) (* AJB "17-Mar-86 17:02")
(* * Get the next buffer of bytes for a stream that's on an emulated IBM-PC format floppy/hard disk)
(LET ((BUFFER (fetch (STREAM CBUFPTR) of STREAM))
(FILE (fetch (STREAM F1) of STREAM)))
[OR BUFFER (SETQ BUFFER (replace (STREAM CBUFPTR) of STREAM
with (\ALLOCBLOCK (FOLDHI (fetch (VPCDISK BYTES.PER.CLUSTER)
of (fetch (VPCFFILE DISK)
of FILE))
BYTESPERCELL)
T]
(SELECTQ WHATFOR
(READ (* Reading. Go read the next cluster's worth of bytes
from the file.)
(PROG1 (\VPCF.READ.CLUSTER FILE BUFFER NOERRORFLG)
(replace (STREAM COFFSET) of STREAM with 0)))
(WRITE)
(SHOULDNT])
)
(* DEVICE and FLOPPY initialization and copying)
(DEFINEQ
(VPCDISK.FLOPPY.TO.FILE
[LAMBDA (TOFILE) (* mjs "20-May-86 08:55")
(* * Copy a PC floppy image to the file TOFILE)
(PROG [(STREAM (OPENSTREAM TOFILE (QUOTE OUTPUT)
(QUOTE NEW)))
(FLOPPYTYPE (PROGN (\PFLOPPY.READPAGENO 2 \FLOPPY.SCRATCH.BUFFER)
(\GETBASEBYTE \FLOPPY.SCRATCH.BUFFER 0]
(RESETLST (RESETSAVE NIL (LIST (FUNCTION CLOSEF)
STREAM))
(RESETSAVE \FLOPPY.TRACKSPERCYLINDER (SELECTC FLOPPYTYPE
(DISK.8SEC2SIDE 2)
(DISK.9SEC2SIDE 2)
(DISK.15SEC2SIDE 2)
(DISK.8SEC1SIDE 1)
(DISK.9SEC1SIDE 1)
(SHOULDNT)))
(RESETSAVE \FLOPPY.SECTORSPERTRACK (SELECTC FLOPPYTYPE
(DISK.8SEC2SIDE 8)
(DISK.8SEC1SIDE 8)
(DISK.9SEC2SIDE 9)
(DISK.9SEC1SIDE 9)
(DISK.15SEC2SIDE 17)
(SHOULDNT)))
(for I from 1 to (ITIMES 40 \FLOPPY.SECTORSPERTRACK
\FLOPPY.TRACKSPERCYLINDER)
do (\PFLOPPY.READPAGENO I \FLOPPY.SCRATCH.BUFFER)
(\BOUTS STREAM \FLOPPY.SCRATCH.BUFFER 0 512])
(VPCDISK.FILE.TO.FLOPPY
[LAMBDA (FROMFILE) (* mjs "20-May-86 08:55")
(* * Copy a LISP virtual floppy backing file to a real floppy)
(PROG* [(STREAM (OPENSTREAM FROMFILE (QUOTE INPUT)
(QUOTE OLD)))
(FLOPPYTYPE (PROGN (SETFILEPTR STREAM 512)
(\BIN STREAM]
(SETFILEPTR STREAM 0)
(RESETLST (RESETSAVE NIL (LIST (FUNCTION CLOSEF)
STREAM))
(RESETSAVE \FLOPPY.TRACKSPERCYLINDER (SELECTC FLOPPYTYPE
(DISK.8SEC2SIDE 2)
(DISK.9SEC2SIDE 2)
(DISK.15SEC2SIDE 2)
(DISK.8SEC1SIDE 1)
(DISK.9SEC1SIDE 1)
(SHOULDNT)))
(RESETSAVE \FLOPPY.SECTORSPERTRACK (SELECTC FLOPPYTYPE
(DISK.8SEC2SIDE 8)
(DISK.8SEC1SIDE 8)
(DISK.9SEC2SIDE 9)
(DISK.9SEC1SIDE 9)
(DISK.15SEC2SIDE 17)
(SHOULDNT)))
(for I from 1 to (ITIMES 40 \FLOPPY.SECTORSPERTRACK
\FLOPPY.TRACKSPERCYLINDER)
do (\BINS STREAM \FLOPPY.SCRATCH.BUFFER 0 512)
(\PFLOPPY.WRITEPAGENO I \FLOPPY.SCRATCH.BUFFER])
(VPCDISK.INSTALL
[LAMBDA NIL (* AJB "12-May-86 10:45")
(* * Define the PCDISK device, to support emulated IBM-PC format floppy and hard disks)
(\DEFINEDEVICE (QUOTE PCDISK)
(create FDEV
DEVICENAME ←(QUOTE PCDISK)
HOSTNAMEP ←(FUNCTION NILL)
DIRECTORYNAMEP ←(FUNCTION TRUE)
REOPENFILE ←(FUNCTION \VPCF.REOPENFILE)
EVENTFN ←(FUNCTION NILL)
OPENFILE ←(FUNCTION \VPCF.OPENFILE)
CLOSEFILE ←(FUNCTION \VPCF.CLOSEFILE)
GENERATEFILES ←(FUNCTION \VPCF.GENERATEFILES)
BUFFERED ← T
GETNEXTBUFFER ←(FUNCTION \VPCF.GETNEXTBUFFER)
GETFILEINFO ←(FUNCTION \VPCF.GETFILEINFO)
SETFILEINFO ←(FUNCTION \VPCF.SETFILEINFO)
GETFILENAME ←(FUNCTION \VPCF.GETFILENAME)
BIN ←(FUNCTION \BUFFERED.BIN)
BOUT ←(FUNCTION \BUFFERED.BOUT)
PEEKBIN ←(FUNCTION \BUFFERED.PEEKBIN)
SETFILEPTR ←(FUNCTION \VPCF.SETFILEPTR)
GETFILEPTR ←(FUNCTION \VPCF.GETFILEPTR)
SETEOFPTR ←(FUNCTION \VPCF.SETEOFPTR)
GETEOFPTR ←(FUNCTION \VPCF.GETEOFPTR)
EOFP ←(FUNCTION \VPCF.EOFP)
DELETEFILE ←(FUNCTION \VPCF.DELETEFILE)
DEVICEINFO ← NIL])
(VPCDISK.CREATE.DEVICE
[LAMBDA (NAME FILE RIGID PARTITION#) (* AJB "10-Apr-86 17:02")
(* * Add or replace a disk device from a LISP file to {PCDISK})
(* * NAME is device name, FILE is filename, RIGID is T for rigid disk else floppy, PARTITION# is PARTITION 1-4 of
RIGID DISK)
(OR (ATOM NAME)
(ERROR "ILLEGAL ARG" NAME))
(SETQ NAME (U-CASE NAME))
(LET ((WASOPEN (OPENP FILE))
STREAM
(FDEV (\GETDEVICEFROMNAME (QUOTE PCDISK)))
DISKS DISK)
[RESETLST (SETQ DISKS (fetch (FDEV DEVICEINFO) of FDEV))
[SETQ STREAM (COND
(WASOPEN (GETSTREAM FILE (QUOTE BOTH)))
(T (OPENSTREAM FILE (QUOTE BOTH]
(RESETSAVE NIL (LIST [FUNCTION (LAMBDA (STREAM)
(COND
((OR WASOPEN (CLOSEF STREAM]
STREAM))
[COND
([SETQ DISK (for DISK in DISKS thereis (EQ NAME (fetch (VPCDISK
VPCDEVICE)
of DISK]
(PRINTOUT T "Already disk named " NAME "." T)
(SELECTQ (ASKUSER DWIMWAIT (QUOTE Y)
"Replace it? ")
(Y (CLOSEF (fetch (VPCDISK FILENAME) of DISK))
(replace (FDEV DEVICEINFO) of FDEV with (DREMOVE DISK DISKS))
)
(N (ERROR "name in use" NAME))
(SHOULDNT]
(SETQ DISK (\VPCF.INITIALIZE.DISK STREAM NAME RIGID PARTITION#))
(replace (FDEV DEVICEINFO) of FDEV with (CONS DISK (fetch (FDEV DEVICEINFO)
of FDEV]
NAME])
(\VPCDISK.CREATE.FLOPPY
[LAMBDA (SIDES SECT.PER.TRACK) (* AJB "10-Apr-86 11:27")
(* * Build a description of the virtual floppy disk we're reading from)
(* * this embodies the table on p5-15 of the DOS technical reference.)
(create VPCDISK
SIDES ← SIDES
SECT.PER.TRACK ← SECT.PER.TRACK
FAT.SIZE ←(SELECTQ SECT.PER.TRACK
(8 1)
(9 2)
(15 7)
(SHOULDNT "INVALID SECTORS.PER.TRACK INDICATOR"))
DIR.SIZE ←(SELECTQ SIDES
(1 4)
(2 (COND
((EQ SECT.PER.TRACK 15)
14)
(T 7)))
(SHOULDNT "INVALID NUMBER.OF.SIDES ON FLOPPY"))
BYTES.PER.CLUSTER ←(ITIMES VPCF.BYTES.PER.SECTOR (SELECTQ SIDES
(1 1)
(2 (COND
((EQ SECT.PER.TRACK 15)
1)
(T 2)))
(SHOULDNT
"INVALID NUMBER.OF.SIDES ON FLOPPY")))
#SECTORS ←(ITIMES 40 SIDES SECT.PER.TRACK)
REL.SECTORS ← 0])
(VPCDISK.DELETE.DEVICE
[LAMBDA (DEVICENAME) (* AJB " 8-Apr-86 12:03")
(* * Remove a disk device from {PCDISK})
(LET (FDEV DISKS DISK)
(SETQ FDEV (\GETDEVICEFROMNAME (QUOTE PCDISK)))
(SETQ DEVICENAME (U-CASE DEVICENAME))
(SETQ DISKS (fetch (FDEV DEVICEINFO) of FDEV))
(COND
([SETQ DISK (for DISK in DISKS thereis (EQ DEVICENAME (fetch (VPCDISK VPCDEVICE)
of DISK]
(replace (FDEV DEVICEINFO) of FDEV with (DREMOVE DISK DISKS))
DEVICENAME])
(VPCDISK.FREEPAGES
[LAMBDA (DEVNAME) (* AJB " 9-May-86 10:40")
(* * Return the number of free disk pages from device on {PCDISK})
(* * Note, only handles 12-bit fats for now)
(SETQ DEVNAME (U-CASE DEVNAME))
(LET ((FDEV (\GETDEVICEFROMNAME (QUOTE PCDISK)))
DISKS DISK CLUSTER WORD STREAM)
(SETQ DISKS (fetch (FDEV DEVICEINFO) of FDEV))
(COND
([SETQ DISK (for DISK in DISKS thereis (EQ DEVNAME (fetch (VPCDISK VPCDEVICE)
of DISK]
(WITH.MONITOR
(fetch (VPCDISK MONITORLOCK) of DISK) (* need monitorlock to be sure that other processes
don't move the file ptr around)
(\VPCF.OPEN.BACKING.STREAM DISK)
(SETQ STREAM (GETSTREAM (fetch (VPCDISK FILENAME) of DISK)
(QUOTE BOTH)))
(PROG1 [ITIMES (IQUOTIENT (fetch (VPCDISK BYTES.PER.CLUSTER) of DISK)
VPCF.BYTES.PER.SECTOR)
(for old CLUSTER from 2
to (IQUOTIENT (ITIMES VPCF.BYTES.PER.SECTOR
(IDIFFERENCE
(fetch (VPCDISK #SECTORS) of DISK)
(IPLUS (ITIMES (fetch (VPCDISK FATS)
of DISK)
(fetch (VPCDISK FAT.SIZE)
of DISK))
(fetch (VPCDISK DIR.SIZE)
of DISK)
1)))
(fetch (VPCDISK BYTES.PER.CLUSTER) of DISK))
count (PROGN [SETFILEPTR STREAM (IPLUS (fetch (VPCDISK
FAT.OFFSET1)
of DISK)
(PLUS CLUSTER
(LRSH CLUSTER 1]
(SETQ WORD (\SWIN STREAM))
(COND
((EQ (COND
((EVENP CLUSTER)
(LOGAND 4095 WORD))
(T (LRSH WORD 4)))
0]
(\VPCF.CLOSE.BACKING.STREAM DISK])
(VPCDISK.GETPARTITION#
[LAMBDA (DEVICENAME) (* AJB " 8-Apr-86 11:01")
(* Return the partition number from a virtual rigid
disk device name, and if the device is not a virtual
rigid disk, returns NIL)
(OR (ATOM DEVICENAME)
(ERROR "ILLEGAL ARG" DEVICENAME))
(SETQ DEVICENAME (U-CASE DEVICENAME))
(PROG ((FDEV (\GETDEVICEFROMNAME (QUOTE PCDISK)))
DISKS DISK)
(SETQ DISKS (fetch (FDEV DEVICEINFO) of FDEV))
(COND
([SETQ DISK (for DISK in DISKS thereis (EQ DEVICENAME (fetch (VPCDISK VPCDEVICE)
of DISK]
(COND
((fetch (VPCDISK RIGIDDISK) of DISK)
(RETURN (fetch (VPCDISK PARTITION#) of DISK])
(VPCDISK.CHANGE.PARTITION.TYPE
[LAMBDA (FILE PARTITION# DOS?) (* AJB "10-Apr-86 16:54")
(LET (DISK STREAM (WASOPEN (OPENP FILE)))
(RESETLST [SETQ STREAM (OR (STREAMP FILE)
(OPENSTREAM FILE (QUOTE BOTH]
(RESETSAVE NIL (LIST [FUNCTION (LAMBDA (STREAM)
(COND
((OR WASOPEN (CLOSEF STREAM]
STREAM))
(* * The numbers are derived using the info in section 9 of the DOS technical reference manual * * *)
(SETFILEPTR STREAM 510)
[COND
((OR (NEQ (BIN STREAM)
85)
(NEQ (BIN STREAM)
170))
(PROGN (CLOSEF STREAM)
(ERROR "Not a valid rigid disk"]
(COND
((OR (NOT PARTITION#)
(IGREATERP PARTITION# 4)
(ILESSP PARTITION# 1))
(SETQ PARTITION# 1)))
(SETFILEPTR STREAM (IPLUS 446 (ITIMES (IDIFFERENCE 4 PARTITION#)
16)))
(* Postition to partition information)
[COND
([NOT (MEMBER (BIN STREAM)
(QUOTE (128 0]
(PROGN (CLOSEF STREAM)
(ERROR "Not a valid rigid disk partition"]
(BIN STREAM) (* Starting head)
(BIN STREAM) (* Starting sector)
(BIN STREAM) (* Starting cylinder)
(COND
(DOS? (BOUT STREAM 1))
(T (BOUT STREAM 0])
(\VPCF.INITIALIZE.DISK
[LAMBDA (STREAM DEVNAME RIGID PARTITION#) (* AJB "15-Apr-86 15:38")
(* * Given a stream that is open to a virtual floppy/hard disk, read the info that is needed to let us actually USE
that disk for I/O)
(LET (DISK DIR.OFFSET DATA.OFFSET H S CYL TS RS D BPD BPS CF SPF SPC BPC TOTAL#CYLINDERS
PARTITION.OFFSET)
[COND
(RIGID
(* * The numbers are derived using the info in section 9 of the DOS technical reference manual * * * Some of the
number are not documented in the IBM manuals and are read from the first sector of the partition using byte index
values obtained from OSD.)
(SETFILEPTR STREAM 510)
[COND
((OR (NEQ (BIN STREAM)
85)
(NEQ (BIN STREAM)
170))
(PROGN (CLOSEF STREAM)
(ERROR "Not a valid rigid disk"]
(COND
((OR (NOT PARTITION#)
(IGREATERP PARTITION# 4)
(ILESSP PARTITION# 1))
(SETQ PARTITION# 1)))
(SETFILEPTR STREAM (IPLUS 446 (ITIMES (IDIFFERENCE 4 PARTITION#)
16)))
(* Postition to partition information)
(SETQ DISK (create VPCDISK))
(replace (VPCDISK RIGIDDISK) of DISK with T)
(replace (VPCDISK PARTITION#) of DISK with PARTITION#)
[COND
([NOT (MEMBER (BIN STREAM)
(QUOTE (128 0]
(PROGN (CLOSEF STREAM)
(ERROR "Not a valid rigid disk partition"]
(SETQ H (BIN STREAM)) (* Starting head)
(SETQ S (BIN STREAM)) (* Starting sector)
(SETQ CYL (BIN STREAM)) (* Starting cylinder)
(SELECTQ (BIN STREAM)
(1)
(2 (PROGN (CLOSEF STREAM)
(ERROR "Only 12-bit FATs currently supported")))
(PROGN (PRINTOUT T "Warning! Non-DOS partition")
(TERPRI T)))
(replace (VPCDISK START.HEAD) of DISK with H)
(replace (VPCDISK START.CYLINDER) of DISK
with (LOGOR CYL (LSH (LOGAND 192 S)
2))) (* OR in the 2 top bits of the cylinder from the 2 top
bits of the sector)
(replace (VPCDISK START.SECTOR) of DISK with (LOGAND S 63))
(SETQ H (BIN STREAM))
(SETQ S (BIN STREAM))
(SETQ CYL (BIN STREAM))
(replace (VPCDISK END.HEAD) of DISK with H)
(replace (VPCDISK END.CYLINDER) of DISK with (LOGOR CYL
(LSH (LOGAND 192 S)
2)))
(replace (VPCDISK END.SECTOR) of DISK with (LOGAND S 63))
(replace (VPCDISK REL.SECTORS) of DISK with (\DSWIN STREAM))
(* Number of sectors preceding this partition)
(SETQ TS (replace (VPCDISK #SECTORS) of DISK with (\DSWIN STREAM)))
(* Number of sectors allocated to the partition)
(COND
((EQ 0 (fetch (VPCDISK #SECTORS) of DISK))
(ERROR "ERROR: Unallocated Partiton")))
(SETQ RS 1) (* Number of sectors in the boot record)
(SETQ BPD VPCF.DIR.ENTRY.LEN) (* Size of directory entry)
(SETQ BPS VPCF.BYTES.PER.SECTOR) (* Bytes per sector)
[SETQ TOTAL#CYLINDERS (ADD1 (IDIFFERENCE (fetch (VPCDISK END.CYLINDER)
of DISK)
(fetch (VPCDISK START.CYLINDER)
of DISK]
(SETQ PARTITION.OFFSET (ITIMES (fetch (VPCDISK REL.SECTORS) of DISK)
VPCF.BYTES.PER.SECTOR))
(* Beginning byte offset into this partition)
(SETFILEPTR STREAM (IPLUS PARTITION.OFFSET 16))
(SETQ CF (\BIN STREAM)) (* FATs per partition)
(SETQ D (\SWIN STREAM)) (* Number of directory entries)
(SETFILEPTR STREAM (IPLUS PARTITION.OFFSET 13))
(SETQ SPC (\BIN STREAM)) (* Sectors per allocation unit)
(SETQ BPC 1.5) (* Number of bytes per FAT entry)
(SETFILEPTR STREAM (IPLUS PARTITION.OFFSET 22))
(SETQ SPF (\SWIN STREAM)) (* Number of sectors per FAT)
(replace (VPCDISK SECT.PER.TRACK) of DISK with 17)
(* Sectors per track)
(replace (VPCDISK SIDES) of DISK with 4)
(* Number of tracks (heads) per cylinder)
(replace (VPCDISK FATS) of DISK with CF)
(* Number of FATS)
(replace (VPCDISK FAT.SIZE) of DISK with SPF)
(* Number of sectors per FAT)
(replace (VPCDISK FAT.OFFSET1) of DISK
with (IPLUS VPCF.BYTES.PER.SECTOR (ITIMES (fetch (VPCDISK REL.SECTORS)
of DISK)
VPCF.BYTES.PER.SECTOR)))
(* Starting byte offset of first FAT)
(replace (VPCDISK FAT.OFFSET2) of DISK with (IPLUS (fetch (VPCDISK
FAT.OFFSET1)
of DISK)
(ITIMES SPF
VPCF.BYTES.PER.SECTOR)))
(* Second FAT offset)
(replace (VPCDISK DIR.SIZE) of DISK with (IQUOTIENT (ITIMES D 32)
VPCF.BYTES.PER.SECTOR))
(* Directory size in sectors)
(SETQ DIR.OFFSET (ITIMES (IPLUS (fetch (VPCDISK REL.SECTORS) of DISK)
RS
(ITIMES SPF CF))
VPCF.BYTES.PER.SECTOR))
(* Offset to first byte of the directory)
(SETQ DATA.OFFSET (IPLUS DIR.OFFSET (ITIMES (fetch (VPCDISK DIR.SIZE)
of DISK)
VPCF.BYTES.PER.SECTOR)))
(* Offset to first byte of data)
(replace (VPCDISK BYTES.PER.CLUSTER) of DISK with (ITIMES SPC
VPCF.BYTES.PER.SECTOR))
(* cluster size)
)
(T (* FLOPPY disk)
(SETFILEPTR STREAM VPCF.BYTES.PER.SECTOR) (* skip first sector)
(* type of floppy is after first sector)
[SETQ DISK (SELECTC (BIN STREAM)
(DISK.8SEC2SIDE (\VPCDISK.CREATE.FLOPPY 2 8))
(DISK.8SEC1SIDE (\VPCDISK.CREATE.FLOPPY 1 8))
(DISK.9SEC2SIDE (\VPCDISK.CREATE.FLOPPY 2 9))
(DISK.9SEC1SIDE (\VPCDISK.CREATE.FLOPPY 1 9))
(DISK.15SEC2SIDE (\VPCDISK.CREATE.FLOPPY 2 15))
(PROGN (CLOSEF STREAM)
(ERROR "NOT A VALID VIRTUAL PC FLOPPY FILE"]
(SETQ DIR.OFFSET (ITIMES (ADD1 (ITIMES 2 (fetch (VPCDISK FAT.SIZE) of DISK)))
VPCF.BYTES.PER.SECTOR))
[SETQ DATA.OFFSET (IPLUS DIR.OFFSET (ITIMES VPCF.BYTES.PER.SECTOR (fetch
(VPCDISK DIR.SIZE) of DISK]
(replace (VPCDISK FATS) of DISK with 2)
(* Number of FATS)
(replace (VPCDISK FAT.OFFSET1) of DISK with VPCF.BYTES.PER.SECTOR)
(replace (VPCDISK FAT.OFFSET2) of DISK with (IPLUS VPCF.BYTES.PER.SECTOR
(ITIMES (fetch (VPCDISK
FAT.SIZE)
of DISK)
VPCF.BYTES.PER.SECTOR]
(replace (VPCDISK DATA.OFFSET) of DISK with DATA.OFFSET)
(replace (VPCDISK DIR.OFFSET) of DISK with DIR.OFFSET)
(replace (VPCDISK VPCDEVICE) of DISK with DEVNAME)
(replace (VPCDISK FILENAME) of DISK with (fetch (STREAM FULLFILENAME) of STREAM))
DISK])
)
(* Directory Manipulation)
(DEFINEQ
(\VPCF.FIND.DIR.ENTRY
[LAMBDA (FILENAME DISK DONTCREATE.DIRECTORY DONTCREATE.FILE)
(* AJB "19-Mar-86 14:43")
(* * Find a directory entry for the file named NAME. If DONTCREATE is NIL, then find an empty entry that we can
fill in for that file.)
(LET* ((DIRLIST (\VPCF.PARSENAME FILENAME))
(CURDIR (\VPCF.ROOTDIRECTORY DISK))
(UNPK (UNPACKFILENAME (CDR DIRLIST)))
(NAME (LISTGET UNPK (QUOTE NAME)))
(EXT (LISTGET UNPK (QUOTE EXTENSION)))
(ATTR 0))
(for DIR in (CAR DIRLIST)
do (SETQ CURDIR (\VPCF.DIR.LOOKUP DIR CURDIR DISK DONTCREATE.DIRECTORY))
(* Find the directory that is to be searched.)
)
(\VPCF.SEARCH.DIR NAME EXT ATTR CURDIR DISK NIL DONTCREATE.FILE])
(\VPCF.DIR.LOOKUP
[LAMBDA (DIRNAME CURDIR DISK DONTCREATE) (* AJB "25-Mar-86 12:18")
(* * Look up the directory named DIRNAME in CURDIR on DISK. Return a byte offset to the new printer.)
(LET* [(ENTRY (\VPCF.SEARCH.DIR DIRNAME NIL ATTR.DIR CURDIR DISK
(FUNCTION [LAMBDA (ENTRY)
(BITTEST (fetch (VPCFDIRENTRY ATTRIBUTE) of ENTRY)
ATTR.DIR])
DONTCREATE))
(CLUSTER (AND ENTRY (fetch (VPCFDIRENTRY START) of ENTRY]
(COND
(ENTRY (* We found a sub-directory entry for this directory.)
(create VPCDIR
DIRSTART ←(\VPCF.CLUSTER.TO.FILEPOS CLUSTER DISK)
DIREND ←(IPLUS (\VPCF.CLUSTER.TO.FILEPOS CLUSTER DISK)
(fetch (VPCDISK BYTES.PER.CLUSTER) of DISK))
DIRCLUSTER ← CLUSTER))
(T (PROGN (\VPCF.CLOSE.BACKING.STREAM DISK)
(ERROR "DIRECTORY NOT FOUND" DIRNAME])
(\VPCF.SEARCH.DIR
[LAMBDA (FILENAME EXTENSION ATTRIBUTE CURDIR DISK TESTFN DONTCREATE)
(* AJB " 8-May-86 14:56")
(* * Look up the file named FILENAME in CURDIR on DISK. Return the directory entry for the file)
(* * If not found, and DONTCREATE is NIL, then create an entry in the directory, if space allows)
(LET ((STREAM (GETSTREAM (fetch (VPCDISK FILENAME) of DISK)
(QUOTE BOTH)))
(EXTENSION (OR EXTENSION (PACKC NIL)))
FINISHED LEN LOC FILELOC PTR ENTRY LASTDIR)
(until FINISHED
do (* Run thru the directory, cluster by cluster, doing
the search)
[for ENTRYLOC from (fetch (VPCDIR DIRSTART) of CURDIR)
to (IDIFFERENCE (fetch (VPCDIR DIREND) of CURDIR)
VPCF.DIR.ENTRY.LEN)
by VPCF.DIR.ENTRY.LEN when (SETQ ENTRY (\VPCF.READ.DIR.ENTRY DISK STREAM
ENTRYLOC))
do (COND
((EQ ENTRY T) (* T indicates no more entries in the directory)
(SETQ FINISHED T)
(SETQ FILELOC NIL)
(RETURN))
((AND (EQ (fetch (VPCFDIRENTRY NAME) of ENTRY)
FILENAME)
(EQ (fetch (VPCFDIRENTRY EXTENSION) of ENTRY)
EXTENSION)
(OR (NOT TESTFN)
(APPLY* TESTFN ENTRY)))
(SETQ FILELOC ENTRY)
(SETQ FINISHED T)
(RETURN) (* This is the subdirectory we want.)
]
(SETQ LASTDIR (COPY CURDIR)) (* Save the current directory cluster in case we have
to allocate a new direntry)
repeatwhile (SETQ CURDIR (\VPCF.NEXT.DIR.CLUSTER CURDIR DISK)))
(COND
(FILELOC FILELOC)
(T (COND
(DONTCREATE NIL)
(T (PROGN (SETQ PTR (\VPCF.FIND.FREE.DIR.ENTRY LASTDIR DISK))
(COND
(PTR (SETQ ENTRY
(create VPCFDIRENTRY
NAME ← FILENAME
EXTENSION ← EXTENSION
ATTRIBUTE ← ATTRIBUTE
IDATE ← 0
START ← 0
SIZE ← 0
DIRENTRYFPOS ← PTR))
(\VPCF.WRITE.DIR.ENTRY DISK STREAM ENTRY)
(SETQ CURDIR LASTDIR) (* Make this the current direntry)
ENTRY)
(T NIL])
(\VPCF.READ.DIR.ENTRY
[LAMBDA (DISK STREAM PTR ALL) (* AJB "25-Mar-86 17:03")
(* * Reads an IBM-PC format floppy/hard disk directory entry, returns a DIRENTRY record)
(WITH.MONITOR (fetch (VPCDISK MONITORLOCK) of DISK)
(* need monitorlock to be sure that other processes
don't move the file ptr around)
(SETFILEPTR STREAM PTR)
(PROG ((BYTE (BIN STREAM))
NAME EXT ATTRIBUTE IDATE START SIZE)
(SELECTQ BYTE
[(0 229) (* unused or erased entry)
(COND
(ALL (* Return deleted and/or erased entries)
(RETURN (create VPCFDIRENTRY
NAME ←[PACKC (CONS BYTE
(from 1
to 7
collect
(BIN STREAM]
EXTENSION ←(PACKC (from 1 to 3
collect
(BIN STREAM)))
ATTRIBUTE ←(BIN STREAM)
IDATE ←(PROG1 0
(from 12 to 31
do
(* discard the rest)
(BIN STREAM)))
START ← 0
SIZE ← 0
DIRENTRYFPOS ← PTR)))
(T (* Only return valid file entries)
(COND
((EQ BYTE 0) (* Return T if byte is zero indicating no more entries
in the directory)
(RETURN T))
(T (RETURN]
(5 (* quoted 229 is first char in filename)
(SETQ BYTE 229))
NIL)
[SETQ NAME (PACKC (DREMOVE (CHARCODE SPACE)
(CONS BYTE (from 1 to 7 collect
(BIN STREAM]
(* get rid of spaces at the end of names)
[SETQ EXT (PACKC (DREMOVE (CHARCODE SPACE)
(from 1 to 3 collect (BIN STREAM]
(SETQ ATTRIBUTE (BIN STREAM))
(from 12 to 21
do (* these bytes unused)
(BIN STREAM))
(SETQ IDATE (\VPCF.READ.FILE.DATE STREAM))
(SETQ START (\SWIN STREAM)) (* START is a byte swapped word
(actually 12 bits))
(SETQ SIZE (\DSWIN STREAM))
(RETURN (create VPCFDIRENTRY
NAME ← NAME
EXTENSION ← EXT
ATTRIBUTE ← ATTRIBUTE
IDATE ← IDATE
START ← START
SIZE ← SIZE
DIRENTRYFPOS ← PTR])
(\VPCF.FIND.FREE.DIR.ENTRY
[LAMBDA (CURDIR DISK) (* AJB " 8-May-86 14:58")
(* * Find a free entry in CURDIR on DISK. Return the directory entry for the file)
(LET ((STREAM (GETSTREAM (fetch (VPCDISK FILENAME) of DISK)
(QUOTE BOTH)))
FINISHED LEN LOC FILELOC PTR ENTRY CLUSTER LASTDIR)
(until FINISHED
do (* Run thru the directory, cluster by cluster, doing
the search)
(for ENTRYLOC from (fetch (VPCDIR DIRSTART) of CURDIR)
to (IDIFFERENCE (fetch (VPCDIR DIREND) of CURDIR)
VPCF.DIR.ENTRY.LEN)
by VPCF.DIR.ENTRY.LEN when (SETQ ENTRY (\VPCF.READ.DIR.ENTRY DISK STREAM
ENTRYLOC T))
do (COND
((MEMBER (CAR (CHCON (fetch (VPCFDIRENTRY NAME) of ENTRY)))
(QUOTE (229 0))) (* Look for xE5 or 0)
(SETQ FILELOC ENTRY)
(SETQ FINISHED T)
(RETURN) (* Found an unused directory entry)
))
(SETQ LASTDIR (COPY CURDIR)) (* Save last entry in case we have to allocate a new
directory cluster))
repeatwhile (SETQ CURDIR (\VPCF.NEXT.DIR.CLUSTER CURDIR DISK)))
(COND
(FILELOC (* Found an entry, return the filepos in the main
stream)
(fetch (VPCFDIRENTRY DIRENTRYFPOS) of FILELOC))
((NOT (fetch (VPCDIR DIRCLUSTER) of LASTDIR))
(\VPCF.CLOSE.BACKING.STREAM DISK)
(ERROR "NO MORE DIRECTORY ENTRIES LEFT IN THE ROOT DIRECTORY"))
(T (* Allocate a cluster for a new directory cluster)
(SETQ CLUSTER (\VPCF.ALLOCATE.CLUSTER DISK))
(* Create a new directory cluster)
(SETQ CURDIR LASTDIR)
(\VPCF.MARK.THE.FAT (fetch (VPCDIR DIRCLUSTER) of CURDIR)
DISK CLUSTER) (* Point the current cluster slot in the FAT to the
newly allocated one which in turn points to EOF)
(replace (VPCDIR DIRCLUSTER) of CURDIR with CLUSTER)
(* And replace the current cluster, starting and
ending positions in the CURDIR record)
(replace (VPCDIR DIRSTART) of CURDIR with (\VPCF.CLUSTER.TO.FILEPOS CLUSTER
DISK))
(replace (VPCDIR DIREND) of CURDIR with (IPLUS (\VPCF.CLUSTER.TO.FILEPOS
CLUSTER
DISK)
(fetch (VPCDISK
BYTES.PER.CLUSTER)
of DISK)))
(SETQ FILELOC (fetch (VPCDIR DIRSTART) of CURDIR])
(\VPCF.WRITE.DIR.ENTRY
[LAMBDA (DISK STREAM DIRENTRY) (* AJB "12-Jun-86 14:16")
(* * Writes an IBM-PC format floppy/hard disk directory entry)
(WITH.MONITOR (fetch (VPCDISK MONITORLOCK) of DISK)
(* need monitorlock to be sure that other processes
don't move the file ptr around)
(PROG (DATEFILEPTR)
(SETFILEPTR STREAM (fetch (VPCFDIRENTRY DIRENTRYFPOS) of DIRENTRY))
(PRINDIRSTR (fetch (VPCFDIRENTRY NAME) of DIRENTRY)
8 STREAM)
(PRINDIRSTR (fetch (VPCFDIRENTRY EXTENSION) of DIRENTRY)
3 STREAM)
(BOUT STREAM (fetch (VPCFDIRENTRY ATTRIBUTE) of DIRENTRY))
(from 12 to 21
do (* these bytes unused)
(\BOUT STREAM 0))
(* * Save the current file ptr to read the date back in)
(SETQ DATEFILEPTR (GETFILEPTR STREAM))
(* * Put out the current DATE and TIME)
(\VPCF.WRITE.FILE.DATE STREAM)
(* * starting cluster)
(\SWOUT STREAM (fetch (VPCFDIRENTRY START) of DIRENTRY))
(* * File size in bytes)
(\DSWOUT STREAM (fetch (VPCFDIRENTRY SIZE) of DIRENTRY))
(* * Now read the date back into the DIRENTRY)
(SETFILEPTR STREAM DATEFILEPTR)
(replace (VPCFDIRENTRY IDATE) of DIRENTRY with (\VPCF.READ.FILE.DATE
STREAM])
(\VPCF.READ.FILE.DATE
[LAMBDA (STREAM) (* AJB "17-Apr-86 16:17")
(* * returns an Interlisp IDATE. Reads 4 bytes from STREAM and interprets according to pp5-12,13 of DOS tech.
ref.)
(LET ((BYTE2 (BIN STREAM))
(BYTE1 (BIN STREAM))
(BYTE4 (BIN STREAM))
(BYTE3 (BIN STREAM))) (* words are byte swapped)
(LET ((HOUR (LRSH BYTE1 3))
(MIN (LOGOR (LSH (LOGAND 7 BYTE1)
3)
(RSH BYTE2 5)))
(SECS (TIMES 2 (LOGAND 31 BYTE2)))
(YEAR (IPLUS 1980 (RSH BYTE3 1)))
(MONTH (LOGOR (LSH (LOGAND 1 BYTE3)
3)
(RSH BYTE4 5)))
(DAY (LOGAND 31 BYTE4)))
(\PACKDATE YEAR (IMAX 0 (SUB1 MONTH))
DAY HOUR MIN SECS])
(\VPCF.WRITE.FILE.DATE
[LAMBDA (STREAM) (* AJB " 7-Mar-86 11:15")
(* * writes an Interlisp IDATE to the STREAM according to pp5-12,13 of DOS tech. ref.)
(PROG* ((IDATE (GDATE NIL (DATEFORMAT NUMBER.OF.MONTH)))
(DAY (STR2INT IDATE 1))
(MONTH (STR2INT IDATE 4))
(YEAR (STR2INT IDATE 7))
(HOUR (STR2INT IDATE 10))
(MINUTE (STR2INT IDATE 13))
(SECOND (STR2INT IDATE 16)))
(\SWOUT STREAM (IPLUS (LSH HOUR 11)
(LSH MINUTE 5)
(LRSH SECOND 1)))
(\SWOUT STREAM (IPLUS (LSH (IDIFFERENCE YEAR 80)
9)
(LSH MONTH 5)
DAY])
(\VPCF.ROOTDIRECTORY
[LAMBDA (DISK) (* AJB "19-Mar-86 14:47")
(* * Given a DISK description, return a description of the root directory.)
(with VPCDISK DISK (create VPCDIR
DIRSTART ← DIR.OFFSET
DIREND ←(IPLUS DIR.OFFSET (ITIMES VPCF.BYTES.PER.SECTOR DIR.SIZE])
(\VPCF.NEXT.DIR.CLUSTER
[LAMBDA (CURDIR DISK) (* AJB "31-Mar-86 15:09")
(* * Given a directory and floppy, find the next cluster in the directory (NIL if no more) and set the directory
appropriately)
(LET (CLUSTER)
(COND
((fetch (VPCDIR DIRCLUSTER) of CURDIR) (* If it was a root directory, there ARE no more
clusters.)
[SETQ CURDIR (create VPCDIR using CURDIR DIRCLUSTER ←(SETQ CLUSTER
(\VPCF.GET.NEXT.CLUSTER (fetch (VPCDIR
DIRCLUSTER)
of CURDIR)
DISK))
DIRSTART ←(\VPCF.CLUSTER.TO.FILEPOS CLUSTER DISK)
DIREND ←(IPLUS (\VPCF.CLUSTER.TO.FILEPOS CLUSTER
DISK)
(fetch (VPCDISK BYTES.PER.CLUSTER)
of DISK]
(* Get the next cluster number;
which is only real if it's less than xFFF8.)
(AND (ILESSP (fetch (VPCDIR DIRCLUSTER) of CURDIR)
VPCF.EOF)
CURDIR])
(\VPCF.CLUSTER.TO.FILEPOS
[LAMBDA (CLUSTER DISK) (* AJB "19-Mar-86 14:52")
(* * Given a cluster and a floppy, return the FILEPTR that is the start of that cluster in the backing file.)
(with VPCDISK DISK (IPLUS DATA.OFFSET (ITIMES (IDIFFERENCE CLUSTER 2)
BYTES.PER.CLUSTER])
(\VPCF.MAPDIR
[LAMBDA (CURDIR DISK FN) (* AJB "25-Mar-86 17:03")
(* * Map thru the PC-format directory CURDIR, calling FN on each directory entry)
(LET ((STREAM (\VPCF.OPEN.BACKING.STREAM DISK))
FINISHED LEN LOC FILELOC ENTRY)
(until FINISHED
do (* Run thru the directory, cluster by cluster, doing
the search)
[for ENTRYLOC from (fetch (VPCDIR DIRSTART) of CURDIR)
to (IDIFFERENCE (fetch (VPCDIR DIREND) of CURDIR)
VPCF.DIR.ENTRY.LEN)
by VPCF.DIR.ENTRY.LEN when (SETQ ENTRY (\VPCF.READ.DIR.ENTRY DISK STREAM
ENTRYLOC))
do (COND
((EQ ENTRY T) (* T indicates no more entries in directory)
(SETQ FINISHED T)
(RETURN)))
(SETQ FINISHED (EQ (QUOTE STOP)
(APPLY* FN ENTRY]
repeatwhile (SETQ CURDIR (\VPCF.NEXT.DIR.CLUSTER CURDIR DISK)))
FILELOC])
(\VPCF.READ.FAT.CHAIN
[LAMBDA (STARTCLUSTER DISK) (* AJB " 4-Mar-86 13:27")
(* * Read the chain of clusters for a file from the FAT)
(for (CLUSTER ← STARTCLUSTER) by (\VPCF.GET.NEXT.CLUSTER CLUSTER DISK) collect CLUSTER
while (LESSP CLUSTER VPCF.EOF])
)
(DEFINEQ
(\VPCF.GENERATEFILES
[LAMBDA (FDEV PATTERN) (* AJB "17-Mar-86 17:08")
(* * Build an instance of a generator to list files)
(* * The generator keeps its state in GENFILESTATE, as a list whose CAR is the list of files--the NIL is so we have
something to remove in the NEXTFILEFN, which removes the "current file" before returning the next one.)
(LET* ((DISK (\VPCF.GET.DISK PATTERN FDEV))
(FILES (\VPCF.FILEMATCH PATTERN DISK)))
(create FILEGENOBJ
NEXTFILEFN ←(FUNCTION \VPCF.NEXTFILEFN)
FILEINFOFN ←(FUNCTION \VPCF.FILEINFOFN)
GENFILESTATE ←(LIST (CONS NIL FILES])
(\VPCF.FILEMATCH
[LAMBDA (FILENAME DISK) (* AJB " 9-Apr-86 11:44")
(* * Build a list of files on DISK that match the pattern in FILENAME. This is used by GENERATEFILES to build the
generator for doing directory listings)
(* * If we had to open it, set FILEINUSE to (QUOTE DIR,) so we know whether to close it or not when we are done)
(LET* ((CURDIR (\VPCF.ROOTDIRECTORY DISK))
ENTRYLOC ENTRY FILELST)
(RESETLST (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (DISK)
(COND
((EQ (QUOTE DIR)
(fetch (VPCDISK FILEINUSE) of DISK))
(\VPCF.CLOSE.BACKING.STREAM DISK]
DISK))
[COND
((fetch (VPCDISK FILEINUSE) of DISK)
(\VPCF.OPEN.BACKING.STREAM DISK))
(T (\VPCF.OPEN.BACKING.STREAM DISK)
(replace (VPCDISK FILEINUSE) of DISK with (QUOTE DIR]
(* * The general matching process is recursive thru all the directories on the disk. This function exists to give
things a start at the root directory.)
(SETQ FILELST (SORT (\VPCF.FILEMATCH1 (DIRECTORY.MATCH.SETUP FILENAME)
(PACKFILENAME (QUOTE DIRECTORY)
NIL
(QUOTE NAME)
NIL
(QUOTE EXTENSION)
NIL
(QUOTE VERSION)
NIL
(QUOTE BODY)
FILENAME)
NIL CURDIR DISK)
T))
FILELST])
(\VPCF.FILEMATCH1
[LAMBDA (PATTERN NAMEBODY DIRS CURDIR DISK) (* AJB "31-Dec-00 20:03")
(* * Make a list of all the files in CURDIR and any of its subdirectories that, when you add the NAMEBODY of host
and device, and directories DIRS, match the pattern in PATTERN. Recursive.)
(LET* ((MATCHLIST NIL)
ENTRYLOC ENTRY)
[\VPCF.MAPDIR CURDIR DISK
(FUNCTION (LAMBDA (ENTRY)
(LET ((CLUSTER (fetch (VPCFDIRENTRY START) of ENTRY))
TRIALFILE)
(COND
((IEQP (CHARCODE %.)
(CHCON1 (fetch (VPCFDIRENTRY NAME) of ENTRY)))
(* This is an entry for the current directory or for
its parent. We don't want these in the listing.)
)
((BITTEST ATTR.VOLLABEL (fetch (VPCFDIRENTRY ATTRIBUTE)
of ENTRY))
(* This is the floppy's volume label.
Don't include it)
)
[(BITTEST ATTR.DIR (fetch (VPCFDIRENTRY ATTRIBUTE)
of ENTRY))
(* This is a subdirectory. Gather it's matches
recursively and add them to the match list)
(SETQ MATCHLIST
(NCONC MATCHLIST
(\VPCF.FILEMATCH1
PATTERN NAMEBODY
[COND
[DIRS (PACK* DIRS (QUOTE >)
(MKSTRING (fetch (VPCFDIRENTRY
NAME)
of ENTRY]
(T (MKSTRING (fetch (VPCFDIRENTRY NAME)
of ENTRY]
(create VPCDIR
DIRSTART ←(\VPCF.CLUSTER.TO.FILEPOS
CLUSTER DISK)
DIREND ←(IPLUS (\VPCF.CLUSTER.TO.FILEPOS
CLUSTER DISK)
(fetch (VPCDISK
BYTES.PER.CLUSTER)
of DISK))
DIRCLUSTER ← CLUSTER)
DISK]
((DIRECTORY.MATCH PATTERN (SETQ TRIALFILE
(PACKFILENAME (QUOTE NAME)
(fetch (VPCFDIRENTRY NAME)
of ENTRY)
(QUOTE EXTENSION)
(fetch (VPCFDIRENTRY
EXTENSION)
of ENTRY)
(QUOTE DIRECTORY)
DIRS
(QUOTE BODY)
NAMEBODY)))
(* This file matches. Add it to the list)
(push MATCHLIST (create VPCGENERATEDFILEINFO
VNAME ← TRIALFILE
VDIRENTRY ← ENTRY]
(* * And return the list of matches.)
MATCHLIST])
(\VPCF.NEXTFILEFN
[LAMBDA (GENERATORSTATE) (* AJB " 1-Apr-86 14:08")
(* * Feed the next file back to DIRECTORY from the generator. VPCDISK keeps the generated files on a list inside
the generator object.)
(PROG [(CURRENTFILE (pop (CAR GENERATORSTATE] (* Remove the current file, then pass back the next
one in line.)
[COND
((NULL (fetch (VPCGENERATEDFILEINFO VNAME) of (CAAR GENERATORSTATE)))
(* * Only close the backing store if we opened it)
(COND
([AND (CAR CURRENTFILE)
(EQ (QUOTE DIR)
(fetch (VPCDISK FILEINUSE) of (\VPCF.GET.DISK (CAR CURRENTFILE]
(\VPCF.CLOSE.BACKING.STREAM (\VPCF.GET.DISK (CAR CURRENTFILE]
(RETURN (fetch (VPCGENERATEDFILEINFO VNAME) of (CAAR GENERATORSTATE])
(\VPCF.FILEINFOFN
[LAMBDA (GENERATORSTATE FIELD) (* AJB " 6-May-86 16:36")
(* * Feed back the requested info about the current file in the generator)
(LET [(ENTRY (fetch (VPCGENERATEDFILEINFO VDIRENTRY) of (CAAR GENERATORSTATE]
(SELECTQ FIELD
(CREATIONDATE (GDATE (fetch (VPCFDIRENTRY IDATE) of ENTRY)))
(ICREATIONDATE (fetch (VPCFDIRENTRY IDATE) of ENTRY))
(LENGTH (fetch (VPCFDIRENTRY SIZE) of ENTRY))
(BYTESIZE 8)
(SIZE (ADD1 (IQUOTIENT (fetch (VPCFDIRENTRY SIZE) of ENTRY)
512)))
NIL])
)
(DEFINEQ
(\VPCF.GETFILEINFO
[LAMBDA (FILE ATTRIBUTE) (* AJB " 6-May-86 15:58")
(* * Returns FILE info The file resides on the emulated IBM-PC format floppy/hard disk DISK.)
(LET ((WASOPEN (OPENP FILE))
STREAM ENTRY ANSWER)
(RESETLST [SETQ STREAM (OR (STREAMP FILE)
(OPENSTREAM (U-CASE FILE)
(QUOTE BOTH]
(RESETSAVE NIL (LIST [FUNCTION (LAMBDA (STREAM)
(COND
((OR WASOPEN (CLOSEF STREAM]
STREAM))
(SETQ ENTRY (fetch (VPCFFILE DIRENTRY) of (fetch F1 of STREAM)))
(* * First, get the information he asked for)
(SETQ ANSWER (SELECTQ ATTRIBUTE
[TYPE (COND
((MEMB (fetch (VPCFDIRENTRY EXTENSION)
of ENTRY)
PC.TEXTFILE.EXTENSIONS)
(QUOTE TEXT))
(T (QUOTE BINARY]
(SIZE (ADD1 (IQUOTIENT (\VPCF.GETEOFPTR STREAM)
512)))
(BYTESIZE 8)
(LENGTH (\VPCF.GETEOFPTR STREAM))
((CREATIONDATE WRITEDATE)
(GDATE (fetch (VPCFDIRENTRY IDATE) of ENTRY)))
((ICREATIONDATE IWRITEDATE)
(fetch (VPCFDIRENTRY IDATE) of ENTRY))
(READDATE)
(IREADDATE)
NIL)))
(* * give him the answer.)
ANSWER])
(\VPCF.SETFILEINFO
[LAMBDA (FILE ATTRIBUTE ITSVALUE) (* AJB " 6-May-86 16:44")
(* * Sets FILE info The file resides on the emulated IBM-PC format floppy/hard disk DISK.)
(LET ((WASOPEN (OPENP FILE))
STREAM ENTRY)
(RESETLST [SETQ STREAM (OR (STREAMP FILE)
(OPENSTREAM (U-CASE FILE)
(QUOTE BOTH]
(RESETSAVE NIL (LIST [FUNCTION (LAMBDA (STREAM)
(COND
((OR WASOPEN (CLOSEF STREAM]
STREAM))
(SETQ ENTRY (fetch (VPCFFILE DIRENTRY) of (fetch F1 of STREAM)))
(* * First, get the information he asked for)
(SELECTQ ATTRIBUTE
(LENGTH (\VPCF.SETEOFPTR STREAM ITSVALUE))
NIL])
(\VPCF.OPEN.BACKING.STREAM
[LAMBDA (DISK) (* AJB " 2-Apr-86 14:42")
(COND
[(OPENP (fetch (VPCDISK FILENAME) of DISK))
(COND
((fetch (VPCDISK FILEINUSE) of DISK)
(GETSTREAM (fetch (VPCDISK FILENAME) of DISK)
(QUOTE BOTH)))
(T (* Indicate file is in use)
(ERROR "FILE IN USE" (fetch (VPCDISK FILENAME) of DISK]
(T (PROG1 (OPENSTREAM (fetch (VPCDISK FILENAME) of DISK)
(QUOTE BOTH))
(replace (VPCDISK FILEINUSE) of DISK with T])
(\VPCF.CLOSE.BACKING.STREAM
[LAMBDA (DISK) (* AJB " 1-Apr-86 12:10")
(* * Close the backing stream)
(PROG* ((FDEV (\GETDEVICEFROMNAME (QUOTE PCDISK)))
(DISKSTREAM (GETSTREAM (fetch (VPCDISK FILENAME) of DISK)
(QUOTE BOTH)))
(DISKS (fetch (FDEV DEVICEINFO) of FDEV))
(FILENAME (fetch (VPCDISK FILENAME) of DISK)))
(COND
((ASSOC DISK \VPCF.OPENFILES) (* At least one other open stream on this device,
don't close backing store)
(RETURN)))
(replace (VPCDISK FILEINUSE) of DISK with NIL)
(* Indicate backing file is not in use for this
partition)
(COND
((for DEVICE in DISKS when (EQ (fetch (VPCDISK FILENAME) of DEVICE)
FILENAME)
do (COND
((fetch (VPCDISK FILEINUSE) of DEVICE)
(RETURN))) (* At least one other partition is open, don't close)
finally (RETURN T))
(COND
((OPENP DISKSTREAM)
(CLOSEF DISKSTREAM])
)
(* FILEPTR Manipulation)
(DEFINEQ
(\VPCF.EOFP
[LAMBDA (STREAM) (* jds "13-Jun-86 12:30")
(* * Determines if an IBM-PC format floppy/hard disk file is at EOF)
(LET* ((FILE (fetch (STREAM F1) of STREAM))
(DISK (fetch (VPCFFILE DISK) of FILE))
(CLUSTERSIZE (fetch (VPCDISK BYTES.PER.CLUSTER) of DISK)))
(* * If this is the end page and user has written thru the previous offset,
then update the offset.)
[OR (READONLY STREAM)
(COND
((AND (fetch (STREAM CBUFPTR) of STREAM)
(\VPCF.UPDATEOF STREAM]
(* (COND ((IGEQ (IPLUS (fetch CPAGE of STREAM)
(IQUOTIENT (fetch COFFSET of STREAM) CLUSTERSIZE))
(fetch (STREAM EPAGE) of STREAM)) (replace
(STREAM EOFFSET) of STREAM with (fetch (STREAM COFFSET) of STREAM))
(replace (STREAM EPAGE) of STREAM with (fetch
(STREAM CPAGE) of STREAM)) (* * Now test for special case where fileptr points
to 1 past the last page, and set it to point to the beginning of the next page
and release the buffer to force a call to GETNEXTBUFFER)
(COND ((EQ (fetch (STREAM COFFSET) of STREAM) CLUSTERSIZE)
(replace (STREAM COFFSET) of STREAM with 0)
(add (fetch (STREAM CPAGE) of STREAM) 1)))
(replace (STREAM CBUFPTR) of STREAM with NIL)
(replace (STREAM CBUFSIZE) of STREAM with 0))))
(COND
((ILESSP (IPLUS (fetch CPAGE of STREAM)
(IQUOTIENT (fetch COFFSET of STREAM)
CLUSTERSIZE))
(fetch EPAGE of STREAM))
(* Not on last page yet, so not eof. Need to figure in the COFFSET because it
is possible for COFFSET to be CLUSTERSIZE before the page is turned)
NIL)
((IGREATERP (fetch CPAGE of STREAM)
(fetch EPAGE of STREAM)))
((IGEQ (fetch COFFSET of STREAM)
(fetch EOFFSET of STREAM])
(\VPCF.SETFILEPTR
[LAMBDA (STREAM FILEPOS) (* AJB " 2-May-86 18:56")
(* * Set the file pointer in a stream on an IBM-PC format floppy/hard disk file)
(LET* ((FILE (fetch (STREAM F1) of STREAM))
(DIRENTRY (fetch (VPCFFILE DIRENTRY) of FILE))
(DISK (fetch (VPCFFILE DISK) of FILE))
(CLUSTERSIZE (fetch (VPCDISK BYTES.PER.CLUSTER) of DISK))
(NEWCPAGE (IQUOTIENT FILEPOS CLUSTERSIZE))
(NEWCOFFSET (IREMAINDER FILEPOS CLUSTERSIZE))
FULLNAME NEXTCLUSTER CPAGE (CLUSTER (fetch (VPCFDIRENTRY START) of DIRENTRY)))
(* * write a dirty buffer)
(COND
((fetch (STREAM CBUFDIRTY) of STREAM)
(\VPCF.WRITE.CLUSTER FILE (fetch (STREAM CBUFPTR) of STREAM)
T) (* Write out CURCLUSTER in FILE)
(replace (STREAM CBUFDIRTY) of STREAM with NIL)))
(* * Set new current page)
(* * If this is the end page and user has written thru the previous offset, then update the offset, before
switching to the new page)
(\VPCF.UPDATEOF STREAM)
(replace (STREAM CPAGE) of STREAM with NEWCPAGE)
(* * Figure out which cluster should be read in by GETNEXTBUFFER if fileptr is not beyond EOF)
(SETQ CPAGE 0)
(SETQ CLUSTER (replace (VPCFFILE CLUSTER) of FILE with (fetch (VPCFDIRENTRY START)
of DIRENTRY)))
(* Start with first cluster from direntry)
(while (IGREATERP NEWCPAGE CPAGE)
do (COND
((AND (ILESSP CLUSTER VPCF.EOF)
(IGEQ CLUSTER 2))
(replace (VPCFFILE CURCLUSTER) of FILE with CLUSTER)))
[SETQ CLUSTER (\VPCF.GET.NEXT.CLUSTER CLUSTER DISK
(MEMBER (fetch (STREAM ACCESS)
of STREAM)
(QUOTE (OUTPUT BOTH APPEND]
(replace (VPCFFILE CLUSTER) of FILE with CLUSTER)
(* The next cluster to read)
(SETQ CPAGE (ADD1 CPAGE)))
(replace (STREAM CBUFPTR) of STREAM with NIL)
(replace (STREAM CBUFSIZE) of STREAM with 0)
(* Force \VPCF.GETNEXTBUFFER to be called to read in
or allocate a buffer and additional cluster
(s))
(* * Now update the current offset so we think we're in the right spot)
(replace (STREAM COFFSET) of STREAM with NEWCOFFSET)
FILEPOS])
(\VPCF.GETFILEPTR
[LAMBDA (STREAM FILEPOS) (* AJB " 5-May-86 10:33")
(* * Get the file pointer in a stream on an IBM-PC format floppy/hard disk file)
(LET* ((FILE (fetch (STREAM F1) of STREAM))
(DISK (fetch (VPCFFILE DISK) of FILE))
(CLUSTERSIZE (fetch (VPCDISK BYTES.PER.CLUSTER) of DISK)))
(IPLUS (fetch COFFSET of STREAM)
(ITIMES (fetch CPAGE of STREAM)
CLUSTERSIZE])
(\VPCF.SETEOFPTR
[LAMBDA (STREAM FILEPOS) (* AJB " 6-May-86 14:48")
(* * Sets the EOF pointer in a stream on an IBM-PC format floppy/hard disk file)
(PROG* ((FILE (fetch (STREAM F1) of STREAM))
(DISK (fetch (VPCFFILE DISK) of FILE))
(CLUSTERSIZE (fetch (VPCDISK BYTES.PER.CLUSTER) of DISK))
(RETURNVALUE T))
(* * Force an immediate lengthening or truncating of the file -
allocating and zeroing new clusters if lengthening, or returning clusters to the FAT if truncating.)
(* * write a dirty buffer)
(COND
((fetch (STREAM CBUFDIRTY) of STREAM)
(\VPCF.WRITE.CLUSTER FILE (fetch (STREAM CBUFPTR) of STREAM)
T) (* Write out CURCLUSTER in FILE)
(replace (STREAM CBUFDIRTY) of STREAM with NIL)))
(\VPCF.UPDATEOF STREAM) (* Update EPAGE & EOFFSET)
[COND
[(IGREATERP (IQUOTIENT FILEPOS CLUSTERSIZE)
(fetch (STREAM EPAGE) of STREAM))
(COND
[(APPENDABLE STREAM)
(SETQ RETURNVALUE (fetch (STREAM EPAGE) of STREAM))
(* Return old EPAGE)
(OR (\VPCF.ALLOCATE.CLUSTERS DISK FILE STREAM (IQUOTIENT FILEPOS CLUSTERSIZE))
(PROGN (\VPCF.DELETEOFD DISK STREAM)
(\VPCF.CLOSE.BACKING.STREAM DISK)
(ERROR "\VPCF.SETEOFPTR: DISK SPACE EXHAUSTED" DISK]
(T (SETQ RETURNVALUE NIL]
((ILESSP (IQUOTIENT FILEPOS CLUSTERSIZE)
(fetch (STREAM EPAGE) of STREAM))
(COND
((OVERWRITEABLE STREAM)
(\VPCF.DEALLOCATE.CLUSTERS DISK FILE STREAM (IQUOTIENT FILEPOS CLUSTERSIZE)))
(T (SETQ RETURNVALUE NIL]
[COND
(RETURNVALUE (replace EPAGE of STREAM with (IQUOTIENT FILEPOS CLUSTERSIZE))
(replace EOFFSET of STREAM with (IREMAINDER FILEPOS CLUSTERSIZE))
(COND
((IGEQ (fetch CPAGE of STREAM)
(fetch EPAGE of STREAM))
(replace CPAGE of STREAM with (fetch EPAGE of STREAM))
[COND
((AND (EQ (fetch (STREAM CPAGE) of STREAM)
(fetch (STREAM EPAGE) of STREAM))
(IGREATERP (fetch (STREAM COFFSET) of STREAM)
(fetch (STREAM EOFFSET) of STREAM)))
(replace COFFSET of STREAM with (fetch EOFFSET
of STREAM]
(* force the buffer to be read in again)
(replace (STREAM CBUFPTR) of STREAM with NIL)
(replace (STREAM CBUFSIZE) of STREAM with 0)
(replace (VPCFFILE CURCLUSTER) of FILE with VPCF.EOF)
(replace (VPCFFILE CLUSTER) of FILE with VPCF.EOF]
(RETURN RETURNVALUE])
(\VPCF.GETEOFPTR
[LAMBDA (STREAM) (* AJB "12-Jun-86 14:44")
(* * Get the EOF pointer in a stream on an IBM-PC format floppy/hard disk file)
(LET* ((FILE (fetch (STREAM F1) of STREAM))
(DISK (fetch (VPCFFILE DISK) of FILE))
(CLUSTERSIZE (fetch (VPCDISK BYTES.PER.CLUSTER) of DISK)))
(\VPCF.UPDATEOF STREAM) (* Update EPAGE & EOFFSET)
(IPLUS (fetch EOFFSET of STREAM)
(ITIMES (fetch EPAGE of STREAM)
CLUSTERSIZE])
(\VPCF.UPDATEOF
[LAMBDA (STREAM) (* AJB "12-Jun-86 14:56")
(* * Update the End of File fields, EPAGE & EOFFSET)
(COND
((OR (OVERWRITEABLE STREAM)
(APPENDABLE STREAM))
(COND
((IGEQ [IPLUS (fetch (STREAM CPAGE) of STREAM)
(IQUOTIENT (fetch (STREAM COFFSET) of STREAM)
(fetch (VPCDISK BYTES.PER.CLUSTER)
of (fetch (VPCFFILE DISK) of (fetch (STREAM F1)
of STREAM]
(fetch (STREAM EPAGE) of STREAM))
[COND
[(EQ [IPLUS (fetch (STREAM CPAGE) of STREAM)
(IQUOTIENT (fetch (STREAM COFFSET) of STREAM)
(fetch (VPCDISK BYTES.PER.CLUSTER)
of (fetch (VPCFFILE DISK) of (fetch (STREAM F1)
of STREAM]
(fetch (STREAM EPAGE) of STREAM))
(COND
((IGREATERP (fetch (STREAM COFFSET) of STREAM)
(fetch (STREAM EOFFSET) of STREAM))
(replace (STREAM EPAGE) of STREAM with (fetch (STREAM CPAGE)
of STREAM))
(replace (STREAM EOFFSET) of STREAM with (fetch (STREAM COFFSET)
of STREAM]
(T (replace (STREAM EPAGE) of STREAM with (fetch (STREAM CPAGE) of STREAM))
(replace (STREAM EOFFSET) of STREAM with (fetch (STREAM COFFSET)
of STREAM]
(COND
([EQ (fetch (STREAM EOFFSET) of STREAM)
(fetch (VPCDISK BYTES.PER.CLUSTER) of (fetch (VPCFFILE DISK)
of (fetch (STREAM F1)
of STREAM]
(add (fetch (STREAM EPAGE) of STREAM)
1)
(replace (STREAM EOFFSET) of STREAM with 0])
)
(DEFINEQ
(\VPCF.OPENFILE
[LAMBDA (NAME ACCESS RECOG PARAMETERS FDEV) (* AJB "28-Apr-86 16:29")
(* * OPEN a file that resides on an IBM-PC format virtual floppy or hard disk)
(LET ((DISK (\VPCF.GET.DISK NAME FDEV))
STREAM)
(SETQ STREAM (SELECTQ ACCESS
(INPUT (\VPCF.OPEN.FOR.INPUT NAME DISK FDEV))
(OUTPUT (\VPCF.OPEN.FOR.OUTPUT NAME DISK FDEV))
(BOTH (\VPCF.OPEN.FOR.BOTH NAME DISK FDEV))
(APPEND (\VPCF.OPEN.FOR.APPEND NAME DISK FDEV))
(SHOULDNT)))
(COND
((\VPCF.SEARCHOFDS DISK NAME))
(T (* Add the stream to the \VPCF.OPENFILES list)
(\VPCF.ADDOFD DISK STREAM)))
STREAM])
(\VPCF.OPEN.FOR.INPUT
[LAMBDA (NAME DISK FDEV) (* AJB "12-Jun-86 14:19")
(* * Open a file for input. The file resides on the emulated IBM-PC format floppy/hard disk DISK.)
(LET ([NAMEFIELD (U-CASE (FILENAMEFIELD NAME (QUOTE NAME]
[EXTENSION (U-CASE (FILENAMEFIELD NAME (QUOTE EXTENSION]
(STREAM (\VPCF.OPEN.BACKING.STREAM DISK))
DIRENTRY FILE FULLNAME) (* Make sure backing store stream is open)
(* * Lookup the directory and file, but dont create either)
(SETQ DIRENTRY (\VPCF.FIND.DIR.ENTRY (PACKFILENAME (QUOTE DEVICE)
NIL
(QUOTE HOST)
NIL
(BQUOTE BODY)
(U-CASE NAME))
DISK T T))
(OR DIRENTRY (PROGN (\VPCF.CLOSE.BACKING.STREAM DISK)
(ERROR "FILE NOT FOUND" NAME)))
(SETQ FULLNAME (PACKFILENAME (QUOTE HOST)
(fetch (FDEV DEVICENAME) of FDEV)
(QUOTE DEVICE)
(fetch (VPCDISK VPCDEVICE) of DISK)
(QUOTE NAME)
NAMEFIELD
(QUOTE EXTENSION)
EXTENSION
(QUOTE BODY)
NAME))
(SETQ FILE (create VPCFFILE
DIRENTRY ← DIRENTRY
DISK ← DISK
CLUSTER ←(fetch (VPCFDIRENTRY START) of DIRENTRY)
CURCLUSTER ←(fetch (VPCFDIRENTRY START) of DIRENTRY)
VPCFULLNAME ← FULLNAME
FATCHAIN ←(\VPCF.READ.FAT.CHAIN (fetch (VPCFDIRENTRY START)
of DIRENTRY)
DISK)))
(* The FATCHAIN in the file entry is only used for
debugging -
and is only accurate when the file is first opened)
(create STREAM
DEVICE ← FDEV
FULLFILENAME ← FULLNAME
F1 ← FILE
CBUFSIZE ← 0
COFFSET ← 0
CPAGE ← 0
EPAGE ←(IQUOTIENT (fetch (VPCFDIRENTRY SIZE) of DIRENTRY)
(fetch (VPCDISK BYTES.PER.CLUSTER) of DISK))
EOFFSET ←(IREMAINDER (fetch (VPCFDIRENTRY SIZE) of DIRENTRY)
(fetch (VPCDISK BYTES.PER.CLUSTER) of DISK))
CBUFMAXSIZE ←(fetch (VPCDISK BYTES.PER.CLUSTER) of DISK)
EOLCONVENTION ← CRLF.EOLC])
(\VPCF.OPEN.FOR.OUTPUT
[LAMBDA (NAME DISK FDEV) (* AJB "25-Apr-86 15:50")
(* * Open a file for output. The file resides on the emulated IBM-PC format floppy/hard disk DISK.)
(LET ([NAMEFIELD (U-CASE (FILENAMEFIELD NAME (QUOTE NAME]
[EXTENSION (U-CASE (FILENAMEFIELD NAME (QUOTE EXTENSION]
(STREAM (\VPCF.OPEN.BACKING.STREAM DISK))
DIRENTRY FILE FULLNAME CLUSTER)
(* * Lookup the directory, but don't create a directory, but do create a file if necessary)
(SETQ DIRENTRY (\VPCF.FIND.DIR.ENTRY (PACKFILENAME (QUOTE DEVICE)
NIL
(QUOTE HOST)
NIL
(BQUOTE BODY)
(U-CASE NAME))
DISK T))
(OR DIRENTRY (PROGN (\VPCF.CLOSE.BACKING.STREAM DISK)
(ERROR "VIRTUAL DISK DISK SPACE EXHAUSTED" DISK)))
(SETQ FULLNAME (PACKFILENAME (QUOTE HOST)
(fetch (FDEV DEVICENAME) of FDEV)
(QUOTE DEVICE)
(fetch (VPCDISK VPCDEVICE) of DISK)
(QUOTE NAME)
NAMEFIELD
(QUOTE EXTENSION)
EXTENSION
(QUOTE BODY)
NAME))
(SETQ FILE
(create VPCFFILE
DIRENTRY ← DIRENTRY
DISK ← DISK
CLUSTER ← 0
CURCLUSTER ← 0
VPCFULLNAME ← FULLNAME
FATCHAIN ← NIL))
(* * Now walk the chain in the FAT, freeing up the pages)
(first (SETQ CLUSTER (fetch (VPCFDIRENTRY START) of DIRENTRY))
until (OR (EQ CLUSTER 0)
(IGEQ CLUSTER VPCF.EOF))
do (SETQ CLUSTER (\VPCF.MARK.THE.FAT CLUSTER DISK 0)))
(* * ZERO indicates no pages allocated)
(replace (VPCFDIRENTRY START) of DIRENTRY with 0)
(* * Open a stream to write the I/O)
(create STREAM
DEVICE ← FDEV
FULLFILENAME ← FULLNAME
F1 ← FILE
CBUFSIZE ← 0
COFFSET ← 0
CPAGE ← 0
EPAGE ← 0
EOFFSET ← 0
CBUFMAXSIZE ←(fetch (VPCDISK BYTES.PER.CLUSTER) of DISK)
EOLCONVENTION ← CRLF.EOLC])
(\VPCF.OPEN.FOR.BOTH
[LAMBDA (NAME DISK FDEV) (* AJB "29-Apr-86 14:41")
(* * Open a file for both input and output. The file resides on the emulated IBM-PC format floppy/hard disk DISK.)
(LET ([NAMEFIELD (U-CASE (FILENAMEFIELD NAME (QUOTE NAME]
[EXTENSION (U-CASE (FILENAMEFIELD NAME (QUOTE EXTENSION]
(STREAM (\VPCF.OPEN.BACKING.STREAM DISK))
DIRENTRY FILE FULLNAME)
(* * Lookup the directory, but don't create a directory, but do create a file if necessary)
(SETQ DIRENTRY (\VPCF.FIND.DIR.ENTRY (PACKFILENAME (QUOTE DEVICE)
NIL
(QUOTE HOST)
NIL
(BQUOTE BODY)
(U-CASE NAME))
DISK T))
(OR DIRENTRY (PROGN (\VPCF.CLOSE.BACKING.STREAM DISK)
(ERROR "VIRTUAL DISK DISK SPACE EXHAUSTED" DISK)))
(SETQ FULLNAME (PACKFILENAME (QUOTE HOST)
(fetch (FDEV DEVICENAME) of FDEV)
(QUOTE DEVICE)
(fetch (VPCDISK VPCDEVICE) of DISK)
(QUOTE NAME)
NAMEFIELD
(QUOTE EXTENSION)
EXTENSION
(QUOTE BODY)
NAME))
(SETQ FILE (create VPCFFILE
DIRENTRY ← DIRENTRY
DISK ← DISK
CLUSTER ←(fetch (VPCFDIRENTRY START) of DIRENTRY)
CURCLUSTER ← 0
VPCFULLNAME ← FULLNAME
FATCHAIN ←(\VPCF.READ.FAT.CHAIN (fetch (VPCFDIRENTRY START)
of DIRENTRY)
DISK)))
(* * Setup next cluster to be the second cluster, or if none, EOF)
(* replace (VPCFFILE CLUSTER) of FILE with
(COND ((CADR (fetch (VPCFFILE FATCHAIN) of FILE)))
(T VPCF.EOF)))
(* * Open a stream to read/ write the I/O)
(create STREAM
DEVICE ← FDEV
FULLFILENAME ← FULLNAME
F1 ← FILE
CBUFSIZE ← 0
COFFSET ← 0
CPAGE ← 0
EPAGE ←(IQUOTIENT (fetch (VPCFDIRENTRY SIZE) of DIRENTRY)
(fetch (VPCDISK BYTES.PER.CLUSTER) of DISK))
EOFFSET ←(IREMAINDER (fetch (VPCFDIRENTRY SIZE) of DIRENTRY)
(fetch (VPCDISK BYTES.PER.CLUSTER) of DISK))
CBUFMAXSIZE ←(fetch (VPCDISK BYTES.PER.CLUSTER) of DISK)
EOLCONVENTION ← CRLF.EOLC])
(\VPCF.OPEN.FOR.APPEND
[LAMBDA (NAME DISK FDEV) (* AJB " 7-May-86 10:35")
(* * Open a file in append mode The file resides on the emulated IBM-PC format floppy/hard disk DISK.)
(LET ([NAMEFIELD (U-CASE (FILENAMEFIELD NAME (QUOTE NAME]
[EXTENSION (U-CASE (FILENAMEFIELD NAME (QUOTE EXTENSION]
(STREAM (\VPCF.OPEN.BACKING.STREAM DISK))
DIRENTRY FILE FULLNAME)
(* * Lookup the directory, but don't create a directory, and dont create a new file)
(SETQ DIRENTRY (\VPCF.FIND.DIR.ENTRY (PACKFILENAME (QUOTE DEVICE)
NIL
(QUOTE HOST)
NIL
(BQUOTE BODY)
(U-CASE NAME))
DISK T T))
(OR DIRENTRY (PROGN (\VPCF.CLOSE.BACKING.STREAM DISK)
(ERROR "VIRTUAL DISK SPACE EXHAUSTED" DISK)))
(SETQ FULLNAME (PACKFILENAME (QUOTE HOST)
(fetch (FDEV DEVICENAME) of FDEV)
(QUOTE DEVICE)
(fetch (VPCDISK VPCDEVICE) of DISK)
(QUOTE NAME)
NAMEFIELD
(QUOTE EXTENSION)
EXTENSION
(QUOTE BODY)
NAME))
(SETQ FILE (create VPCFFILE
DIRENTRY ← DIRENTRY
DISK ← DISK
VPCFULLNAME ← FULLNAME
FATCHAIN ←(\VPCF.READ.FAT.CHAIN (fetch (VPCFDIRENTRY START)
of DIRENTRY)
DISK)))
(* * Set CURCLUSTER and CLUSTER to last cluster in the file)
[replace (VPCFFILE CLUSTER) of FILE with (replace (VPCFFILE CURCLUSTER)
of FILE
with (CAR (LAST (fetch (VPCFFILE
FATCHAIN)
of FILE]
(* * Open a stream to write the I/O)
(create STREAM
DEVICE ← FDEV
FULLFILENAME ← FULLNAME
F1 ← FILE
CBUFSIZE ← 0
COFFSET ←(IREMAINDER (fetch (VPCFDIRENTRY SIZE) of DIRENTRY)
(fetch (VPCDISK BYTES.PER.CLUSTER) of DISK))
CPAGE ←(IQUOTIENT (fetch (VPCFDIRENTRY SIZE) of DIRENTRY)
(fetch (VPCDISK BYTES.PER.CLUSTER) of DISK))
EPAGE ←(IQUOTIENT (fetch (VPCFDIRENTRY SIZE) of DIRENTRY)
(fetch (VPCDISK BYTES.PER.CLUSTER) of DISK))
EOFFSET ←(IREMAINDER (fetch (VPCFDIRENTRY SIZE) of DIRENTRY)
(fetch (VPCDISK BYTES.PER.CLUSTER) of DISK))
CBUFMAXSIZE ←(fetch (VPCDISK BYTES.PER.CLUSTER) of DISK)
EOLCONVENTION ← CRLF.EOLC])
(\VPCF.REOPENFILE
[LAMBDA (STREAM) (* AJB "12-May-86 10:42")
(* * Simply returns the original stream to say everthing ok)
(* * Used by system restart from LOGOUT to reopen any streams that were open prior to LOGOUT)
STREAM])
(\VPCF.CLOSEFILE
[LAMBDA (STREAM) (* AJB "12-Jun-86 14:43")
(* * Closes a stream on a file)
(PROG* [(FILE (fetch F1 of STREAM))
(DISK (fetch (VPCFFILE DISK) of FILE))
(BUFFER (fetch (STREAM CBUFPTR) of STREAM))
(DIRENTRY (fetch (VPCFFILE DIRENTRY) of FILE))
(DISKSTREAM (GETSTREAM (fetch (VPCDISK FILENAME) of DISK)
(QUOTE BOTH]
(* * If this is the end page and user has written thru the previous offset, then update the offset)
(\VPCF.UPDATEOF STREAM) (* Update EPAGE & EOFFSET)
(replace (VPCFDIRENTRY SIZE) of DIRENTRY with (IPLUS (ITIMES (fetch (STREAM EPAGE)
of STREAM)
(fetch (VPCDISK
BYTES.PER.CLUSTER)
of DISK))
(fetch (STREAM EOFFSET)
of STREAM)))
(* * Write the directory entry back to the backing stream)
[COND
((OR (OVERWRITEABLE STREAM)
(APPENDABLE STREAM))
(\VPCF.WRITE.DIR.ENTRY DISK DISKSTREAM DIRENTRY)
(* * Flush last buffer)
(COND
((fetch (STREAM CBUFDIRTY) of STREAM)
(\VPCF.WRITE.CLUSTER FILE BUFFER NIL NIL (fetch (STREAM COFFSET) of STREAM]
(replace (STREAM ACCESSBITS) of STREAM with NoBits)
(replace (STREAM ACCESS) of STREAM with NIL)
(replace (STREAM STRMBINFN) of STREAM with (FUNCTION \STREAM.NOT.OPEN))
(replace (STREAM STRMBOUTFN) of STREAM with (FUNCTION \STREAM.NOT.OPEN))
(\VPCF.DELETEOFD DISK STREAM) (* Remove the entry from the open file list)
(\VPCF.CLOSE.BACKING.STREAM DISK) (* Close the backing stream)
(RETURN (fetch (STREAM FULLFILENAME) of STREAM])
(\VPCF.DELETEFILE
[LAMBDA (NAME FDEV) (* AJB " 8-May-86 14:53")
(* * Delete a file. The file resides on the emulated IBM-PC format floppy/hard disk DISK.)
(PROG* ((DISK (\VPCF.GET.DISK NAME FDEV))
[NAMEFIELD (U-CASE (FILENAMEFIELD NAME (QUOTE NAME]
[EXTENSION (U-CASE (FILENAMEFIELD NAME (QUOTE EXTENSION]
DIRENTRY FILE FULLNAME CLUSTER STREAM)
[RESETLST (SETQ STREAM (\VPCF.OPEN.BACKING.STREAM DISK))
(RESETSAVE NIL (LIST (FUNCTION [LAMBDA (DISK)
(\VPCF.CLOSE.BACKING.STREAM DISK])
DISK))
(SETQ DIRENTRY (\VPCF.FIND.DIR.ENTRY (PACKFILENAME (QUOTE DEVICE)
NIL
(QUOTE HOST)
NIL
(BQUOTE BODY)
(U-CASE NAME))
DISK T T))
(COND
(DIRENTRY
(* * Mark the directory entry unused)
(WITH.MONITOR (fetch (VPCDISK MONITORLOCK) of DISK)
(* need monitorlock to be sure that other processes
don't move the file ptr around)
(SETFILEPTR STREAM (fetch DIRENTRYFPOS of DIRENTRY)
)
(BOUT STREAM 229)
(* * Now walk the chain in the FAT, freeing up the pages)
(first (SETQ CLUSTER (fetch (VPCFDIRENTRY START)
of DIRENTRY))
until (OR (EQ CLUSTER 0)
(IGEQ CLUSTER VPCF.EOF))
do (SETQ CLUSTER (\VPCF.MARK.THE.FAT CLUSTER
DISK 0]
(COND
(DIRENTRY (RETURN NAME])
(\VPCF.SEARCHOFDS
[LAMBDA (DISK FILENAME) (* AJB " 1-Apr-86 15:23")
(* Returns a stream whose fullname is NAME and matches
the device DISK if it is on the open file list)
(for ALIST in \VPCF.OPENFILES when (EQ (CAR ALIST)
DISK)
do (COND
((EQ (fetch FULLNAME of (CADR ALIST))
FILENAME)
(RETURN (CADR ALIST])
(\VPCF.DELETEOFD
[LAMBDA (DISK STREAM) (* AJB " 1-Apr-86 13:53")
(* * Removes an entry from the \VPCF.OPENFILES list)
(SETQ \VPCF.OPENFILES (REMOVE (LIST DISK STREAM)
\VPCF.OPENFILES])
(\VPCF.ADDOFD
[LAMBDA (DISK STREAM) (* AJB " 1-Apr-86 11:09")
(* adds to \VPCF.OPENFILES)
(AND (fetch NAMEDP of STREAM)
(push \VPCF.OPENFILES (LIST DISK STREAM])
)
(DEFINEQ
(\VPCF.PARSENAME
[LAMBDA (NAME) (* jds "14-Feb-86 23:10")
(* * Parse a PC-format filename into a directory chain to drive the search for that file)
(* Returns a CONS pair of (directory-list .
rootname.ext))
(LET ((DIRPART (FILENAMEFIELD NAME (QUOTE DIRECTORY)))
DIRS POS)
[while DIRPART
do
(* * Split the directory apart into subdirectories)
[SETQ POS (OR (STRPOS ">" DIRPART)
(ADD1 (NCHARS DIRPART]
(push DIRS (SUBATOM DIRPART 1 (SUB1 POS)))
(SETQ DIRPART (SUBATOM DIRPART (ADD1 POS]
(* * Return a CONS pair, of (the-directory-list . filename))
(CONS (REVERSE DIRS)
NAME])
(\VPCF.GETFILENAME
[LAMBDA (NAME RECOG FDEV) (* AJB "17-Mar-86 17:08")
(LET ((DISK (\VPCF.GET.DISK NAME FDEV)))
(COND
(DISK (PACKFILENAME (QUOTE HOST)
(QUOTE PCDISK)
(QUOTE DEVICE)
(fetch (VPCDISK VPCDEVICE) of DISK)
(QUOTE BODY)
(U-CASE NAME)))
(T NIL])
(\VPCF.GET.DISK
[LAMBDA (FILENAME FDEV) (* AJB "26-Mar-86 14:19")
(* Given a disk's name, return the data structure that
describes that disk)
[OR (type? FDEV FDEV)
(SETQ FDEV (\GETDEVICEFROMNAME (QUOTE PCDISK]
(OR (for DISK in (fetch (FDEV DEVICEINFO) of FDEV)
thereis (EQ (MKATOM (U-CASE (SUBSTRING (FILENAMEFIELD FILENAME (QUOTE DEVICE))
1 -2)))
(fetch (VPCDISK VPCDEVICE) of DISK)))
(ERROR "NO DISK FOR NAME" FILENAME])
(\VPCF.GETNEXTBUFFER
[LAMBDA (STREAM WHATFOR NOERRORFLG NEXTCLUSTER) (* jds "13-Jun-86 14:28")
(* * Get the next buffer of bytes for a stream that's on an emulated IBM-PC
format floppy/hard disk)
(PROG* ((BUFFER (fetch (STREAM CBUFPTR) of STREAM))
(OLDBUFFER BUFFER)
(FILE (fetch (STREAM F1) of STREAM))
(DISK (fetch (VPCFFILE DISK) of FILE))
CLUSTER)
[COND
((NOT (OPENED STREAM))
(LISPERROR "FILE NOT OPEN" (FETCH FULLNAME OF STREAM]
(* * write a dirty buffer)
(COND
((fetch (STREAM CBUFDIRTY) of STREAM)
(\VPCF.WRITE.CLUSTER FILE BUFFER NOERRORFLG) (* Write out CURCLUSTER in FILE)
(replace (STREAM CBUFDIRTY) of STREAM with NIL)))
(COND
((AND (ILESSP (fetch COFFSET of STREAM)
(SELECTQ WHATFOR
(READ (fetch CBUFSIZE of STREAM))
(fetch (VPCDISK BYTES.PER.CLUSTER) of DISK)))
(fetch CBUFPTR of STREAM))
(RETURN T))) (* Bytes still in the buffer RETURN T)
(* * Make sure we have a buffer to read things into)
[OR BUFFER (SETQ BUFFER (replace (STREAM CBUFPTR) of STREAM
with (\ALLOCBLOCK (FOLDHI (fetch (VPCDISK BYTES.PER.CLUSTER)
of (fetch (VPCFFILE DISK)
of FILE))
BYTESPERCELL)
NIL]
(COND
((EQ (fetch (VPCDISK BYTES.PER.CLUSTER) of DISK)
(fetch (STREAM COFFSET) of STREAM))
(replace (STREAM COFFSET) of STREAM with 0)
(add (fetch (STREAM CPAGE) of STREAM)
1)))
[COND
((IGEQ (fetch (STREAM CPAGE) of STREAM)
(fetch (STREAM EPAGE) of STREAM))
(replace (STREAM CBUFSIZE) of STREAM with (fetch (STREAM EOFFSET) of STREAM)))
(T (replace (STREAM CBUFSIZE) of STREAM with (fetch (VPCDISK BYTES.PER.CLUSTER)
of DISK]
(replace (STREAM CBUFMAXSIZE) of STREAM with (fetch (VPCDISK BYTES.PER.CLUSTER)
of DISK))
(* * Now go get the next buffer-full)
(SELECTQ WHATFOR
(READ (* Reading. Go read the next cluster's
worth of bytes from the file.)
[COND
((\VPCF.READ.CLUSTER FILE BUFFER NOERRORFLG NEXTCLUSTER)
(* The next buffer-full read in OK)
(RETURN T))
(T (* No next buffer to read--must be at
EOF.)
(COND
(NOERRORFLG (* Zero the buffer)
(\ZEROBYTES BUFFER 0 (SUB1 (fetch (VPCDISK BYTES.PER.CLUSTER)
of DISK)))
(RETURN))
(T (* He wants an error signalled.
Set things so the fileptr is at
EOFPTR, and call the end-of-stream op.)
(replace (STREAM CBUFPTR) of STREAM with NIL)
(replace (STREAM CBUFSIZE) of STREAM with 0)
(replace (STREAM COFFSET) of STREAM with 0)
(replace (STREAM CPAGE) of STREAM with (ADD1 (fetch (STREAM EPAGE)
of STREAM)))
(RETURN (AND (NULL NOERRORFLG)
(\EOF.ACTION STREAM])
(WRITE (COND
((\VPCF.READ.CLUSTER FILE BUFFER NOERRORFLG NEXTCLUSTER))
(T (* EOF, go allocate new cluster
(s)%, and zero the buffer)
(* Zero out the buffer before the user
stores in it)
(\ZEROBYTES BUFFER 0 (SUB1 (fetch (VPCDISK BYTES.PER.CLUSTER)
of DISK)))
(* * Normally, CPAGE will increment by 1 page past the EPAGE for sequential
writes, or possibly higher via SETFILEPTR.
So, allocate new clusters up to CPAGE and set EPAGE equal to it)
(OR (SETQ CLUSTER (\VPCF.ALLOCATE.CLUSTERS DISK FILE STREAM
(fetch (STREAM CPAGE) of STREAM)))
(PROGN (\VPCF.DELETEOFD DISK STREAM)
(ERROR "\VPCF.GETNEXTBUFFER: DISK SPACE EXHAUSTED" DISK))
(* No free clusters in the FAT)
) (* Save as current cluster)
(replace (VPCFFILE CURCLUSTER) of FILE with CLUSTER)
(replace (STREAM EPAGE) of STREAM with (fetch (STREAM CPAGE) of STREAM))
(replace (STREAM EOFFSET) of STREAM with 0)
(* Store end of file in next cluster
slot)
(replace (VPCFFILE CLUSTER) of FILE with VPCF.EOF)
(replace (STREAM CBUFSIZE) of STREAM with (fetch (VPCDISK
BYTES.PER.CLUSTER
) of DISK))
(* * Mark the buffer as dirty to make sure it gets written out)
(replace (STREAM CBUFDIRTY) of STREAM with T)))
(RETURN T))
(SHOULDNT])
(\VPCF.READ.CLUSTER
[LAMBDA (FILE BUFFER NOERRORFLG NEWCLUSTER) (* AJB "24-Mar-86 17:24")
(* * Fills BUFFER with bytes from FILE on DISK)
(WITH.MONITOR (fetch (VPCDISK MONITORLOCK) of (fetch (VPCFFILE DISK) of FILE))
(* need monitorlock to be sure that other processes
don't move the file ptr around)
(LET* [(CLUSTER (OR NEWCLUSTER (fetch (VPCFFILE CLUSTER) of FILE)))
(DISK (fetch (VPCFFILE DISK) of FILE))
(STREAM (GETSTREAM (fetch (VPCDISK FILENAME) of DISK)
(QUOTE BOTH]
(COND
((OR (EQ CLUSTER 0)
(GEQ CLUSTER VPCF.EOF)) (* end of file)
(* (OR NOERRORFLG (LISPERROR "END OF FILE"
(fetch (VPCFFILE VPCFULLNAME) of FILE))))
NIL)
(T (replace (VPCFFILE CURCLUSTER) of FILE with CLUSTER)
(* Remember which cluster is currently in the buffer,
so we know where to write it back, if need be.)
(SETFILEPTR STREAM (\VPCF.CLUSTER.TO.FILEPOS CLUSTER DISK))
(\BINS STREAM BUFFER 0 (fetch (VPCDISK BYTES.PER.CLUSTER)
of DISK))
(* Read the bytes into the buffer)
(replace (VPCFFILE CLUSTER) of FILE with (\VPCF.GET.NEXT.CLUSTER
CLUSTER DISK))
T])
(\VPCF.WRITE.CLUSTER
[LAMBDA (FILE BUFFER ERRORFLG NEWCLUSTER BYTECOUNT) (* AJB " 2-Apr-86 15:35")
(* * Writes a cluster from the buffer to the FILE on DISK)
(WITH.MONITOR (fetch (VPCDISK MONITORLOCK) of (fetch (VPCFFILE DISK) of FILE))
(* need monitorlock to be sure that other processes
don't move the file ptr around)
(LET* [(CLUSTER (OR NEWCLUSTER (fetch (VPCFFILE CURCLUSTER) of FILE)))
(DISK (fetch (VPCFFILE DISK) of FILE))
(STREAM (GETSTREAM (fetch (VPCDISK FILENAME) of DISK)
(QUOTE BOTH]
(COND
((EQ CLUSTER 0)
(SHOULDNT "ERROR: TRYING TO WRITE AN ILLEGAL CLUSTER"))
((GEQ CLUSTER VPCF.EOF) (* end of file)
NIL)
(T (SETFILEPTR STREAM (\VPCF.CLUSTER.TO.FILEPOS CLUSTER DISK))
(\BOUTS STREAM BUFFER 0 (OR BYTECOUNT (fetch (VPCDISK
BYTES.PER.CLUSTER)
of DISK)))
(* Write the bytes from the buffer to the stream)
T])
(\VPCF.GET.NEXT.CLUSTER
[LAMBDA (CLUSTER DISK NOERRORFLG) (* AJB " 4-Apr-86 16:15")
(* * Returns the next cluster on DISK after CLUSTER. This embodies the procedure described on p 5-8 of DOS tech.
ref.)
(* NB THAT THIS ONLY WORKS WITH 12-BIT FATS FOR NOW)
(PROG ((STREAM (GETSTREAM (fetch (VPCDISK FILENAME) of DISK)
(QUOTE BOTH)))
(OFFSET (PLUS CLUSTER (LRSH CLUSTER 1)))
WORD)
(OR (AND (NEQ CLUSTER 0)
(LESSP CLUSTER VPCF.EOF))
(RETURN VPCF.EOF))
(WITH.MONITOR (fetch (VPCDISK MONITORLOCK) of DISK)
(* need monitorlock to be sure that other processes
don't move the file ptr around)
(SETFILEPTR STREAM (IPLUS (fetch (VPCDISK FAT.OFFSET1) of DISK)
OFFSET)) (* Point to beginning of FAT)
(SETQ WORD (\SWIN STREAM)))
(RETURN (COND
((EVENP CLUSTER)
(LOGAND 4095 WORD))
(T (LRSH WORD 4])
(\VPCF.ALLOCATE.CLUSTERS
[LAMBDA (DISK FILE STREAM NEWEPAGE) (* AJB "28-Apr-86 17:42")
(* * Allocate clusters from current end of file to NEWEPAGE zeroing the clusters. Returns the last cluster
allocated or NIL if out of storage)
(PROG (CLUSTER (DIRENTRY (fetch (VPCFFILE DIRENTRY) of FILE)))
(while (OR (EQ VPCF.EOF (fetch (VPCFFILE CLUSTER) of FILE))
(EQ 0 (fetch (VPCFFILE CURCLUSTER) of FILE))
(ILESSP (fetch (STREAM EPAGE) of STREAM)
NEWEPAGE))
do (SETQ CLUSTER (\VPCF.ALLOCATE.CLUSTER DISK))
(COND
((NULL CLUSTER) (* Out of storage)
(RETURN)))
(COND
((EQ 0 (fetch (VPCFFILE CURCLUSTER) of FILE))
(* First cluster for the file, goes into the directory
entry)
(replace (VPCFDIRENTRY START) of DIRENTRY with CLUSTER))
(T (* Point the current cluster in the FAT to the just
allocated one)
(\VPCF.MARK.THE.FAT (fetch (VPCFFILE CURCLUSTER) of FILE)
DISK CLUSTER) (* Bump the cluster count by 1)
(add (fetch (STREAM EPAGE) of STREAM)
1))) (* Update the current cluster we just allocated which
is used each time above)
(replace (VPCFFILE CURCLUSTER) of FILE with CLUSTER)
(* To prevent infinite loop in the "while" check)
(replace (VPCFFILE CLUSTER) of FILE with CLUSTER))
(* * Set the next cluster to write on to EOF)
(replace (VPCFFILE CLUSTER) of FILE with VPCF.EOF)
(* * Write out the current directory to keep PC file system intact)
(\VPCF.WRITE.DIR.ENTRY DISK (GETSTREAM (fetch (VPCDISK FILENAME) of DISK)
(QUOTE BOTH))
DIRENTRY)
(* * Return the last cluster allocated)
(RETURN CLUSTER])
(\VPCF.ALLOCATE.CLUSTER
[LAMBDA (DISK) (* AJB " 9-May-86 10:38")
(* * Allocate one cluster, zero the data out, store EOF in the slot in the FAT, and Return the cluster allocated)
(* * Note, only handles 12-bit fats for now)
(WITH.MONITOR (fetch (VPCDISK MONITORLOCK) of DISK)
(* need monitorlock to be sure that other processes
don't move the file ptr around)
(PROG [CLUSTER WORD (STREAM (GETSTREAM (fetch (VPCDISK FILENAME) of DISK)
(QUOTE BOTH]
(RETURN (COND
([for old CLUSTER from 2
to (IQUOTIENT
(ITIMES VPCF.BYTES.PER.SECTOR
(IDIFFERENCE (fetch (VPCDISK #SECTORS)
of DISK)
(IPLUS (ITIMES (fetch
(VPCDISK FATS)
of DISK)
(fetch
(VPCDISK FAT.SIZE)
of DISK))
(fetch (VPCDISK DIR.SIZE)
of DISK)
1)))
(fetch (VPCDISK BYTES.PER.CLUSTER) of DISK))
do [SETFILEPTR STREAM (IPLUS (fetch (VPCDISK FAT.OFFSET1)
of DISK)
(PLUS CLUSTER (LRSH CLUSTER 1]
(SETQ WORD (\SWIN STREAM))
(COND
((EQ (COND
((EVENP CLUSTER)
(LOGAND 4095 WORD))
(T (LRSH WORD 4)))
0)
(RETURN CLUSTER]
(\VPCF.MARK.THE.FAT CLUSTER DISK VPCF.EOF)
(SETFILEPTR STREAM (\VPCF.CLUSTER.TO.FILEPOS CLUSTER DISK))
(for I from 1 to (fetch (VPCDISK BYTES.PER.CLUSTER)
of DISK)
do (BOUT STREAM 0))
CLUSTER])
(\VPCF.DEALLOCATE.CLUSTERS
[LAMBDA (DISK FILE STREAM NEWEPAGE) (* AJB "29-Apr-86 15:44")
(* * Deallocate clusters from current NEWEPAGE to end of file)
[PROG [CURPAGE (ENDPAGE (fetch (STREAM EPAGE) of STREAM))
(CLUSTER (fetch (VPCFDIRENTRY START) of (fetch (VPCFFILE DIRENTRY)
of FILE]
(for old CURPAGE from 0 to (SUB1 NEWEPAGE) do (SETQ CLUSTER (
\VPCF.GET.NEXT.CLUSTER
CLUSTER
DISK)))
(replace (VPCFFILE CURCLUSTER) of FILE with CLUSTER)
(SETQ CLUSTER (\VPCF.GET.NEXT.CLUSTER CLUSTER DISK))
(for old CURPAGE from CURPAGE to (SUB1 ENDPAGE)
do
(* * Free up the cluster, and get its previous)
(AND (LESSP CLUSTER VPCF.EOF)
(IGREATERP CLUSTER 1)
(SETQ CLUSTER (\VPCF.MARK.THE.FAT CLUSTER DISK 0]
(* * Now mark the last cluster as end of file in the FAT)
(\VPCF.MARK.THE.FAT (fetch (VPCFFILE CURCLUSTER) of FILE)
DISK VPCF.EOF)
(* * Set the next cluster to write on to EOF)
(replace (VPCFFILE CLUSTER) of FILE with VPCF.EOF])
(\VPCF.MARK.THE.FAT
[LAMBDA (CLUSTER DISK NEWVALUE) (* AJB " 8-May-86 17:09")
(* Sets the FAT entry for CLUSTER to NEWVALUE to point
to a new entry or mark it free.
Returns the old value.)
(* NB THAT THIS ONLY WORKS WITH 12-BIT FATS FOR NOW)
(OR (LESSP CLUSTER 4088)
(SHOULDNT "ILLEGAL FAT VALUE"))
(WITH.MONITOR (fetch (VPCDISK MONITORLOCK) of DISK)
(* need monitorlock to be sure that other processes
don't move the file ptr around)
(PROG ((STREAM (GETSTREAM (fetch (VPCDISK FILENAME) of DISK)
(QUOTE BOTH)))
(OFFSET (PLUS CLUSTER (LRSH CLUSTER 1)))
WORD OLDVALUE)
(SETFILEPTR STREAM (IPLUS (fetch (VPCDISK FAT.OFFSET1) of DISK)
OFFSET))
(SETQ WORD (\SWIN STREAM))
[SETQ OLDVALUE (COND
((EVENP CLUSTER)
(LOGAND 4095 WORD))
(T (LRSH WORD 4]
(SETFILEPTR STREAM (IPLUS (fetch (VPCDISK FAT.OFFSET1) of DISK)
OFFSET))
[COND
[(EVENP CLUSTER) (* "OR" in the newvalue, preserving the high order 4
bits of the other cluster)
(\SWOUT STREAM (SETQ WORD (LOGOR (LOGAND NEWVALUE 4095)
(LOGAND WORD 61440]
(T (* "OR" in the newvalue shifted left 4 bits,
preserving the low-order 4 bits of the other cluster)
(\SWOUT STREAM (SETQ WORD (LOGOR (LSH NEWVALUE 4)
(LOGAND WORD 15]
(* * Now write in the second copy of the FAT)
(SETFILEPTR STREAM (IPLUS OFFSET (fetch (VPCDISK FAT.OFFSET2) of DISK)))
(\SWOUT STREAM WORD)
(RETURN OLDVALUE])
(\VPCF.PRINT.FATS
[LAMBDA (DIR) (* AJB " 2-May-86 15:29")
(for X in (DIRECTORY DIR) bind STR
do (SETQ STR (OPENSTREAM X (QUOTE INPUT)
(QUOTE OLD)))
(PRINTOUT T (FULLNAME STR)
,,,
(fetch (VPCFFILE FATCHAIN) of (fetch (STREAM F1) of STR))
T)
(CLOSEF STR])
(\VPCF.GET.CLUSTER.CHAIN
[LAMBDA (STARTCLUSTER DISK) (* AJB " 4-Mar-86 13:26")
(for (CLUSTER ← STARTCLUSTER) by (\VPCF.GET.NEXT.CLUSTER CLUSTER DISK) collect CLUSTER
while (LESSP CLUSTER VPCF.EOF])
(\VPCF.DIRTEST
[LAMBDA (PCDISKDIR NUMBER.OF.FILES) (* AJB " 8-May-86 11:07")
(PROG (TS)
(for I from 1 to NUMBER.OF.FILES
do (PRINTOUT T "OPENING FILE " (CONCAT PCDISKDIR I))
(TERPRI)
(TERPRI)
(SETQ TS (OPENSTREAM (CONCAT PCDISKDIR I)
(QUOTE OUTPUT)))
(CLOSEF TS))
(for I from 1 to NUMBER.OF.FILES by 2
do (PRINTOUT T "DELETING FILE " (CONCAT PCDISKDIR I))
(TERPRI)
(TERPRI)
(DELFILE (CONCAT PCDISKDIR I)))
(for I from (IPLUS NUMBER.OF.FILES 1) to (ITIMES NUMBER.OF.FILES 2)
do (SETQ TS (OPENSTREAM (CONCAT PCDISKDIR I)
(QUOTE OUTPUT)))
(PRINTOUT T "OPENING FILE " (CONCAT PCDISKDIR I))
(TERPRI)
(TERPRI)
(CLOSEF TS])
)
(RPAQQ \VPCF.OPENFILES NIL)
(RPAQ? PC.TEXTFILE.EXTENSIONS NIL)
(VPCDISK.INSTALL)
(PUTPROPS VPCDISK COPYRIGHT ("Xerox Corporation" 1986 1900))
(DECLARE: DONTCOPY
(FILEMAP (NIL (16481 18044 (PRINDIRSTR 16491 . 16795) (STR2INT 16797 . 17125) (\VPCF.READPAGES 17127
. 18042)) (18102 37324 (VPCDISK.FLOPPY.TO.FILE 18112 . 19307) (VPCDISK.FILE.TO.FLOPPY 19309 . 20559)
(VPCDISK.INSTALL 20561 . 21816) (VPCDISK.CREATE.DEVICE 21818 . 23344) (\VPCDISK.CREATE.FLOPPY 23346 .
24356) (VPCDISK.DELETE.DEVICE 24358 . 24967) (VPCDISK.FREEPAGES 24969 . 26847) (VPCDISK.GETPARTITION#
26849 . 27694) (VPCDISK.CHANGE.PARTITION.TYPE 27696 . 29143) (\VPCF.INITIALIZE.DISK 29145 . 37322)) (
37360 53503 (\VPCF.FIND.DIR.ENTRY 37370 . 38273) (\VPCF.DIR.LOOKUP 38275 . 39269) (\VPCF.SEARCH.DIR
39271 . 41636) (\VPCF.READ.DIR.ENTRY 41638 . 44225) (\VPCF.FIND.FREE.DIR.ENTRY 44227 . 47139) (
\VPCF.WRITE.DIR.ENTRY 47141 . 48755) (\VPCF.READ.FILE.DATE 48757 . 49549) (\VPCF.WRITE.FILE.DATE 49551
. 50238) (\VPCF.ROOTDIRECTORY 50240 . 50597) (\VPCF.NEXT.DIR.CLUSTER 50599 . 51731) (
\VPCF.CLUSTER.TO.FILEPOS 51733 . 52088) (\VPCF.MAPDIR 52090 . 53159) (\VPCF.READ.FAT.CHAIN 53161 .
53501)) (53504 59928 (\VPCF.GENERATEFILES 53514 . 54212) (\VPCF.FILEMATCH 54214 . 55701) (
\VPCF.FILEMATCH1 55703 . 58399) (\VPCF.NEXTFILEFN 58401 . 59297) (\VPCF.FILEINFOFN 59299 . 59926)) (
59929 63833 (\VPCF.GETFILEINFO 59939 . 61229) (\VPCF.SETFILEINFO 61231 . 61968) (
\VPCF.OPEN.BACKING.STREAM 61970 . 62605) (\VPCF.CLOSE.BACKING.STREAM 62607 . 63831)) (63867 74780 (
\VPCF.EOFP 63877 . 66174) (\VPCF.SETFILEPTR 66176 . 68916) (\VPCF.GETFILEPTR 68918 . 69418) (
\VPCF.SETEOFPTR 69420 . 72405) (\VPCF.GETEOFPTR 72407 . 72999) (\VPCF.UPDATEOF 73001 . 74778)) (74781
89945 (\VPCF.OPENFILE 74791 . 75572) (\VPCF.OPEN.FOR.INPUT 75574 . 77889) (\VPCF.OPEN.FOR.OUTPUT 77891
. 80021) (\VPCF.OPEN.FOR.BOTH 80023 . 82420) (\VPCF.OPEN.FOR.APPEND 82422 . 84936) (\VPCF.REOPENFILE
84938 . 85252) (\VPCF.CLOSEFILE 85254 . 87260) (\VPCF.DELETEFILE 87262 . 88900) (\VPCF.SEARCHOFDS
88902 . 89390) (\VPCF.DELETEOFD 89392 . 89650) (\VPCF.ADDOFD 89652 . 89943)) (89946 111820 (
\VPCF.PARSENAME 89956 . 90769) (\VPCF.GETFILENAME 90771 . 91151) (\VPCF.GET.DISK 91153 . 91761) (
\VPCF.GETNEXTBUFFER 91763 . 99187) (\VPCF.READ.CLUSTER 99189 . 100789) (\VPCF.WRITE.CLUSTER 100791 .
101965) (\VPCF.GET.NEXT.CLUSTER 101967 . 103083) (\VPCF.ALLOCATE.CLUSTERS 103085 . 105290) (
\VPCF.ALLOCATE.CLUSTER 105292 . 107094) (\VPCF.DEALLOCATE.CLUSTERS 107096 . 108381) (
\VPCF.MARK.THE.FAT 108383 . 110333) (\VPCF.PRINT.FATS 110335 . 110726) (\VPCF.GET.CLUSTER.CHAIN 110728
. 110997) (\VPCF.DIRTEST 110999 . 111818)))))
STOP