(FILECREATED "28-Jul-86 16:40:40" {DSK}<LISPFILES>VPCDISK.;5 113373
changes to: (FNS PRINDIRSTR STR2INT \VPCF.READPAGES 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
\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
\VPCF.GENERATEFILES \VPCF.FILEMATCH \VPCF.FILEMATCH1 \VPCF.NEXTFILEFN
\VPCF.FILEINFOFN \VPCF.GETFILEINFO \VPCF.SETFILEINFO
\VPCF.OPEN.BACKING.STREAM \VPCF.CLOSE.BACKING.STREAM \VPCF.EOFP
\VPCF.SETFILEPTR \VPCF.GETFILEPTR \VPCF.SETEOFPTR \VPCF.GETEOFPTR
\VPCF.UPDATEOF \VPCF.BACKFILEPTR \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 \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 VPCDISKCOMS)
previous date: "28-Jul-86 14:56:21" {DSK}<LISPFILES>VPCDISK.;4)
(* 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 (* LISP to real PC FLOPPY functions)
(FNS PCFLOPPY.INSTALL \PCFLOPPY.OPEN.FOR.APPEND \PCFLOPPY.OPEN.FOR.BOTH
\PCFLOPPY.OPEN.FOR.INPUT \PCFLOPPY.OPEN.FOR.OUTPUT \PCFLOPPY.OPENFILE
\PCFLOPPY.CLOSEFILE \PCFLOPPY.READPAGES \PCFLOPPY.WRITEPAGES))
(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.BACKFILEPTR \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)
\PCFLOPPY.TRACKSPERCYLINDER.SAVE \PCFLOPPY.SECTORSPERTRACK.SAVE)
(INITVARS (PC.TEXTFILE.EXTENSIONS NIL))
(P (VPCDISK.INSTALL))
(P (PCFLOPPY.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 "23-Jun-86 15:44")
(* * 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)
BACKFILEPTR ←(FUNCTION \VPCF.BACKFILEPTR)
EOFP ←(FUNCTION \VPCF.EOFP)
DELETEFILE ←(FUNCTION \VPCF.DELETEFILE)
DEVICEINFO ← NIL])
(VPCDISK.CREATE.DEVICE
[LAMBDA (NAME FILE RIGID PARTITION#) (* AJB "23-Jun-86 11:42")
(* * 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)
(QUOTE OLD]
(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 "23-Jun-86 11: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))
(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]
(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 (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))
(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])
)
(* LISP to real PC FLOPPY functions)
(DEFINEQ
(PCFLOPPY.INSTALL
[LAMBDA NIL (* AJB "24-Jul-86 15:16")
(* * Define the PCFLOPPY device, to support emulated IBM-PC format floppy)
[\DEFINEDEVICE (QUOTE PCFLOPPY)
(SETQ \PCFLOPPY.FDEV (create FDEV
DEVICENAME ←(QUOTE PCFLOPPY)
HOSTNAMEP ←(FUNCTION NILL)
DIRECTORYNAMEP ←(FUNCTION NILL)
REOPENFILE ←(FUNCTION NILL)
EVENTFN ←(FUNCTION NILL)
OPENFILE ←(FUNCTION \PCFLOPPY.OPENFILE)
CLOSEFILE ←(FUNCTION \PCFLOPPY.CLOSEFILE)
GENERATEFILES ←(FUNCTION NILL)
BUFFERED ← T
GETFILEINFO ←(FUNCTION NILL)
SETFILEINFO ←(FUNCTION NILL)
GETFILENAME ←(FUNCTION NILL)
BIN ←(FUNCTION \BUFFERED.BIN)
BOUT ←(FUNCTION \BUFFERED.BOUT)
PEEKBIN ←(FUNCTION \BUFFERED.PEEKBIN)
DELETEFILE ←(FUNCTION NILL)
DEVICEINFO ← NIL
READPAGES ←(FUNCTION \PCFLOPPY.READPAGES)
WRITEPAGES ←(FUNCTION \PCFLOPPY.WRITEPAGES)
TRUNCATEFILE←(FUNCTION NILL]
(\MAKE.PMAP.DEVICE \PCFLOPPY.FDEV])
(\PCFLOPPY.OPEN.FOR.APPEND
[LAMBDA (NAME FDEV) (* AJB "28-Jul-86 11:51")
(* * Open a file for input. The file resides on a IBM-PC format floppy)
(create STREAM
DEVICE ← FDEV
FULLFILENAME ← NAME
CBUFSIZE ← 0
COFFSET ← 0
CPAGE ←(ITIMES 40 \FLOPPY.SECTORSPERTRACK \FLOPPY.TRACKSPERCYLINDER)
EPAGE ←(ITIMES 40 \FLOPPY.SECTORSPERTRACK \FLOPPY.TRACKSPERCYLINDER)
EOFFSET ← 0
CBUFMAXSIZE ← 512
EOLCONVENTION ← CRLF.EOLC])
(\PCFLOPPY.OPEN.FOR.BOTH
[LAMBDA (NAME FDEV) (* AJB "28-Jul-86 11:51")
(* * Open a file for both The file resides on a IBM-PC format floppy)
(create STREAM
DEVICE ← FDEV
FULLFILENAME ← NAME
CBUFSIZE ← 0
COFFSET ← 0
CPAGE ← 0
EPAGE ←(ITIMES 40 \FLOPPY.SECTORSPERTRACK \FLOPPY.TRACKSPERCYLINDER)
EOFFSET ← 0
CBUFMAXSIZE ← 512
EOLCONVENTION ← CRLF.EOLC])
(\PCFLOPPY.OPEN.FOR.INPUT
[LAMBDA (NAME FDEV) (* AJB "28-Jul-86 11:50")
(* * Open a file for input. The file resides on a IBM-PC format floppy)
(create STREAM
DEVICE ← FDEV
FULLFILENAME ← NAME
CBUFSIZE ← 0
COFFSET ← 0
CPAGE ← 0
EPAGE ←(ITIMES 40 \FLOPPY.SECTORSPERTRACK \FLOPPY.TRACKSPERCYLINDER)
EOFFSET ← 0
CBUFMAXSIZE ← 512
EOLCONVENTION ← CRLF.EOLC])
(\PCFLOPPY.OPEN.FOR.OUTPUT
[LAMBDA (NAME FDEV) (* AJB "24-Jul-86 11:46")
(* * Open a file for output The file resides on a IBM-PC format floppy)
(create STREAM
DEVICE ← FDEV
FULLFILENAME ← NAME
CBUFSIZE ← 0
COFFSET ← 0
CPAGE ← 0
EPAGE ← 0
EOFFSET ← 0
CBUFMAXSIZE ← 512
EOLCONVENTION ← CRLF.EOLC])
(\PCFLOPPY.OPENFILE
[LAMBDA (NAME ACCESS RECOG PARAMETERS FDEV) (* AJB "24-Jul-86 11:40")
(* * OPEN an IBM-PC format floppy)
(LET (STREAM)
(SETQ STREAM (SELECTQ ACCESS
(INPUT (\PCFLOPPY.OPEN.FOR.INPUT NAME FDEV))
(OUTPUT (\PCFLOPPY.OPEN.FOR.OUTPUT NAME FDEV))
(BOTH (\PCFLOPPY.OPEN.FOR.BOTH NAME FDEV))
(APPEND (\PCFLOPPY.OPEN.FOR.APPEND NAME FDEV))
(SHOULDNT)))
STREAM])
(\PCFLOPPY.CLOSEFILE
[LAMBDA (STREAM) (* AJB "24-Jul-86 15:03")
(* * Closes a PCFLOPPY stream)
(\CLEARMAP STREAM)
STREAM])
(\PCFLOPPY.READPAGES
[LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* AJB "24-Jul-86 11:54")
(PROG NIL (* ((EQ \SFLOPPY.RECOG (QUOTE NEW))
(RETURN)))
(for BUFFER in (MKLIST BUFFERS) as I from 1 do (\PFLOPPY.READPAGENO (IPLUS
FIRSTPAGE# I)
BUFFER])
(\PCFLOPPY.WRITEPAGES
[LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* AJB "24-Jul-86 13:56")
(PROG NIL (* ((EQ \SFLOPPY.RECOG (QUOTE NEW))
(RETURN)))
(for BUFFER in (MKLIST BUFFERS) as I from 1 do (\PFLOPPY.WRITEPAGENO
(IPLUS FIRSTPAGE# I)
BUFFER])
)
(* 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 "19-Jun-86 15:57")
(* * 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 INPUT]
(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 "28-Jul-86 11:43")
(PROG1 [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]
(COND
((EQ (QUOTE {PCFLOPPY})
(FETCH (VPCDISK FILENAME) OF DISK)) (* save FLOPPY global vars)
(SETQ \PCFLOPPY.TRACKSPERCYLINDER.SAVE \FLOPPY.TRACKSPERCYLINDER)
(SETQ \PCFLOPPY.SECTORSPERTRACK.SAVE \FLOPPY.SECTORSPERTRACK)
(SETQ \FLOPPY.TRACKSPERCYLINDER (FETCH (VPCDISK SIDES) OF DISK))
(SETQ \FLOPPY.SECTORSPERTRACK (FETCH (VPCDISK SECT.PER.TRACK) OF DISK])
(\VPCF.CLOSE.BACKING.STREAM
[LAMBDA (DISK) (* AJB "28-Jul-86 11:46")
(* * 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)
(COND
((EQ (QUOTE {PCFLOPPY})
(FETCH (VPCDISK FILENAME) OF DISK))
(* * Restore floppy global vars)
(SETQ \FLOPPY.TRACKSPERCYLINDER \PCFLOPPY.TRACKSPERCYLINDER.SAVE)
(SETQ \FLOPPY.SECTORSPERTRACK \PCFLOPPY.SECTORSPERTRACK.SAVE])
)
(* FILEPTR Manipulation)
(DEFINEQ
(\VPCF.EOFP
[LAMBDA (STREAM) (* AJB "18-Jun-86 16:13")
(* * 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 (IMOD (fetch COFFSET of STREAM)
CLUSTERSIZE)
(fetch EOFFSET of STREAM])
(\VPCF.SETFILEPTR
[LAMBDA (STREAM FILEPOS) (* AJB "19-Jun-86 15:54")
(* * 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.BACKFILEPTR
[LAMBDA (STREAM) (* AJB "23-Jun-86 16:06")
(* * Backup the file pointer by one)
[COND
((APPENDONLY STREAM)
(ERROR "BACKFILEPTR illegal on APPEND-ONLY access" (fetch (STREAM FULLNAME) of STREAM]
(\VPCF.UPDATEOF STREAM)
[replace (STREAM CHARPOSITION) of STREAM with (IMAX 0 (SUB1 (fetch (STREAM CHARPOSITION)
of STREAM]
(COND
((NOT (AND (EQ (fetch (STREAM COFFSET) of STREAM)
0)
(EQ (fetch (STREAM CPAGE) of STREAM)
0)))
(COND
[(EQ (fetch (STREAM COFFSET) of STREAM)
0)
(\VPCF.SETFILEPTR STREAM (SUB1 (\VPCF.GETFILEPTR STREAM]
(T (add (fetch (STREAM COFFSET) of STREAM)
-1])
(\VPCF.SETEOFPTR
[LAMBDA (STREAM FILEPOS) (* AJB "20-Jun-86 10:29")
(* * 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))
CLUSTER
(DISKSTREAM (\VPCF.OPEN.BACKING.STREAM 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))
(* * Zero the remaining bytes in the current cluster)
[SETQ CLUSTER (CAR (LAST (\VPCF.GET.CLUSTER.CHAIN
(fetch (VPCFDIRENTRY START)
of (fetch (VPCFFILE DIRENTRY)
of FILE))
DISK]
(SETFILEPTR DISKSTREAM (IPLUS (\VPCF.CLUSTER.TO.FILEPOS CLUSTER DISK)
(IREMAINDER FILEPOS CLUSTERSIZE)))
(for I from (IREMAINDER FILEPOS CLUSTERSIZE)
to (SUB1 (fetch (VPCDISK BYTES.PER.CLUSTER) of DISK))
do (BOUT DISKSTREAM 0))
(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 "19-Jun-86 15:50")
(* * Update the End of File fields, EPAGE & EOFFSET)
(COND
((OR (OVERWRITEABLE STREAM)
(APPENDABLE STREAM))
(PROG [(CPAGE (fetch (STREAM CPAGE) of STREAM))
(COFFSET (fetch (STREAM COFFSET) of STREAM))
(EPAGE (fetch (STREAM EPAGE) of STREAM))
(EOFFSET (fetch (STREAM EOFFSET) of STREAM))
(BYTESPERCLUSTER (fetch (VPCDISK BYTES.PER.CLUSTER)
of (fetch (VPCFFILE DISK) of (fetch (STREAM F1)
of STREAM]
(COND
((IGEQ EOFFSET BYTESPERCLUSTER)
(add EPAGE (IQUOTIENT EOFFSET BYTESPERCLUSTER))
(SETQ EOFFSET (IMOD EOFFSET BYTESPERCLUSTER))
(replace (STREAM EPAGE) of STREAM with EPAGE)
(replace (STREAM EOFFSET) of STREAM with EOFFSET)))
[COND
((IGEQ COFFSET BYTESPERCLUSTER)
(add CPAGE (IQUOTIENT COFFSET BYTESPERCLUSTER))
(SETQ COFFSET (IMOD COFFSET BYTESPERCLUSTER]
(COND
((EQ CPAGE EPAGE)
(replace (STREAM CBUFSIZE) of STREAM with EOFFSET)
(replace (STREAM EPAGE) of STREAM with CPAGE)
(replace (STREAM EOFFSET) of STREAM with (IMAX COFFSET EOFFSET)))
(T (replace CBUFSIZE of STREAM with BYTESPERCLUSTER)))
(COND
((IGREATERP CPAGE EPAGE)
(replace (STREAM EPAGE) of STREAM with CPAGE)
(replace (STREAM EOFFSET) of STREAM with COFFSET])
)
(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 (FULLFILENAME RECOG FDEV) (* AJB "23-Jun-86 17:45")
(LET (DISK WASOPEN RESULT)
(NLSETQ (SETQ DISK (\VPCF.GET.DISK FULLFILENAME FDEV)))
(SETQ WASOPEN (OPENP (fetch (VPCDISK FILENAME) of DISK)))
(\VPCF.OPEN.BACKING.STREAM DISK)
[NLSETQ (SETQ RESULT (COND
((\VPCF.FIND.DIR.ENTRY FULLFILENAME DISK T T)
(SELECTQ RECOG
((OLD/NEW OLD OLDEST)
FULLFILENAME)
(NEW NIL)
NIL))
(T (SELECTQ RECOG
((OLDEST OLD)
NIL)
((NEW OLD/NEW)
FULLFILENAME)
NIL]
(COND
(WASOPEN)
(T (\VPCF.CLOSE.BACKING.STREAM DISK)))
RESULT])
(\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) (* AJB "23-Jun-86 14:15")
(* * 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 (* call the end-of-stream op.)
(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 "19-Jun-86 14:15")
(* * 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 "19-Jun-86 14:04")
(* * 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)
(RPAQQ \PCFLOPPY.TRACKSPERCYLINDER.SAVE 2)
(RPAQQ \PCFLOPPY.SECTORSPERTRACK.SAVE 9)
(RPAQ? PC.TEXTFILE.EXTENSIONS NIL)
(VPCDISK.INSTALL)
(PCFLOPPY.INSTALL)
(PUTPROPS VPCDISK COPYRIGHT ("Xerox Corporation" 1986 1900))
(DECLARE: DONTCOPY
(FILEMAP (NIL (13843 15406 (PRINDIRSTR 13853 . 14157) (STR2INT 14159 . 14487) (\VPCF.READPAGES 14489
. 15404)) (15464 34460 (VPCDISK.FLOPPY.TO.FILE 15474 . 16601) (VPCDISK.FILE.TO.FLOPPY 16603 . 17740)
(VPCDISK.INSTALL 17742 . 19047) (VPCDISK.CREATE.DEVICE 19049 . 20598) (\VPCDISK.CREATE.FLOPPY 20600 .
21610) (VPCDISK.DELETE.DEVICE 21612 . 22221) (VPCDISK.FREEPAGES 22223 . 24101) (VPCDISK.GETPARTITION#
24103 . 24948) (VPCDISK.CHANGE.PARTITION.TYPE 24950 . 26397) (\VPCF.INITIALIZE.DISK 26399 . 34458)) (
34506 39091 (PCFLOPPY.INSTALL 34516 . 35613) (\PCFLOPPY.OPEN.FOR.APPEND 35615 . 36166) (
\PCFLOPPY.OPEN.FOR.BOTH 36168 . 36656) (\PCFLOPPY.OPEN.FOR.INPUT 36658 . 37149) (
\PCFLOPPY.OPEN.FOR.OUTPUT 37151 . 37584) (\PCFLOPPY.OPENFILE 37586 . 38083) (\PCFLOPPY.CLOSEFILE 38085
. 38284) (\PCFLOPPY.READPAGES 38286 . 38687) (\PCFLOPPY.WRITEPAGES 38689 . 39089)) (39127 55270 (
\VPCF.FIND.DIR.ENTRY 39137 . 40040) (\VPCF.DIR.LOOKUP 40042 . 41036) (\VPCF.SEARCH.DIR 41038 . 43403)
(\VPCF.READ.DIR.ENTRY 43405 . 45992) (\VPCF.FIND.FREE.DIR.ENTRY 45994 . 48906) (\VPCF.WRITE.DIR.ENTRY
48908 . 50522) (\VPCF.READ.FILE.DATE 50524 . 51316) (\VPCF.WRITE.FILE.DATE 51318 . 52005) (
\VPCF.ROOTDIRECTORY 52007 . 52364) (\VPCF.NEXT.DIR.CLUSTER 52366 . 53498) (\VPCF.CLUSTER.TO.FILEPOS
53500 . 53855) (\VPCF.MAPDIR 53857 . 54926) (\VPCF.READ.FAT.CHAIN 54928 . 55268)) (55271 61695 (
\VPCF.GENERATEFILES 55281 . 55979) (\VPCF.FILEMATCH 55981 . 57468) (\VPCF.FILEMATCH1 57470 . 60166) (
\VPCF.NEXTFILEFN 60168 . 61064) (\VPCF.FILEINFOFN 61066 . 61693)) (61696 66337 (\VPCF.GETFILEINFO
61706 . 62997) (\VPCF.SETFILEINFO 62999 . 63736) (\VPCF.OPEN.BACKING.STREAM 63738 . 64822) (
\VPCF.CLOSE.BACKING.STREAM 64824 . 66335)) (66371 78166 (\VPCF.EOFP 66381 . 68341) (\VPCF.SETFILEPTR
68343 . 71083) (\VPCF.GETFILEPTR 71085 . 71585) (\VPCF.BACKFILEPTR 71587 . 72405) (\VPCF.SETEOFPTR
72407 . 76006) (\VPCF.GETEOFPTR 76008 . 76600) (\VPCF.UPDATEOF 76602 . 78164)) (78167 93331 (
\VPCF.OPENFILE 78177 . 78958) (\VPCF.OPEN.FOR.INPUT 78960 . 81275) (\VPCF.OPEN.FOR.OUTPUT 81277 .
83407) (\VPCF.OPEN.FOR.BOTH 83409 . 85806) (\VPCF.OPEN.FOR.APPEND 85808 . 88322) (\VPCF.REOPENFILE
88324 . 88638) (\VPCF.CLOSEFILE 88640 . 90646) (\VPCF.DELETEFILE 90648 . 92286) (\VPCF.SEARCHOFDS
92288 . 92776) (\VPCF.DELETEOFD 92778 . 93036) (\VPCF.ADDOFD 93038 . 93329)) (93332 113086 (
\VPCF.PARSENAME 93342 . 94155) (\VPCF.GETFILENAME 94157 . 94875) (\VPCF.GET.DISK 94877 . 95485) (
\VPCF.GETNEXTBUFFER 95487 . 100453) (\VPCF.READ.CLUSTER 100455 . 102055) (\VPCF.WRITE.CLUSTER 102057
. 103231) (\VPCF.GET.NEXT.CLUSTER 103233 . 104349) (\VPCF.ALLOCATE.CLUSTERS 104351 . 106556) (
\VPCF.ALLOCATE.CLUSTER 106558 . 108360) (\VPCF.DEALLOCATE.CLUSTERS 108362 . 109647) (
\VPCF.MARK.THE.FAT 109649 . 111599) (\VPCF.PRINT.FATS 111601 . 111992) (\VPCF.GET.CLUSTER.CHAIN 111994
. 112263) (\VPCF.DIRTEST 112265 . 113084)))))
STOP