(FILECREATED "20-Mar-84 19:45:55" {PHYLUM}<LISPCORE>SOURCES>FLOPPY.;3 200902
changes to: (VARS FLOPPYCOMS)
(RECORDS DISKADDRESS IOCB RESULT SECTOR9 MP LP FILELIST FLE FLOPPYSTREAM
FILEGENOBJ GENFILESTATE PALLOC PINFO PFLOPPYFDEV CFLOPPYFDEV CINFO FCB)
(FNS \FLOPPY.TRANSLATERESULT \FLOPPY.SEVERE.ERROR \FLOPPY.TRANSLATEMPETYPE
\FLOPPY.TRANSLATEFILETYPE \FLOPPY.MTL.FIXP \FLOPPY.LTM.FIXP \FLOPPY.MTL.IDATE
\FLOPPY.LTM.IDATE \FLOPPY.TRANSLATESETUP \FLOPPY.SETUP \FLOPPY.CHECK.IOCB
\FLOPPY.DENSITY \FLOPPY.SECTORLENGTH \FLOPPY.ENCODEDSECTORLENGTH \FLOPPY.GAP3
\FLOPPY.SECTORSPERTRACK \FLOPPY.RUN \FLOPPY.LOCK.BUFFER \FLOPPY.UNLOCK.BUFFER
\FLOPPY.ERROR \FLOPPY.PREPAREFORCRASH \FLOPPY.COMMAND \FLOPPY.TRANSFER
\FLOPPY.NOP \FLOPPY.RECALIBRATE \FLOPPY.INITIALIZE \FLOPPY.FORMATTRACKS
\FLOPPY.READSECTOR \FLOPPY.WRITESECTOR \FLOPPY.RECOVER FLOPPY.RESTART
FLOPPY.MODE \FLOPPY.EVENTFN \FLOPPY.CLOSE \FLOPPY.FLUSH \FLOPPY.HOSTNAMEP
\FLOPPY.ADDDEVICENAME \FLOPPY.ASSUREFILENAME \FLOPPY.OTHERINFO
\FLOPPY.LEXASSOC \FLOPPY.LEXPUTASSOC \FLOPPY.LEXREMOVEASSOC \FLOPPY.CATCH
\FLOPPY.THROW \FLOPPY.BREAK \FLOPPY.MESSAGE \PFLOPPY.INIT \PFLOPPY.OPEN
\PFLOPPY.DOORCHECK \PFLOPPY.START \PFLOPPY.OPEN.SECTOR9 \PFLOPPY.GET.SECTOR9
\PFLOPPY.OPEN.FILELIST \PFLOPPY.OPENFILE \PFLOPPY.OPENFILE1
\PFLOPPY.OPENOLDFILE \PFLOPPY.OPENNEWFILE \PFLOPPY.ASSURESTREAM
\PFLOPPY.GETFILEINFO \PFLOPPY.SETFILEINFO \PFLOPPY.CLOSEFILE
\PFLOPPY.CLOSEFILE1 \PFLOPPY.DELETEFILE \PFLOPPY.GETFILENAME
\PFLOPPY.GENERATEFILES \PFLOPPY.GENERATEFILES1 \PFLOPPY.RENAMEFILE
\PFLOPPY.STREAMS.AGAINST \PFLOPPY.STREAMS.USING \PFLOPPY.READPAGES
\PFLOPPY.READPAGE \PFLOPPY.WRITEPAGENO \PFLOPPY.READPAGENO
\PFLOPPY.PAGENOTODISKADDRESS \PFLOPPY.DISKADDRESSTOPAGENO \PFLOPPY.DIR.GET
\PFLOPPY.DIR.PUT \PFLOPPY.DIR.REMOVE \PFLOPPY.DIR.VERSION
\PFLOPPY.CREATE.FILELIST \PFLOPPY.ADD.TO.FILELIST
\PFLOPPY.DELETE.FROM.FILELIST \PFLOPPY.SAVE.FILELIST \PFLOPPY.SAVE.SECTOR9
\PFLOPPY.WRITEPAGES \PFLOPPY.WRITEPAGE \PFLOPPY.TRUNCATEFILE FLOPPY.CROCK
\PFLOPPY.ALLOCATE \PFLOPPY.ALLOCATE.LARGEST \PFLOPPY.TRUNCATE
\PFLOPPY.DEALLOCATE \PFLOPPY.EXTEND \PFLOPPY.GAINSPACE
\PFLOPPY.GAINSPACE.MERGE FLOPPY.BUG FRESH.FLOPPY FLOPPY.LENGTHS FLOPPY.STARTS
FLOPPY.ICHECK FLOPPY.ALLOCATIONS FLOPPY.FREE.PAGES \PFLOPPY.FREE.PAGES
FLOPPY.FORMAT \PFLOPPY.FORMAT \PFLOPPY.CONFIRM FLOPPY.NAME FLOPPY.GET.NAME
\PFLOPPY.GET.NAME FLOPPY.SET.NAME \PFLOPPY.SET.NAME FLOPPY.DRIVE.EXISTSP
FLOPPY.CAN.READP FLOPPY.CAN.WRITEP FLOPPY.WAIT.FOR.FLOPPY \SFLOPPY.INIT
\SFLOPPY.GETFILEINFO \SFLOPPY.OPENHUGEFILE \SFLOPPY.READPAGES
\SFLOPPY.READPAGE \SFLOPPY.WRITEPAGES \SFLOPPY.WRITEPAGE
\SFLOPPY.CLOSEHUGEFILE \SFLOPPY.CLOSESMALLFILE \HFLOPPY.INIT
\HFLOPPY.GETFILEINFO \HFLOPPY.OPENHUGEFILE \HFLOPPY.WRITEPAGES
\HFLOPPY.WRITEPAGE \HFLOPPY.READPAGES \HFLOPPY.READPAGE
\HFLOPPY.CLOSEHUGEFILE \HFLOPPY.CLOSESMALLFILE FLOPPY.SCAVENGE
\PFLOPPY.SCAVENGE \PFLOPPY.SCAVENGE.MPS \PFLOPPY.SCAVENGE.MP31
\PFLOPPY.SCAVENGE.MP.AFTER \PFLOPPY.SCAVENGE.MP.AFTER1 \PFLOPPY.SCAVENGE.LPS
\PFLOPPY.SCAVENGE.SECTOR9 \PFLOPPY.SCAVENGE.FILELIST FLOPPY.TO.FILE
FLOPPY.FROM.FILE FLOPPY.COMPACT \PFLOPPY.COMPACT \PFLOPPY.COMPACT.PALLOCS
\PFLOPPY.COMPACT.PALLOC \PFLOPPY.COMPACT.SECTOR9 \PFLOPPY.COMPACT.FILELIST
\CFLOPPY.FCB.FILENAME \CFLOPPY.INIT \CFLOPPY.OPEN \CFLOPPY.OPEN.DIRECTORY
\CFLOPPY.READPAGES \CFLOPPY.READPAGENO \CFLOPPY.WRITEPAGENO
\CFLOPPY.PAGENOTODISKADDRESS \CFLOPPY.OPENFILE \CFLOPPY.GETFILEHANDLE
\CFLOPPY.GETFILEFCB \CFLOPPY.FORMAT)
previous date: "12-Mar-84 22:49:14" {PHYLUM}<LISPCORE>SOURCES>FLOPPY.;2)
(PRETTYCOMPRINT FLOPPYCOMS)
(RPAQQ FLOPPYCOMS ((* FLOPPY -- By Kelly Roach. *)
(COMS (* SA800FACE *)
(DECLARE: EVAL@COMPILE DONTCOPY
(CONSTANTS (C.NOP 0)
(C.READSECTOR 1)
(C.WRITESECTOR 2)
(C.WRITEDELETEDSECTOR 3)
(C.READID 4)
(C.FORMATTRACK 5)
(C.RECALIBRATE 6)
(C.INITIALIZE 7)
(C.ESCAPE 8)
(SC.NOP 0)
(SC.DISKCHANGECLEAR 1)
(S.DOOROPENED 32768)
(S.TWOSIDED 8192)
(S.DISKID 4096)
(S.ERROR 2048)
(S.RECALIBRATEERROR 512)
(S.DATALOST 256)
(S.NOTREADY 128)
(S.WRITEPROTECT 64)
(S.DELETEDDATA 32)
(S.RECORDNOTFOUND 16)
(S.CRCERROR 8)
(S.TRACK0 4)
(S.INDEX 2)
(S.BUSY 1)
(R.OK 0)
(R.BUSY S.BUSY)
(R.CRCERROR (LOGOR S.ERROR S.CRCERROR))
(R.DATALOST (LOGOR S.ERROR S.DATALOST))
(R.DOOROPENED (LOGOR S.ERROR S.DOOROPENED))
(R.DOORISOPEN (LOGOR S.ERROR S.DOOROPENED S.NOTREADY))
(R.DOORISOPEN2 (LOGOR S.DOOROPENED S.NOTREADY))
(R.NOTREADY (LOGOR S.ERROR S.NOTREADY))
(R.RECALIBRATEERROR (LOGOR S.ERROR S.RECALIBRATEERROR))
(R.RECORDNOTFOUND (LOGOR S.ERROR S.RECORDNOTFOUND))
(R.WRITEPROTECT (LOGOR S.ERROR S.WRITEPROTECT))
(R.READERRORMASK (LOGOR S.DOOROPENED S.ERROR S.RECALIBRATEERROR
S.DATALOST S.NOTREADY S.RECORDNOTFOUND
S.CRCERROR))
(R.WRITEERRORMASK (LOGOR R.READERRORMASK S.WRITEPROTECT))
(R.INFOMASK (LOGOR S.TWOSIDED S.WRITEPROTECT S.TRACK0))
(IOCB.SIZE 16)
(B128 0)
(B256 1)
(B512 2)
(B1024 3)
(IBM 0)
(TROY 1)
(SINGLE 0)
(DOUBLE 8)
(NoBits 0)
(IDLENGTH 3)
(SEAL.SECTOR9 49932)
(VERSION.SECTOR9 1)
(BADSPOTSECTORS 2)
(BADSPOTSECTOR 10)
(SEAL.MP 13003)
(VERSION.MP 1)
(SEAL.FILELIST 45771)
(VERSION.FILELIST 1)
(CYLINDERS 77)
(TRACKSPERCYLINDER 2)
(SECTORSPERTRACK 15)
(MPETYPE.FREE 0)
(MPETYPE.FILE 1)
(MPETYPE.FILELIST 2)
(MPETYPE.BADSECTORS 3)
(SEAL.LP 43690)
(VERSION.LP 1)
(NAMEMAXLENGTH.LP 100)
(FILETYPE.FREE 0)
(FILETYPE.FILE 2052)
(FILETYPE.FILELIST 2054)))
(INITRECORDS DISKADDRESS IOCB RESULT SECTOR9 MP LP FILELIST FLE)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS DISKADDRESS IOCB RESULT SECTOR9 MP LP FILELIST
FLE))
(FNS \FLOPPY.TRANSLATERESULT \FLOPPY.SEVERE.ERROR \FLOPPY.TRANSLATEMPETYPE
\FLOPPY.TRANSLATEFILETYPE \FLOPPY.MTL.FIXP \FLOPPY.LTM.FIXP \FLOPPY.MTL.IDATE
\FLOPPY.LTM.IDATE))
(COMS (* SA800HEAD *)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS (IBMS128 0)
(IBMS256 1)
(IBMS512 2)
(IBMS1024 3)
(IBMD128 4)
(IBMD256 5)
(IBMD512 6)
(IBMD1024 7)))
(INITVARS (\FLOPPY.INSPECTW NIL)
(\FLOPPY.DEBUG NIL))
(FNS \FLOPPY.TRANSLATESETUP \FLOPPY.SETUP \FLOPPY.CHECK.IOCB \FLOPPY.DENSITY
\FLOPPY.SECTORLENGTH \FLOPPY.ENCODEDSECTORLENGTH \FLOPPY.GAP3
\FLOPPY.SECTORSPERTRACK \FLOPPY.RUN \FLOPPY.LOCK.BUFFER \FLOPPY.UNLOCK.BUFFER
\FLOPPY.ERROR \FLOPPY.PREPAREFORCRASH \FLOPPY.COMMAND \FLOPPY.TRANSFER \FLOPPY.NOP
\FLOPPY.RECALIBRATE \FLOPPY.INITIALIZE \FLOPPY.FORMATTRACKS \FLOPPY.READSECTOR
\FLOPPY.WRITESECTOR \FLOPPY.RECOVER))
(COMS (* COMMON *)
(INITVARS (\FLOPPYFDEV NIL)
(\FLOPPYLOCK NIL)
(\FLOPPY.SCRATCH.BUFFER NIL)
(\FLOPPY.SCRATCH.IOCB NIL)
(\FLOPPY.IBMS128.IOCB NIL)
(\FLOPPY.IBMD256.IOCB NIL)
(\FLOPPY.IBMD512.IOCB NIL)
(\FLOPPY.MODE.BEFORE.EVENT NIL)
(\FLOPPYIOCBADDR NIL)
(\FLOPPYIOCB NIL)
(\FLOPPYRESULT NIL))
(INITRECORDS FLOPPYSTREAM FILEGENOBJ GENFILESTATE)
(DECLARE: EVAL@COMPILE DONTCOPY (GLOBALRESOURCES (\FLOPPY.SCRATCH.IOCB (CREATE IOCB))
(\FLOPPY.IBMS128.IOCB
(\FLOPPY.SETUP (CREATE IOCB)
IBMS128))
(\FLOPPY.IBMD256.IOCB
(\FLOPPY.SETUP (CREATE IOCB)
IBMD256))
(\FLOPPY.IBMD512.IOCB
(\FLOPPY.SETUP (CREATE IOCB)
IBMD512))
(\FLOPPY.SCRATCH.BUFFER (\ALLOCBLOCK
512 NIL 256))
)
(RECORDS FLOPPYSTREAM FILEGENOBJ GENFILESTATE))
(FNS FLOPPY.RESTART FLOPPY.MODE \FLOPPY.EVENTFN \FLOPPY.CLOSE \FLOPPY.FLUSH
\FLOPPY.HOSTNAMEP \FLOPPY.ADDDEVICENAME \FLOPPY.ASSUREFILENAME \FLOPPY.OTHERINFO
\FLOPPY.LEXASSOC \FLOPPY.LEXPUTASSOC \FLOPPY.LEXREMOVEASSOC \FLOPPY.CATCH
\FLOPPY.THROW \FLOPPY.BREAK \FLOPPY.MESSAGE))
(COMS (* PILOT *)
(INITVARS (\PFLOPPYSECTOR9 NIL)
(\PFLOPPYFILELIST NIL)
(\PFLOPPYINFO NIL)
(\PFLOPPYFDEV NIL))
(INITRECORDS PALLOC PINFO PFLOPPYFDEV)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS PALLOC PINFO PFLOPPYFDEV))
(FNS \PFLOPPY.INIT \PFLOPPY.OPEN \PFLOPPY.DOORCHECK \PFLOPPY.START
\PFLOPPY.OPEN.SECTOR9 \PFLOPPY.GET.SECTOR9 \PFLOPPY.OPEN.FILELIST
\PFLOPPY.OPENFILE \PFLOPPY.OPENFILE1 \PFLOPPY.OPENOLDFILE \PFLOPPY.OPENNEWFILE
\PFLOPPY.ASSURESTREAM \PFLOPPY.GETFILEINFO \PFLOPPY.SETFILEINFO \PFLOPPY.CLOSEFILE
\PFLOPPY.CLOSEFILE1 \PFLOPPY.DELETEFILE \PFLOPPY.GETFILENAME
\PFLOPPY.GENERATEFILES \PFLOPPY.GENERATEFILES1 \PFLOPPY.RENAMEFILE
\PFLOPPY.STREAMS.AGAINST \PFLOPPY.STREAMS.USING \PFLOPPY.READPAGES
\PFLOPPY.READPAGE \PFLOPPY.WRITEPAGENO \PFLOPPY.READPAGENO
\PFLOPPY.PAGENOTODISKADDRESS \PFLOPPY.DISKADDRESSTOPAGENO \PFLOPPY.DIR.GET
\PFLOPPY.DIR.PUT \PFLOPPY.DIR.REMOVE \PFLOPPY.DIR.VERSION \PFLOPPY.CREATE.FILELIST
\PFLOPPY.ADD.TO.FILELIST \PFLOPPY.DELETE.FROM.FILELIST \PFLOPPY.SAVE.FILELIST
\PFLOPPY.SAVE.SECTOR9 \PFLOPPY.WRITEPAGES \PFLOPPY.WRITEPAGE \PFLOPPY.TRUNCATEFILE
FLOPPY.CROCK))
(COMS (* ALLOCATE *)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS (MINIMUM.ALLOCATION 5)
(DEFAULT.ALLOCATION 50)))
(INITVARS (\FLOPPY.ALLOCATIONS.BITMAP NIL))
(FNS \PFLOPPY.ALLOCATE \PFLOPPY.ALLOCATE.LARGEST \PFLOPPY.TRUNCATE \PFLOPPY.DEALLOCATE
\PFLOPPY.EXTEND \PFLOPPY.GAINSPACE \PFLOPPY.GAINSPACE.MERGE FLOPPY.BUG
FRESH.FLOPPY FLOPPY.LENGTHS FLOPPY.STARTS FLOPPY.ICHECK FLOPPY.ALLOCATIONS))
(COMS (* SERVICES *)
(FNS FLOPPY.FREE.PAGES \PFLOPPY.FREE.PAGES FLOPPY.FORMAT \PFLOPPY.FORMAT
\PFLOPPY.CONFIRM FLOPPY.NAME FLOPPY.GET.NAME \PFLOPPY.GET.NAME FLOPPY.SET.NAME
\PFLOPPY.SET.NAME FLOPPY.DRIVE.EXISTSP FLOPPY.CAN.READP FLOPPY.CAN.WRITEP
FLOPPY.WAIT.FOR.FLOPPY))
(COMS (* SYSOUT *)
(INITVARS (\SFLOPPYFDEV NIL)
(\SFLOPPYINFO NIL)
(\SFLOPPY.RECOG NIL)
(\SFLOPPY.PAGENO NIL)
(\SFLOPPY.FLOPPYNO NIL)
(\SFLOPPY.HUGELENGTH NIL)
(\SFLOPPY.HUGEPAGELENGTH NIL)
(\SFLOPPY.IWRITEDATE NIL))
(FNS \SFLOPPY.INIT \SFLOPPY.GETFILEINFO \SFLOPPY.OPENHUGEFILE \SFLOPPY.READPAGES
\SFLOPPY.READPAGE \SFLOPPY.WRITEPAGES \SFLOPPY.WRITEPAGE \SFLOPPY.CLOSEHUGEFILE
\SFLOPPY.CLOSESMALLFILE))
(COMS (* HUGE *)
(INITVARS (\HFLOPPYINFO NIL)
(\HFLOPPYFDEV NIL)
(\HFLOPPY.MAXPAGES 2250)
(\HFLOPPY.PAGENO NIL)
(\HFLOPPY.FLOPPYNO NIL)
(\HFLOPPY.HUGELENGTH NIL)
(\HFLOPPY.HUGEPAGELENGTH NIL)
(\HFLOPPY.IWRITEDATE NIL)
(\HFLOPPY.RECOG NIL)
(\HFLOPPY.FILENAME NIL))
(FNS \HFLOPPY.INIT \HFLOPPY.GETFILEINFO \HFLOPPY.OPENHUGEFILE \HFLOPPY.WRITEPAGES
\HFLOPPY.WRITEPAGE \HFLOPPY.READPAGES \HFLOPPY.READPAGE \HFLOPPY.CLOSEHUGEFILE
\HFLOPPY.CLOSESMALLFILE))
(COMS (* SCAVENGE *)
(INITVARS \FLOPPY.SCAVENGE.IDATE)
(FNS FLOPPY.SCAVENGE \PFLOPPY.SCAVENGE \PFLOPPY.SCAVENGE.MPS \PFLOPPY.SCAVENGE.MP31
\PFLOPPY.SCAVENGE.MP.AFTER \PFLOPPY.SCAVENGE.MP.AFTER1 \PFLOPPY.SCAVENGE.LPS
\PFLOPPY.SCAVENGE.SECTOR9 \PFLOPPY.SCAVENGE.FILELIST))
(COMS (* COPY *)
(FNS FLOPPY.TO.FILE FLOPPY.FROM.FILE))
(COMS (* COMPACT *)
(FNS FLOPPY.COMPACT \PFLOPPY.COMPACT \PFLOPPY.COMPACT.PALLOCS \PFLOPPY.COMPACT.PALLOC
\PFLOPPY.COMPACT.SECTOR9 \PFLOPPY.COMPACT.FILELIST))
(COMS (* CPM *)
(INITVARS (\CFLOPPYSECTORMAP NIL)
(\CFLOPPYFDEV NIL)
(\CFLOPPYINFO NIL)
(\CFLOPPYBLANKSECTOR NIL))
(INITRECORDS CINFO FCB)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS CFLOPPYFDEV CINFO FCB))
(FNS \CFLOPPY.FCB.FILENAME \CFLOPPY.INIT \CFLOPPY.OPEN \CFLOPPY.OPEN.DIRECTORY
\CFLOPPY.READPAGES \CFLOPPY.READPAGENO \CFLOPPY.WRITEPAGENO
\CFLOPPY.PAGENOTODISKADDRESS \CFLOPPY.OPENFILE \CFLOPPY.GETFILEHANDLE
\CFLOPPY.GETFILEFCB \CFLOPPY.FORMAT))
(P (FLOPPY.RESTART))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA \FLOPPY.CATCH)
(NLAML)
(LAMA)))))
(* FLOPPY -- By Kelly Roach. *)
(* SA800FACE *)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ C.NOP 0)
(RPAQQ C.READSECTOR 1)
(RPAQQ C.WRITESECTOR 2)
(RPAQQ C.WRITEDELETEDSECTOR 3)
(RPAQQ C.READID 4)
(RPAQQ C.FORMATTRACK 5)
(RPAQQ C.RECALIBRATE 6)
(RPAQQ C.INITIALIZE 7)
(RPAQQ C.ESCAPE 8)
(RPAQQ SC.NOP 0)
(RPAQQ SC.DISKCHANGECLEAR 1)
(RPAQQ S.DOOROPENED 32768)
(RPAQQ S.TWOSIDED 8192)
(RPAQQ S.DISKID 4096)
(RPAQQ S.ERROR 2048)
(RPAQQ S.RECALIBRATEERROR 512)
(RPAQQ S.DATALOST 256)
(RPAQQ S.NOTREADY 128)
(RPAQQ S.WRITEPROTECT 64)
(RPAQQ S.DELETEDDATA 32)
(RPAQQ S.RECORDNOTFOUND 16)
(RPAQQ S.CRCERROR 8)
(RPAQQ S.TRACK0 4)
(RPAQQ S.INDEX 2)
(RPAQQ S.BUSY 1)
(RPAQQ R.OK 0)
(RPAQ R.BUSY S.BUSY)
(RPAQ R.CRCERROR (LOGOR S.ERROR S.CRCERROR))
(RPAQ R.DATALOST (LOGOR S.ERROR S.DATALOST))
(RPAQ R.DOOROPENED (LOGOR S.ERROR S.DOOROPENED))
(RPAQ R.DOORISOPEN (LOGOR S.ERROR S.DOOROPENED S.NOTREADY))
(RPAQ R.DOORISOPEN2 (LOGOR S.DOOROPENED S.NOTREADY))
(RPAQ R.NOTREADY (LOGOR S.ERROR S.NOTREADY))
(RPAQ R.RECALIBRATEERROR (LOGOR S.ERROR S.RECALIBRATEERROR))
(RPAQ R.RECORDNOTFOUND (LOGOR S.ERROR S.RECORDNOTFOUND))
(RPAQ R.WRITEPROTECT (LOGOR S.ERROR S.WRITEPROTECT))
(RPAQ R.READERRORMASK (LOGOR S.DOOROPENED S.ERROR S.RECALIBRATEERROR S.DATALOST S.NOTREADY
S.RECORDNOTFOUND S.CRCERROR))
(RPAQ R.WRITEERRORMASK (LOGOR R.READERRORMASK S.WRITEPROTECT))
(RPAQ R.INFOMASK (LOGOR S.TWOSIDED S.WRITEPROTECT S.TRACK0))
(RPAQQ IOCB.SIZE 16)
(RPAQQ B128 0)
(RPAQQ B256 1)
(RPAQQ B512 2)
(RPAQQ B1024 3)
(RPAQQ IBM 0)
(RPAQQ TROY 1)
(RPAQQ SINGLE 0)
(RPAQQ DOUBLE 8)
(RPAQQ NoBits 0)
(RPAQQ IDLENGTH 3)
(RPAQQ SEAL.SECTOR9 49932)
(RPAQQ VERSION.SECTOR9 1)
(RPAQQ BADSPOTSECTORS 2)
(RPAQQ BADSPOTSECTOR 10)
(RPAQQ SEAL.MP 13003)
(RPAQQ VERSION.MP 1)
(RPAQQ SEAL.FILELIST 45771)
(RPAQQ VERSION.FILELIST 1)
(RPAQQ CYLINDERS 77)
(RPAQQ TRACKSPERCYLINDER 2)
(RPAQQ SECTORSPERTRACK 15)
(RPAQQ MPETYPE.FREE 0)
(RPAQQ MPETYPE.FILE 1)
(RPAQQ MPETYPE.FILELIST 2)
(RPAQQ MPETYPE.BADSECTORS 3)
(RPAQQ SEAL.LP 43690)
(RPAQQ VERSION.LP 1)
(RPAQQ NAMEMAXLENGTH.LP 100)
(RPAQQ FILETYPE.FREE 0)
(RPAQQ FILETYPE.FILE 2052)
(RPAQQ FILETYPE.FILELIST 2054)
(CONSTANTS (C.NOP 0)
(C.READSECTOR 1)
(C.WRITESECTOR 2)
(C.WRITEDELETEDSECTOR 3)
(C.READID 4)
(C.FORMATTRACK 5)
(C.RECALIBRATE 6)
(C.INITIALIZE 7)
(C.ESCAPE 8)
(SC.NOP 0)
(SC.DISKCHANGECLEAR 1)
(S.DOOROPENED 32768)
(S.TWOSIDED 8192)
(S.DISKID 4096)
(S.ERROR 2048)
(S.RECALIBRATEERROR 512)
(S.DATALOST 256)
(S.NOTREADY 128)
(S.WRITEPROTECT 64)
(S.DELETEDDATA 32)
(S.RECORDNOTFOUND 16)
(S.CRCERROR 8)
(S.TRACK0 4)
(S.INDEX 2)
(S.BUSY 1)
(R.OK 0)
(R.BUSY S.BUSY)
(R.CRCERROR (LOGOR S.ERROR S.CRCERROR))
(R.DATALOST (LOGOR S.ERROR S.DATALOST))
(R.DOOROPENED (LOGOR S.ERROR S.DOOROPENED))
(R.DOORISOPEN (LOGOR S.ERROR S.DOOROPENED S.NOTREADY))
(R.DOORISOPEN2 (LOGOR S.DOOROPENED S.NOTREADY))
(R.NOTREADY (LOGOR S.ERROR S.NOTREADY))
(R.RECALIBRATEERROR (LOGOR S.ERROR S.RECALIBRATEERROR))
(R.RECORDNOTFOUND (LOGOR S.ERROR S.RECORDNOTFOUND))
(R.WRITEPROTECT (LOGOR S.ERROR S.WRITEPROTECT))
(R.READERRORMASK (LOGOR S.DOOROPENED S.ERROR S.RECALIBRATEERROR S.DATALOST S.NOTREADY
S.RECORDNOTFOUND S.CRCERROR))
(R.WRITEERRORMASK (LOGOR R.READERRORMASK S.WRITEPROTECT))
(R.INFOMASK (LOGOR S.TWOSIDED S.WRITEPROTECT S.TRACK0))
(IOCB.SIZE 16)
(B128 0)
(B256 1)
(B512 2)
(B1024 3)
(IBM 0)
(TROY 1)
(SINGLE 0)
(DOUBLE 8)
(NoBits 0)
(IDLENGTH 3)
(SEAL.SECTOR9 49932)
(VERSION.SECTOR9 1)
(BADSPOTSECTORS 2)
(BADSPOTSECTOR 10)
(SEAL.MP 13003)
(VERSION.MP 1)
(SEAL.FILELIST 45771)
(VERSION.FILELIST 1)
(CYLINDERS 77)
(TRACKSPERCYLINDER 2)
(SECTORSPERTRACK 15)
(MPETYPE.FREE 0)
(MPETYPE.FILE 1)
(MPETYPE.FILELIST 2)
(MPETYPE.BADSECTORS 3)
(SEAL.LP 43690)
(VERSION.LP 1)
(NAMEMAXLENGTH.LP 100)
(FILETYPE.FREE 0)
(FILETYPE.FILE 2052)
(FILETYPE.FILELIST 2054))
)
)
(/DECLAREDATATYPE (QUOTE IOCB)
(QUOTE (WORD WORD WORD WORD (BITS 12)
(BITS 4)
FIXP WORD WORD FLAG (BITS 15)
WORD
(BITS 8)
(BITS 8)
(BITS 8)
(BITS 8)
WORD WORD WORD)))
(/DECLAREDATATYPE (QUOTE SECTOR9)
(QUOTE (WORD WORD WORD WORD WORD WORD SWAPPEDFIXP WORD SWAPPEDFIXP WORD WORD WORD
WORD WORD WORD WORD SWAPPEDFIXP FLAG (BITS 15)
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD)))
(/DECLAREDATATYPE (QUOTE MP)
(QUOTE (WORD WORD SWAPPEDFIXP WORD SWAPPEDFIXP WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD SWAPPEDFIXP WORD SWAPPEDFIXP WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD)))
(/DECLAREDATATYPE (QUOTE LP)
(QUOTE (WORD WORD WORD SWAPPEDFIXP SWAPPEDFIXP SWAPPEDFIXP SWAPPEDFIXP SWAPPEDFIXP
SWAPPEDFIXP WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD)))
(/DECLAREDATATYPE (QUOTE FLE)
(QUOTE (SWAPPEDFIXP WORD WORD WORD)))
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(ACCESSFNS DISKADDRESS ((CYLINDER (LRSH DATUM 16))
(HEAD (LRSH (LOGAND DATUM 65535)
8))
(SECTOR (LOGAND DATUM 255)))
(CREATE (IPLUS (COND
((OR (ILESSP CYLINDER 0)
(IGREATERP CYLINDER 76))
(\FLOPPY.SEVERE.ERROR "Illegal Diskaddress"))
(T (LLSH CYLINDER 16)))
(COND
((OR (ILESSP HEAD 0)
(IGREATERP HEAD 1))
(\FLOPPY.SEVERE.ERROR "Illegal Diskaddress"))
(T (LLSH HEAD 8)))
(COND
((OR (ILESSP SECTOR 1)
(IGREATERP SECTOR 36))
(\FLOPPY.SEVERE.ERROR "Illegal Diskaddress"))
(T SECTOR)))))
(DATATYPE IOCB ((\BUFFERLOLOC WORD)
(\BUFFERHILOC WORD)
(NIL WORD)
(SECTORLENGTHDIV2 WORD)
(TROYORIBM BITS 12)
(DENSITY BITS 4)
(DISKADDRESS FIXP)
(SECTORCOUNT WORD)
(RESULT WORD)
(SAMEPAGE FLAG)
(COMMAND BITS 15)
(SUBCOMMAND WORD)
(SECTORLENGTHDIV4 BITS 8)
(ENCODEDSECTORLENGTH BITS 8)
(SECTORSPERTRACK BITS 8)
(GAP3 BITS 8)
(NIL 3 WORD))
(CREATE (PROGN (\FLOPPY.SETUP DATUM IBMD512)
(replace (IOCB DISKADDRESS) of DATUM
with (CREATE DISKADDRESS
CYLINDER ← 0
HEAD ← 0
SECTOR ← 1))
DATUM))
(ACCESSFNS (($COMMAND (SELECT (fetch (IOCB COMMAND) of DATUM)
(C.NOP (QUOTE NOP))
(C.READSECTOR (QUOTE READSECTOR))
(C.WRITESECTOR (QUOTE WRITESECTOR))
(C.WRITEDELETEDSECTOR (QUOTE WRITEDELETEDSECTOR))
(C.READID (QUOTE READID))
(C.FORMATTRACK (QUOTE FORMATTRACK))
(C.RECALIBRATE (QUOTE RECALIBRATE))
(C.INITIALIZE (QUOTE INITIALIZE))
(C.ESCAPE (QUOTE ESCAPE))
(QUOTE ?)))
($SUBCOMMAND (SELECT (fetch (IOCB SUBCOMMAND) of DATUM)
(SC.NOP (QUOTE NOP))
(SC.DISKCHANGECLEAR (QUOTE DISKCHANGECLEAR))
(QUOTE ?)))
($RESULT (\FLOPPY.TRANSLATERESULT (fetch (IOCB RESULT) of DATUM)))
($TROYORIBM (SELECT (fetch (IOCB TROYORIBM) of DATUM)
(IBM (QUOTE IBM))
(TROY (QUOTE TROY))
(QUOTE ?)))
($DENSITY (SELECT (fetch (IOCB DENSITY) of DATUM)
(SINGLE (QUOTE SINGLE))
(DOUBLE (QUOTE DOUBLE))
(QUOTE ?)))
($ENCODEDSECTORLENGTH (SELECT (fetch (IOCB ENCODEDSECTORLENGTH)
of DATUM)
(B128 128)
(B256 256)
(B512 512)
(B1024 1024)
(QUOTE ?)))
(BUFFER (\VAG2 (fetch (IOCB \BUFFERHILOC) of DATUM)
(fetch (IOCB \BUFFERLOLOC) of DATUM))
(PROGN (replace (IOCB \BUFFERLOLOC) of DATUM with (\LOLOC NEWVALUE)
)
(replace (IOCB \BUFFERHILOC) of DATUM with (\HILOC NEWVALUE)
)))
(CYLINDER (fetch (DISKADDRESS CYLINDER) of (fetch (IOCB DISKADDRESS)
of DATUM)))
(HEAD (fetch (DISKADDRESS HEAD) of (fetch (IOCB DISKADDRESS) of DATUM)))
(SECTOR (fetch (DISKADDRESS SECTOR) of (fetch (IOCB DISKADDRESS)
of DATUM))))))
(BLOCKRECORD RESULT ((DOOROPENED FLAG)
(MPERROR FLAG)
(TWOSIDED FLAG)
(DISKID FLAG)
(ERROR FLAG)
(NIL FLAG)
(RECALIBRATEERROR FLAG)
(DATALOST FLAG)
(NOTREADY FLAG)
(WRITEPROTECT FLAG)
(DELETEDDATA FLAG)
(RECORDNOTFOUND FLAG)
(CRCERROR FLAG)
(TRACK0 FLAG)
(NIL FLAG)
(BUSY FLAG))
(BLOCKRECORD RESULT ((WORD WORD)))
(ACCESSFNS (($DISKID (COND
((fetch (RESULT DISKID) of DATUM)
(QUOTE SA850))
(T (QUOTE SA800))))
(MPCODE (COND
((NOT (fetch (RESULT MPERROR) of DATUM))
0)
(T (LOGXOR (fetch (RESULT WORD) of DATUM)
(LLSH 1 14)))))
(MPMESSAGE (SELECTQ (fetch (RESULT MPCODE) of DATUM)
(0 NIL)
(580 "Domino NoValidCommand Error")
(581 "Domino UnImplFloppyCmd Error")
(582 "Domino InvalidEscapeCmd Error")
(583 "Domino CommandTrack Error")
(584 "Domino TrackToBig Error")
(585 "Domino BadDmaChannel Error")
(586 "Domino NoDmaEndCount1 Error")
(587 "Domino NoDmaEndCount2 Error")
"Unknown Domino Error")))))
(DATATYPE SECTOR9 ((SEAL WORD)
(VERSION WORD)
(CYLINDERS WORD)
(TRACKSPERCYLINDER WORD)
(SECTORSPERTRACK WORD)
(FILELISTSTART WORD)
(FILELISTFILEID SWAPPEDFIXP)
(FILELISTLENGTH WORD)
(ROOTFILEID SWAPPEDFIXP)
(NIL WORD)
(PILOTMICROCODE WORD)
(DIAGNOSTICMICROCODE WORD)
(GERM WORD)
(PILOTBOOTFILE WORD)
(FIRSTALTERNATESECTOR WORD)
(COUNTBADSECTORS WORD)
(NEXTUNUSEDFILEID SWAPPEDFIXP)
(CHANGING FLAG)
(NIL BITS 15)
(\LABELLENGTH WORD)
(\LABEL 106 WORD))
SEAL ← SEAL.SECTOR9 VERSION ← VERSION.SECTOR9 CYLINDERS ← CYLINDERS
TRACKSPERCYLINDER ← TRACKSPERCYLINDER SECTORSPERTRACK ← SECTORSPERTRACK
(ACCESSFNS ((INTACT (AND (IEQP (fetch (SECTOR9 SEAL) of DATUM)
SEAL.SECTOR9)
(ILEQ (fetch (SECTOR9 \LABELLENGTH) of DATUM)
106)))
($LABEL (MKATOM (CREATE STRINGP
BASE ← (fetch (SECTOR9 \LABELBASE)
of DATUM)
LENGTH ← (IMIN 106 (fetch (SECTOR9 \LABELLENGTH)
of DATUM))))
(PROG (VALUE) (* NOTE: Can't set SETQ NEWVALUE with record package.
*)
(SETQ VALUE (MKSTRING NEWVALUE))
(replace (SECTOR9 \LABELLENGTH) of DATUM
with (IMIN 106 (NCHARS VALUE)))
(RPLSTRING (CREATE STRINGP
BASE ← (fetch (SECTOR9 \LABELBASE)
of DATUM)
LENGTH ← (fetch (SECTOR9 \LABELLENGTH)
of DATUM))
1
(SUBSTRING VALUE 1 (fetch (SECTOR9
\LABELLENGTH)
of DATUM)))))
(\LABELBASE (\ADDBASE DATUM 22)))))
(DATATYPE MP ((SEAL WORD)
(VERSION WORD) (* Previous marker page entry *)
(PLENGTH SWAPPEDFIXP)
(PTYPE WORD)
(PFILEID SWAPPEDFIXP)
(PFILETYPE WORD)
(NIL 121 WORD) (* Next marker page entry *)
(NLENGTH SWAPPEDFIXP)
(NTYPE WORD)
(NFILEID SWAPPEDFIXP)
(NFILETYPE WORD)
(NIL 121 WORD))
SEAL ← SEAL.MP VERSION ← VERSION.MP (ACCESSFNS ((INTACT (IEQP (fetch (MP SEAL)
of DATUM)
SEAL.MP))
($PTYPE (\FLOPPY.TRANSLATEMPETYPE
(fetch (MP PTYPE)
of DATUM)))
($PFILETYPE (\FLOPPY.TRANSLATEFILETYPE
(fetch (MP PFILETYPE)
of DATUM)))
($NTYPE (\FLOPPY.TRANSLATEMPETYPE
(fetch (MP NTYPE)
of DATUM)))
($NFILETYPE (\FLOPPY.TRANSLATEFILETYPE
(fetch (MP NFILETYPE)
of DATUM))))))
(DATATYPE LP ((SEAL WORD)
(VERSION WORD)
(MESATYPE WORD) (* Offset 6 *)
(\CREATIONDATE SWAPPEDFIXP)
(\WRITEDATE SWAPPEDFIXP)
(PAGELENGTH SWAPPEDFIXP)
(HUGEPAGESTART SWAPPEDFIXP)
(HUGEPAGELENGTH SWAPPEDFIXP)
(HUGELENGTH SWAPPEDFIXP)
(\NAMELENGTH WORD)
(NAMEMAXLENGTH WORD) (* Offset 17 *)
(\NAME 50 WORD) (* Offset 67 *)
(UFO1 WORD)
(UFO2 WORD)
(UFO3 WORD)
(UFO4 WORD)
(NIL 184 WORD))
SEAL ← SEAL.LP VERSION ← VERSION.LP MESATYPE ← 65535 NAMEMAXLENGTH ← NAMEMAXLENGTH.LP UFO1
← 2 UFO2 ← 187 UFO3 ← 2222 UFO4 ← 1
(ACCESSFNS ((INTACT (AND (IEQP (fetch (LP SEAL) of DATUM)
SEAL.LP)
(ILEQ (fetch (LP \NAMELENGTH) of DATUM)
NAMEMAXLENGTH.LP)))
($NAME (MKATOM (CREATE STRINGP
BASE ← (fetch (LP \NAMEBASE) of DATUM)
LENGTH ← (IMIN 100 (fetch (LP \NAMELENGTH) of DATUM))))
(PROG (VALUE) (* NOTE: Can't SETQ NEWVALUE with record package.
*)
(SETQ VALUE (MKSTRING NEWVALUE))
(replace (LP \NAMELENGTH) of DATUM with (IMIN NAMEMAXLENGTH.LP
(NCHARS VALUE)))
(RPLSTRING (CREATE STRINGP
BASE ← (fetch (LP \NAMEBASE) of DATUM)
LENGTH ← (fetch (LP \NAMELENGTH) of DATUM))
1
(SUBSTRING VALUE 1 (fetch (LP \NAMELENGTH)
of DATUM)))))
(\NAMEBASE (\ADDBASE DATUM 17))
(CREATIONDATE (GDATE (fetch (LP ICREATIONDATE) of DATUM))
(replace (LP ICREATIONDATE) of DATUM with (IDATE NEWVALUE)))
(ICREATIONDATE (\FLOPPY.MTL.IDATE (fetch (LP \CREATIONDATE) of DATUM))
(replace (LP \CREATIONDATE) of DATUM with (\FLOPPY.LTM.IDATE
NEWVALUE)))
(WRITEDATE (GDATE (fetch (LP IWRITEDATE) of DATUM))
(replace (LP IWRITEDATE) of DATUM with (IDATE NEWVALUE)))
(IWRITEDATE (\FLOPPY.MTL.IDATE (fetch (LP \WRITEDATE) of DATUM))
(replace (LP \WRITEDATE) of DATUM with (\FLOPPY.LTM.IDATE NEWVALUE))
)
(LENGTH (COND
((ILESSP (IPLUS (fetch (LP HUGEPAGESTART) of DATUM)
(fetch (LP PAGELENGTH) of DATUM))
(fetch (LP HUGEPAGELENGTH) of DATUM))
(ITIMES 512 (fetch (LP PAGELENGTH) of DATUM)))
(T (IDIFFERENCE (fetch (LP HUGELENGTH) of DATUM)
(ITIMES 512 (fetch (LP HUGEPAGESTART) of DATUM)))))
(PROGN (* Works for ordinairy (not huge) files.
*)
(replace (LP PAGELENGTH) of DATUM
with (IQUOTIENT (IPLUS NEWVALUE 511)
512))
(replace (LP HUGELENGTH) of DATUM
with (IMAX (fetch (LP HUGELENGTH) of DATUM)
NEWVALUE))
(replace (LP HUGEPAGELENGTH) of DATUM
with (IMAX (fetch (LP HUGEPAGELENGTH) of DATUM)
(fetch (LP PAGELENGTH) of DATUM)))))
(\VALUE DATUM (\BLT DATUM NEWVALUE 256)))))
(BLOCKRECORD FILELIST ((SEAL WORD)
(VERSION WORD)
(NENTRIES WORD)
(MAXENTRIES WORD))
(ACCESSFNS ((INTACT (IEQP (fetch (FILELIST SEAL) of DATUM)
SEAL.FILELIST))
(NPAGES (IQUOTIENT (IPLUS 8 (ITIMES 5 (fetch (FILELIST MAXENTRIES)
of DATUM)))
256))
(\FIRSTFLE (\ADDBASE DATUM 4)))))
(DATATYPE FLE ((FILEID SWAPPEDFIXP)
(TYPE WORD)
(START WORD)
(LENGTH WORD))
(ACCESSFNS (($TYPE (\FLOPPY.TRANSLATEFILETYPE (fetch (FLE TYPE) of DATUM)))
(\VALUE DATUM (\BLT DATUM NEWVALUE 5)))))
]
(/DECLAREDATATYPE (QUOTE IOCB)
(QUOTE (WORD WORD WORD WORD (BITS 12)
(BITS 4)
FIXP WORD WORD FLAG (BITS 15)
WORD
(BITS 8)
(BITS 8)
(BITS 8)
(BITS 8)
WORD WORD WORD)))
(/DECLAREDATATYPE (QUOTE SECTOR9)
(QUOTE (WORD WORD WORD WORD WORD WORD SWAPPEDFIXP WORD SWAPPEDFIXP WORD WORD WORD
WORD WORD WORD WORD SWAPPEDFIXP FLAG (BITS 15)
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD)))
(/DECLAREDATATYPE (QUOTE MP)
(QUOTE (WORD WORD SWAPPEDFIXP WORD SWAPPEDFIXP WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD SWAPPEDFIXP WORD SWAPPEDFIXP WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD)))
(/DECLAREDATATYPE (QUOTE LP)
(QUOTE (WORD WORD WORD SWAPPEDFIXP SWAPPEDFIXP SWAPPEDFIXP SWAPPEDFIXP SWAPPEDFIXP
SWAPPEDFIXP WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD)))
(/DECLAREDATATYPE (QUOTE FLE)
(QUOTE (SWAPPEDFIXP WORD WORD WORD)))
)
(DEFINEQ
(\FLOPPY.TRANSLATERESULT
(LAMBDA (RESULT) (* kbr: "14-Jan-84 15:26")
(SELECT (LOGAND RESULT R.WRITEERRORMASK)
(R.WRITEPROTECT (QUOTE WRITEPROTECT))
(SELECT (LOGAND RESULT R.READERRORMASK)
(R.OK (QUOTE OK))
(R.BUSY (QUOTE BUSY))
(R.CRCERROR (QUOTE CRCERROR))
(R.DATALOST (QUOTE DATALOST))
(R.DOOROPENED (QUOTE DOOROPENED))
(R.DOORISOPEN (QUOTE DOORISOPEN))
(R.DOORISOPEN2 (QUOTE DOORISOPEN))
(R.NOTREADY (QUOTE NOTREADY))
(R.RECALIBRATEERROR (QUOTE RECALIBRATERROR))
(R.RECORDNOTFOUND (QUOTE RECORDNOTFOUND))
(R.WRITEPROTECT (QUOTE WRITEPROTECT))
(QUOTE UNKNOWNERROR)))))
(\FLOPPY.SEVERE.ERROR
(LAMBDA (MESSAGE) (* kbr: "14-Jan-84 15:26")
(* FLOPPY just tried to do something that would have
crashed lisp. *)
(PROG NIL
(ERROR "Floppy: Severe Error!" MESSAGE))))
(\FLOPPY.TRANSLATEMPETYPE
(LAMBDA (MPETYPE) (* kbr: "14-Jan-84 15:27")
(SELECT MPETYPE (MPETYPE.FREE (QUOTE FREE))
(MPETYPE.FILE (QUOTE FILE))
(MPETYPE.FILELIST (QUOTE FILELIST))
(MPETYPE.BADSECTORS (QUOTE BADSECTORS))
(QUOTE ?))))
(\FLOPPY.TRANSLATEFILETYPE
(LAMBDA (FILETYPE) (* kbr: "14-Jan-84 15:27")
(SELECT FILETYPE (FILETYPE.FREE (QUOTE FREE))
(2048 (QUOTE UNASSIGNED))
(2049 (QUOTE DIRECTORY))
(2050 (QUOTE ATVMSTRANSACTION))
(2051 (QUOTE BACKSTOPLOG))
(FILETYPE.FILE (QUOTE FILE))
(2053 (QUOTE CLEARINGHOUSEBACKUPFILE))
(FILETYPE.FILELIST (QUOTE FILELIST))
(2055 (QUOTE BACKSTOPDEBUGGER))
(2066 (QUOTE BACKSTOPDEBUGGEE))
(QUOTE ?))))
(\FLOPPY.MTL.FIXP
(LAMBDA (X) (* kbr: "14-Jan-84 15:27")
(* Mesa FIXP to Lisp FIXP. *)
(ROT X 16 32)))
(\FLOPPY.LTM.FIXP
(LAMBDA (X) (* kbr: "14-Jan-84 15:27")
(* Lisp FIXP to Mesa FIXP. *)
(ROT X 16 32)))
(\FLOPPY.MTL.IDATE
(LAMBDA (X) (* kbr: "14-Jan-84 15:27")
(* Mesa IDATE to Lisp IDATE. *)
(LOGXOR -2147483648 X)))
(\FLOPPY.LTM.IDATE
(LAMBDA (X) (* kbr: "14-Jan-84 15:27")
(* Lisp IDATE to Mesa IDATE. *)
(LOGXOR -2147483648 X)))
)
(* SA800HEAD *)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ IBMS128 0)
(RPAQQ IBMS256 1)
(RPAQQ IBMS512 2)
(RPAQQ IBMS1024 3)
(RPAQQ IBMD128 4)
(RPAQQ IBMD256 5)
(RPAQQ IBMD512 6)
(RPAQQ IBMD1024 7)
(CONSTANTS (IBMS128 0)
(IBMS256 1)
(IBMS512 2)
(IBMS1024 3)
(IBMD128 4)
(IBMD256 5)
(IBMD512 6)
(IBMD1024 7))
)
)
(RPAQ? \FLOPPY.INSPECTW NIL)
(RPAQ? \FLOPPY.DEBUG NIL)
(DEFINEQ
(\FLOPPY.TRANSLATESETUP
(LAMBDA (SETUP) (* kbr: "14-Jan-84 15:27")
(SELECT SETUP (IBMS128 (QUOTE IBMS128))
(IBMS256 (QUOTE IBMS256))
(IBMS512 (QUOTE IBMS512))
(IBMS1024 (QUOTE IBMS1024))
(IBMD128 (QUOTE IBMD128))
(IBMD256 (QUOTE IBMD256))
(IBMD512 (QUOTE IBMD512))
(IBMD1024 (QUOTE IBMD1024))
(SHOULDNT))))
(\FLOPPY.SETUP
(LAMBDA (IOCB SETUP) (* kbr: "14-Jan-84 15:27")
(* Change setup (i.e. manufacturer, density, and
sectorlength info) of IOCB to SETUP.
*)
(PROG (SECTORLENGTH DENSITY ENCODEDSECTORLENGTH SECTORSPERTRACK GAP3)
(SETQ SECTORLENGTH (\FLOPPY.SECTORLENGTH SETUP))
(SETQ DENSITY (\FLOPPY.DENSITY SETUP))
(SETQ ENCODEDSECTORLENGTH (\FLOPPY.ENCODEDSECTORLENGTH SETUP))
(SETQ SECTORSPERTRACK (\FLOPPY.SECTORSPERTRACK SETUP))
(SETQ GAP3 (\FLOPPY.GAP3 SETUP)) (* UNINTERRUPTABLY because mislaid IOCBs result in 500
mp series hard crashes. *)
(UNINTERRUPTABLY
(replace (IOCB SECTORLENGTHDIV2) of IOCB with (LRSH SECTORLENGTH 1))
(replace (IOCB DENSITY) of IOCB with DENSITY)
(replace (IOCB TROYORIBM) of IOCB with IBM)
(replace (IOCB SECTORLENGTHDIV4) of IOCB with (LRSH SECTORLENGTH 2))
(replace (IOCB ENCODEDSECTORLENGTH) of IOCB with ENCODEDSECTORLENGTH)
(replace (IOCB SECTORSPERTRACK) of IOCB with SECTORSPERTRACK)
(replace (IOCB GAP3) of IOCB with GAP3))
(RETURN IOCB))))
(\FLOPPY.CHECK.IOCB
(LAMBDA (IOCB) (* kbr: "14-Jan-84 15:27")
(* Check IOCB is legal--A better debugging tool than
bletcherous flashing MP codes.
*)
(PROG (SETUP) (* Check command *)
(COND
((OR (NOT (MEMB (fetch (IOCB COMMAND) of IOCB)
(LIST C.NOP C.INITIALIZE C.RECALIBRATE C.READSECTOR C.WRITESECTOR
C.FORMATTRACK)))
(NOT (IEQP (fetch (IOCB SUBCOMMAND) of IOCB)
SC.NOP))) (* We're not supporting anything besides these.
*)
(\FLOPPY.SEVERE.ERROR "Illegal IOCB Command")))
(* Check diskaddress *)
(create DISKADDRESS
CYLINDER ← (fetch (IOCB CYLINDER) of IOCB)
HEAD ← (fetch (IOCB HEAD) of IOCB)
SECTOR ← (fetch (IOCB SECTOR) of IOCB)) (* Check buffer *)
(COND
((NOT (OR (AND (fetch (IOCB BUFFER) of IOCB)
(IEQP (fetch (IOCB SECTORCOUNT) of IOCB)
1))
(AND (NULL (fetch (IOCB BUFFER) of IOCB))
(ZEROP (fetch (IOCB SECTORCOUNT) of IOCB)))
(AND (IEQP (fetch (IOCB COMMAND) of IOCB)
C.FORMATTRACK)
(ILEQ (IPLUS (fetch (IOCB CYLINDER) of IOCB)
(fetch (IOCB SECTORCOUNT) of IOCB))
77))))
(\FLOPPY.SEVERE.ERROR "Illegal IOCB Buffer")))
(* Check setup *)
(COND
((OR (IEQP (fetch (IOCB TROYORIBM) of IOCB)
TROY)
(fetch (IOCB SAMEPAGE) of IOCB)) (* We're not supporting these.
*)
(\FLOPPY.SEVERE.ERROR "Illegal IOCB Setup 1")))
(SETQ SETUP (SELECTC (fetch (IOCB DENSITY) of IOCB)
(SINGLE (SELECTC (fetch (IOCB ENCODEDSECTORLENGTH) of IOCB)
(B128 IBMS128)
(B256 IBMS256)
(B512 IBMS512)
(B1024 IBMS1024)
(\FLOPPY.SEVERE.ERROR "Illegal IOCB Setup 2")))
(DOUBLE (SELECTC (fetch (IOCB ENCODEDSECTORLENGTH) of IOCB)
(B128 IBMD128)
(B256 IBMD256)
(B512 IBMD512)
(B1024 IBMD1024)
(\FLOPPY.SEVERE.ERROR "Illegal IOCB Setup 2")))
(\FLOPPY.SEVERE.ERROR "Illegal IOCB Setup 2")))
(COND
((OR (NOT (IEQP (fetch (IOCB SECTORLENGTHDIV2) of IOCB)
(IQUOTIENT (\FLOPPY.SECTORLENGTH SETUP)
2)))
(NOT (IEQP (fetch (IOCB SECTORLENGTHDIV4) of IOCB)
(IQUOTIENT (\FLOPPY.SECTORLENGTH SETUP)
4)))
(NOT (IEQP (fetch (IOCB SECTORSPERTRACK) of IOCB)
(\FLOPPY.SECTORSPERTRACK SETUP)))
(IGREATERP (fetch (IOCB SECTOR) of IOCB)
(fetch (IOCB SECTORSPERTRACK) of IOCB))
(NOT (IEQP (fetch (IOCB GAP3) of IOCB)
(\FLOPPY.GAP3 SETUP))))
(\FLOPPY.SEVERE.ERROR "Illegal IOCB Setup 3"))))))
(\FLOPPY.DENSITY
(LAMBDA (SETUP) (* kbr: "14-Jan-84 15:27")
(SELECT SETUP ((IBMS128 IBMS256 IBMS512 IBMS1024)
SINGLE)
((IBMD128 IBMD256 IBMD512 IBMD1024)
DOUBLE)
(SHOULDNT))))
(\FLOPPY.SECTORLENGTH
(LAMBDA (SETUP) (* kbr: "14-Jan-84 15:27")
(SELECT SETUP ((IBMS128 IBMD128)
128)
((IBMS256 IBMD256)
256)
((IBMS512 IBMD512)
512)
((IBMS1024 IBMD1024)
1024)
(SHOULDNT))))
(\FLOPPY.ENCODEDSECTORLENGTH
(LAMBDA (SETUP) (* kbr: "14-Jan-84 15:27")
(SELECT SETUP ((IBMS128 IBMD128)
B128)
((IBMS256 IBMD256)
B256)
((IBMS512 IBMD512)
B512)
((IBMS1024 IBMD1024)
B1024)
(SHOULDNT))))
(\FLOPPY.GAP3
(LAMBDA (SETUP) (* kbr: "14-Jan-84 15:27")
(SELECT SETUP (IBMS128 27)
(IBMS256 42)
(IBMS512 58)
(IBMS1024 75)
(IBMD128 26)
(IBMD256 54)
(IBMD512 84)
(IBMD1024 116)
(SHOULDNT))))
(\FLOPPY.SECTORSPERTRACK
(LAMBDA (SETUP) (* kbr: "14-Jan-84 15:27")
(SELECT SETUP (IBMS128 26)
(IBMS256 15)
(IBMS512 8)
(IBMS1024 4)
(IBMD128 36)
(IBMD256 26)
(IBMD512 15)
(IBMD1024 8)
(SHOULDNT))))
(\FLOPPY.RUN
(LAMBDA (IOCB NOERROR) (* kbr: "23-Jan-84 21:27")
(* Returns T if command successfully completed.
*)
(PROG (RETRYFLG)
RETRY
(RESETLST (RESETSAVE (\FLOPPY.LOCK.BUFFER IOCB)
(\BQUOTE (\FLOPPY.UNLOCK.BUFFER (\COMMA IOCB))))
(* IOP acts when it sees nonzero NEXT field of CSB.
*)
(while (NOT (ZEROP (fetch (IOPAGE DLFLOPPYCMD) of \IOPAGE)))
do (* Since we're monitor locked, this particular loop
shouldnt be necessary. *)
(BLOCK))
(\FLOPPY.CHECK.IOCB IOCB)
(COND
(\FLOPPY.DEBUG (* For floppy wizards. *)
(COND
(\FLOPPY.INSPECTW (CLOSEW \FLOPPY.INSPECTW)))
(SETQ \FLOPPY.INSPECTW
(INSPECT IOCB (QUOTE IOCB)
(create POSITION
XCOORD ← 0
YCOORD ← 0)))
(printout T (fetch (IOCB $COMMAND) of IOCB)
" (C"
(fetch (IOCB CYLINDER) of IOCB)
" H"
(fetch (IOCB HEAD) of IOCB)
" S"
(fetch (IOCB SECTOR) of IOCB)
") "
(QUOTE %
))))
(UNINTERRUPTABLY
(\BLT \FLOPPYIOCB IOCB IOCB.SIZE)
(replace (IOPAGE DLFLOPPYCMD) of \IOPAGE with \FLOPPYIOCBADDR))
(while (NOT (ZEROP (fetch (IOPAGE DLFLOPPYCMD) of \IOPAGE))) do (BLOCK)))
(COND
((NOT (OR (fetch (RESULT ERROR) of \FLOPPYRESULT)
(fetch (RESULT MPERROR) of \FLOPPYRESULT)))
(RETURN T))
((fetch (RESULT MPERROR) of \FLOPPYRESULT) (* These should only be generated by still undiagnosed
bugs living in IOP assembly language code.
Reissuing command seems to work.
*)
(COND
(\FLOPPY.DEBUG (PRIN1 (fetch (RESULT MPMESSAGE) of \FLOPPYRESULT)
T)
(BREAK1 NIL T)))
(COND
((OR RETRYFLG \FLOPPY.DEBUG)
(\FLOPPY.MESSAGE (fetch (RESULT MPMESSAGE) of \FLOPPYRESULT)))))
((fetch (RESULT DOOROPENED) of \FLOPPYRESULT) (* Door opened. Always an error at this deep a level.
(Otherwise user could switch floppies on stream.) *)
(COND
((AND RETRYFLG NOERROR) (* Abandon command. *)
(RETURN NIL)))
(COND
((AND (NOT RETRYFLG)
(MEMB (fetch (IOCB COMMAND) of IOCB)
(LIST C.NOP C.INITIALIZE C.RECALIBRATE)))
(\FLOPPY.INITIALIZE)
(COND
((NOT (fetch (RESULT DOOROPENED) of \FLOPPYRESULT))
(\FLOPPY.RECALIBRATE))))
(T (\FLOPPY.ERROR)
(RETURN NIL))) (* Abandon command. *)
)
((fetch (RESULT CRCERROR) of \FLOPPYRESULT) (* Cyclic Redundancy Check. Reissuing command seems to
work. *)
(COND
(\FLOPPY.DEBUG (PRIN1 (QUOTE CRCERROR)
T)
(BREAK1 NIL T)))
(COND
((AND RETRYFLG NOERROR) (* Abandon command. *)
(RETURN NIL)))
(COND
((OR RETRYFLG \FLOPPY.DEBUG)
(\FLOPPY.MESSAGE (QUOTE CRCERROR)))))
((AND (OR (fetch (RESULT RECORDNOTFOUND) of \FLOPPYRESULT)
(fetch (RESULT RECALIBRATEERROR) of \FLOPPYRESULT))
(NOT RETRYFLG)
(NOT (MEMB (fetch (IOCB COMMAND) of IOCB)
(LIST C.INITIALIZE C.RECALIBRATE C.NOP))))
(* Try one more time after initializing and
recalibrating. TBW: Make \FLOPPY.SCRATCH.IOCB a global
resource. *)
(COND
(\FLOPPY.DEBUG (PRIN1 (\FLOPPY.TRANSLATERESULT (fetch (RESULT WORD) of \FLOPPYRESULT))
T)
(\FLOPPY.MESSAGE (\FLOPPY.TRANSLATERESULT (fetch (RESULT WORD)
of \FLOPPYRESULT)))
(BREAK1 NIL T)))
(\FLOPPY.INITIALIZE NOERROR)
(COND
((NOT (fetch (RESULT DOOROPENED) of \FLOPPYRESULT))
(\FLOPPY.RECALIBRATE NOERROR))))
(NOERROR (* Abandon command. Calling routine will handle
(or ignore) error. *)
(RETURN NIL))
(T (* Hit the user with the bad news.
*)
(\FLOPPY.ERROR)))
(SETQ RETRYFLG T)
(GO RETRY))))
(\FLOPPY.LOCK.BUFFER
(LAMBDA (IOCB) (* kbr: "14-Jan-84 15:27")
(* Lock floppy buffer down. *)
(PROG (BUFFER COUNT)
(* NOTE: This routine insures each floppy buffer page has been referenced before being sent to the IOP.
If the IOP sees a CP page hasn't been referenced, the IOP forces a fatal 510 crash. *)
(COND
((MEMB (fetch (IOCB COMMAND) of IOCB)
(LIST C.READSECTOR C.WRITESECTOR))
(SETQ BUFFER (fetch (IOCB BUFFER) of IOCB))
(SETQ COUNT (fetch (IOCB SECTORCOUNT) of IOCB))
(\LOCKPAGES BUFFER COUNT) (* Fatal 510 error possible without this loop.
*)
(for J from 0 to (SUB1 COUNT) do (\PUTBASE BUFFER (ITIMES 256 J)
(\GETBASE BUFFER (ITIMES 256 J)))))))))
(\FLOPPY.UNLOCK.BUFFER
(LAMBDA (IOCB) (* kbr: "14-Jan-84 15:27")
(* Unlock floppy buffer. *)
(PROG (BUFFER COUNT)
(COND
((MEMB (fetch (IOCB COMMAND) of IOCB)
(LIST C.READSECTOR C.WRITESECTOR))
(SETQ BUFFER (fetch (IOCB BUFFER) of IOCB))
(SETQ COUNT (fetch (IOCB SECTORCOUNT) of IOCB))
(\UNLOCKPAGES BUFFER COUNT))))))
(\FLOPPY.ERROR
(LAMBDA NIL (* kbr: "23-Jan-84 22:36")
(PROG ($RESULT)
(SETQ $RESULT (\FLOPPY.TRANSLATERESULT (fetch (RESULT WORD) of \FLOPPYRESULT)))
(COND
(\FLOPPY.DEBUG (PRIN1 $RESULT \FLOPPY.HISTORYW)
(BREAK1 NIL T)))
(COND
((MEMB $RESULT (QUOTE (DOOROPENED DOORISOPEN)))
(\FLOPPY.CLOSE)))
(\FLOPPY.INITIALIZE)
(* Floppy drive door solenoids will lock drive door in place after a DOOROPENED error. INITIALIZE done before
break to unlock the door and allow user to remedy if no floppy present. *)
(\FLOPPY.BREAK $RESULT) (* INITIALIZE again, since user may open floppy drive
door during break. *)
(\FLOPPY.INITIALIZE)
(COND
((NOT (fetch (RESULT DOOROPENED) of \FLOPPYRESULT))
(\FLOPPY.RECALIBRATE))))))
(\FLOPPY.PREPAREFORCRASH
(LAMBDA NIL (* kbr: "14-Jan-84 15:27")
(PROG NIL (* Prepare for the worst by dumping all pertinent
records to screen before doing \FLOPPY.RUN in case we
crash *)
(\FLOPPY.DEBUGBLOCKS)
(SAVEVM)
(COND
((NOT (MEMBER (PROMPTFORWORD "Proceed?" NIL NIL PROMPTWINDOW)
(QUOTE (NIL "y" "Y" "yes" "YES"))))
(RESET))))))
(\FLOPPY.COMMAND
(LAMBDA (IOCB COMMAND SUBCOMMAND NOERROR) (* kbr: "14-Jan-84 15:27")
(PROG (DISKADDRESS)
(SETQ DISKADDRESS (CONSTANT (create DISKADDRESS
CYLINDER ← 0
HEAD ← 0
SECTOR ← 1)))
(UNINTERRUPTABLY
(replace (IOCB COMMAND) of IOCB with COMMAND)
(replace (IOCB SUBCOMMAND) of IOCB with SUBCOMMAND)
(replace (IOCB DISKADDRESS) of IOCB with DISKADDRESS)
(replace (IOCB BUFFER) of IOCB with NIL)
(replace (IOCB SECTORCOUNT) of IOCB with 0))
(RETURN (\FLOPPY.RUN IOCB NOERROR)))))
(\FLOPPY.TRANSFER
(LAMBDA (IOCB COMMAND DISKADDRESS PAGE NOERROR) (* kbr: "14-Jan-84 15:27")
(PROG NIL
(UNINTERRUPTABLY
(replace (IOCB COMMAND) of IOCB with COMMAND)
(replace (IOCB SUBCOMMAND) of IOCB with SC.NOP)
(replace (IOCB DISKADDRESS) of IOCB with DISKADDRESS)
(replace (IOCB BUFFER) of IOCB with PAGE)
(replace (IOCB SECTORCOUNT) of IOCB with 1))
(COND
((\FLOPPY.RUN IOCB NOERROR) (* Successful completion. *)
(RETURN PAGE))))))
(\FLOPPY.NOP
(LAMBDA (NOERROR) (* kbr: "14-Jan-84 15:27")
(GLOBALRESOURCE \FLOPPY.SCRATCH.IOCB (\FLOPPY.COMMAND \FLOPPY.SCRATCH.IOCB C.NOP SC.NOP NOERROR)))
)
(\FLOPPY.RECALIBRATE
(LAMBDA (NOERROR) (* kbr: "14-Jan-84 15:27")
(GLOBALRESOURCE \FLOPPY.SCRATCH.IOCB (\FLOPPY.COMMAND \FLOPPY.SCRATCH.IOCB C.RECALIBRATE SC.NOP
NOERROR))))
(\FLOPPY.INITIALIZE
(LAMBDA (NOERROR) (* kbr: "14-Jan-84 15:27")
(GLOBALRESOURCE \FLOPPY.SCRATCH.IOCB (\FLOPPY.COMMAND \FLOPPY.SCRATCH.IOCB C.INITIALIZE SC.NOP
NOERROR))))
(\FLOPPY.FORMATTRACKS
(LAMBDA (IOCB DISKADDRESS COUNT NOERROR) (* kbr: "14-Jan-84 15:27")
(PROG NIL
(UNINTERRUPTABLY
(replace (IOCB COMMAND) of IOCB with C.FORMATTRACK)
(replace (IOCB SUBCOMMAND) of IOCB with SC.NOP)
(replace (IOCB DISKADDRESS) of IOCB with DISKADDRESS)
(replace (IOCB BUFFER) of IOCB with NIL)
(replace (IOCB SECTORCOUNT) of IOCB with COUNT))
(RETURN (\FLOPPY.RUN IOCB NOERROR)))))
(\FLOPPY.READSECTOR
(LAMBDA (IOCB DISKADDRESS PAGE NOERROR) (* kbr: "14-Jan-84 15:27")
(\FLOPPY.TRANSFER IOCB C.READSECTOR DISKADDRESS PAGE NOERROR)))
(\FLOPPY.WRITESECTOR
(LAMBDA (IOCB DISKADDRESS PAGE NOERROR) (* kbr: "14-Jan-84 15:27")
(\FLOPPY.TRANSFER IOCB C.WRITESECTOR DISKADDRESS PAGE NOERROR)))
(\FLOPPY.RECOVER
(LAMBDA (NOERROR) (* kbr: "14-Jan-84 15:27")
(GLOBALRESOURCE \FLOPPY.SCRATCH.IOCB (\FLOPPY.COMMAND \FLOPPY.SCRATCH.IOCB C.ESCAPE
SC.DISKCHANGECLEAR NOERROR))))
)
(* COMMON *)
(RPAQ? \FLOPPYFDEV NIL)
(RPAQ? \FLOPPYLOCK NIL)
(RPAQ? \FLOPPY.SCRATCH.BUFFER NIL)
(RPAQ? \FLOPPY.SCRATCH.IOCB NIL)
(RPAQ? \FLOPPY.IBMS128.IOCB NIL)
(RPAQ? \FLOPPY.IBMD256.IOCB NIL)
(RPAQ? \FLOPPY.IBMD512.IOCB NIL)
(RPAQ? \FLOPPY.MODE.BEFORE.EVENT NIL)
(RPAQ? \FLOPPYIOCBADDR NIL)
(RPAQ? \FLOPPYIOCB NIL)
(RPAQ? \FLOPPYRESULT NIL)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(PUTDEF (QUOTE \FLOPPY.SCRATCH.IOCB)
(QUOTE GLOBALRESOURCES)
(QUOTE (CREATE IOCB)))
(PUTDEF (QUOTE \FLOPPY.IBMS128.IOCB)
(QUOTE GLOBALRESOURCES)
(QUOTE (\FLOPPY.SETUP (CREATE IOCB)
IBMS128)))
(PUTDEF (QUOTE \FLOPPY.IBMD256.IOCB)
(QUOTE GLOBALRESOURCES)
(QUOTE (\FLOPPY.SETUP (CREATE IOCB)
IBMD256)))
(PUTDEF (QUOTE \FLOPPY.IBMD512.IOCB)
(QUOTE GLOBALRESOURCES)
(QUOTE (\FLOPPY.SETUP (CREATE IOCB)
IBMD512)))
(PUTDEF (QUOTE \FLOPPY.SCRATCH.BUFFER)
(QUOTE GLOBALRESOURCES)
(QUOTE (\ALLOCBLOCK 512 NIL 256)))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \FLOPPY.SCRATCH.BUFFER \FLOPPY.IBMD512.IOCB \FLOPPY.IBMD256.IOCB
\FLOPPY.IBMS128.IOCB \FLOPPY.SCRATCH.IOCB)
)
(RPAQQ \FLOPPY.SCRATCH.BUFFER NIL)
(RPAQQ \FLOPPY.IBMD512.IOCB NIL)
(RPAQQ \FLOPPY.IBMD256.IOCB NIL)
(RPAQQ \FLOPPY.IBMS128.IOCB NIL)
(RPAQQ \FLOPPY.SCRATCH.IOCB NIL)
[DECLARE: EVAL@COMPILE
(ACCESSFNS FLOPPYSTREAM ((PALLOC (fetch (STREAM F1) of DATUM)
(replace (STREAM F1) of DATUM with NEWVALUE))
(LP (fetch (STREAM F2) of DATUM)
(replace (STREAM F2) of DATUM with NEWVALUE))
(CALLOC (fetch (STREAM F1) of DATUM)
(replace (STREAM F1) of DATUM with NEWVALUE))
(FCB (fetch (STREAM F2) of DATUM)
(replace (STREAM F2) of DATUM with NEWVALUE))))
(RECORD FILEGENOBJ (NEXTFILEFN . GENFILESTATE))
(RECORD GENFILESTATE (FILES DEVICENAME))
]
)
(DEFINEQ
(FLOPPY.RESTART
(LAMBDA NIL (* kbr: "24-Jan-84 00:40")
(* Initializes floppy code, setting globals and creating
file devices. *)
(SETQ \FLOPPYLOCK (CREATE.MONITORLOCK (QUOTE FLOPPY)))
(WITH.MONITOR \FLOPPYLOCK (PROG NIL (* 16 quad aligned words needed for IOCB in the first
64K. Cannibalize last part of \IOCBPAGE located at real
address 256 *)
(SETQ \FLOPPYIOCBADDR (IPLUS 256 (IDIFFERENCE 256 16)))
(SETQ \FLOPPYIOCB (\ADDBASE \IOCBPAGE (IDIFFERENCE 256 16)))
(SETQ \FLOPPYRESULT (\ADDBASE \FLOPPYIOCB 8))
(SETQ \FLOPPY.SCRATCH.BUFFER (\ALLOCBLOCK 512 NIL 256))
(SETQ \FLOPPY.SCRATCH.IOCB (create IOCB))
(SETQ \FLOPPY.IBMS128.IOCB (\FLOPPY.SETUP (create IOCB)
IBMS128))
(SETQ \FLOPPY.IBMD256.IOCB (\FLOPPY.SETUP (create IOCB)
IBMD256))
(SETQ \FLOPPY.IBMD512.IOCB (\FLOPPY.SETUP (create IOCB)
IBMD512))
(SETQ \HFLOPPY.MAXPAGES 2250)
(COND
(\FLOPPYFDEV (\FLOPPY.FLUSH)))
(\PFLOPPY.INIT)
(\HFLOPPY.INIT)
(\SFLOPPY.INIT)
(\CFLOPPY.INIT)
(FLOPPY.MODE (QUOTE PILOT))
(COND
((FLOPPY.DRIVE.EXISTSP)
(\FLOPPY.INITIALIZE)))))))
(FLOPPY.MODE
(LAMBDA (MODE) (* kbr: "24-Jan-84 00:40")
(* Set floppy MODE to one of PILOT or CPM.
Indicate current mode if MODE = NIL.
*)
(WITH.MONITOR \FLOPPYLOCK (PROG (OLDMODE FDEV)
RETRY
(SETQ OLDMODE (SELECT \FLOPPYFDEV (\PFLOPPYFDEV (QUOTE PILOT))
(\HFLOPPYFDEV (QUOTE HUGEPILOT))
(\SFLOPPYFDEV (QUOTE SYSOUT))
(\CFLOPPYFDEV (QUOTE CPM))
(PROGN
(* Shouldn't happen, but a SHOULDNT here would kill
FLOPPY for good. So ignore. *)
NIL)))
(SELECTQ MODE
(PILOT (SETQ FDEV \PFLOPPYFDEV))
(HUGEPILOT (SETQ FDEV \HFLOPPYFDEV))
(SYSOUT (SETQ FDEV \SFLOPPYFDEV))
(CPM (SETQ FDEV \CFLOPPYFDEV))
(NIL (* No change *)
(SETQ FDEV \FLOPPYFDEV))
(PROGN (SETQ MODE (LISPERROR "ILLEGAL ARG" MODE))
(GO RETRY)))
(COND
((AND \FLOPPYFDEV (NOT (EQ FDEV \FLOPPYFDEV)))
(\FLOPPY.CLOSE)))
(COND
(MODE (UNINTERRUPTABLY
(\DEFINEDEVICE (QUOTE FLOPPY)
FDEV)
(SETQ \FLOPPYFDEV FDEV))))
(RETURN OLDMODE)))))
(\FLOPPY.EVENTFN
(LAMBDA (FDEV EVENT) (* kbr: " 3-Feb-84 11:40")
(WITH.MONITOR \FLOPPYLOCK (PROG NIL
(COND
((NOT (FLOPPY.DRIVE.EXISTSP))
(RETURN)))
(SELECTQ EVENT
((AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS RESTART)
(FLOPPY.MODE \FLOPPY.MODE.BEFORE.EVENT)
(\FLOPPY.INITIALIZE))
((BEFOREMAKESYS BEFORESYSOUT)
(* This cute little piece switches FDEVs for FLOPPY if
the caller is not SAVEVM. *)
(COND
((NULL (STKPOS (QUOTE SAVEVM)))
(SETQ \FLOPPY.MODE.BEFORE.EVENT
(FLOPPY.MODE (QUOTE SYSOUT))))))
(* NOP *))))))
(\FLOPPY.CLOSE
(LAMBDA NIL (* kbr: "24-Jan-84 00:55")
(* Forcibly close floppy. *)
(PROG NIL (* TBW: This function will go away when a wrong floppy
FDEV is implemented. *)
(SELECT \FLOPPYFDEV (\PFLOPPYFDEV (replace (PINFO OPEN) of \PFLOPPYINFO with NIL))
(\HFLOPPYFDEV (replace (PINFO OPEN) of \HFLOPPYINFO with NIL))
(\SFLOPPYFDEV (replace (PINFO OPEN) of \SFLOPPYINFO with NIL))
(\CFLOPPYFDEV (replace (CINFO OPEN) of \CFLOPPYINFO with NIL))
NIL)
(\FLOPPY.FLUSH))))
(\FLOPPY.FLUSH
(LAMBDA NIL (* kbr: "24-Jan-84 00:40")
(* Forcibly flush streams. *)
(PROG NIL (* TBW: This function will go away when a wrong floppy
FDEV is implemented. *)
(for STREAM in \OPENFILES when (EQ (fetch (STREAM DEVICE) of STREAM)
\FLOPPYFDEV)
do (SETQ \OPENFILES (DREMOVE STREAM \OPENFILES))))))
(\FLOPPY.HOSTNAMEP
(LAMBDA (NAME FDEV) (* kbr: "24-Jan-84 00:40")
(* NAME equals name of floppy FDEV? *)
(WITH.MONITOR \FLOPPYLOCK (AND (type? FDEV FDEV)
(EQ NAME (fetch (FDEV DEVICENAME) of FDEV))))))
(\FLOPPY.ADDDEVICENAME
(LAMBDA (FILENAME) (* kbr: "24-Jan-84 00:40")
(* Pack floppy FDEV name onto FILENAME.
*)
(PACK* (QUOTE {)
(fetch (FDEV DEVICENAME) of \FLOPPYFDEV)
(QUOTE })
FILENAME)))
(\FLOPPY.ASSUREFILENAME
(LAMBDA (FILE) (* kbr: "24-Jan-84 00:40")
(* Coerce FILE to a litatom FILENAME.
*)
(PROG (FILENAME)
(COND
((type? STREAM FILE)
(SETQ FILENAME (fetch (STREAM FULLFILENAME) of FILE)))
(T (SETQ FILENAME (SUBATOM FILE (ADD1 (OR (STRPOS "}" FILE)
0))
-1))))
(RETURN FILENAME))))
(\FLOPPY.OTHERINFO
(LAMBDA (OTHERINFO) (* kbr: "24-Jan-84 00:40")
(* Convert OPENFILE OTHERINFO into alist.
*)
(for BUCKET in OTHERINFO collect (COND
((LISTP BUCKET)
(COND
((LISTP (CDR BUCKET))
(CONS (CAR BUCKET)
(CADR BUCKET)))
(T BUCKET)))
(T (CONS BUCKET T))))))
(\FLOPPY.LEXASSOC
(LAMBDA (KEY ALIST) (* kbr: "24-Jan-84 00:40")
(* ASSOC for sorted alist. *)
(for BUCKET in ALIST while (ALPHORDER KEY (CAR BUCKET)) when (EQ KEY (CAR BUCKET))
do (RETURN BUCKET))))
(\FLOPPY.LEXPUTASSOC
(LAMBDA (KEY VAL ALIST) (* kbr: "24-Jan-84 00:40")
(* PUTASSOC for sorted alist.
Returns alist. *)
(PROG (BUCKET)
(SETQ BUCKET (CAR ALIST))
(COND
((NULL ALIST)
(SETQ ALIST (LIST (CONS KEY VAL)))
(RETURN ALIST))
((EQ KEY (CAR BUCKET))
(RPLACD BUCKET VAL)
(RETURN ALIST))
((ALPHORDER KEY (CAR BUCKET))
(push ALIST (CONS KEY VAL))
(RETURN ALIST)))
(for (TAIL ← ALIST) by (CDR TAIL) as BUCKET in (CDR ALIST) while (CDR TAIL)
do (COND
((EQ KEY (CAR BUCKET))
(RPLACD BUCKET VAL)
(RETURN))
((ALPHORDER KEY (CAR BUCKET))
(RPLACD TAIL (CONS (CONS KEY VAL)
(CDR TAIL)))
(RETURN)))
finally (RPLACD TAIL (LIST (CONS KEY VAL))))
(RETURN ALIST))))
(\FLOPPY.LEXREMOVEASSOC
(LAMBDA (KEY ALIST) (* kbr: "24-Jan-84 00:40")
(* Opposite of PUTASSOC for sorted alist.
Returns alist. *)
(PROG (BUCKET)
(SETQ BUCKET (CAR ALIST))
(COND
((NULL ALIST)
(RETURN ALIST))
((EQ KEY (CAR BUCKET))
(RETURN (CDR ALIST))))
(for (TAIL ← ALIST) by (CDR TAIL) as BUCKET in (CDR ALIST) while (CDR TAIL)
do (COND
((EQ KEY (CAR BUCKET))
(RPLACD TAIL (CDDR TAIL))
(RETURN))
((ALPHORDER KEY (CAR BUCKET))
(RETURN))))
(RETURN ALIST))))
(\FLOPPY.CATCH
(NLAMBDA $FEXPR$ (* kbr: "24-Jan-84 00:40")
((LAMBDA (TAG FORM) (* Like MACLISP *CATCH. *)
(PROG NIL
(SETQ TAG (EVAL TAG))
(RETURN (EVAL FORM))))
(pop $FEXPR$)
(pop $FEXPR$))))
(\FLOPPY.THROW
(LAMBDA (TAG VALUE MESSAGE) (* kbr: "24-Jan-84 00:40")
(* Like MACLISP *THROW. *)
(PROG (CATCHTAG)
(for (POS ← (STKNTH -1)) by (STKNTH -1 POS POS) while POS when (EQ (STKNAME POS)
(QUOTE \FLOPPY.CATCH))
do (SETQ CATCHTAG (STKARG (QUOTE TAG)
POS))
(COND
((OR (EQ CATCHTAG TAG)
(MEMB TAG CATCHTAG)
(EQ CATCHTAG T))
(RETFROM POS VALUE T))))
(LISPERROR MESSAGE ""))))
(\FLOPPY.BREAK
(LAMBDA (MESSAGE) (* kbr: "12-Mar-84 22:39")
(PROG NIL
(\FLOPPY.MESSAGE MESSAGE)
(LISPERROR "HARD DISK ERROR" (QUOTE {FLOPPY})
T))))
(\FLOPPY.MESSAGE
(LAMBDA (MESSAGE) (* kbr: "24-Jan-84 00:40")
(PROG NIL
(FRESHLINE PROMPTWINDOW)
(PRIN1 "Floppy: " PROMPTWINDOW)
(PRIN1 MESSAGE PROMPTWINDOW))))
)
(* PILOT *)
(RPAQ? \PFLOPPYSECTOR9 NIL)
(RPAQ? \PFLOPPYFILELIST NIL)
(RPAQ? \PFLOPPYINFO NIL)
(RPAQ? \PFLOPPYFDEV NIL)
(/DECLAREDATATYPE (QUOTE PALLOC)
(QUOTE (POINTER FULLXPOINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG)))
(/DECLAREDATATYPE (QUOTE PINFO)
(QUOTE (POINTER POINTER POINTER POINTER POINTER)))
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(DATATYPE PALLOC (FILENAME (PREV FULLXPOINTER)
NEXT START MP LP FLE (WRITEFLG FLAG)
(DELETEFLG FLAG))
(ACCESSFNS ((LENGTH (fetch (MP NLENGTH) of (fetch (PALLOC MP) of DATUM)))
(END (IPLUS (fetch (PALLOC START) of DATUM)
(fetch (PALLOC LENGTH) of DATUM)
-1))
(FILETYPE (fetch (MP NFILETYPE) of (fetch (PALLOC MP) of DATUM))))))
(DATATYPE PINFO (OPEN FILELIST PALLOCS DIR SECTOR9))
(ACCESSFNS PFLOPPYFDEV ((OPEN (fetch (PINFO OPEN) of (fetch (FDEV DEVICEINFO) of DATUM))
(replace (PINFO OPEN) of (fetch (FDEV DEVICEINFO) of DATUM)
with NEWVALUE))
(FILELIST (fetch (PINFO FILELIST) of (fetch (FDEV DEVICEINFO) of DATUM))
(PROGN (replace (PINFO FILELIST) of (fetch (FDEV DEVICEINFO)
of DATUM)
with NEWVALUE)
(SETQ \PFLOPPYFILELIST NEWVALUE)))
(PALLOCS (fetch (PINFO PALLOCS) of (fetch (FDEV DEVICEINFO) of DATUM))
(replace (PINFO PALLOCS) of (fetch (FDEV DEVICEINFO) of DATUM)
with NEWVALUE))
(DIR (fetch (PINFO DIR) of (fetch (FDEV DEVICEINFO) of DATUM))
(replace (PINFO DIR) of (fetch (FDEV DEVICEINFO) of DATUM) with NEWVALUE)
)
(SECTOR9 (fetch (PINFO SECTOR9) of (fetch (FDEV DEVICEINFO) of DATUM))
(PROGN (replace (PINFO SECTOR9) of (fetch (FDEV DEVICEINFO)
of DATUM)
with NEWVALUE)
(SETQ \PFLOPPYSECTOR9 NEWVALUE)))))
]
(/DECLAREDATATYPE (QUOTE PALLOC)
(QUOTE (POINTER FULLXPOINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG)))
(/DECLAREDATATYPE (QUOTE PINFO)
(QUOTE (POINTER POINTER POINTER POINTER POINTER)))
)
(DEFINEQ
(\PFLOPPY.INIT
(LAMBDA NIL (* kbr: " 3-Feb-84 16:27")
(PROG NIL
(SETQ \PFLOPPYINFO (create PINFO))
(SETQ \PFLOPPYFDEV (create FDEV
DEVICENAME ← (QUOTE FLOPPY)
RESETABLE ← T
RANDOMACCESSP ← T
NODIRECTORIES ← T
PAGEMAPPED ← T
CLOSEFILE ← (QUOTE \PFLOPPY.CLOSEFILE)
DELETEFILE ← (QUOTE \PFLOPPY.DELETEFILE)
DIRECTORYNAMEP ← (QUOTE TRUE)
EVENTFN ← (QUOTE \FLOPPY.EVENTFN)
GENERATEFILES ← (QUOTE \PFLOPPY.GENERATEFILES)
GETFILEINFO ← (QUOTE \PFLOPPY.GETFILEINFO)
GETFILENAME ← (QUOTE \PFLOPPY.GETFILENAME)
HOSTNAMEP ← (QUOTE \FLOPPY.HOSTNAMEP)
OPENFILE ← (QUOTE \PFLOPPY.OPENFILE)
READPAGES ← (QUOTE \PFLOPPY.READPAGES)
REOPENFILE ← (QUOTE \PFLOPPY.OPENFILE)
SETFILEINFO ← (QUOTE \PFLOPPY.SETFILEINFO)
TRUNCATEFILE ← (QUOTE \PFLOPPY.TRUNCATEFILE)
WRITEPAGES ← (QUOTE \PFLOPPY.WRITEPAGES)
BIN ← (QUOTE \PAGEDBIN)
BOUT ← (QUOTE \PAGEDBOUT)
PEEKBIN ← (QUOTE \PAGEDPEEKBIN)
READP ← (QUOTE \PAGEDREADP)
BACKFILEPTR ← (QUOTE \PAGEDBACKFILEPTR)
DEVICEINFO ← \PFLOPPYINFO
SETFILEPTR ← (QUOTE \PAGEDSETFILEPTR)
GETFILEPTR ← (QUOTE \PAGEDGETFILEPTR)
GETEOFPTR ← (QUOTE \PAGEDGETEOFPTR)
EOFP ← (QUOTE \PAGEDEOFP)
BLOCKIN ← (QUOTE \PAGEDBINS)
BLOCKOUT ← (QUOTE \PAGEDBOUTS)
RENAMEFILE ← (QUOTE \PFLOPPY.RENAMEFILE)
FLUSHOUTPUT ← (QUOTE \PAGED.FLUSHOUTPUT))))))
(\PFLOPPY.OPEN
(LAMBDA NIL (* kbr: " 3-Feb-84 16:33")
(* Cache directory info for floppy if not already
cached. Return T on successful open.
*)
(PROG NIL
(COND
((OR (NOT (FLOPPY.DRIVE.EXISTSP))
(NOT (FLOPPY.CAN.READP)))
(RETURN NIL)))
(COND
((fetch (PFLOPPYFDEV OPEN) of \FLOPPYFDEV) (* Already open *)
(RETURN T)))
(replace (PFLOPPYFDEV FILELIST) of \FLOPPYFDEV with NIL)
(replace (PFLOPPYFDEV PALLOCS) of \FLOPPYFDEV with NIL)
(replace (PFLOPPYFDEV DIR) of \FLOPPYFDEV with NIL)
(replace (PFLOPPYFDEV SECTOR9) of \FLOPPYFDEV with NIL)
(\PFLOPPY.START)
(\PFLOPPY.OPEN.SECTOR9)
(\PFLOPPY.OPEN.FILELIST)
(replace (PFLOPPYFDEV OPEN) of \FLOPPYFDEV with T)
(RETURN T))))
(\PFLOPPY.DOORCHECK
(LAMBDA NIL (* kbr: " 3-Feb-84 16:28")
(* Verify original floppy (corresponding to cached dir info) still present in drive. If not, open new floppy and
cache new dir info. If either of these actions succeeds, return T. *)
(PROG NIL
(\FLOPPY.NOP)
(COND
((fetch (RESULT DOOROPENED) of \FLOPPYRESULT)
(\FLOPPY.CLOSE)))
(COND
((NOT (FLOPPY.CAN.READP))
(RETURN NIL)))
(RETURN (\PFLOPPY.OPEN)))))
(\PFLOPPY.START
(LAMBDA NIL (* kbr: " 3-Feb-84 16:28")
(PROG NIL
(\FLOPPY.INITIALIZE)
(\FLOPPY.RECALIBRATE))))
(\PFLOPPY.OPEN.SECTOR9
(LAMBDA NIL (* kbr: " 3-Feb-84 16:28")
(PROG (SECTOR9)
RETRY
(SETQ SECTOR9 (\PFLOPPY.GET.SECTOR9))
(COND
((NULL SECTOR9)
(\FLOPPY.BREAK "Not a pilot floppy")
(GO RETRY)))
(replace (PFLOPPYFDEV SECTOR9) of \FLOPPYFDEV with SECTOR9))))
(\PFLOPPY.GET.SECTOR9
(LAMBDA NIL (* kbr: " 3-Feb-84 16:28")
(* Gets SECTOR9 of a Pilot floppy.
Returns NIL if not a Pilot floppy.
*)
(PROG (SECTOR9) (* Read SECTOR9. *)
(GLOBALRESOURCE \FLOPPY.IBMS128.IOCB
(SETQ SECTOR9
(\FLOPPY.READSECTOR \FLOPPY.IBMS128.IOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 0
SECTOR ← 9)
(NCREATE (QUOTE SECTOR9))
T))) (* Return answer. *)
(COND
((AND SECTOR9 (fetch (SECTOR9 INTACT) of SECTOR9))
(RETURN SECTOR9))
(T (RETURN NIL))))))
(\PFLOPPY.OPEN.FILELIST
(LAMBDA NIL (* kbr: " 3-Feb-84 16:28")
(PROG (SECTOR9 FILELIST FILENAME MP LP PALLOC PALLOCS)
RETRY
(SETQ SECTOR9 (fetch (PFLOPPYFDEV SECTOR9) of \FLOPPYFDEV))
(SETQ FILELIST (\PFLOPPY.CREATE.FILELIST 2))
(replace (PFLOPPYFDEV FILELIST) of \FLOPPYFDEV with FILELIST)
(replace (SECTOR9 NEXTUNUSEDFILEID) of SECTOR9 with 1)
(for (START ← 32) by (IPLUS START (fetch (MP NLENGTH) of MP)
1)
do (SETQ MP (NCREATE (QUOTE MP)))
(\PFLOPPY.READPAGENO (SUB1 START)
MP)
(COND
((NOT (fetch (MP INTACT) of MP))
(\FLOPPY.BREAK "Damaged floppy. Needs scavenging.")
(SETQ PALLOCS NIL)
(GO RETRY)))
(COND
((EQ (fetch (MP NFILETYPE) of MP)
FILETYPE.FILE)
(SETQ LP (NCREATE (QUOTE LP)))
(\PFLOPPY.READPAGENO START LP)
(COND
((NOT (fetch (LP INTACT) of LP))
(\FLOPPY.BREAK "Damaged floppy. Needs scavenging.")
(SETQ PALLOCS NIL)
(GO RETRY)))
(SETQ FILENAME (fetch (LP $NAME) of LP)))
(T (SETQ LP NIL)
(SETQ FILENAME (LIST (fetch (MP $NFILETYPE) of MP)))))
(SETQ PALLOC (create PALLOC
FILENAME ← FILENAME
START ← START
MP ← MP
LP ← LP))
(COND
((NOT (EQ (fetch (MP NFILETYPE) of MP)
FILETYPE.FREE))
(\PFLOPPY.ADD.TO.FILELIST PALLOC)))
(push PALLOCS PALLOC)
(COND
((IEQP START (ADD1 2310))
(RETURN))))
(SETQ PALLOCS (DREVERSE PALLOCS))
(for PREV in PALLOCS as NEXT in (CDR PALLOCS) while NEXT
do (replace (PALLOC NEXT) of PREV with NEXT)
(replace (PALLOC PREV) of NEXT with PREV))
(replace (PFLOPPYFDEV PALLOCS) of \FLOPPYFDEV with PALLOCS)
(* We create the directory last because PACKFILENAME is brittle and it is nice to have the other info already
filled in if you have to debug. *)
(for PALLOC in PALLOCS when (EQ (fetch (PALLOC FILETYPE) of PALLOC)
FILETYPE.FILE)
do (\PFLOPPY.DIR.PUT (fetch (PALLOC FILENAME) of PALLOC)
(QUOTE OLD)
PALLOC)))))
(\PFLOPPY.OPENFILE
(LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* kbr: " 3-Feb-84 16:54")
(PROG (STREAM WAIT PALLOC FULLFILENAME)
(SETQ OTHERINFO (\FLOPPY.OTHERINFO OTHERINFO))
RETRY (* Get STREAM *)
(COND
((\PFLOPPY.DOORCHECK)
(COND
((AND (NOT (EQ ACCESS (QUOTE INPUT)))
(NOT (FLOPPY.CAN.WRITEP)))
(\FLOPPY.MESSAGE (QUOTE WRITEPROTECTED))
(LISPERROR "FILE WON'T OPEN" "")
(GO RETRY)))
(COND
((NOT (type? STREAM FILE))
(SETQ STREAM (\PFLOPPY.OPENFILE1 FILE RECOG OTHERINFO)))
(T (SETQ STREAM FILE)))))
(COND
((NULL STREAM) (* FILE NOT FOUND error generated in \OPENFILE when we
return NIL. *)
(RETURN NIL))) (* Establish ACCESS rights. *)
(SETQ PALLOC (fetch (FLOPPYSTREAM PALLOC) of STREAM))
(COND
((NOT (EQ ACCESS (QUOTE INPUT)))
(* WRITEFLG indicates whether FILE is currently being written. Impossible for more than one stream to point to a
file that is being written. *)
(SETQ WAIT (CDR (ASSOC (QUOTE WAIT)
OTHERINFO)))
(COND
(WAIT (while (\PFLOPPY.STREAMS.AGAINST STREAM) do (BLOCK))
(replace (PALLOC WRITEFLG) of PALLOC with T))
((fetch (PALLOC WRITEFLG) of PALLOC)
(SETQ FULLFILENAME (fetch (STREAM FULLFILENAME) of STREAM))
(SETQ FILE (LISPERROR "FILE WON'T OPEN" FULLFILENAME T))
(GO RETRY))) (* Use OTHERINFO to establish correct CREATIONDATE etc.
*)
(for BUCKET in OTHERINFO do (\PFLOPPY.SETFILEINFO STREAM (CAR BUCKET)
(CDR BUCKET)))))
(COND
((EQ ACCESS (QUOTE OUTPUT)) (* ACCESS = OUTPUT always starts empty.
*)
(replace (STREAM EPAGE) of STREAM with 0)
(replace (STREAM EOFFSET) of STREAM with 0)))
(RETURN STREAM))))
(\PFLOPPY.OPENFILE1
(LAMBDA (FILE RECOG OTHERINFO) (* kbr: " 3-Feb-84 16:28")
(WITH.MONITOR \FLOPPYLOCK (PROG (FILENAME EXTENSION PALLOC LP IDATE STREAM)
RETRY (* Case where old FILE is being opened for output or
appending to be written *)
(SETQ FILENAME (\FLOPPY.ASSUREFILENAME FILE))
(SETQ PALLOC (\PFLOPPY.DIR.GET FILENAME RECOG))
(SETQ STREAM (SELECTQ RECOG
((EXACT OLD/NEW)
(COND
((NULL PALLOC)
(\PFLOPPY.OPENNEWFILE FILENAME
OTHERINFO))
(T (\PFLOPPY.OPENOLDFILE PALLOC))))
(NEW (COND
((NULL PALLOC)
(\PFLOPPY.OPENNEWFILE FILENAME
OTHERINFO))))
((OLD OLDEST)
(\PFLOPPY.OPENOLDFILE PALLOC))
(SHOULDNT)))
(COND
((NULL STREAM)
(SELECTQ RECOG
((NEW OLD/NEW)
(SETQ FILENAME (LISPERROR "FILE WON'T OPEN"
FILENAME T)))
(PROGN (* "FILE NOT FOUND" error is generated in \OPENFILE by
our returning NIL *)
(RETURN NIL)))
(GO RETRY)))
(RETURN STREAM)))))
(\PFLOPPY.OPENOLDFILE
(LAMBDA (PALLOC) (* kbr: " 3-Feb-84 16:28")
(PROG (LP STREAM)
(COND
((NULL PALLOC) (* Error in calling function.
*)
(RETURN NIL)))
(SETQ LP (fetch (PALLOC LP) of PALLOC))
(SETQ STREAM (create STREAM
DEVICE ← \FLOPPYFDEV
FULLFILENAME ← (\FLOPPY.ADDDEVICENAME (fetch (PALLOC FILENAME)
of PALLOC))
EPAGE ← (IQUOTIENT (fetch (LP LENGTH) of LP)
512)
EOFFSET ← (IREMAINDER (fetch (LP LENGTH) of LP)
512)))
(replace (FLOPPYSTREAM PALLOC) of STREAM with PALLOC)
(replace (FLOPPYSTREAM LP) of STREAM with LP)
(RETURN STREAM))))
(\PFLOPPY.OPENNEWFILE
(LAMBDA (FILENAME OTHERINFO) (* kbr: " 3-Feb-84 16:28")
(PROG (LENGTH PALLOC LP IDATE STREAM)
(SETQ LENGTH (CDR (ASSOC (QUOTE LENGTH)
OTHERINFO)))
(COND
(LENGTH (SETQ LENGTH (ADD1 (IQUOTIENT (IPLUS LENGTH 511)
512)))))
(SETQ PALLOC (\PFLOPPY.ALLOCATE LENGTH))
(\PFLOPPY.DIR.PUT FILENAME (QUOTE NEW)
PALLOC) (* ICREATIONDATE defaults to IWRITEDATE.
TBW: Should put in check for length of FILENAME.
*)
(SETQ IDATE (IDATE))
(SETQ LP (create LP
ICREATIONDATE ← IDATE
IWRITEDATE ← IDATE))
(replace (LP $NAME) of LP with (MKSTRING (fetch (PALLOC FILENAME) of PALLOC)))
(replace (PALLOC LP) of PALLOC with LP)
(\PFLOPPY.ADD.TO.FILELIST PALLOC) (* File is empty *)
(SETQ STREAM (create STREAM
DEVICE ← \FLOPPYFDEV
FULLFILENAME ← (\FLOPPY.ADDDEVICENAME (fetch (PALLOC FILENAME)
of PALLOC))
EPAGE ← 0
EOFFSET ← 0))
(replace (FLOPPYSTREAM PALLOC) of STREAM with PALLOC)
(replace (FLOPPYSTREAM LP) of STREAM with (fetch (PALLOC LP) of PALLOC))
(RETURN STREAM))))
(\PFLOPPY.ASSURESTREAM
(LAMBDA (FILE) (* kbr: " 3-Feb-84 16:28")
(PROG (STREAM)
RETRY
(COND
((type? STREAM FILE)
(RETURN FILE)))
(SETQ STREAM (\PFLOPPY.OPENFILE1 FILE (QUOTE OLD)))
(COND
((NULL STREAM)
(SETQ FILE (LISPERROR "FILE NOT FOUND" FILE))
(GO RETRY)))
(RETURN STREAM))))
(\PFLOPPY.GETFILEINFO
(LAMBDA (FILE ATTRIBUTE FDEV) (* kbr: " 3-Feb-84 16:28")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM LP ANSWER)
(\PFLOPPY.DOORCHECK)
(SETQ STREAM (\PFLOPPY.ASSURESTREAM FILE))
(COND
(STREAM (SETQ LP (fetch (FLOPPYSTREAM LP) of STREAM))
(* Wizard incantations: PAGELENGTH, HUGEPAGESTART,
HUGEPAGELENGTH, HUGELENGTH *)
(SETQ ANSWER (SELECTQ ATTRIBUTE
(WRITEDATE (fetch (LP WRITEDATE)
of LP))
(CREATIONDATE
(fetch (LP CREATIONDATE)
of LP))
(IWRITEDATE (fetch (LP IWRITEDATE)
of LP))
(ICREATIONDATE
(fetch (LP ICREATIONDATE)
of LP))
(LENGTH (fetch (LP LENGTH)
of LP))
(MESATYPE (fetch (LP MESATYPE)
of LP))
(PAGELENGTH (fetch (LP PAGELENGTH)
of LP))
(HUGEPAGESTART
(fetch (LP HUGEPAGESTART)
of LP))
(HUGEPAGELENGTH
(fetch (LP HUGEPAGELENGTH)
of LP))
(HUGELENGTH (fetch (LP HUGELENGTH)
of LP))
NIL))))
(RETURN ANSWER)))))
(\PFLOPPY.SETFILEINFO
(LAMBDA (FILE ATTRIBUTE VALUE) (* kbr: " 3-Feb-84 16:28")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM LP)
(\PFLOPPY.DOORCHECK)
(SETQ STREAM (\PFLOPPY.ASSURESTREAM FILE))
(COND
(STREAM (SETQ LP (fetch (FLOPPYSTREAM LP) of STREAM))
(SELECTQ ATTRIBUTE
(WRITEDATE (replace (LP WRITEDATE)
of LP with VALUE))
(CREATIONDATE (replace (LP CREATIONDATE)
of LP with VALUE))
(IWRITEDATE (replace (LP IWRITEDATE)
of LP with VALUE))
(ICREATIONDATE (replace (LP ICREATIONDATE)
of LP with VALUE))
(LENGTH
(* Request refused. *))
(MESATYPE (replace (LP MESATYPE) of LP
with VALUE))
(PAGELENGTH (replace (LP PAGELENGTH)
of LP with VALUE))
(HUGEPAGESTART (replace (LP HUGEPAGESTART)
of LP with VALUE))
(HUGEPAGELENGTH (replace (LP HUGEPAGELENGTH)
of LP with VALUE))
(HUGELENGTH (replace (LP HUGELENGTH)
of LP with VALUE))
NIL)
(COND
((OPENP STREAM)
(* LP will be written out to floppy when STREAM is
closed. *)
)
(T (\PFLOPPY.WRITEPAGENO (fetch (PALLOC START)
of (fetch (FLOPPYSTREAM
PALLOC)
of STREAM))
LP)))))))))
(\PFLOPPY.CLOSEFILE
(LAMBDA (FILE) (* kbr: " 3-Feb-84 16:28")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM FULLFILENAME)
(SETQ STREAM (\PFLOPPY.ASSURESTREAM FILE))
(RELEASECPAGE STREAM)
(\CLEARMAP STREAM)
(SETQ FULLFILENAME (\PFLOPPY.CLOSEFILE1 STREAM))
(RETURN FULLFILENAME)))))
(\PFLOPPY.CLOSEFILE1
(LAMBDA (STREAM) (* kbr: " 3-Feb-84 16:28")
(* The real CLOSEFILE. *)
(* Part of \PFLOPPY.CLOSEFILE needed to close
subportions of huge files. *)
(PROG (PALLOC MP NEXT NMP FULLFILENAME)
(SETQ PALLOC (fetch (FLOPPYSTREAM PALLOC) of STREAM))
(SETQ FULLFILENAME (fetch (STREAM FULLFILENAME) of STREAM))
(COND
((EQ (fetch (STREAM ACCESS) of STREAM)
(QUOTE INPUT))
(RETURN FULLFILENAME))) (* Best place to fail is in trying to write LP.
TBW: FILE WON'T CLOSE error message? *)
(COND
((NULL (\PFLOPPY.WRITEPAGENO (fetch (PALLOC START) of PALLOC)
(fetch (PALLOC LP) of PALLOC)))
(RETURN NIL))) (* Ignore any errors now. *)
(SETQ MP (fetch (PALLOC MP) of PALLOC))
(SETQ NEXT (fetch (PALLOC NEXT) of PALLOC))
(SETQ NMP (PALLOC.MP NEXT))
(UNINTERRUPTABLY
(replace (MP NTYPE) of MP with MPETYPE.FILE)
(replace (MP NFILETYPE) of MP with FILETYPE.FILE)
(replace (MP PTYPE) of NMP with MPETYPE.FILE)
(replace (MP PFILETYPE) of NMP with FILETYPE.FILE)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PALLOC START) of PALLOC))
MP T)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PALLOC START) of NEXT))
NMP T)
(\PFLOPPY.SAVE.FILELIST T)
(\PFLOPPY.SAVE.SECTOR9 T)) (* Release STREAM. *)
(replace (PALLOC WRITEFLG) of PALLOC with NIL)
(COND
((fetch (PALLOC DELETEFLG) of PALLOC)
(\PFLOPPY.DELETEFILE STREAM)))
(RETURN FULLFILENAME))))
(\PFLOPPY.DELETEFILE
(LAMBDA (FILE FDEV) (* kbr: " 3-Feb-84 16:29")
(WITH.MONITOR \FLOPPYLOCK (PROG (FILENAME PALLOC MP NEXT NMP FULLFILENAME)
(\PFLOPPY.OPEN)
(SETQ FILENAME (\FLOPPY.ASSUREFILENAME FILE))
(SETQ PALLOC (\PFLOPPY.DIR.GET FILENAME (QUOTE OLDEST)))
(COND
((NULL PALLOC) (* File not found. *)
(* Returning NIL means unsuccessful.
*)
(RETURN NIL)))
(SETQ FULLFILENAME (\FLOPPY.ADDDEVICENAME (fetch (PALLOC FILENAME)
of PALLOC)))
(COND
((\PFLOPPY.STREAMS.USING PALLOC)
(* Make deletion pending. *)
(replace (PALLOC DELETEFLG) of PALLOC with T))
(T (* Carry out deletion. *)
(replace (PALLOC DELETEFLG) of PALLOC with NIL)
(\PFLOPPY.DIR.REMOVE PALLOC)
(\PFLOPPY.DEALLOCATE PALLOC)
(\PFLOPPY.DELETE.FROM.FILELIST PALLOC)
(\PFLOPPY.SAVE.FILELIST)))
(RETURN FULLFILENAME)))))
(\PFLOPPY.GETFILENAME
(LAMBDA (FILE RECOG FDEV) (* kbr: " 3-Feb-84 16:29")
(WITH.MONITOR \FLOPPYLOCK (PROG (FILENAME PALLOC)
(COND
((type? STREAM FILE)
(RETURN (fetch (STREAM FULLFILENAME) of FILE))))
(COND
((AND (FLOPPY.DRIVE.EXISTSP)
(\PFLOPPY.DOORCHECK))
(SETQ FILENAME (\FLOPPY.ASSUREFILENAME FILE))
(SETQ PALLOC (\PFLOPPY.DIR.GET FILENAME RECOG))
(COND
((NULL PALLOC)
(RETURN NIL)))
(RETURN (\FLOPPY.ADDDEVICENAME (fetch (PALLOC FILENAME)
of PALLOC)))))
(* NIL is returned if there is no floppy.
*)
))))
(\PFLOPPY.GENERATEFILES
(LAMBDA (FDEV PATTERN) (* kbr: " 3-Feb-84 16:29")
(WITH.MONITOR \FLOPPYLOCK (PROG (FILES GENFILESTATE FILEGENOBJ)
(* No floppy gives empty directory so that {FLOPPY} can
safely be on DIRECTORIES search path.
*)
(COND
((AND (FLOPPY.DRIVE.EXISTSP)
(\PFLOPPY.DOORCHECK)
(SETQ FILES (SORT (for PALLOC in (fetch (PFLOPPYFDEV
PALLOCS)
of \FLOPPYFDEV)
when (LITATOM (fetch (PALLOC
FILENAME)
of PALLOC))
collect (fetch (PALLOC FILENAME)
of PALLOC)))))))
(SETQ GENFILESTATE (create GENFILESTATE
FILES ← FILES
DEVICENAME ← (fetch (FDEV DEVICENAME)
of FDEV)))
(SETQ FILEGENOBJ (create FILEGENOBJ
NEXTFILEFN ← (FUNCTION
\PFLOPPY.GENERATEFILES1)
GENFILESTATE ← GENFILESTATE))
(RETURN FILEGENOBJ)))))
(\PFLOPPY.GENERATEFILES1
(LAMBDA (GENFILESTATE SCRATCHLIST NOVERSION HOST/DIR) (* kbr: " 3-Feb-84 16:29")
(* Passes back list of char codes naming file in
SCRATCHLIST and updates GENFILESTATE.
Used by \PFLOPPY.GENERATEFILES.
*)
(PROG (FILES FILE DEVICENAME ANSWER)
(SETQ FILES (fetch (GENFILESTATE FILES) of GENFILESTATE))
(COND
((NULL FILES)
(RETURN)))
(SETQ FILE (pop FILES))
(SETQ DEVICENAME (fetch (GENFILESTATE DEVICENAME) of GENFILESTATE))
(SETQ ANSWER (SCRATCHLIST SCRATCHLIST (COND
(HOST/DIR (ADDTOSCRATCHLIST (CHARCODE {))
(for C in (CHCON DEVICENAME) do (ADDTOSCRATCHLIST
C))
(ADDTOSCRATCHLIST (CHARCODE }))))
(for C in (CHCON FILE) do (ADDTOSCRATCHLIST C))))
(replace (GENFILESTATE FILES) of GENFILESTATE with FILES)
(RETURN ANSWER))))
(\PFLOPPY.RENAMEFILE
(LAMBDA (OLDFILE NEWFILE FDEV) (* kbr: " 3-Feb-84 16:29")
(WITH.MONITOR \FLOPPYLOCK (PROG (OLDFILENAME NEWFILENAME PALLOC LP FULLFILENAME)
(\PFLOPPY.OPEN)
(SETQ OLDFILENAME (\FLOPPY.ASSUREFILENAME OLDFILE))
(SETQ NEWFILENAME (\FLOPPY.ASSUREFILENAME NEWFILE))
(SETQ PALLOC (\PFLOPPY.DIR.GET OLDFILENAME (QUOTE OLD)))
(COND
((NULL PALLOC) (* File not found. *)
(* Returning NIL means unsuccessful.
*)
(RETURN NIL)))
(\PFLOPPY.DIR.REMOVE PALLOC)
(\PFLOPPY.DIR.PUT NEWFILENAME (QUOTE NEW)
PALLOC)
(SETQ LP (fetch (PALLOC LP) of PALLOC))
(* TBW: If new file name too long.
*)
(replace (LP $NAME) of LP with (fetch (PALLOC FILENAME)
of PALLOC))
(\PFLOPPY.WRITEPAGENO (fetch (PALLOC START) of PALLOC)
LP)
(SETQ FULLFILENAME (\FLOPPY.ADDDEVICENAME (fetch (PALLOC FILENAME)
of PALLOC)))
(RETURN FULLFILENAME)))))
(\PFLOPPY.STREAMS.AGAINST
(LAMBDA (STREAM) (* kbr: " 3-Feb-84 16:29")
(* Return other open floppy streams with same PALLOC.
*)
(for F in \OPENFILES when (AND (EQ (fetch (STREAM DEVICE) of F)
\FLOPPYFDEV)
(EQ (fetch (FLOPPYSTREAM PALLOC) of F)
(fetch (FLOPPYSTREAM PALLOC) of STREAM))
(NOT (EQ F STREAM)))
collect F)))
(\PFLOPPY.STREAMS.USING
(LAMBDA (PALLOC) (* kbr: " 3-Feb-84 16:29")
(* Return open floppy streams with this PALLOC.
*)
(for F in \OPENFILES when (AND (EQ (fetch (STREAM DEVICE) of F)
\FLOPPYFDEV)
(EQ (fetch (FLOPPYSTREAM PALLOC) of F)
PALLOC))
collect F)))
(\PFLOPPY.READPAGES
(LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* kbr: " 3-Feb-84 16:29")
(PROG NIL
(for BUFFER in (MKLIST BUFFERS) as I from 0 do (\PFLOPPY.READPAGE STREAM (IPLUS FIRSTPAGE#
I)
BUFFER)))))
(\PFLOPPY.READPAGE
(LAMBDA (FILE FIRSTPAGE# BUFFER) (* kbr: " 3-Feb-84 16:29")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM PALLOC PAGENO)
(SETQ STREAM (\PFLOPPY.ASSURESTREAM FILE))
(SETQ PALLOC (fetch (FLOPPYSTREAM PALLOC) of STREAM))
(SETQ PAGENO (IPLUS (fetch (PALLOC START) of PALLOC)
1 FIRSTPAGE#))
(COND
((IGREATERP FIRSTPAGE# (fetch (STREAM EPAGE) of STREAM))
(* Don't bother to do actual read.
*)
(COND
((IGREATERP PAGENO (fetch (PALLOC END) of PALLOC))
(* Typically (because of lisp page buffering) we will try to write to PAGENO in the very near future.
It's easier for the user to confront FILE SYSTEM RESOURCES EXCEEDED if we reallocate now instead of later.
*)
(\PFLOPPY.EXTEND PALLOC)))
(RETURN)))
(\PFLOPPY.READPAGENO PAGENO BUFFER)))
(BLOCK)))
(\PFLOPPY.WRITEPAGENO
(LAMBDA (PAGENO PAGE NOERROR) (* kbr: " 3-Feb-84 16:29")
(PROG (ANSWER) (* Write page. *)
(GLOBALRESOURCE \FLOPPY.IBMD512.IOCB (SETQ ANSWER (COND
((OR (ILESSP PAGENO 1)
(IGREATERP PAGENO 2310))
(\FLOPPY.SEVERE.ERROR "Illegal Write Page Number")
NIL)
(T (\FLOPPY.WRITESECTOR \FLOPPY.IBMD512.IOCB (
\PFLOPPY.PAGENOTODISKADDRESS PAGENO)
PAGE NOERROR)))))
(* Return ANSWER (PAGE or NIL) *)
(RETURN ANSWER))))
(\PFLOPPY.READPAGENO
(LAMBDA (PAGENO PAGE NOERROR) (* kbr: " 3-Feb-84 16:29")
(PROG (ANSWER) (* Read page. *)
(GLOBALRESOURCE \FLOPPY.IBMD512.IOCB (SETQ ANSWER (COND
((OR (ILESSP PAGENO 1)
(IGREATERP PAGENO 2310))
(\FLOPPY.SEVERE.ERROR "Illegal Read Page Number")
NIL)
(T (\FLOPPY.READSECTOR \FLOPPY.IBMD512.IOCB (
\PFLOPPY.PAGENOTODISKADDRESS PAGENO)
PAGE NOERROR)))))
(* Return ANSWER (PAGE or NIL) *)
(RETURN ANSWER))))
(\PFLOPPY.PAGENOTODISKADDRESS
(LAMBDA (PAGENO) (* kbr: " 3-Feb-84 16:29")
(PROG (QUOTIENT CYLINDER HEAD SECTOR DISKADDRESS)
(SETQ SECTOR (ADD1 (IREMAINDER (SUB1 PAGENO)
SECTORSPERTRACK)))
(SETQ QUOTIENT (IQUOTIENT (SUB1 PAGENO)
SECTORSPERTRACK))
(SETQ HEAD (IREMAINDER QUOTIENT TRACKSPERCYLINDER))
(SETQ CYLINDER (IQUOTIENT QUOTIENT TRACKSPERCYLINDER))
(SETQ DISKADDRESS (create DISKADDRESS
SECTOR ← SECTOR
HEAD ← HEAD
CYLINDER ← CYLINDER))
(RETURN DISKADDRESS))))
(\PFLOPPY.DISKADDRESSTOPAGENO
(LAMBDA (DISKADDRESS) (* kbr: " 3-Feb-84 16:29")
(PROG (PAGENO)
(SETQ PAGENO (IPLUS (fetch (DISKADDRESS SECTOR) of DISKADDRESS)
(ITIMES SECTORSPERTRACK (IPLUS (fetch (DISKADDRESS HEAD) of DISKADDRESS)
(ITIMES TRACKSPERCYLINDER
(fetch (DISKADDRESS CYLINDER)
of DISKADDRESS))))))
(RETURN PAGENO))))
(\PFLOPPY.DIR.GET
(LAMBDA (FILENAME RECOG) (* kbr: " 3-Feb-84 16:29")
(PROG (UNAME NALIST EALIST VALIST NAME EXTENSION VERSION PALLOC)
(COND
((NOT (EQ RECOG (QUOTE EXACT)))
(SETQ UNAME (UNPACKFILENAME FILENAME))
(SETQ VERSION (U-CASE (LISTGET UNAME (QUOTE VERSION))))
(SETQ NAME (U-CASE (LISTGET UNAME (QUOTE NAME))))
(SETQ EXTENSION (U-CASE (LISTGET UNAME (QUOTE EXTENSION))))
(SETQ NALIST (fetch (PFLOPPYFDEV DIR) of \FLOPPYFDEV))
(SETQ EALIST (CDR (ASSOC NAME NALIST)))
(SETQ VALIST (CDR (ASSOC EXTENSION EALIST)))
(SETQ VERSION (\PFLOPPY.DIR.VERSION VERSION RECOG VALIST))
(SETQ PALLOC (CDR (ASSOC VERSION VALIST))))
(T (SETQ PALLOC (for PALLOC in (fetch (PFLOPPYFDEV PALLOCS) of \FLOPPYFDEV)
thereis (EQ (fetch (PALLOC FILENAME) of PALLOC)
FILENAME)))))
(RETURN PALLOC))))
(\PFLOPPY.DIR.PUT
(LAMBDA (FILENAME RECOG PALLOC) (* kbr: " 3-Feb-84 16:29")
(PROG (UNAME NALIST EALIST VALIST NAME EXTENSION VERSION)
(SETQ UNAME (UNPACKFILENAME FILENAME))
(SETQ VERSION (U-CASE (LISTGET UNAME (QUOTE VERSION))))
(SETQ NAME (U-CASE (LISTGET UNAME (QUOTE NAME))))
(SETQ EXTENSION (U-CASE (LISTGET UNAME (QUOTE EXTENSION))))
(SETQ NALIST (fetch (PFLOPPYFDEV DIR) of \FLOPPYFDEV))
(SETQ EALIST (CDR (ASSOC NAME NALIST)))
(SETQ VALIST (CDR (ASSOC EXTENSION EALIST)))
(SETQ VERSION (\PFLOPPY.DIR.VERSION VERSION RECOG VALIST))
(LISTPUT UNAME (QUOTE VERSION)
VERSION)
(LISTPUT UNAME (QUOTE HOST)
NIL)
(SETQ FILENAME (PACKFILENAME UNAME))
(replace (PALLOC FILENAME) of PALLOC with FILENAME)
(SETQ VALIST (\FLOPPY.LEXPUTASSOC VERSION PALLOC VALIST))
(SETQ EALIST (\FLOPPY.LEXPUTASSOC EXTENSION VALIST EALIST))
(SETQ NALIST (\FLOPPY.LEXPUTASSOC NAME EALIST NALIST))
(replace (PFLOPPYFDEV DIR) of \FLOPPYFDEV with NALIST)
(RETURN PALLOC))))
(\PFLOPPY.DIR.REMOVE
(LAMBDA (PALLOC) (* kbr: " 3-Feb-84 16:29")
(PROG (FILENAME UNAME NALIST EALIST VALIST NAME EXTENSION VERSION)
(SETQ FILENAME (fetch (PALLOC FILENAME) of PALLOC))
(SETQ UNAME (UNPACKFILENAME FILENAME))
(SETQ VERSION (U-CASE (LISTGET UNAME (QUOTE VERSION))))
(SETQ NAME (U-CASE (LISTGET UNAME (QUOTE NAME))))
(SETQ EXTENSION (U-CASE (LISTGET UNAME (QUOTE EXTENSION))))
(SETQ NALIST (fetch (PFLOPPYFDEV DIR) of \FLOPPYFDEV))
(SETQ EALIST (CDR (ASSOC NAME NALIST)))
(SETQ VALIST (CDR (ASSOC EXTENSION EALIST)))
(SETQ VERSION (\PFLOPPY.DIR.VERSION VERSION (QUOTE OLD)
VALIST))
(SETQ VALIST (\FLOPPY.LEXREMOVEASSOC VERSION VALIST))
(COND
(VALIST (SETQ EALIST (\FLOPPY.LEXPUTASSOC EXTENSION VALIST EALIST))
(SETQ NALIST (\FLOPPY.LEXPUTASSOC NAME EALIST NALIST)))
(T (SETQ EALIST (\FLOPPY.LEXREMOVEASSOC EXTENSION EALIST))
(COND
(EALIST (SETQ NALIST (\FLOPPY.LEXPUTASSOC NAME EALIST NALIST)))
(T (SETQ NALIST (\FLOPPY.LEXREMOVEASSOC NAME NALIST))))))
(replace (PFLOPPYFDEV DIR) of \FLOPPYFDEV with NALIST)
(RETURN PALLOC))))
(\PFLOPPY.DIR.VERSION
(LAMBDA (VERSION RECOG VALIST) (* kbr: " 3-Feb-84 16:29")
(PROG NIL
(COND
((EQ RECOG (QUOTE OLD/NEW))
(COND
(VALIST (SETQ RECOG (QUOTE OLD)))
(T (SETQ RECOG (QUOTE NEW))))))
(COND
((NULL VERSION)
(SELECTQ RECOG
(NEW (COND
((NULL VALIST)
(SETQ VERSION 1))
(T (SETQ VERSION (CAAR (LAST VALIST)))
(COND
((NUMBERP VERSION)
(SETQ VERSION (ADD1 VERSION)))))))
(OLD (SETQ VERSION (CAAR (LAST VALIST))))
(OLDEST (SETQ VERSION (CAAR VALIST)))
(EXACT (* No version. *))
(SHOULDNT))))
(RETURN VERSION))))
(\PFLOPPY.CREATE.FILELIST
(LAMBDA (NPAGES) (* kbr: " 3-Feb-84 16:29")
(PROG (FILELIST) (* Must be page aligned integral number of pages.
*)
(SETQ FILELIST (\ALLOCBLOCK (ITIMES 128 NPAGES)
NIL 128))
(replace (FILELIST SEAL) of FILELIST with SEAL.FILELIST)
(replace (FILELIST VERSION) of FILELIST with VERSION.FILELIST)
(replace (FILELIST MAXENTRIES) of FILELIST with (IQUOTIENT (IDIFFERENCE (ITIMES 256 NPAGES)
4)
5))
(RETURN FILELIST))))
(\PFLOPPY.ADD.TO.FILELIST
(LAMBDA (PALLOC) (* kbr: " 3-Feb-84 16:29")
(PROG (SECTOR9 FILELIST FLE NENTRIES NPAGES NEWFILELIST NEXT MP NMP)
(SETQ SECTOR9 (fetch (PFLOPPYFDEV SECTOR9) of \FLOPPYFDEV))
(SETQ FILELIST (fetch (PFLOPPYFDEV FILELIST) of \FLOPPYFDEV))
(* Create FLE. *)
(SETQ FLE (create FLE
FILEID ← (fetch (SECTOR9 NEXTUNUSEDFILEID) of SECTOR9)
TYPE ← (fetch (PALLOC FILETYPE) of PALLOC)
START ← (fetch (PALLOC START) of PALLOC)
LENGTH ← (fetch (PALLOC LENGTH) of PALLOC)))
(replace (SECTOR9 NEXTUNUSEDFILEID) of SECTOR9 with (ADD1 (fetch (SECTOR9 NEXTUNUSEDFILEID)
of SECTOR9)))
(replace (PALLOC FLE) of PALLOC with FLE) (* Add FLE to FILELIST. *)
(SETQ NENTRIES (fetch (FILELIST NENTRIES) of FILELIST))
(COND
((IEQP NENTRIES (fetch (FILELIST MAXENTRIES) of FILELIST))
(* First increase size of FILELIST)
(SETQ NPAGES (fetch (FILELIST NPAGES) of FILELIST))
(SETQ NEWFILELIST (\PFLOPPY.CREATE.FILELIST (ADD1 NPAGES)))
(\BLT NEWFILELIST FILELIST (ITIMES 256 NPAGES))
(SETQ FILELIST NEWFILELIST)
(replace (PFLOPPYFDEV FILELIST) of \FLOPPYFDEV with FILELIST)
(* Now allocate larger block on floppy.
*)
(SETQ PALLOC (\PFLOPPY.ALLOCATE NPAGES))
(\PFLOPPY.DEALLOCATE (for PALLOC in (fetch (PFLOPPYFDEV PALLOCS) of \FLOPPYFDEV)
thereis (EQUAL (fetch (PALLOC FILENAME) of PALLOC)
(QUOTE (FILELIST)))))
(SETQ NEXT (fetch (PALLOC NEXT) of PALLOC))
(SETQ MP (fetch (PALLOC MP) of PALLOC))
(SETQ NMP (fetch (PALLOC MP) of NEXT))
(SETQ SECTOR9 (fetch (PFLOPPYFDEV SECTOR9) of \FLOPPYFDEV))
(UNINTERRUPTABLY
(replace (PALLOC FILENAME) of PALLOC with (QUOTE (FILELIST)))
(replace (MP NTYPE) of MP with MPETYPE.FILELIST)
(replace (MP NFILETYPE) of MP with FILETYPE.FILELIST)
(replace (MP PTYPE) of NMP with MPETYPE.FILELIST)
(replace (MP PFILETYPE) of NMP with FILETYPE.FILELIST)
(replace (SECTOR9 FILELISTSTART) of SECTOR9 with (fetch (PALLOC START)
of PALLOC))
(replace (SECTOR9 FILELISTLENGTH) of SECTOR9 with NPAGES)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PALLOC START) of PALLOC))
MP T)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PALLOC START) of NEXT))
NMP T)
(\PFLOPPY.SAVE.FILELIST T)
(\PFLOPPY.SAVE.SECTOR9 T))))
(\MOVEWORDS FLE 0 FILELIST (IPLUS 4 (ITIMES 5 NENTRIES))
5)
(replace (FILELIST NENTRIES) of FILELIST with (ADD1 NENTRIES)))))
(\PFLOPPY.DELETE.FROM.FILELIST
(LAMBDA (PALLOC) (* kbr: " 3-Feb-84 16:29")
(PROG (FILELIST FLE FILEID NENTRIES)
(SETQ FILELIST (fetch (PFLOPPYFDEV FILELIST) of \FLOPPYFDEV))
(SETQ FLE (fetch (PALLOC FLE) of PALLOC))
(SETQ FILEID (fetch (FLE FILEID) of FLE))
(SETQ NENTRIES (fetch (FILELIST NENTRIES) of FILELIST))
(* Delete FLE from FILELIST. *)
(for I from 1 to NENTRIES when (IEQP (\FLOPPY.MTL.FIXP (\GETBASEFIXP FILELIST
(IPLUS 4
(ITIMES 5 I))))
FILEID)
do (SETQ NENTRIES (SUB1 NENTRIES))
(\MOVEWORDS FILELIST (IPLUS 4 (ITIMES 5 NENTRIES))
FILELIST
(IPLUS 4 (ITIMES 5 I))
5)
(\ZEROWORDS (\ADDBASE FILELIST (IPLUS 4 (ITIMES 5 NENTRIES)))
(\ADDBASE FILELIST (IPLUS 8 (ITIMES 5 NENTRIES))))
(replace (FILELIST NENTRIES) of FILELIST with NENTRIES))
(* TBW: Could try to shorten FILELIST after a delete.
Not a crucial problem. *)
(replace (PALLOC FLE) of PALLOC with NIL))))
(\PFLOPPY.SAVE.FILELIST
(LAMBDA (NOERROR) (* kbr: " 3-Feb-84 16:29")
(PROG (FILELIST)
(SETQ FILELIST (fetch (PFLOPPYFDEV FILELIST) of \FLOPPYFDEV))
(for I from 0 to (SUB1 (fetch (FILELIST NPAGES) of FILELIST))
do (\PFLOPPY.WRITEPAGENO (IPLUS (fetch (SECTOR9 FILELISTSTART)
of (fetch (PFLOPPYFDEV SECTOR9) of \FLOPPYFDEV))
I)
(\ADDBASE FILELIST (ITIMES I 256))
NOERROR)))))
(\PFLOPPY.SAVE.SECTOR9
(LAMBDA (NOERROR) (* kbr: " 3-Feb-84 16:29")
(PROG NIL
(GLOBALRESOURCE \FLOPPY.IBMS128.IOCB
(\FLOPPY.WRITESECTOR \FLOPPY.IBMS128.IOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 0
SECTOR ← 9)
(fetch (PFLOPPYFDEV SECTOR9) of \FLOPPYFDEV)
NOERROR)))))
(\PFLOPPY.WRITEPAGES
(LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* kbr: " 3-Feb-84 16:29")
(PROG NIL
(for BUFFER in (MKLIST BUFFERS) as I from 0 do (\PFLOPPY.WRITEPAGE STREAM (IPLUS FIRSTPAGE#
I)
BUFFER)))))
(\PFLOPPY.WRITEPAGE
(LAMBDA (FILE FIRSTPAGE# BUFFER) (* kbr: " 3-Feb-84 16:29")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM PALLOC PAGENO)
(SETQ STREAM (\PFLOPPY.ASSURESTREAM FILE))
(* Put in a check to see that we have not exceeded our
allocation. *)
(SETQ PALLOC (fetch (FLOPPYSTREAM PALLOC) of STREAM))
RETRY
(SETQ PAGENO (IPLUS (fetch (PALLOC START) of PALLOC)
1 FIRSTPAGE#))
(COND
((IGREATERP PAGENO (fetch (PALLOC END) of PALLOC))
(\PFLOPPY.EXTEND PALLOC)
(GO RETRY)))
(\PFLOPPY.WRITEPAGENO PAGENO BUFFER)))
(BLOCK)))
(\PFLOPPY.TRUNCATEFILE
(LAMBDA (FILE LASTPAGE LASTOFFSET) (* kbr: " 3-Feb-84 16:29")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM PALLOC LP)
(SETQ STREAM (\PFLOPPY.ASSURESTREAM FILE))
(* Split PALLOC into file block and free block.
*)
(COND
((NULL LASTPAGE) (* LASTPAGE = NIL means to truncate to the current
length. *)
(SETQ LASTPAGE (fetch (STREAM EPAGE) of STREAM))
(SETQ LASTOFFSET (fetch (STREAM EOFFSET) of STREAM))))
(SETQ PALLOC (fetch (FLOPPYSTREAM PALLOC) of STREAM))
(replace (LP LENGTH) of (fetch (PALLOC LP) of PALLOC)
with (IPLUS (ITIMES 512 LASTPAGE)
LASTOFFSET))
(* Convert remaining pages into free block.
*)
(COND
((ZEROP LASTOFFSET) (* Special case LASTOFFSET = 0.0 *)
(\PFLOPPY.TRUNCATE PALLOC (IPLUS 1 LASTPAGE)))
(T (\PFLOPPY.TRUNCATE PALLOC (IPLUS 1 (ADD1 LASTPAGE)))))))))
(FLOPPY.CROCK
(LAMBDA NIL (* kbr: " 3-Feb-84 16:29")
(PROG NIL
(COPYFILE (QUOTE {PHYLUM}<LISPUSERS>CROCK)
(QUOTE {FLOPPY}CROCK))
(COPYFILE (QUOTE {PHYLUM}<LISPUSERS>CROCK.BRAVO)
(QUOTE {FLOPPY}CROCK.BRAVO))
(COPYFILE (QUOTE {PHYLUM}<LISPUSERS>CROCK.DCOM)
(QUOTE {FLOPPY}CROCK.DCOM))
(COPYFILE (QUOTE {PHYLUM}<LISPUSERS>CROCK.PRESS)
(QUOTE {FLOPPY}CROCK.PRESS)))))
)
(* ALLOCATE *)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ MINIMUM.ALLOCATION 5)
(RPAQQ DEFAULT.ALLOCATION 50)
(CONSTANTS (MINIMUM.ALLOCATION 5)
(DEFAULT.ALLOCATION 50))
)
)
(RPAQ? \FLOPPY.ALLOCATIONS.BITMAP NIL)
(DEFINEQ
(\PFLOPPY.ALLOCATE
(LAMBDA (LENGTH) (* kbr: "14-Jan-84 15:33")
(* Return a PALLOC pointing to a free block.
*)
(PROG (FREE FLENGTH MP NEXT NMP)
RETRY
(SETQ FREE (\PFLOPPY.ALLOCATE.LARGEST))
(COND
((NULL FREE)
(\PFLOPPY.GAINSPACE LENGTH)
(GO RETRY)))
(SETQ FLENGTH (fetch (PALLOC LENGTH) of FREE))
(COND
(LENGTH (* Required LENGTH. *)
(COND
((ILESSP FLENGTH LENGTH)
(\PFLOPPY.GAINSPACE LENGTH)
(GO RETRY))
((ILESSP FLENGTH (IPLUS LENGTH MINIMUM.ALLOCATION)))
(T (\PFLOPPY.TRUNCATE FREE LENGTH))))
(T (* Defaulted LENGTH. *)
(COND
((ILESSP FLENGTH MINIMUM.ALLOCATION)
(\PFLOPPY.GAINSPACE MINIMUM.ALLOCATION)
(GO RETRY))
((ILESSP FLENGTH (IPLUS DEFAULT.ALLOCATION MINIMUM.ALLOCATION)))
(T (\PFLOPPY.TRUNCATE FREE DEFAULT.ALLOCATION)))))
(replace (PALLOC FILENAME) of FREE with (QUOTE (FILE)))
(SETQ MP (fetch (PALLOC MP) of FREE))
(COND
((NOT (EQ (fetch (MP NTYPE) of MP)
MPETYPE.FILE)) (* Marker pages need to be updated.
*)
(SETQ NEXT (fetch (PALLOC NEXT) of FREE))
(SETQ NMP (fetch (PALLOC MP) of NEXT))
(UNINTERRUPTABLY
(replace (MP NTYPE) of MP with MPETYPE.FILE)
(replace (MP NFILETYPE) of MP with FILETYPE.FILE)
(replace (MP PTYPE) of NMP with MPETYPE.FILE)
(replace (MP PFILETYPE) of NMP with FILETYPE.FILE)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PALLOC START) of FREE))
MP T)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PALLOC START) of NEXT))
NMP T))))
(FLOPPY.ICHECK)
(RETURN FREE))))
(\PFLOPPY.ALLOCATE.LARGEST
(LAMBDA NIL (* kbr: "14-Jan-84 15:33")
(* Return largest free PALLOC.
*)
(PROG (LENGTH ANSWER)
(SETQ LENGTH 0)
(for PALLOC in (fetch (PFLOPPYFDEV PALLOCS) of \FLOPPYFDEV)
when (AND (EQUAL (fetch (PALLOC FILENAME) of PALLOC)
(QUOTE (FREE)))
(IGREATERP (fetch (PALLOC LENGTH) of PALLOC)
LENGTH))
do (SETQ ANSWER PALLOC)
(SETQ LENGTH (fetch (PALLOC LENGTH) of PALLOC)))
(FLOPPY.ICHECK)
(RETURN ANSWER))))
(\PFLOPPY.TRUNCATE
(LAMBDA (PALLOC LENGTH) (* kbr: "14-Jan-84 15:33")
(* Trunctate PALLOC to LENGTH pages.
*)
(PROG (MP NEXT NMP FREE FMP TAIL) (* Trivial case = already the right length.
*)
(COND
((IGEQ LENGTH (fetch (MP NLENGTH) of (fetch (PALLOC MP) of PALLOC)))
(* No remaining pages, so no free block.
*)
(FLOPPY.ICHECK)
(RETURN))) (* Nontrivial case. *)
(SETQ MP (fetch (PALLOC MP) of PALLOC))
(SETQ NEXT (fetch (PALLOC NEXT) of PALLOC))
(SETQ NMP (fetch (PALLOC MP) of NEXT)) (* Create FREE block. *)
(SETQ FMP (create MP
PLENGTH ← LENGTH
PTYPE ← (fetch (MP NTYPE) of MP)
PFILETYPE ← (fetch (MP NFILETYPE) of MP)
NLENGTH ← (IPLUS (fetch (MP NLENGTH) of MP)
(IMINUS (ADD1 LENGTH)))
NTYPE ← MPETYPE.FREE
NFILETYPE ← FILETYPE.FREE))
(SETQ FREE (create PALLOC
FILENAME ← (QUOTE (FREE))
START ← (IPLUS (fetch (PALLOC START) of PALLOC)
(ADD1 LENGTH))
MP ← FMP))
(SETQ TAIL (MEMB PALLOC (fetch (PFLOPPYFDEV PALLOCS) of \FLOPPYFDEV)))
(UNINTERRUPTABLY (* Fix MP and NMP fields. *)
(replace (MP NLENGTH) of MP with (fetch (MP PLENGTH) of FMP))
(replace (MP PLENGTH) of NMP with (fetch (MP NLENGTH) of FMP))
(replace (MP PTYPE) of NMP with (fetch (MP NTYPE) of FMP))
(replace (MP PFILETYPE) of NMP with (fetch (MP NFILETYPE) of FMP))
(* Insert FREE between PALLOC and NEXT.
*)
(push (CDR TAIL)
FREE)
(replace (PALLOC NEXT) of PALLOC with FREE)
(replace (PALLOC PREV) of FREE with PALLOC)
(replace (PALLOC NEXT) of FREE with NEXT)
(replace (PALLOC PREV) of NEXT with FREE) (* Write new marker pages out to floppy.
*)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PALLOC START) of PALLOC))
MP T)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PALLOC START) of FREE))
FMP T)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PALLOC START) of NEXT))
NMP T))
(FLOPPY.ICHECK))))
(\PFLOPPY.DEALLOCATE
(LAMBDA (PALLOC) (* kbr: "14-Jan-84 15:33")
(PROG (MP NEXT NMP)
(replace (PALLOC LP) of PALLOC with NIL)
(SETQ MP (fetch (PALLOC MP) of PALLOC))
(SETQ NEXT (fetch (PALLOC NEXT) of PALLOC))
(SETQ NMP (fetch (PALLOC MP) of NEXT))
(UNINTERRUPTABLY
(replace (PALLOC FILENAME) of PALLOC with (QUOTE (FREE)))
(replace (MP NFILETYPE) of MP with FILETYPE.FREE)
(replace (MP NTYPE) of MP with MPETYPE.FREE)
(replace (MP PFILETYPE) of NMP with FILETYPE.FREE)
(replace (MP PTYPE) of NMP with MPETYPE.FREE)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PALLOC START) of PALLOC))
MP T)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PALLOC START) of NEXT))
NMP T))
(FLOPPY.ICHECK))))
(\PFLOPPY.EXTEND
(LAMBDA (PALLOC) (* kbr: "14-Jan-84 15:33")
(PROG (NEXT MP NNEXT NNMP OLDLENGTH LENGTH TAIL NEW START1 START2 MP1 MP2 PREV1 PREV2 NEXT1 NEXT2
TAIL1 TAIL2)
(SETQ NEXT (fetch (PALLOC NEXT) of PALLOC))
(COND
((AND (EQUAL (fetch (PALLOC FILENAME) of NEXT)
(QUOTE (FREE)))
(fetch (PALLOC NEXT) of NEXT)) (* Cannibalize following free block.
*)
(SETQ MP (fetch (PALLOC MP) of PALLOC))
(SETQ NNEXT (fetch (PALLOC NEXT) of NEXT))
(SETQ NNMP (fetch (PALLOC MP) of NNEXT))
(SETQ OLDLENGTH (fetch (PALLOC LENGTH) of PALLOC))
(SETQ LENGTH (IPLUS (fetch (PALLOC START) of NNEXT)
(IMINUS (fetch (PALLOC START) of PALLOC))
-1))
(SETQ TAIL (MEMB PALLOC (fetch (PFLOPPYFDEV PALLOCS) of \FLOPPYFDEV)))
(UNINTERRUPTABLY
(replace (MP NLENGTH) of MP with LENGTH)
(replace (MP PLENGTH) of NNMP with LENGTH)
(replace (MP PTYPE) of NNMP with MPETYPE.FILE)
(replace (MP PFILETYPE) of NNMP with FILETYPE.FILE)
(pop (CDR TAIL))
(replace (PALLOC NEXT) of PALLOC with NNEXT)
(replace (PALLOC PREV) of NNEXT with PALLOC)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PALLOC START) of PALLOC))
MP T)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PALLOC START) of NNEXT))
NNMP T))
(COND
((IGREATERP LENGTH (IPLUS OLDLENGTH DEFAULT.ALLOCATION MINIMUM.ALLOCATION))
(\PFLOPPY.TRUNCATE PALLOC (IPLUS OLDLENGTH DEFAULT.ALLOCATION))))
(FLOPPY.ICHECK)
(RETURN))) (* Have to reallocate. *)
(SETQ NEW (\PFLOPPY.ALLOCATE (IPLUS (fetch (PALLOC LENGTH) of PALLOC)
DEFAULT.ALLOCATION)))
(* Copy contents from PALLOC to NEW.
*)
(\FLOPPY.MESSAGE "Reallocating")
(GLOBALRESOURCE \FLOPPY.SCRATCH.BUFFER (for I from (fetch (PALLOC START) of PALLOC)
to (fetch (PALLOC END) of PALLOC) as J
from (fetch (PALLOC START) of NEW)
do (\PFLOPPY.WRITEPAGENO J (\PFLOPPY.READPAGENO
I
\FLOPPY.SCRATCH.BUFFER))))
(\FLOPPY.MESSAGE "Finished Reallocating") (* Make PALLOC and NEW switch places in
(fetch (PFLOPPYFDEV PALLOCS) of \FLOPPYFDEV) *)
(\PFLOPPY.DELETE.FROM.FILELIST PALLOC)
(SETQ START1 (fetch (PALLOC START) of PALLOC))
(SETQ START2 (fetch (PALLOC START) of NEW))
(SETQ MP1 (fetch (PALLOC MP) of PALLOC))
(SETQ MP2 (fetch (PALLOC MP) of NEW))
(SETQ PREV1 (fetch (PALLOC PREV) of PALLOC))
(SETQ PREV2 (fetch (PALLOC PREV) of NEW))
(SETQ NEXT1 (fetch (PALLOC NEXT) of PALLOC))
(SETQ NEXT2 (fetch (PALLOC NEXT) of NEW))
(SETQ TAIL1 (MEMB PALLOC (fetch (PFLOPPYFDEV PALLOCS) of \FLOPPYFDEV)))
(SETQ TAIL2 (MEMB NEW (fetch (PFLOPPYFDEV PALLOCS) of \FLOPPYFDEV)))
(UNINTERRUPTABLY
(replace (PALLOC START) of PALLOC with START2)
(replace (PALLOC START) of NEW with START1)
(replace (PALLOC MP) of PALLOC with MP2)
(replace (PALLOC MP) of NEW with MP1)
(COND
(PREV1 (replace (PALLOC NEXT) of PREV1 with NEW)))
(COND
(PREV2 (replace (PALLOC NEXT) of PREV2 with PALLOC)))
(COND
(NEXT1 (replace (PALLOC PREV) of NEXT1 with NEW)))
(COND
(NEXT2 (replace (PALLOC PREV) of NEXT2 with PALLOC)))
(replace (PALLOC PREV) of PALLOC with PREV2)
(replace (PALLOC PREV) of NEW with PREV1)
(replace (PALLOC NEXT) of PALLOC with NEXT2)
(replace (PALLOC NEXT) of NEW with NEXT1)
(RPLACA TAIL1 NEW)
(RPLACA TAIL2 PALLOC))
(\PFLOPPY.ADD.TO.FILELIST PALLOC) (* Now that PALLOC points to extended block and NEW
points to old block, we can deallocate NEW.
*)
(\PFLOPPY.DEALLOCATE NEW)
(FLOPPY.ICHECK))))
(\PFLOPPY.GAINSPACE
(LAMBDA (LENGTH) (* kbr: "14-Jan-84 15:33")
(* Returns after a free block of length LENGTH has been
made available. *)
(PROG (PALLOCS) (* TBW: Hook in compaction algorithm.
*)
RETRY
(\PFLOPPY.GAINSPACE.MERGE) (* See if we have a long enough block yet.
*)
(COND
((for PALLOC in (fetch (PFLOPPYFDEV PALLOCS) of \FLOPPYFDEV)
thereis (AND (EQUAL (fetch (PALLOC FILENAME) of PALLOC)
(QUOTE (FREE)))
(IGEQ (fetch (PALLOC LENGTH) of PALLOC)
LENGTH)))
(RETURN))) (* Punt to user. *)
(LISPERROR "FILE SYSTEM RESOURCES EXCEEDED" (QUOTE {FLOPPY})
T)
(GO RETRY))))
(\PFLOPPY.GAINSPACE.MERGE
(LAMBDA NIL (* kbr: "14-Jan-84 15:33")
(* Merge adjacent free blocks.
*)
(PROG (PALLOCS FREE OTHERS LAST NEXT MP NMP LENGTH)
(SETQ PALLOCS (fetch (PFLOPPYFDEV PALLOCS) of \FLOPPYFDEV))
(FLOPPY.ICHECK)
(do (SETQ FREE (for P in PALLOCS thereis (AND (EQUAL (fetch (PALLOC FILENAME) of P)
(QUOTE (FREE)))
(fetch (PALLOC NEXT) of P)
(EQUAL (fetch (PALLOC FILENAME)
of (fetch (PALLOC NEXT)
of P))
(QUOTE (FREE)))
(fetch (PALLOC NEXT)
of (fetch (PALLOC NEXT) of P)))))
(COND
((NULL FREE)
(RETURN)))
(SETQ OTHERS (for (P ← (fetch (PALLOC NEXT) of FREE)) by (fetch (PALLOC NEXT)
of P)
while (AND (EQUAL (fetch (PALLOC FILENAME) of P)
(QUOTE (FREE)))
(fetch (PALLOC NEXT) of P))
collect P))
(SETQ LAST (CAR (LAST OTHERS)))
(SETQ NEXT (fetch (PALLOC NEXT) of LAST))
(SETQ MP (fetch (PALLOC MP) of FREE))
(SETQ NMP (fetch (PALLOC MP) of NEXT))
(SETQ LENGTH (IPLUS (fetch (PALLOC START) of NEXT)
(IMINUS (fetch (PALLOC START) of FREE))
-1))
(UNINTERRUPTABLY
(for P in OTHERS do (DREMOVE P PALLOCS))
(replace (PALLOC NEXT) of FREE with NEXT)
(replace (PALLOC PREV) of NEXT with FREE)
(replace (MP NLENGTH) of MP with LENGTH)
(replace (MP PLENGTH) of NMP with LENGTH)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PALLOC START) of FREE))
MP T)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PALLOC START) of NEXT))
NMP T))
(FLOPPY.ICHECK)))))
(FLOPPY.BUG
(LAMBDA NIL (* kbr: "14-Jan-84 15:33")
(PROG NIL
(FRESH.FLOPPY)
(SETQ S1 (OPENSTREAM (QUOTE {FLOPPY}FOO)
(QUOTE OUTPUT)
(QUOTE NEW)))
(SETQ S2 (OPENSTREAM (QUOTE {FLOPPY}BAR)
(QUOTE OUTPUT)
(QUOTE NEW)))
(S1)
(S1)
(S1)
(S2)
(S2)
(S2))))
(FRESH.FLOPPY
(LAMBDA NIL (* kbr: "14-Jan-84 15:33")
(PROG NIL
(FLOPPY.FORMAT NIL T))))
(FLOPPY.LENGTHS
(LAMBDA NIL (* kbr: "14-Jan-84 15:33")
(for P in (fetch (PFLOPPYFDEV PALLOCS) of \FLOPPYFDEV) collect (fetch (PALLOC LENGTH)
of P))))
(FLOPPY.STARTS
(LAMBDA NIL (* kbr: "14-Jan-84 15:33")
(for P in (fetch (PFLOPPYFDEV PALLOCS) of \FLOPPYFDEV) collect (fetch (PALLOC START)
of P))))
(FLOPPY.ICHECK
(LAMBDA NIL (* kbr: "14-Jan-84 15:33")
(* Integrity check. *)
(PROG (STARTS LENGTHS PALLOCS MP1 MP2)
(SETQ STARTS (FLOPPY.STARTS))
(SETQ LENGTHS (FLOPPY.LENGTHS))
(COND
((NOT (EQUAL STARTS (SORT (COPY STARTS))))
(\FLOPPY.SEVERE.ERROR "Starts Allocation Error")))
(COND
((for L in LENGTHS thereis (ILESSP L 0))
(\FLOPPY.SEVERE.ERROR "Lengths1 Allocation Error")))
(COND
((NOT (IEQP (IPLUS (for L in LENGTHS sum L)
(LENGTH LENGTHS))
2280))
(\FLOPPY.SEVERE.ERROR "Lengths2 Allocation Error")))
(SETQ PALLOCS (fetch (PFLOPPYFDEV PALLOCS) of \FLOPPYFDEV))
(for P1 in PALLOCS when (OR (AND (fetch (PALLOC PREV) of P1)
(NOT (MEMB (fetch (PALLOC PREV) of P1)
PALLOCS)))
(AND (fetch (PALLOC NEXT) of P1)
(NOT (MEMB (fetch (PALLOC NEXT) of P1)
PALLOCS))))
do (\FLOPPY.SEVERE.ERROR "Links Allocation Error"))
(for P1 in PALLOCS as P2 in (CDR PALLOCS) when (OR (NOT (EQ (fetch (PALLOC NEXT)
of P1)
P2))
(NOT (EQ (fetch (PALLOC PREV)
of P2)
P1)))
do (\FLOPPY.SEVERE.ERROR "Links2 Allocation Error"))
(for P1 in PALLOCS as P2 in (CDR PALLOCS) when (NOT (IEQP (IPLUS (fetch (PALLOC END)
of P1)
2)
(fetch (PALLOC START)
of P2)))
do (\FLOPPY.SEVERE.ERROR "Lengths3 Allocation Error"))
(OR (QUOTE POSSIBLE.FUGUE.FLOPPY)
(for P1 in PALLOCS as P2 in (CDR PALLOCS)
do (SETQ MP1 (fetch (PALLOC MP) of P1))
(SETQ MP2 (fetch (PALLOC MP) of P2))
(COND
((OR (NOT (IEQP (fetch (MP NLENGTH) of MP1)
(fetch (MP PLENGTH) of MP2)))
(NOT (IEQP (fetch (MP NTYPE) of MP1)
(fetch (MP PTYPE) of MP2)))
(NOT (IEQP (fetch (MP NFILEID) of MP1)
(fetch (MP PFILEID) of MP2)))
(NOT (IEQP (fetch (MP NFILETYPE) of MP1)
(fetch (MP PFILETYPE) of MP2))))
(\FLOPPY.SEVERE.ERROR "Mps Allocation Error")))))
(for F in \OPENFILES when (AND (EQ (fetch (STREAM DEVICE) of F)
\FLOPPYFDEV)
(NOT (MEMB (fetch (FLOPPYSTREAM PALLOC) of F)
(fetch (PFLOPPYFDEV PALLOCS) of \FLOPPYFDEV))))
do (\FLOPPY.SEVERE.ERROR "Streams Allocation Error")))))
(FLOPPY.ALLOCATIONS
(LAMBDA NIL (* kbr: "14-Jan-84 15:33")
(PROG (REGION)
(COND
((NULL \FLOPPY.ALLOCATIONS.BITMAP)
(SETQ \FLOPPY.ALLOCATIONS.BITMAP (BITMAPCREATE 30 77))))
(BITBLT NIL NIL NIL \FLOPPY.ALLOCATIONS.BITMAP NIL NIL NIL NIL (QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE)
(for PALLOC in (fetch (PFLOPPYFDEV PALLOCS) of \FLOPPYFDEV)
when (NOT (EQUAL (fetch (PALLOC FILENAME) of PALLOC)
(QUOTE (FREE))))
do (for I from (fetch (PALLOC START) of PALLOC) to (fetch (PALLOC END) of PALLOC)
do (BITMAPBIT \FLOPPY.ALLOCATIONS.BITMAP (IREMAINDER (SUB1 I)
30)
(IQUOTIENT (SUB1 I)
30)
1)))
(EDITBM \FLOPPY.ALLOCATIONS.BITMAP))))
)
(* SERVICES *)
(DEFINEQ
(FLOPPY.FREE.PAGES
(LAMBDA NIL (* kbr: "24-Jan-84 00:18")
(\PFLOPPY.FREE.PAGES)))
(\PFLOPPY.FREE.PAGES
(LAMBDA NIL (* kbr: "24-Jan-84 00:18")
(WITH.MONITOR \FLOPPYLOCK (* Number of free pages on floppy.
*)
(PROG (ANSWER)
(\PFLOPPY.DOORCHECK) (* Answer is calculated as if all free blocks were
concentrated into one large free block.
*)
(SETQ ANSWER 0)
(for PALLOC in (fetch (PINFO PALLOCS) of (fetch (FDEV DEVICEINFO)
of \FLOPPYFDEV))
when (EQUAL (fetch (PALLOC FILENAME) of PALLOC)
(QUOTE (FREE)))
do (* Add in 1 here for overhead pages that could be
reclaimed. *)
(SETQ ANSWER (IPLUS ANSWER 1 (fetch (PALLOC LENGTH) of PALLOC))))
(* Lose 1 for overhead on large free block.
*)
(SETQ ANSWER (SUB1 ANSWER))
(RETURN ANSWER)))))
(FLOPPY.FORMAT
(LAMBDA (NAME AUTOCONFIRMFLG SLOWFLG) (* kbr: "24-Jan-84 00:18")
(WITH.MONITOR \FLOPPYLOCK (SELECTQ (FLOPPY.MODE)
((PILOT HUGEPILOT SYSOUT)
(\PFLOPPY.FORMAT NAME AUTOCONFIRMFLG SLOWFLG))
(CPM (\CFLOPPY.FORMAT NAME AUTOCONFIRMFLG SLOWFLG))
(SHOULDNT)))))
(\PFLOPPY.FORMAT
(LAMBDA (NAME AUTOCONFIRMFLG SLOWFLG) (* kbr: "24-Jan-84 00:18")
(* Return T if formatted, NIL if user abort.
*)
(PROG (SECTOR9 MP31 MP34 MP2310 FILELIST FLE) (* Confirmation. *)
(\PFLOPPY.START)
(COND
((NOT (\PFLOPPY.CONFIRM "Destroy contents of floppy" AUTOCONFIRMFLG T))
(RETURN NIL))) (* Forcibly close floppy. *)
(\FLOPPY.CLOSE) (* Create critical records. *)
(SETQ FILELIST (\ALLOCBLOCK 256 NIL 128))
(replace (FILELIST SEAL) of FILELIST with SEAL.FILELIST)
(replace (FILELIST VERSION) of FILELIST with VERSION.FILELIST)
(replace (FILELIST NENTRIES) of FILELIST with 1)
(replace (FILELIST MAXENTRIES) of FILELIST with (IQUOTIENT (IDIFFERENCE 512 4)
5))
(SETQ FLE (create FLE
FILEID ← 1
TYPE ← FILETYPE.FILELIST
START ← 32
LENGTH ← 2))
(\MOVEWORDS FLE 0 FILELIST 4 5)
(SETQ MP31
(create MP
PTYPE ← MPETYPE.FREE
PFILEID ← 0
PFILETYPE ← FILETYPE.FREE
PLENGTH ← 0
NTYPE ← MPETYPE.FILELIST
NFILETYPE ← FILETYPE.FILELIST
NFILEID ← 1
NLENGTH ← 2))
(SETQ MP34
(create MP
PTYPE ← MPETYPE.FILELIST
PFILETYPE ← FILETYPE.FILELIST
PFILEID ← 1
PLENGTH ← 2
NTYPE ← MPETYPE.FREE
NFILETYPE ← FILETYPE.FREE
NFILEID ← 0
NLENGTH ← 2275))
(SETQ MP2310
(create MP
PTYPE ← MPETYPE.FREE
PFILEID ← 0
PFILETYPE ← FILETYPE.FREE
PLENGTH ← 2275
NTYPE ← MPETYPE.FREE
NFILEID ← 0
NFILETYPE ← FILETYPE.FREE
NLENGTH ← 0))
(SETQ SECTOR9
(create SECTOR9
FILELISTSTART ← 32
FILELISTFILEID ← 1
FILELISTLENGTH ← 2
ROOTFILEID ← 0
NEXTUNUSEDFILEID ← 2))
(replace (SECTOR9 $LABEL) of SECTOR9 with NAME) (* Check floppy can write. *)
RETRY
(COND
((NOT (FLOPPY.CAN.READP))
(\FLOPPY.BREAK (QUOTE DOORISOPEN))
(GO RETRY))
((NOT (FLOPPY.CAN.WRITEP))
(\FLOPPY.BREAK (QUOTE WRITEPROTECTED))
(GO RETRY))) (* Configure floppy. *)
(COND
((OR SLOWFLG (NULL SECTOR9))
(COND
((NOT (AND (\FLOPPY.INITIALIZE T)
(\FLOPPY.RECALIBRATE T)
(GLOBALRESOURCE \FLOPPY.IBMS128.IOCB
(\FLOPPY.FORMATTRACKS \FLOPPY.IBMS128.IOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 0
SECTOR ← 1)
1 T))
(GLOBALRESOURCE \FLOPPY.IBMD256.IOCB
(\FLOPPY.FORMATTRACKS \FLOPPY.IBMD256.IOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 1
SECTOR ← 1)
1 T))
(\FLOPPY.INITIALIZE T)
(\FLOPPY.RECALIBRATE T)
(GLOBALRESOURCE \FLOPPY.IBMD512.IOCB
(\FLOPPY.FORMATTRACKS \FLOPPY.IBMD512.IOCB
(create DISKADDRESS
CYLINDER ← 1
HEAD ← 0
SECTOR ← 1)
76 T)
(\FLOPPY.FORMATTRACKS \FLOPPY.IBMD512.IOCB
(create DISKADDRESS
CYLINDER ← 1
HEAD ← 1
SECTOR ← 1)
76 T))))
(SETQ SLOWFLG T)
(\FLOPPY.MESSAGE "RETRYING FORMAT")
(GO RETRY))))) (* Write MPs, FILELIST, and SECTOR9.
Write SECTOR9 last. We check for it first when we open
floppy. *)
(COND
((NOT (AND (\PFLOPPY.WRITEPAGENO 31 MP31 T)
(\PFLOPPY.WRITEPAGENO 32 FILELIST T)
(\PFLOPPY.WRITEPAGENO 33 (\ADDBASE FILELIST 256)
T)
(\PFLOPPY.WRITEPAGENO 34 MP34 T)
(\PFLOPPY.WRITEPAGENO 2310 MP2310 T)
(GLOBALRESOURCE \FLOPPY.IBMS128.IOCB
(\FLOPPY.WRITESECTOR \FLOPPY.IBMS128.IOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 0
SECTOR ← 9)
SECTOR9 T))))
(SETQ SLOWFLG T)
(\FLOPPY.MESSAGE "RETRYING FORMAT")
(GO RETRY))) (* Successful Return. *)
(RETURN T))))
(\PFLOPPY.CONFIRM
(LAMBDA (MESSAGE AUTOCONFIRMFLG NOERROR) (* kbr: "24-Jan-84 00:18")
(PROG (SECTOR9)
RETRY
(SETQ SECTOR9 (\PFLOPPY.GET.SECTOR9))
(COND
((AND SECTOR9 (NOT AUTOCONFIRMFLG))
(COND
((NOT (while (NULL (SELECTQ (ASKUSER NIL NIL (CONCAT MESSAGE " " (fetch (SECTOR9
$LABEL)
of SECTOR9)
"? "))
(Y (RETURN T))
(N (RETURN NIL))
NIL))
do (* Ask again. *)))
(RETURN NIL))
(T (RETURN T))))
(T (RETURN T)))
(COND
((NOT (OR SECTOR9 NOERROR))
(\FLOPPY.BREAK "Not a pilot floppy")
(GO RETRY))))))
(FLOPPY.NAME
(LAMBDA (NAME) (* kbr: "11-Mar-84 15:35")
(COND
(NAME (FLOPPY.SET.NAME NAME))
(T (FLOPPY.GET.NAME)))))
(FLOPPY.GET.NAME
(LAMBDA NIL (* kbr: "24-Jan-84 00:18")
(WITH.MONITOR \FLOPPYLOCK (SELECTQ (FLOPPY.MODE)
((PILOT HUGEPILOT SYSOUT)
(\PFLOPPY.GET.NAME))
(SHOULDNT)))))
(\PFLOPPY.GET.NAME
(LAMBDA NIL (* kbr: "24-Jan-84 00:18")
(PROG NIL
(\PFLOPPY.DOORCHECK)
(RETURN (fetch (SECTOR9 $LABEL) of (fetch (PFLOPPYFDEV SECTOR9) of \FLOPPYFDEV))))))
(FLOPPY.SET.NAME
(LAMBDA (NAME) (* kbr: "24-Jan-84 00:18")
(WITH.MONITOR \FLOPPYLOCK (SELECTQ (FLOPPY.MODE)
((PILOT HUGEPILOT SYSOUT)
(\PFLOPPY.SET.NAME NAME))
(SHOULDNT)))))
(\PFLOPPY.SET.NAME
(LAMBDA (NAME) (* kbr: "24-Jan-84 00:18")
(PROG NIL
(\PFLOPPY.DOORCHECK)
(UNINTERRUPTABLY
(replace (SECTOR9 $LABEL) of (fetch (PFLOPPYFDEV SECTOR9) of \FLOPPYFDEV) with NAME)
(\PFLOPPY.SAVE.SECTOR9))
(RETURN (fetch (SECTOR9 $LABEL) of (fetch (PFLOPPYFDEV SECTOR9) of \FLOPPYFDEV))))))
(FLOPPY.DRIVE.EXISTSP
(LAMBDA NIL (* kbr: "24-Jan-84 00:18")
(* Machine has a floppy drive? *)
(EQ \MACHINETYPE \DANDELION)))
(FLOPPY.CAN.READP
(LAMBDA NIL (* kbr: "24-Jan-84 00:18")
(WITH.MONITOR \FLOPPYLOCK (PROG (ANSWER)
(\FLOPPY.INITIALIZE)
(UNINTERRUPTABLY
(\FLOPPY.NOP T)
(SETQ ANSWER (NOT (fetch (RESULT DOOROPENED) of \FLOPPYRESULT)
)))
(RETURN ANSWER)))))
(FLOPPY.CAN.WRITEP
(LAMBDA NIL (* kbr: "24-Jan-84 00:18")
(WITH.MONITOR \FLOPPYLOCK (PROG (ANSWER)
(\FLOPPY.INITIALIZE)
(UNINTERRUPTABLY
(\FLOPPY.NOP T)
(SETQ ANSWER (AND (NOT (fetch (RESULT WRITEPROTECT)
of \FLOPPYRESULT))
(NOT (fetch (RESULT DOOROPENED)
of \FLOPPYRESULT)))))
(RETURN ANSWER)))))
(FLOPPY.WAIT.FOR.FLOPPY
(LAMBDA (NEWFLG) (* kbr: "20-Mar-84 19:43")
(* Wait until floppy drive contains
(new) floppy. *)
(WITH.MONITOR \FLOPPYLOCK (PROG NIL (* NOTE: Wait 2 seconds to guarantee drive door is
secure. *)
(\FLOPPY.CLOSE)
(\FLOPPY.INITIALIZE)
(COND
(NEWFLG (until (NOT (FLOPPY.CAN.READP)) do (BLOCK))))
DEBOUNCE
(until (FLOPPY.CAN.READP) do (BLOCK))
(COND
(NEWFLG (DISMISS 2000)))
(COND
((NOT (FLOPPY.CAN.READP))
(* Drive door probably didn't stick.
*)
(GO DEBOUNCE)))))))
)
(* SYSOUT *)
(RPAQ? \SFLOPPYFDEV NIL)
(RPAQ? \SFLOPPYINFO NIL)
(RPAQ? \SFLOPPY.RECOG NIL)
(RPAQ? \SFLOPPY.PAGENO NIL)
(RPAQ? \SFLOPPY.FLOPPYNO NIL)
(RPAQ? \SFLOPPY.HUGELENGTH NIL)
(RPAQ? \SFLOPPY.HUGEPAGELENGTH NIL)
(RPAQ? \SFLOPPY.IWRITEDATE NIL)
(DEFINEQ
(\SFLOPPY.INIT
(LAMBDA NIL (* kbr: "12-Mar-84 19:55")
(PROG NIL
(SETQ \SFLOPPYINFO (create PINFO))
(SETQ \SFLOPPYFDEV (create FDEV
DEVICENAME ← (QUOTE FLOPPY)
RESETABLE ← NIL
RANDOMACCESSP ← NIL
NODIRECTORIES ← T
PAGEMAPPED ← NIL
CLOSEFILE ← (QUOTE \SFLOPPY.CLOSEHUGEFILE)
DELETEFILE ← (QUOTE NILL)
DIRECTORYNAMEP ← (QUOTE TRUE)
EVENTFN ← (QUOTE \FLOPPY.EVENTFN)
GENERATEFILES ← (QUOTE \PFLOPPY.GENERATEFILES)
GETFILEINFO ← (QUOTE \SFLOPPY.GETFILEINFO)
GETFILENAME ← (QUOTE \PFLOPPY.GETFILENAME)
HOSTNAMEP ← (QUOTE \FLOPPY.HOSTNAMEP)
OPENFILE ← (QUOTE \SFLOPPY.OPENHUGEFILE)
READPAGES ← (QUOTE \SFLOPPY.READPAGES)
REOPENFILE ← (QUOTE \SFLOPPY.OPENHUGEFILE)
SETFILEINFO ← (QUOTE NILL)
TRUNCATEFILE ← (QUOTE NILL)
WRITEPAGES ← (QUOTE \SFLOPPY.WRITEPAGES)
BIN ← (QUOTE \PAGEDBIN)
BOUT ← (QUOTE \PAGEDBOUT)
PEEKBIN ← (QUOTE \PAGEDPEEKBIN)
READP ← (QUOTE \PAGEDREADP)
BACKFILEPTR ← (QUOTE \PAGEDBACKFILEPTR)
DEVICEINFO ← \SFLOPPYINFO
SETFILEPTR ← (QUOTE \IS.NOT.RANDACCESSP)
GETFILEPTR ← (QUOTE \PAGEDGETFILEPTR)
GETEOFPTR ← (QUOTE \PAGEDGETEOFPTR)
EOFP ← (QUOTE \PAGEDEOFP)
BLOCKIN ← (QUOTE \PAGEDBINS)
BLOCKOUT ← (QUOTE \PAGEDBOUTS)
RENAMEFILE ← (QUOTE NILL)
FLUSHOUTPUT ← (QUOTE \PAGED.FLUSHOUTPUT))))))
(\SFLOPPY.GETFILEINFO
(LAMBDA (FILE ATTRIBUTE FDEV) (* kbr: "12-Mar-84 19:55")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM LP ANSWER)
(\PFLOPPY.DOORCHECK)
(SETQ STREAM (\PFLOPPY.ASSURESTREAM FILE))
(SETQ LP (fetch (FLOPPYSTREAM LP) of STREAM))
(* Wizard incantations: PAGELENGTH, HUGEPAGESTART,
HUGEPAGELENGTH, HUGELENGTH *)
(SETQ ANSWER (SELECTQ ATTRIBUTE
(WRITEDATE (fetch (LP WRITEDATE)
of LP))
(CREATIONDATE (fetch (LP CREATIONDATE)
of LP))
(IWRITEDATE (fetch (LP IWRITEDATE)
of LP))
(ICREATIONDATE (fetch (LP ICREATIONDATE)
of LP))
(LENGTH
(* We want hugelength. *)
(fetch (LP HUGELENGTH)
of LP))
(MESATYPE (fetch (LP MESATYPE)
of LP))
(PAGELENGTH (fetch (LP PAGELENGTH)
of LP))
(HUGEPAGESTART (fetch (LP HUGEPAGESTART)
of LP))
(HUGEPAGELENGTH (fetch (LP HUGEPAGELENGTH)
of LP))
(HUGELENGTH (fetch (LP HUGELENGTH)
of LP))
NIL))
(RETURN ANSWER)))))
(\SFLOPPY.OPENHUGEFILE
(LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* kbr: "12-Mar-84 19:55")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM)
RETRY
(SELECTQ ACCESS
(OUTPUT (SELECTQ RECOG
(NEW
(* OK. *))
(PROGN (SETQ RECOG (LISPERROR
"ILLEGAL ARG"
RECOG))
(GO RETRY))))
(INPUT (SELECTQ RECOG
(OLD
(* OK. *))
(PROGN (SETQ RECOG (LISPERROR
"ILLEGAL ARG"
RECOG))
(GO RETRY))))
(PROGN (SETQ ACCESS (LISPERROR "ILLEGAL ARG" ACCESS))
(GO RETRY)))
(SETQ \SFLOPPY.RECOG RECOG)
(SETQ \SFLOPPY.FLOPPYNO 0)
(SETQ \SFLOPPY.PAGENO 0)
(COND
((EQ RECOG (QUOTE NEW))
(SETQ OTHERINFO (\FLOPPY.OTHERINFO OTHERINFO))
(SETQ \SFLOPPY.HUGELENGTH (CDR (ASSOC (QUOTE LENGTH)
OTHERINFO)))
(SETQ \SFLOPPY.HUGEPAGELENGTH (IQUOTIENT (IPLUS
\SFLOPPY.HUGELENGTH 511)
512))
(\PFLOPPY.FORMAT "Lisp Sysout #1")
(SETQ STREAM (\PFLOPPY.OPENFILE
(QUOTE lisp.sysout)
ACCESS RECOG (\BQUOTE ((LENGTH (\COMMA (ITIMES 2274 512)))
))))
(replace (STREAM FULLFILENAME) of STREAM with (QUOTE
{FLOPPY}lisp.sysout))
(replace (LP $NAME) of (fetch (FLOPPYSTREAM LP) of STREAM)
with "lisp.sysout")
(replace (PALLOC FILENAME) of (fetch (FLOPPYSTREAM PALLOC)
of STREAM)
with (QUOTE lisp.sysout)))
(T (SETQ STREAM (\PFLOPPY.OPENFILE (QUOTE lisp.sysout)
ACCESS RECOG OTHERINFO))
(SETQ \SFLOPPY.HUGELENGTH (fetch (LP HUGELENGTH)
of (fetch (FLOPPYSTREAM LP)
of STREAM)))
(SETQ \SFLOPPY.HUGEPAGELENGTH (fetch (LP HUGEPAGELENGTH)
of (fetch (FLOPPYSTREAM
LP)
of STREAM)))
(replace (STREAM EPAGE) of STREAM with (IQUOTIENT
\SFLOPPY.HUGELENGTH 512)
)
(replace (STREAM EOFFSET) of STREAM with (IREMAINDER
\SFLOPPY.HUGELENGTH 512)
)))
(COND
((NOT (EQ (fetch (STREAM ACCESS) of STREAM)
(QUOTE INPUT)))
(SETQ \SFLOPPY.IWRITEDATE (IDATE))))
(RETURN STREAM)))))
(\SFLOPPY.READPAGES
(LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* kbr: "12-Mar-84 19:55")
(PROG NIL
(COND
((NOT (EQ (fetch (STREAM ACCESS) of STREAM)
(QUOTE INPUT)))
(RETURN)))
(for BUFFER in (MKLIST BUFFERS) as I from 0 do (\SFLOPPY.READPAGE STREAM (IPLUS FIRSTPAGE#
I)
BUFFER)))))
(\SFLOPPY.READPAGE
(LAMBDA (STREAM FIRSTPAGE# BUFFER) (* kbr: "12-Mar-84 19:55")
(WITH.MONITOR \FLOPPYLOCK (PROG (NEWSTREAM) (* Read page \SFLOPPY.PAGENO.
*)
(\PFLOPPY.READPAGE STREAM \SFLOPPY.PAGENO BUFFER)
(* Calc next \SFLOPPY.PAGENO to be written.
*)
(SETQ \SFLOPPY.PAGENO (ADD1 \SFLOPPY.PAGENO))
(COND
((ILESSP \SFLOPPY.PAGENO \HFLOPPY.MAXPAGES)
(RETURN)))
(\SFLOPPY.CLOSESMALLFILE STREAM)
(SETQ \SFLOPPY.FLOPPYNO (ADD1 \SFLOPPY.FLOPPYNO))
(SETQ \SFLOPPY.PAGENO 0)
(FRESHLINE T)
(PRIN1 "INSERT NEXT FLOPPY" T)
(TERPRI T)
(RINGBELLS)
(FLOPPY.WAIT.FOR.FLOPPY T)
(SETQ NEWSTREAM (\PFLOPPY.OPENFILE (QUOTE lisp.sysout)
(fetch (STREAM ACCESS)
of STREAM)
\SFLOPPY.RECOG))
(replace (FLOPPYSTREAM PALLOC) of STREAM
with (fetch (FLOPPYSTREAM PALLOC) of NEWSTREAM))
(replace (FLOPPYSTREAM LP) of STREAM with (fetch (FLOPPYSTREAM
LP)
of NEWSTREAM))))))
(\SFLOPPY.WRITEPAGES
(LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* kbr: "12-Mar-84 19:55")
(PROG NIL
(for BUFFER in (MKLIST BUFFERS) as I from 0 do (\SFLOPPY.WRITEPAGE STREAM (IPLUS FIRSTPAGE#
I)
BUFFER)))))
(\SFLOPPY.WRITEPAGE
(LAMBDA (STREAM FIRSTPAGE# BUFFER) (* kbr: "12-Mar-84 19:55")
(WITH.MONITOR \FLOPPYLOCK (PROG (NEWSTREAM) (* Write page \SFLOPPY.PAGENO.
*)
(GLOBALRESOURCE \FLOPPY.SCRATCH.BUFFER (\BLT
\FLOPPY.SCRATCH.BUFFER
BUFFER 256)
(\PFLOPPY.WRITEPAGE STREAM \SFLOPPY.PAGENO
\FLOPPY.SCRATCH.BUFFER))
(* Calc next \SFLOPPY.PAGENO to be written.
*)
(SETQ \SFLOPPY.PAGENO (ADD1 \SFLOPPY.PAGENO))
(COND
((ILESSP \SFLOPPY.PAGENO \HFLOPPY.MAXPAGES)
(RETURN)))
(\SFLOPPY.CLOSESMALLFILE STREAM)
(SETQ \SFLOPPY.FLOPPYNO (ADD1 \SFLOPPY.FLOPPYNO))
(SETQ \SFLOPPY.PAGENO 0)
(FRESHLINE T)
(PRIN1 "INSERT NEXT FLOPPY" T)
(TERPRI T)
(RINGBELLS)
(FLOPPY.WAIT.FOR.FLOPPY T)
(COND
((EQ \SFLOPPY.RECOG (QUOTE NEW))
(\PFLOPPY.FORMAT (CONCAT "Lisp Sysout #" (ADD1
\SFLOPPY.FLOPPYNO)))))
(SETQ NEWSTREAM (\PFLOPPY.OPENFILE
(QUOTE lisp.sysout)
(fetch (STREAM ACCESS) of STREAM)
\SFLOPPY.RECOG
(\BQUOTE ((LENGTH (\COMMA (ITIMES 2274 512)))))))
(replace (FLOPPYSTREAM PALLOC) of STREAM
with (fetch (FLOPPYSTREAM PALLOC) of NEWSTREAM))
(replace (FLOPPYSTREAM LP) of STREAM with (fetch (FLOPPYSTREAM
LP)
of NEWSTREAM))
(replace (LP $NAME) of (fetch (FLOPPYSTREAM LP) of STREAM)
with "lisp.sysout")
(replace (PALLOC FILENAME) of (fetch (FLOPPYSTREAM PALLOC)
of STREAM)
with (QUOTE lisp.sysout))))))
(\SFLOPPY.CLOSEHUGEFILE
(LAMBDA (STREAM) (* kbr: "12-Mar-84 19:55")
(WITH.MONITOR \FLOPPYLOCK (PROG NIL
(COND
((EQ (fetch (STREAM ACCESS) of STREAM)
(QUOTE INPUT))
(RETURN)))
(RELEASECPAGE STREAM)
(\CLEARMAP STREAM) (* Patch SYSOUT not passing us right HUGELENGTH.
*)
(SETQ \SFLOPPY.HUGELENGTH (IPLUS (ITIMES 512 (fetch (STREAM
EPAGE)
of STREAM))
(fetch (STREAM EOFFSET)
of STREAM)))
(SETQ \SFLOPPY.HUGEPAGELENGTH (IQUOTIENT (IPLUS
\SFLOPPY.HUGELENGTH 511)
512))
(\SFLOPPY.CLOSESMALLFILE STREAM)))))
(\SFLOPPY.CLOSESMALLFILE
(LAMBDA (STREAM) (* kbr: "12-Mar-84 19:55")
(* The same as \PFLOPPY.CLOSEFILE but without releasing
STREAM. Called only by \SFLOPPY.WRITEPAGE.
*)
(PROG (PALLOC LP MP NEXT NMP)
(COND
((EQ (fetch (STREAM ACCESS) of STREAM)
(QUOTE INPUT))
(RETURN))) (* At this point \SFLOPPY.PAGENO is the next page we
would write. *)
(\PFLOPPY.TRUNCATEFILE STREAM \SFLOPPY.PAGENO (fetch (STREAM EOFFSET) of STREAM))
(SETQ PALLOC (fetch (FLOPPYSTREAM PALLOC) of STREAM))
(SETQ LP (fetch (PALLOC LP) of PALLOC))
(replace (LP IWRITEDATE) of LP with \SFLOPPY.IWRITEDATE)
(COND
((EQ \SFLOPPY.RECOG (QUOTE NEW))
(replace (LP ICREATIONDATE) of LP with \SFLOPPY.IWRITEDATE)
(replace (LP PAGELENGTH) of LP with \SFLOPPY.PAGENO)
(replace (LP HUGEPAGESTART) of LP with (ITIMES \HFLOPPY.MAXPAGES \SFLOPPY.FLOPPYNO))
(replace (LP HUGEPAGELENGTH) of LP with \SFLOPPY.HUGEPAGELENGTH)
(replace (LP HUGELENGTH) of LP with \SFLOPPY.HUGELENGTH)))
(\PFLOPPY.WRITEPAGENO (fetch (PALLOC START) of PALLOC)
(fetch (PALLOC LP) of PALLOC))
(\PFLOPPY.SAVE.FILELIST)
(\PFLOPPY.SAVE.SECTOR9))))
)
(* HUGE *)
(RPAQ? \HFLOPPYINFO NIL)
(RPAQ? \HFLOPPYFDEV NIL)
(RPAQ? \HFLOPPY.MAXPAGES 2250)
(RPAQ? \HFLOPPY.PAGENO NIL)
(RPAQ? \HFLOPPY.FLOPPYNO NIL)
(RPAQ? \HFLOPPY.HUGELENGTH NIL)
(RPAQ? \HFLOPPY.HUGEPAGELENGTH NIL)
(RPAQ? \HFLOPPY.IWRITEDATE NIL)
(RPAQ? \HFLOPPY.RECOG NIL)
(RPAQ? \HFLOPPY.FILENAME NIL)
(DEFINEQ
(\HFLOPPY.INIT
(LAMBDA NIL (* kbr: "12-Mar-84 19:55")
(PROG NIL
(SETQ \HFLOPPYINFO (create PINFO))
(SETQ \HFLOPPYFDEV (create FDEV
DEVICENAME ← (QUOTE FLOPPY)
RESETABLE ← NIL
RANDOMACCESSP ← NIL
NODIRECTORIES ← T
PAGEMAPPED ← NIL
CLOSEFILE ← (QUOTE \HFLOPPY.CLOSEHUGEFILE)
DELETEFILE ← (QUOTE NILL)
DIRECTORYNAMEP ← (QUOTE TRUE)
EVENTFN ← (QUOTE \FLOPPY.EVENTFN)
GENERATEFILES ← (QUOTE \PFLOPPY.GENERATEFILES)
GETFILEINFO ← (QUOTE \HFLOPPY.GETFILEINFO)
GETFILENAME ← (QUOTE \PFLOPPY.GETFILENAME)
HOSTNAMEP ← (QUOTE \FLOPPY.HOSTNAMEP)
OPENFILE ← (QUOTE \HFLOPPY.OPENHUGEFILE)
READPAGES ← (QUOTE \HFLOPPY.READPAGES)
REOPENFILE ← (QUOTE \HFLOPPY.OPENHUGEFILE)
SETFILEINFO ← (QUOTE NILL)
TRUNCATEFILE ← (QUOTE NILL)
WRITEPAGES ← (QUOTE \HFLOPPY.WRITEPAGES)
BIN ← (QUOTE \PAGEDBIN)
BOUT ← (QUOTE \PAGEDBOUT)
PEEKBIN ← (QUOTE \PAGEDPEEKBIN)
READP ← (QUOTE \PAGEDREADP)
BACKFILEPTR ← (QUOTE \PAGEDBACKFILEPTR)
DEVICEINFO ← \HFLOPPYINFO
SETFILEPTR ← (QUOTE \IS.NOT.RANDACCESSP)
GETFILEPTR ← (QUOTE \PAGEDGETFILEPTR)
GETEOFPTR ← (QUOTE \PAGEDGETEOFPTR)
EOFP ← (QUOTE \PAGEDEOFP)
BLOCKIN ← (QUOTE \PAGEDBINS)
BLOCKOUT ← (QUOTE \PAGEDBOUTS)
RENAMEFILE ← (QUOTE NILL)
FLUSHOUTPUT ← (QUOTE \PAGED.FLUSHOUTPUT))))))
(\HFLOPPY.GETFILEINFO
(LAMBDA (FILE ATTRIBUTE FDEV) (* kbr: "12-Mar-84 19:55")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM LP ANSWER)
(\PFLOPPY.DOORCHECK)
(SETQ STREAM (\PFLOPPY.ASSURESTREAM FILE))
(SETQ LP (fetch (FLOPPYSTREAM LP) of STREAM))
(* Wizard incantations: PAGELENGTH, HUGEPAGESTART,
HUGEPAGELENGTH, HUGELENGTH *)
(SETQ ANSWER (SELECTQ ATTRIBUTE
(WRITEDATE (fetch (LP WRITEDATE)
of LP))
(CREATIONDATE (fetch (LP CREATIONDATE)
of LP))
(IWRITEDATE (fetch (LP IWRITEDATE)
of LP))
(ICREATIONDATE (fetch (LP ICREATIONDATE)
of LP))
(LENGTH
(* We want hugelength. *)
(fetch (LP HUGELENGTH)
of LP))
(MESATYPE (fetch (LP MESATYPE)
of LP))
(PAGELENGTH (fetch (LP PAGELENGTH)
of LP))
(HUGEPAGESTART (fetch (LP HUGEPAGESTART)
of LP))
(HUGEPAGELENGTH (fetch (LP HUGEPAGELENGTH)
of LP))
(HUGELENGTH (fetch (LP HUGELENGTH)
of LP))
NIL))
(RETURN ANSWER)))))
(\HFLOPPY.OPENHUGEFILE
(LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* kbr: "12-Mar-84 19:55")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM)
RETRY
(SELECTQ ACCESS
(OUTPUT (SELECTQ RECOG
(NEW
(* OK. *))
(PROGN (SETQ RECOG (LISPERROR
"ILLEGAL ARG"
RECOG))
(GO RETRY))))
(INPUT (SELECTQ RECOG
(OLD
(* OK. *))
(PROGN (SETQ RECOG (LISPERROR
"ILLEGAL ARG"
RECOG))
(GO RETRY))))
(PROGN (SETQ ACCESS (LISPERROR "ILLEGAL ARG" ACCESS))
(GO RETRY)))
(SETQ \HFLOPPY.RECOG RECOG)
(SETQ \HFLOPPY.FILENAME (\FLOPPY.ASSUREFILENAME FILE))
(SETQ \HFLOPPY.FLOPPYNO 0)
(SETQ \HFLOPPY.PAGENO 0)
(COND
((EQ RECOG (QUOTE NEW))
(SETQ OTHERINFO (\FLOPPY.OTHERINFO OTHERINFO))
(SETQ \HFLOPPY.HUGELENGTH (CDR (ASSOC (QUOTE LENGTH)
OTHERINFO)))
(SETQ \HFLOPPY.HUGEPAGELENGTH (IQUOTIENT (IPLUS
\HFLOPPY.HUGELENGTH 511)
512))
(\PFLOPPY.FORMAT (CONCAT \HFLOPPY.FILENAME "#1"))
(SETQ STREAM (\PFLOPPY.OPENFILE
\HFLOPPY.FILENAME ACCESS RECOG
(\BQUOTE ((LENGTH (\COMMA (ITIMES 2274 512)))))))
(replace (STREAM FULLFILENAME) of STREAM with (
\FLOPPY.ADDDEVICENAME \HFLOPPY.FILENAME))
(replace (LP $NAME) of (fetch (FLOPPYSTREAM LP) of STREAM)
with \HFLOPPY.FILENAME)
(replace (PALLOC FILENAME) of (fetch (FLOPPYSTREAM PALLOC)
of STREAM)
with \HFLOPPY.FILENAME))
(T (SETQ STREAM (\PFLOPPY.OPENFILE \HFLOPPY.FILENAME ACCESS
RECOG OTHERINFO))
(SETQ \HFLOPPY.HUGELENGTH (fetch (LP HUGELENGTH)
of (fetch (FLOPPYSTREAM LP)
of STREAM)))
(SETQ \HFLOPPY.HUGEPAGELENGTH (fetch (LP HUGEPAGELENGTH)
of (fetch (FLOPPYSTREAM
LP)
of STREAM)))
(replace (STREAM EPAGE) of STREAM with (IQUOTIENT
\HFLOPPY.HUGELENGTH 512)
)
(replace (STREAM EOFFSET) of STREAM with (IREMAINDER
\HFLOPPY.HUGELENGTH 512)
)))
(COND
((NOT (EQ (fetch (STREAM ACCESS) of STREAM)
(QUOTE INPUT)))
(SETQ \HFLOPPY.IWRITEDATE (IDATE))))
(RETURN STREAM)))))
(\HFLOPPY.WRITEPAGES
(LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* kbr: "12-Mar-84 19:55")
(PROG NIL
(for BUFFER in (MKLIST BUFFERS) as I from 0 do (\HFLOPPY.WRITEPAGE STREAM (IPLUS FIRSTPAGE#
I)
BUFFER)))))
(\HFLOPPY.WRITEPAGE
(LAMBDA (STREAM FIRSTPAGE# BUFFER) (* kbr: "12-Mar-84 19:55")
(WITH.MONITOR \FLOPPYLOCK (PROG (NEWSTREAM) (* Write page \HFLOPPY.PAGENO.
*)
(GLOBALRESOURCE \FLOPPY.SCRATCH.BUFFER (\BLT
\FLOPPY.SCRATCH.BUFFER
BUFFER 256)
(\PFLOPPY.WRITEPAGE STREAM \HFLOPPY.PAGENO
\FLOPPY.SCRATCH.BUFFER))
(* Calc next \HFLOPPY.PAGENO to be written.
*)
(SETQ \HFLOPPY.PAGENO (ADD1 \HFLOPPY.PAGENO))
(COND
((ILESSP \HFLOPPY.PAGENO \HFLOPPY.MAXPAGES)
(RETURN)))
(\HFLOPPY.CLOSESMALLFILE STREAM)
(SETQ \HFLOPPY.FLOPPYNO (ADD1 \HFLOPPY.FLOPPYNO))
(SETQ \HFLOPPY.PAGENO 0)
(FRESHLINE T)
(PRIN1 "INSERT NEXT FLOPPY" T)
(TERPRI T)
(RINGBELLS)
(FLOPPY.WAIT.FOR.FLOPPY T)
(COND
((EQ \HFLOPPY.RECOG (QUOTE NEW))
(\PFLOPPY.FORMAT (CONCAT \HFLOPPY.FILENAME "#" (ADD1
\HFLOPPY.FLOPPYNO)))))
(SETQ NEWSTREAM (\PFLOPPY.OPENFILE
\HFLOPPY.FILENAME
(fetch (STREAM ACCESS) of STREAM)
\HFLOPPY.RECOG
(\BQUOTE ((LENGTH (\COMMA (ITIMES 2274 512)))))))
(replace (FLOPPYSTREAM PALLOC) of STREAM
with (fetch (FLOPPYSTREAM PALLOC) of NEWSTREAM))
(replace (FLOPPYSTREAM LP) of STREAM with (fetch (FLOPPYSTREAM
LP)
of NEWSTREAM))
(replace (LP $NAME) of (fetch (FLOPPYSTREAM LP) of STREAM)
with \HFLOPPY.FILENAME)
(replace (PALLOC FILENAME) of (fetch (FLOPPYSTREAM PALLOC)
of STREAM)
with \HFLOPPY.FILENAME)))))
(\HFLOPPY.READPAGES
(LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* kbr: "12-Mar-84 19:55")
(PROG NIL
(COND
((NOT (EQ (fetch (STREAM ACCESS) of STREAM)
(QUOTE INPUT)))
(RETURN)))
(for BUFFER in (MKLIST BUFFERS) as I from 0 do (\HFLOPPY.READPAGE STREAM (IPLUS FIRSTPAGE#
I)
BUFFER)))))
(\HFLOPPY.READPAGE
(LAMBDA (STREAM FIRSTPAGE# BUFFER) (* kbr: "12-Mar-84 19:55")
(WITH.MONITOR \FLOPPYLOCK (PROG (NEWSTREAM) (* Read page \HFLOPPY.PAGENO.
*)
(\PFLOPPY.READPAGE STREAM \HFLOPPY.PAGENO BUFFER)
(* Calc next \HFLOPPY.PAGENO to be written.
*)
(SETQ \HFLOPPY.PAGENO (ADD1 \HFLOPPY.PAGENO))
(COND
((ILESSP \HFLOPPY.PAGENO \HFLOPPY.MAXPAGES)
(RETURN)))
(\HFLOPPY.CLOSESMALLFILE STREAM)
(SETQ \HFLOPPY.FLOPPYNO (ADD1 \HFLOPPY.FLOPPYNO))
(SETQ \HFLOPPY.PAGENO 0)
(FRESHLINE T)
(PRIN1 "INSERT NEXT FLOPPY" T)
(TERPRI T)
(RINGBELLS)
(FLOPPY.WAIT.FOR.FLOPPY T)
(SETQ NEWSTREAM (\PFLOPPY.OPENFILE \HFLOPPY.FILENAME
(fetch (STREAM ACCESS)
of STREAM)
\HFLOPPY.RECOG))
(replace (FLOPPYSTREAM PALLOC) of STREAM
with (fetch (FLOPPYSTREAM PALLOC) of NEWSTREAM))
(replace (FLOPPYSTREAM LP) of STREAM with (fetch (FLOPPYSTREAM
LP)
of NEWSTREAM))))))
(\HFLOPPY.CLOSEHUGEFILE
(LAMBDA (STREAM) (* kbr: "12-Mar-84 19:55")
(WITH.MONITOR \FLOPPYLOCK (PROG NIL
(COND
((EQ (fetch (STREAM ACCESS) of STREAM)
(QUOTE INPUT))
(RETURN)))
(RELEASECPAGE STREAM)
(\CLEARMAP STREAM) (* Patch SYSOUT not passing us right HUGELENGTH.
*)
(SETQ \HFLOPPY.HUGELENGTH (IPLUS (ITIMES 512 (fetch (STREAM
EPAGE)
of STREAM))
(fetch (STREAM EOFFSET)
of STREAM)))
(SETQ \HFLOPPY.HUGEPAGELENGTH (IQUOTIENT (IPLUS
\HFLOPPY.HUGELENGTH 511)
512))
(\HFLOPPY.CLOSESMALLFILE STREAM)))))
(\HFLOPPY.CLOSESMALLFILE
(LAMBDA (STREAM) (* kbr: "12-Mar-84 19:55")
(* The same as \PFLOPPY.CLOSEFILE but without releasing
STREAM. Called only by \HFLOPPY.WRITEPAGE.
*)
(PROG (PALLOC LP MP NEXT NMP)
(COND
((EQ (fetch (STREAM ACCESS) of STREAM)
(QUOTE INPUT))
(RETURN))) (* At this point \HFLOPPY.PAGENO is the next page we
would write. *)
(\PFLOPPY.TRUNCATEFILE STREAM \HFLOPPY.PAGENO (fetch (STREAM EOFFSET) of STREAM))
(SETQ PALLOC (fetch (FLOPPYSTREAM PALLOC) of STREAM))
(SETQ LP (fetch (PALLOC LP) of PALLOC))
(replace (LP IWRITEDATE) of LP with \HFLOPPY.IWRITEDATE)
(COND
((EQ \HFLOPPY.RECOG (QUOTE NEW))
(replace (LP ICREATIONDATE) of LP with \HFLOPPY.IWRITEDATE)
(replace (LP PAGELENGTH) of LP with \HFLOPPY.PAGENO)
(replace (LP HUGEPAGESTART) of LP with (ITIMES \HFLOPPY.MAXPAGES \HFLOPPY.FLOPPYNO))
(replace (LP HUGEPAGELENGTH) of LP with \HFLOPPY.HUGEPAGELENGTH)
(replace (LP HUGELENGTH) of LP with \HFLOPPY.HUGELENGTH)))
(\PFLOPPY.WRITEPAGENO (fetch (PALLOC START) of PALLOC)
(fetch (PALLOC LP) of PALLOC))
(\PFLOPPY.SAVE.FILELIST)
(\PFLOPPY.SAVE.SECTOR9))))
)
(* SCAVENGE *)
(RPAQ? \FLOPPY.SCAVENGE.IDATE NIL)
(DEFINEQ
(FLOPPY.SCAVENGE
(LAMBDA NIL (* kbr: "14-Jan-84 15:29")
(SETQ \FLOPPY.SCAVENGE.IDATE (IDATE))
(\PFLOPPY.SCAVENGE)))
(\PFLOPPY.SCAVENGE
(LAMBDA NIL (* kbr: "14-Jan-84 15:29")
(PROG NIL
(\PFLOPPY.START)
(COND
((NOT (\PFLOPPY.CONFIRM "Scavenge contents of floppy"))
(RETURN NIL)))
(\FLOPPY.CLOSE)
(\PFLOPPY.SCAVENGE.MPS)
(\PFLOPPY.SCAVENGE.LPS)
(\PFLOPPY.OPEN)
(\PFLOPPY.SCAVENGE.SECTOR9)
(\PFLOPPY.SCAVENGE.FILELIST)
(RETURN T))))
(\PFLOPPY.SCAVENGE.MPS
(LAMBDA NIL (* kbr: "14-Jan-84 15:29")
(* Scavenge the marker pages.
*)
(PROG (LOCATION MP NMP)
(SETQ LOCATION 31)
(SETQ MP (\PFLOPPY.SCAVENGE.MP31))
(while (ILESSP LOCATION 2310)
do (SETQ NMP (\PFLOPPY.SCAVENGE.MP.AFTER MP LOCATION))
(\PFLOPPY.WRITEPAGENO LOCATION MP)
(SETQ LOCATION (IPLUS LOCATION (fetch (MP NLENGTH) of MP)
1))
(SETQ MP NMP))
(COND
((NOT (IEQP LOCATION 2310))
(SHOULDNT)))
(\PFLOPPY.WRITEPAGENO LOCATION MP))))
(\PFLOPPY.SCAVENGE.MP31
(LAMBDA NIL (* kbr: "14-Jan-84 15:29")
(PROG (MP LOCATION) (* Try to believe page 31.0 *)
(SETQ LOCATION 31)
(SETQ MP (\PFLOPPY.READPAGENO LOCATION (NCREATE (QUOTE MP))))
(COND
((fetch (MP INTACT) of MP)
(replace (MP VERSION) of MP with VERSION.MP)
(replace (MP PLENGTH) of MP with 0)
(replace (MP PTYPE) of MP with MPETYPE.FREE)
(replace (MP PFILETYPE) of MP with FILETYPE.FREE)
(replace (MP PFILEID) of MP with 0)
(replace (MP NLENGTH) of MP with (IMAX 0 (IMIN (IDIFFERENCE 2309 LOCATION)
(fetch (MP NLENGTH) of MP))))
(COND
((ZEROP (fetch (MP NLENGTH) of MP))
(replace (MP NTYPE) of MP with MPETYPE.FREE)
(replace (MP NFILETYPE) of MP with FILETYPE.FREE)
(replace (MP NFILEID) of MP with 0))
((OR (IEQP (fetch (MP NTYPE) of MP)
MPETYPE.FILELIST)
(IEQP (fetch (MP NFILETYPE) of MP)
FILETYPE.FILELIST))
(replace (MP NTYPE) of MP with MPETYPE.FILELIST)
(replace (MP NFILETYPE) of MP with FILETYPE.FILELIST)
(replace (MP NFILEID) of MP with 1))
(T (replace (MP NTYPE) of MP with MPETYPE.FILE)
(replace (MP NFILETYPE) of MP with FILETYPE.FILE)
(replace (MP NFILEID) of MP with 0)))
(RETURN MP))) (* Page 31 lied. *)
(SETQ MP
(create MP
SEAL ← SEAL.MP
VERSION ← VERSION.MP
PLENGTH ← 0
PTYPE ← MPETYPE.FREE
PFILEID ← 0
PFILETYPE ← FILETYPE.FREE
NLENGTH ← 0
NTYPE ← MPETYPE.FILE
NFILEID ← 0
NFILETYPE ← FILETYPE.FILE))
(RETURN MP))))
(\PFLOPPY.SCAVENGE.MP.AFTER
(LAMBDA (PMP PLOCATION) (* kbr: "14-Jan-84 15:29")
(* Come up with a plausible MP between
(ADD1 PLOCATION) and 2310 inclusive where PMP at
PLOCATION is the preceding marker page.
*)
(PROG (MP LOCATION) (* First we try to believe PMP about where the next MP
will be. *)
(SETQ MP (NCREATE (QUOTE MP)))
(SETQ LOCATION (IPLUS PLOCATION (fetch (MP NLENGTH) of PMP)
1))
(\PFLOPPY.SCAVENGE.MP.AFTER1 PLOCATION PMP LOCATION MP)
(COND
((fetch (MP INTACT) of MP)
(RETURN MP))) (* PMP lied. Hunt for first plausible MP after PMP.
Smash MP into correctness and make PMP tell the new
truth. *)
(for LOCATION from (ADD1 PLOCATION) to 2310
do (PRIN1 "." T)
(\PFLOPPY.SCAVENGE.MP.AFTER1 PLOCATION PMP LOCATION MP)
(COND
((fetch (MP INTACT) of MP)
(RETURN))))
(RETURN MP))))
(\PFLOPPY.SCAVENGE.MP.AFTER1
(LAMBDA (PLOCATION PMP LOCATION MP) (* kbr: "14-Jan-84 15:29")
(PROG NIL
(COND
((OR (ILESSP PLOCATION 31)
(IGEQ PLOCATION 2310))
(SHOULDNT)))
(COND
((OR (ILESSP LOCATION PLOCATION)
(IGREATERP LOCATION 2310))
(SHOULDNT)))
(\PFLOPPY.READPAGENO LOCATION MP)
(COND
((OR (fetch (MP INTACT) of MP)
(IEQP LOCATION 2310)) (* Force MP to be a legal marker page.
*)
(replace (MP SEAL) of MP with SEAL.MP)
(replace (MP VERSION) of MP with VERSION.MP)
(replace (MP PLENGTH) of MP with (IPLUS LOCATION (IMINUS PLOCATION)
-1))
(replace (MP PTYPE) of MP with (fetch (MP NTYPE) of PMP))
(replace (MP PFILETYPE) of MP with (fetch (MP NFILETYPE) of PMP))
(replace (MP PFILEID) of MP with (fetch (MP NFILEID) of PMP))
(replace (MP NLENGTH) of MP with (IMAX 0 (IMIN (IDIFFERENCE 2309 LOCATION)
(fetch (MP NLENGTH) of MP))))
(COND
((ZEROP (fetch (MP NLENGTH) of MP))
(replace (MP NTYPE) of MP with MPETYPE.FREE)
(replace (MP NFILETYPE) of MP with FILETYPE.FREE)
(replace (MP NFILEID) of MP with 0))
((OR (IEQP (fetch (MP NTYPE) of MP)
MPETYPE.FILELIST)
(IEQP (fetch (MP NFILETYPE) of MP)
FILETYPE.FILELIST))
(replace (MP NTYPE) of MP with MPETYPE.FILELIST)
(replace (MP NFILETYPE) of MP with FILETYPE.FILELIST)
(replace (MP NFILEID) of MP with 1))
(T (replace (MP NTYPE) of MP with MPETYPE.FILE)
(replace (MP NFILETYPE) of MP with FILETYPE.FILE)
(replace (MP NFILEID) of MP with 0)))
(RETURN))) (* Fix PMP wrt MP now *)
(replace (MP NLENGTH) of PMP with (fetch (MP PLENGTH) of MP))
(replace (MP NTYPE) of PMP with (fetch (MP PTYPE) of MP))
(replace (MP NFILEID) of PMP with (fetch (MP PFILEID) of MP))
(replace (MP NFILETYPE) of PMP with (fetch (MP PFILETYPE) of MP)))))
(\PFLOPPY.SCAVENGE.LPS
(LAMBDA NIL (* kbr: "14-Jan-84 15:29")
(* Scavenge the leader pages.
*)
(PROG (LOCATION MP LP LENGTH START)
(SETQ LOCATION 31)
(SETQ MP (NCREATE (QUOTE MP)))
(SETQ LP (create LP))
(while (ILESSP LOCATION 2310)
do (\PFLOPPY.READPAGENO LOCATION MP)
(COND
((NOT (fetch (MP INTACT) of MP)) (* Huh? We just scavenged the marker pages.
*)
(SHOULDNT)))
(SETQ LENGTH (SUB1 (fetch (MP NLENGTH) of MP)))
(COND
((IEQP (fetch (MP NTYPE) of MP)
MPETYPE.FILE)
(SETQ START (ADD1 LOCATION))
(\PFLOPPY.READPAGENO START LP)
(replace (LP SEAL) of LP with SEAL.LP)
(replace (LP VERSION) of LP with VERSION.LP)
(replace (LP MESATYPE) of LP with 65535)
(replace (LP NAMEMAXLENGTH) of LP with NAMEMAXLENGTH.LP)
(replace (LP UFO1) of LP with 2)
(replace (LP UFO2) of LP with 187)
(replace (LP UFO3) of LP with 222)
(replace (LP UFO4) of LP with 1)
(COND
((fetch (LP INTACT) of LP) (* Try to save as much info as we can about file.
*)
(replace (LP PAGELENGTH) of LP with (IMIN (fetch (LP PAGELENGTH)
of LP)
LENGTH))
(replace (LP HUGEPAGELENGTH) of LP
with (IMAX (fetch (LP PAGELENGTH) of LP)
(fetch (LP HUGEPAGELENGTH) of LP)
(fetch (LP HUGEPAGESTART) of LP)
(IQUOTIENT (IPLUS (fetch (LP HUGELENGTH) of LP)
511)
512)))
(replace (LP HUGELENGTH) of LP
with (IMAX (IDIFFERENCE (ITIMES (fetch (LP HUGEPAGELENGTH) of LP)
512)
511)
(fetch (LP HUGELENGTH) of LP))))
(T (* Meef *)
(replace (LP \CREATIONDATE) of LP with \FLOPPY.SCAVENGE.IDATE)
(replace (LP \WRITEDATE) of LP with \FLOPPY.SCAVENGE.IDATE)
(replace (LP PAGELENGTH) of LP with LENGTH)
(replace (LP HUGEPAGESTART) of LP with 0)
(replace (LP HUGEPAGELENGTH) of LP with LENGTH)
(replace (LP PAGELENGTH) of LP with (ITIMES LENGTH 512))
(replace (LP $NAME) of LP with (GENSYM (QUOTE ?)))))
(\PFLOPPY.WRITEPAGENO START LP)))
(SETQ LOCATION (IPLUS LOCATION (ADD1 LENGTH)
1))))))
(\PFLOPPY.SCAVENGE.SECTOR9
(LAMBDA NIL (* kbr: "12-Mar-84 22:43")
(PROG (SECTOR9 PALLOC)
(SETQ SECTOR9 (fetch (PFLOPPYFDEV SECTOR9) of \FLOPPYFDEV))
(replace (SECTOR9 SEAL) of SECTOR9 with SEAL.SECTOR9)
(replace (SECTOR9 VERSION) of SECTOR9 with VERSION.SECTOR9)
(replace (SECTOR9 CYLINDERS) of SECTOR9 with CYLINDERS)
(replace (SECTOR9 TRACKSPERCYLINDER) of SECTOR9 with TRACKSPERCYLINDER)
(replace (SECTOR9 SECTORSPERTRACK) of SECTOR9 with SECTORSPERTRACK)
(SETQ PALLOC (for P in (fetch (PFLOPPYFDEV PALLOCS) of \FLOPPYFDEV)
thereis (EQUAL (fetch (PALLOC FILENAME) of P)
(QUOTE (FILELIST)))))
(COND
((NULL PALLOC)
(\FLOPPY.BREAK "Can't find filelist")))
(replace (SECTOR9 FILELISTSTART) of SECTOR9 with (fetch (PALLOC START) of PALLOC))
(replace (SECTOR9 FILELISTFILEID) of SECTOR9 with 1)
(replace (SECTOR9 FILELISTLENGTH) of SECTOR9 with (fetch (PALLOC LENGTH) of PALLOC))
(replace (SECTOR9 ROOTFILEID) of SECTOR9 with 0)
(replace (SECTOR9 PILOTMICROCODE) of SECTOR9 with 0)
(replace (SECTOR9 DIAGNOSTICMICROCODE) of SECTOR9 with 0)
(replace (SECTOR9 GERM) of SECTOR9 with 0)
(replace (SECTOR9 PILOTBOOTFILE) of SECTOR9 with 0)
(replace (SECTOR9 FIRSTALTERNATESECTOR) of SECTOR9 with 0)
(replace (SECTOR9 COUNTBADSECTORS) of SECTOR9 with 0)
(replace (SECTOR9 CHANGING) of SECTOR9 with 0)
(replace (SECTOR9 \LABELLENGTH) of SECTOR9 with (IMIN (fetch (SECTOR9 \LABELLENGTH)
of SECTOR9)
20))
(\PFLOPPY.SAVE.SECTOR9))))
(\PFLOPPY.SCAVENGE.FILELIST
(LAMBDA NIL (* kbr: "14-Jan-84 15:29")
(PROG (FILELIST)
(SETQ FILELIST (fetch (PFLOPPYFDEV FILELIST) of \FLOPPYFDEV))
(COND
((ILEQ (fetch (FILELIST NENTRIES) of FILELIST)
49)
(replace (FILELIST MAXENTRIES) of FILELIST with 49)))
(\PFLOPPY.SAVE.FILELIST))))
)
(* COPY *)
(DEFINEQ
(FLOPPY.TO.FILE
(LAMBDA (TOFILE) (* kbr: " 2-Feb-84 10:40")
(WITH.MONITOR \FLOPPYLOCK
(PROG (TOSTREAM SECTOR9)
(SETQ TOSTREAM
(OPENSTREAM TOFILE (QUOTE OUTPUT)
(QUOTE NEW)
NIL
(\BQUOTE ((LENGTH (\COMMA (ITIMES (IPLUS 1 1
(ITIMES 2 15 76))
512)))))))
RETRY
(COND
((NOT (FLOPPY.CAN.READP))
(\FLOPPY.BREAK (QUOTE DOORISOPEN))
(GO RETRY)))
(\PFLOPPY.START) (* First page. *)
(PRIN1 "PILOT" TOSTREAM)
(for I from 6 to 512 do (\BOUT TOSTREAM 0))
(* Sector9 page. *)
(GLOBALRESOURCE (\FLOPPY.SCRATCH.BUFFER \FLOPPY.IBMS128.IOCB)
(\FLOPPY.READSECTOR \FLOPPY.IBMS128.IOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 0
SECTOR ← 9)
\FLOPPY.SCRATCH.BUFFER)
(\BOUTS TOSTREAM \FLOPPY.SCRATCH.BUFFER 0 512))
(* Remaining pages. *)
(GLOBALRESOURCE \FLOPPY.SCRATCH.BUFFER (for I from 31 to 2310
do (\PFLOPPY.READPAGENO I
\FLOPPY.SCRATCH.BUFFER)
(\BOUTS TOSTREAM
\FLOPPY.SCRATCH.BUFFER 0
512)))
(CLOSEF TOSTREAM)))))
(FLOPPY.FROM.FILE
(LAMBDA (FROMFILE) (* kbr: " 2-Feb-84 10:40")
(WITH.MONITOR \FLOPPYLOCK
(PROG (FROMSTREAM SECTOR9)
(SETQ FROMSTREAM (OPENSTREAM FROMFILE (QUOTE INPUT)
(QUOTE OLD)))
RETRY
(COND
((NOT (IEQP (GETFILEINFO FROMSTREAM (QUOTE LENGTH))
(ITIMES (IPLUS 1 1 (ITIMES 2 15 76))
512)))
(\FLOPPY.BREAK "Wrong length form FROMFILE")
(GO RETRY)))
(COND
((NOT (FLOPPY.CAN.READP))
(\FLOPPY.BREAK (QUOTE DOORISOPEN))
(GO RETRY))
((NOT (FLOPPY.CAN.WRITEP))
(\FLOPPY.BREAK (QUOTE WRITEPROTECTED))
(GO RETRY)))
(COND
((NOT (\PFLOPPY.FORMAT))
(GO RETRY))) (* Throw away first page. *)
(for I from 1 to 512 do (\BIN FROMSTREAM))
(* Sector9 page. *)
(GLOBALRESOURCE (\FLOPPY.SCRATCH.BUFFER \FLOPPY.IBMS128.IOCB)
(\BINS FROMSTREAM \FLOPPY.SCRATCH.BUFFER 0 512)
(\FLOPPY.WRITESECTOR \FLOPPY.IBMS128.IOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 0
SECTOR ← 9)
\FLOPPY.SCRATCH.BUFFER))
(* Remaining pages. *)
(GLOBALRESOURCE \FLOPPY.SCRATCH.BUFFER (for I from 31 to 2310
do (\BINS FROMSTREAM
\FLOPPY.SCRATCH.BUFFER 0
512)
(\PFLOPPY.WRITEPAGENO I
\FLOPPY.SCRATCH.BUFFER)))
(CLOSEF FROMSTREAM)))))
)
(* COMPACT *)
(DEFINEQ
(FLOPPY.COMPACT
(LAMBDA NIL (* kbr: "23-Jan-84 23:45")
(\PFLOPPY.COMPACT)))
(\PFLOPPY.COMPACT
(LAMBDA NIL (* kbr: "23-Jan-84 23:45")
(WITH.MONITOR \FLOPPYLOCK (* Compact scattered free blocks into large free block
at end of floppy. *)
(PROG (PINFO PALLOCS) (* Confirmation. *)
(\PFLOPPY.CONFIRM "Compact contents of floppy")
(* Forcibly close floppy. *)
(\FLOPPY.CLOSE) (* Trivial case = floppy is already compact.
*)
(SETQ PINFO (fetch (FDEV DEVICEINFO) of \FLOPPYFDEV))
(SETQ PALLOCS (fetch (PINFO PALLOCS) of PINFO))
(SELECT (FOR PALLOC IN PALLOCS COUNT (EQUAL (fetch (PALLOC FILENAME)
of PALLOC)
(QUOTE (FREE))))
(1 (RETURN))
(2 (COND
((EQUAL (fetch (PALLOC FILENAME)
of (fetch (PALLOC PREV) of (CAR (LAST PALLOCS))))
(QUOTE (FREE)))
(RETURN)))) (* Need to compact. *)
) (* Nontrivial case. *)
(\FLOPPY.MESSAGE "Compacting floppy")
(\PFLOPPY.COMPACT.PALLOCS)
(\PFLOPPY.COMPACT.SECTOR9)
(\PFLOPPY.COMPACT.FILELIST)
(\FLOPPY.MESSAGE "Finished compacting floppy")))))
(\PFLOPPY.COMPACT.PALLOCS
(LAMBDA NIL (* kbr: "23-Jan-84 23:45")
(PROG (PINFO PREV NEXT NMP LAST)
(SETQ PINFO (fetch (FDEV DEVICEINFO) of \FLOPPYFDEV))
(* PREV = the last block moved.
NEXT = block to be moved. LAST = zero length final
block. *)
(* Skip blocks that don't need to be moved.
*)
(SETQ LAST (CAR (LAST (fetch (PINFO PALLOCS) of PINFO))))
(SETQ NEXT (CAR (fetch (PINFO PALLOCS) of PINFO)))
(while (NOT (EQUAL (fetch (PALLOC FILENAME) of NEXT)
(QUOTE (FREE))))
do (SETQ NEXT (fetch (PALLOC NEXT) of NEXT)))
(SETQ PREV (fetch (PALLOC PREV) of NEXT))
LOOP (* Get NEXT non free block. *)
(while (AND NEXT (EQUAL (fetch (PALLOC FILENAME) of NEXT)
(QUOTE (FREE))))
do (SETQ NEXT (fetch (PALLOC NEXT) of NEXT)))
(COND
((NULL NEXT) (* No more non free blocks. PREV cannot be NIL at this
point since every floppy has a non free filelist block.
*)
(COND
((ILESSP (fetch (PALLOC END) of PREV)
2309) (* Create next to LAST free block.
*)
(SETQ NMP (create MP
SEAL ← SEAL.MP
VERSION ← VERSION.MP
PFILEID ← (fetch (MP NFILEID) of (fetch (PALLOC MP) of PREV))
NLENGTH ← (IDIFFERENCE 2308 (fetch (PALLOC END) of PREV))
NTYPE ← MPETYPE.FREE
NFILEID ← 0
NFILETYPE ← FILETYPE.FREE))
(SETQ NEXT (create PALLOC
FILENAME ← (QUOTE (FREE))
START ← (IPLUS (fetch (PALLOC END) of PREV)
2)
MP ← NMP
NEXT ← LAST))
(replace (PALLOC PREV) of LAST with NEXT))
((IEQP (fetch (PALLOC END) of PREV)
2309) (* Zero length LAST block. *)
(SETQ NEXT LAST))
((IEQP (fetch (PALLOC END) of PREV)
2310) (* No more blocks. *)
(GO EXIT))
(T (SHOULDNT)))))
(\PFLOPPY.COMPACT.PALLOC PREV NEXT)
(SETQ PREV NEXT)
(SETQ NEXT (fetch (PALLOC NEXT) of PREV))
(GO LOOP)
EXIT(replace (PINFO PALLOCS) of PINFO with (DREVERSE (for (PALLOC ← LAST)
by (fetch (PALLOC PREV) of PALLOC)
while PALLOC collect PALLOC))))))
(\PFLOPPY.COMPACT.PALLOC
(LAMBDA (PREV NEXT) (* kbr: "23-Jan-84 23:45")
(* Smash NEXT PALLOC start location and fields on NMP between PREV and NEXT. Write new NMP out to floppy.
Move contents of NEXT block. *)
(PROG (NMP NSTART PMP)
(SETQ NMP (fetch (PALLOC MP) of NEXT))
(SETQ NSTART (fetch (PALLOC START) of NEXT))
(replace (PALLOC PREV) of NEXT with PREV)
(COND
(PREV (replace (PALLOC NEXT) of PREV with NEXT)
(replace (PALLOC START) of NEXT with (IPLUS (fetch (PALLOC END) of PREV)
2))
(SETQ PMP (fetch (PALLOC MP) of PREV))
(replace (MP PLENGTH) of NMP with (fetch (MP NLENGTH) of PMP))
(replace (MP PFILEID) of NMP with (fetch (MP NFILEID) of PMP))
(replace (MP PTYPE) of NMP with (fetch (MP NTYPE) of PMP))
(replace (MP PFILETYPE) of NMP with (fetch (MP NFILETYPE) of PMP)))
(T (replace (PALLOC START) of NEXT with 32)
(replace (MP PLENGTH) of NMP with 0)
(replace (MP PFILEID) of NMP with 0)
(replace (MP PTYPE) of NMP with MPETYPE.FREE)
(replace (MP PFILETYPE) of NMP with FILETYPE.FREE)))
(COND
((NOT (EQUAL (fetch (PALLOC FILENAME) of NEXT)
(QUOTE (FREE))))
(replace (FLE START) of (fetch (PALLOC FLE) of NEXT) with (fetch (PALLOC START)
of NEXT))))
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PALLOC START) of NEXT))
NMP)
(COND
((EQUAL (fetch (PALLOC FILENAME) of NEXT)
(QUOTE (FREE)))
(RETURN)))
(for I from 0 to (SUB1 (fetch (PALLOC LENGTH) of NEXT))
do (\PFLOPPY.WRITEPAGENO (IPLUS (fetch (PALLOC START) of NEXT)
I)
(\PFLOPPY.READPAGENO (IPLUS NSTART I)
\FLOPPY.SCRATCH.BUFFER))))))
(\PFLOPPY.COMPACT.SECTOR9
(LAMBDA NIL (* kbr: "23-Jan-84 23:45")
(PROG (PINFO SECTOR9)
(SETQ PINFO (fetch (FDEV DEVICEINFO) of \FLOPPYFDEV))
(SETQ SECTOR9 (fetch (PINFO SECTOR9) of PINFO))
(replace (SECTOR9 FILELISTSTART) of SECTOR9
with (fetch (PALLOC START) of (for PALLOC in (fetch (PINFO PALLOCS) of PINFO)
thereis (EQUAL (fetch (PALLOC FILENAME) of PALLOC)
(QUOTE (FILELIST))))))
(\PFLOPPY.SAVE.SECTOR9))))
(\PFLOPPY.COMPACT.FILELIST
(LAMBDA NIL (* kbr: "23-Jan-84 23:45")
(PROG (PINFO FILELIST)
(SETQ PINFO (fetch (FDEV DEVICEINFO) of \FLOPPYFDEV))
(SETQ FILELIST (fetch (PINFO FILELIST) of PINFO))
(replace (FILELIST NENTRIES) of FILELIST with 0)
(for PALLOC in (fetch (PINFO PALLOCS) of PINFO) when (NOT (EQUAL (fetch (PALLOC FILENAME)
of PALLOC)
(QUOTE (FREE))))
do (\PFLOPPY.ADD.TO.FILELIST PALLOC))
(\PFLOPPY.SAVE.FILELIST))))
)
(* CPM *)
(RPAQ? \CFLOPPYSECTORMAP NIL)
(RPAQ? \CFLOPPYFDEV NIL)
(RPAQ? \CFLOPPYINFO NIL)
(RPAQ? \CFLOPPYBLANKSECTOR NIL)
(/DECLAREDATATYPE (QUOTE CINFO)
(QUOTE (POINTER POINTER)))
(/DECLAREDATATYPE (QUOTE FCB)
(QUOTE (BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE)))
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(ACCESSFNS CFLOPPYFDEV ((OPEN (fetch (CINFO OPEN) of (fetch (FDEV DEVICEINFO) of DATUM))
(replace (CINFO OPEN) of (fetch (FDEV DEVICEINFO) of DATUM)
with NEWVALUE))
(FCBS (fetch (CINFO FCBS) of (fetch (FDEV DEVICEINFO) of DATUM))
(PROGN (replace (CINFO FCBS) of (fetch (FDEV DEVICEINFO) of DATUM)
with NEWVALUE)
(SETQ \CFLOPPYFCBS NEWVALUE)))))
(DATATYPE CINFO (OPEN FCBS))
(DATATYPE FCB ((ET BYTE)
(\NAME 8 BYTE)
(\EXTENSION 3 BYTE)
(EXTENT BYTE)
(\UNUSEDHI BYTE)
(\UNUSEDLO BYTE)
(RECORDCOUNT BYTE)
(\DISKMAP 16 BYTE))
(ACCESSFNS ((FILENAME (\CFLOPPY.FCB.FILENAME DATUM))
(NAME (CREATE STRINGP
BASE ← DATUM
LENGTH ← 8
OFFST ← 1))
(EXTENSION (CREATE STRINGP
BASE ← DATUM
LENGTH ← 3
OFFST ← 9))
(UNUSED (IPLUS (ITIMES 256 (fetch (FCB \UNUSEDHI) of DATUM))
(fetch (FCB \UNUSEDLO) of DATUM)))
(DISKMAP (\ADDBASE DATUM 8))
(\VALUE DATUM (\BLT DATUM NEWVALUE 16)))))
]
(/DECLAREDATATYPE (QUOTE CINFO)
(QUOTE (POINTER POINTER)))
(/DECLAREDATATYPE (QUOTE FCB)
(QUOTE (BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE BYTE
BYTE BYTE BYTE)))
)
(DEFINEQ
(\CFLOPPY.FCB.FILENAME
(LAMBDA (FCB) (* kbr: "14-Jan-84 15:29")
(PROG (NAME EXTENSION POS FILENAME)
(SETQ NAME (fetch (FCB NAME) of FCB))
(SETQ EXTENSION (fetch (FCB EXTENSION) of FCB))
(SETQ POS (SUB1 (OR (STRPOS " " NAME)
9)))
(COND
((ZEROP POS)
(SETQ NAME ""))
(T (SETQ NAME (SUBSTRING NAME 1 POS))))
(SETQ POS (SUB1 (OR (STRPOS " " EXTENSION)
4)))
(COND
((ZEROP POS)
(SETQ EXTENSION ""))
(T (SETQ EXTENSION (SUBSTRING EXTENSION 1 POS))))
(SETQ FILENAME (PACK* NAME "." EXTENSION))
(RETURN FILENAME))))
(\CFLOPPY.INIT
(LAMBDA NIL (* kbr: "14-Jan-84 15:29")
(PROG NIL
(SETQ \CFLOPPYSECTORMAP (ARRAY 26 (QUOTE BYTE)
0 0))
(for I from 0 as J
in (QUOTE (1 7 13 19 25 5 11 17 23 3 9 15 21 2 8 14 20 26 6 12 18 24 4 10 16 22))
do (SETA \CFLOPPYSECTORMAP I J))
(SETQ \CFLOPPYBLANKSECTOR (\ALLOCBLOCK 256 NIL 256))
(for I from 0 to 255 do (\PUTBASE \CFLOPPYBLANKSECTOR I (IPLUS (ITIMES 256 229)
229)))
(SETQ \CFLOPPYINFO (create CINFO))
(SETQ \CFLOPPYFDEV (create FDEV
DEVICENAME ← (QUOTE FLOPPY)
RESETABLE ← T
RANDOMACCESSP ← T
NODIRECTORIES ← T
PAGEMAPPED ← T
CLOSEFILE ← (QUOTE NILL)
DELETEFILE ← (QUOTE NILL)
DIRECTORYNAMEP ← (QUOTE NILL)
EVENTFN ← (QUOTE \FLOPPY.EVENTFN)
GENERATEFILES ← (QUOTE NILL)
GETFILEINFO ← (QUOTE NILL)
GETFILENAME ← (QUOTE NILL)
HOSTNAMEP ← (QUOTE \FLOPPY.HOSTNAMEP)
OPENFILE ← (QUOTE \CFLOPPY.OPENFILE)
READPAGES ← (QUOTE \CFLOPPY.READPAGES)
REOPENFILE ← (QUOTE \CFLOPPY.OPENFILE)
SETFILEINFO ← (QUOTE NILL)
TRUNCATEFILE ← (QUOTE NILL)
WRITEPAGES ← (QUOTE NILL)
BIN ← (QUOTE \PAGEDBIN)
BOUT ← (QUOTE \PAGEDBOUT)
PEEKBIN ← (QUOTE \PAGEDPEEKBIN)
READP ← (QUOTE \PAGEDREADP)
BACKFILEPTR ← (QUOTE \PAGEDBACKFILEPTR)
DEVICEINFO ← \CFLOPPYINFO
SETFILEPTR ← (QUOTE \PAGEDSETFILEPTR)
GETFILEPTR ← (QUOTE \PAGEDGETFILEPTR)
GETEOFPTR ← (QUOTE \PAGEDGETEOFPTR)
EOFP ← (QUOTE \PAGEDEOFP)
BLOCKIN ← (QUOTE \PAGEDBINS)
BLOCKOUT ← (QUOTE \PAGEDBOUTS)
RENAMEFILE ← (QUOTE NILL)
FLUSHOUTPUT ← (QUOTE \PAGED.FLUSHOUTPUT))))))
(\CFLOPPY.OPEN
(LAMBDA NIL (* kbr: "14-Jan-84 15:29")
(PROG NIL
(COND
((NOT (FLOPPY.DRIVE.EXISTSP))
(\FLOPPY.BREAK "No floppy drive on this machine")))
(COND
((fetch (CINFO OPEN) of \CFLOPPYINFO) (* Already open. *)
(RETURN)))
(\FLOPPY.INITIALIZE)
(\FLOPPY.RECALIBRATE)
(\CFLOPPY.OPEN.DIRECTORY)
(replace (CINFO OPEN) of \CFLOPPYINFO with T))))
(\CFLOPPY.OPEN.DIRECTORY
(LAMBDA NIL (* kbr: "14-Jan-84 15:29")
(PROG (BUFFER FCB FCBS)
(SETQ BUFFER (NCREATE (QUOTE VMEMPAGEP)))
(for I from 0 to 15
do (\CFLOPPY.READPAGENO I BUFFER)
(for J from 0 to 3
do (SETQ FCB (create FCB
\VALUE ← (\ADDBASE BUFFER (ITIMES J 16))))
(* TBW: A better test to see if we are out of FCBs.
*)
(COND
((IEQP (\GETBASE FCB 0)
(IPLUS (ITIMES 256 229)
229))
(GO EXIT)))
(push FCBS FCB)))
EXIT(SETQ FCBS (DREVERSE FCBS))
(replace (CINFO FCBS) of \CFLOPPYINFO with FCBS))))
(\CFLOPPY.READPAGES
(LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* kbr: "14-Jan-84 15:29")
(WITH.MONITOR \FLOPPYLOCK (PROG (FCB PAGENO)
(SETQ FCB (fetch (FLOPPYSTREAM FCB) of STREAM))
(COND
((IGREATERP FIRSTPAGE# 8)
(ERROR "EXTENTS NOT IMPLEMENTED YET")))
(SETQ PAGENO (IPLUS (ITIMES 8 (\GETBASEBYTE (fetch (FCB DISKMAP)
of FCB)
(IQUOTIENT FIRSTPAGE#
2)))
(ITIMES 4 (IREMAINDER FIRSTPAGE# 2))))
(for I from 0 to 3 do (\CFLOPPY.READPAGENO (IPLUS PAGENO I)
(\ADDBASE
BUFFERS
(ITIMES 64 I))))))))
(\CFLOPPY.READPAGENO
(LAMBDA (PAGENO PAGE NOERROR) (* kbr: "14-Jan-84 15:29")
(GLOBALRESOURCE \FLOPPY.IBMS128.IOCB (\FLOPPY.READSECTOR \FLOPPY.IBMS128.IOCB (
\CFLOPPY.PAGENOTODISKADDRESS PAGENO)
PAGE NOERROR))))
(\CFLOPPY.WRITEPAGENO
(LAMBDA (PAGENO PAGE NOERROR) (* kbr: "14-Jan-84 15:29")
(GLOBALRESOURCE \FLOPPY.IBMS128.IOCB (\FLOPPY.WRITESECTOR \FLOPPY.IBMS128.IOCB (
\CFLOPPY.PAGENOTODISKADDRESS PAGENO)
PAGE NOERROR))))
(\CFLOPPY.PAGENOTODISKADDRESS
(LAMBDA (PAGENO) (* kbr: "14-Jan-84 15:29")
(PROG (CPMSECTORSPERTRACK CPMTRACKSPERCYLINDER QUOTIENT CYLINDER HEAD SECTOR DISKADDRESS)
(SETQ CPMSECTORSPERTRACK 26)
(SETQ CPMTRACKSPERCYLINDER 1)
(SETQ SECTOR (ELT \CFLOPPYSECTORMAP (IREMAINDER PAGENO CPMSECTORSPERTRACK)))
(SETQ QUOTIENT (IQUOTIENT PAGENO CPMSECTORSPERTRACK))
(SETQ CYLINDER (IPLUS (IQUOTIENT QUOTIENT CPMTRACKSPERCYLINDER)
2))
(SETQ HEAD (IREMAINDER QUOTIENT CPMTRACKSPERCYLINDER))
(SETQ DISKADDRESS (create DISKADDRESS
SECTOR ← SECTOR
HEAD ← HEAD
CYLINDER ← CYLINDER))
(RETURN DISKADDRESS))))
(\CFLOPPY.OPENFILE
(LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* kbr: "14-Jan-84 15:29")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM)
(\CFLOPPY.OPEN)
(COND
((NOT (type? STREAM FILE))
(SETQ STREAM (\CFLOPPY.GETFILEHANDLE
FILE RECOG (NOT (EQ ACCESS (QUOTE INPUT))))))
(T (SETQ STREAM FILE)))
(RETURN STREAM)))))
(\CFLOPPY.GETFILEHANDLE
(LAMBDA (FILE RECOG CREATEFLG) (* kbr: "14-Jan-84 15:29")
(PROG (NAME FCB STREAM)
(COND
(CREATEFLG (ERROR RECOG "NOT IMPLEMENTED")))
(SETQ NAME (\FLOPPY.ASSUREFILENAME FILE))
(SETQ FCB (\CFLOPPY.GETFILEFCB NAME)) (* TBW: Correct length of FILE.
*)
(COND
((NULL FCB)
(LISPERROR "BAD FILE NAME" FILE)))
(SETQ STREAM (create STREAM
DEVICE ← \FLOPPYFDEV
FULLFILENAME ← (\FLOPPY.ADDDEVICENAME NAME \FLOPPYFDEV)
EPAGE ← 512
EOFFSET ← 0))
(replace (FLOPPYSTREAM FCB) of STREAM with FCB)
(RETURN STREAM))))
(\CFLOPPY.GETFILEFCB
(LAMBDA (FILE) (* kbr: "14-Jan-84 15:29")
(PROG (FCB)
(SETQ FCB (for FCB in (fetch (CINFO FCBS) of \CFLOPPYINFO)
thereis (EQ (fetch (FCB FILENAME) of FCB)
FILE)))
(RETURN FCB))))
(\CFLOPPY.FORMAT
(LAMBDA (NAME AUTOCONFIRMFLG SLOWFLG) (* kbr: "14-Jan-84 16:31")
(WITH.MONITOR \FLOPPYLOCK
(PROG NIL
RETRY
(GLOBALRESOURCE \FLOPPY.IBMS128.IOCB
(COND
((NOT (AND (\FLOPPY.INITIALIZE T)
(\FLOPPY.RECALIBRATE T)
(\FLOPPY.FORMATTRACKS \FLOPPY.IBMS128.IOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 0
SECTOR ← 1)
77 T)
(\FLOPPY.INITIALIZE T)
(\FLOPPY.RECALIBRATE T)
(\FLOPPY.FORMATTRACKS \FLOPPY.IBMS128.IOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 1
SECTOR ← 1)
77 T)))
(\FLOPPY.MESSAGE "RETRYING FORMAT")
(GO RETRY))))
(for I from 0 to 15 do (COND
((NULL (\CFLOPPY.WRITEPAGENO I \CFLOPPYBLANKSECTOR T)
) (* Unsuccessful write. *)
(\FLOPPY.MESSAGE "RETRYING FORMAT")
(GO RETRY))))))))
)
(FLOPPY.RESTART)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA \FLOPPY.CATCH)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (36283 39109 (\FLOPPY.TRANSLATERESULT 36293 . 37001) (\FLOPPY.SEVERE.ERROR 37003 . 37339
) (\FLOPPY.TRANSLATEMPETYPE 37341 . 37647) (\FLOPPY.TRANSLATEFILETYPE 37649 . 38163) (\FLOPPY.MTL.FIXP
38165 . 38393) (\FLOPPY.LTM.FIXP 38395 . 38623) (\FLOPPY.MTL.IDATE 38625 . 38865) (\FLOPPY.LTM.IDATE
38867 . 39107)) (39585 56895 (\FLOPPY.TRANSLATESETUP 39595 . 39998) (\FLOPPY.SETUP 40000 . 41396) (
\FLOPPY.CHECK.IOCB 41398 . 44551) (\FLOPPY.DENSITY 44553 . 44807) (\FLOPPY.SECTORLENGTH 44809 . 45101)
(\FLOPPY.ENCODEDSECTORLENGTH 45103 . 45406) (\FLOPPY.GAP3 45408 . 45696) (\FLOPPY.SECTORSPERTRACK
45698 . 45993) (\FLOPPY.RUN 45995 . 50723) (\FLOPPY.LOCK.BUFFER 50725 . 51666) (\FLOPPY.UNLOCK.BUFFER
51668 . 52173) (\FLOPPY.ERROR 52175 . 53158) (\FLOPPY.PREPAREFORCRASH 53160 . 53687) (\FLOPPY.COMMAND
53689 . 54376) (\FLOPPY.TRANSFER 54378 . 55002) (\FLOPPY.NOP 55004 . 55221) (\FLOPPY.RECALIBRATE 55223
. 55465) (\FLOPPY.INITIALIZE 55467 . 55707) (\FLOPPY.FORMATTRACKS 55709 . 56266) (\FLOPPY.READSECTOR
56268 . 56455) (\FLOPPY.WRITESECTOR 56457 . 56646) (\FLOPPY.RECOVER 56648 . 56893)) (58882 68982 (
FLOPPY.RESTART 58892 . 60374) (FLOPPY.MODE 60376 . 61775) (\FLOPPY.EVENTFN 61777 . 62575) (
\FLOPPY.CLOSE 62577 . 63326) (\FLOPPY.FLUSH 63328 . 63879) (\FLOPPY.HOSTNAMEP 63881 . 64219) (
\FLOPPY.ADDDEVICENAME 64221 . 64567) (\FLOPPY.ASSUREFILENAME 64569 . 65077) (\FLOPPY.OTHERINFO 65079
. 65553) (\FLOPPY.LEXASSOC 65555 . 65899) (\FLOPPY.LEXPUTASSOC 65901 . 66869) (\FLOPPY.LEXREMOVEASSOC
66871 . 67582) (\FLOPPY.CATCH 67584 . 67907) (\FLOPPY.THROW 67909 . 68498) (\FLOPPY.BREAK 68500 .
68733) (\FLOPPY.MESSAGE 68735 . 68980)) (71228 113294 (\PFLOPPY.INIT 71238 . 72867) (\PFLOPPY.OPEN
72869 . 73930) (\PFLOPPY.DOORCHECK 73932 . 74516) (\PFLOPPY.START 74518 . 74717) (
\PFLOPPY.OPEN.SECTOR9 74719 . 75111) (\PFLOPPY.GET.SECTOR9 75113 . 75895) (\PFLOPPY.OPEN.FILELIST
75897 . 78280) (\PFLOPPY.OPENFILE 78282 . 80439) (\PFLOPPY.OPENFILE1 80441 . 81678) (
\PFLOPPY.OPENOLDFILE 81680 . 82534) (\PFLOPPY.OPENNEWFILE 82536 . 83948) (\PFLOPPY.ASSURESTREAM 83950
. 84372) (\PFLOPPY.GETFILEINFO 84374 . 85788) (\PFLOPPY.SETFILEINFO 85790 . 87510) (
\PFLOPPY.CLOSEFILE 87512 . 87892) (\PFLOPPY.CLOSEFILE1 87894 . 89917) (\PFLOPPY.DELETEFILE 89919 .
91140) (\PFLOPPY.GETFILENAME 91142 . 91919) (\PFLOPPY.GENERATEFILES 91921 . 93068) (
\PFLOPPY.GENERATEFILES1 93070 . 94129) (\PFLOPPY.RENAMEFILE 94131 . 95404) (\PFLOPPY.STREAMS.AGAINST
95406 . 95943) (\PFLOPPY.STREAMS.USING 95945 . 96406) (\PFLOPPY.READPAGES 96408 . 96704) (
\PFLOPPY.READPAGE 96706 . 97743) (\PFLOPPY.WRITEPAGENO 97745 . 98413) (\PFLOPPY.READPAGENO 98415 .
99084) (\PFLOPPY.PAGENOTODISKADDRESS 99086 . 99708) (\PFLOPPY.DISKADDRESSTOPAGENO 99710 . 100174) (
\PFLOPPY.DIR.GET 100176 . 101152) (\PFLOPPY.DIR.PUT 101154 . 102370) (\PFLOPPY.DIR.REMOVE 102372 .
103693) (\PFLOPPY.DIR.VERSION 103695 . 104433) (\PFLOPPY.CREATE.FILELIST 104435 . 105109) (
\PFLOPPY.ADD.TO.FILELIST 105111 . 108284) (\PFLOPPY.DELETE.FROM.FILELIST 108286 . 109584) (
\PFLOPPY.SAVE.FILELIST 109586 . 110127) (\PFLOPPY.SAVE.SECTOR9 110129 . 110558) (\PFLOPPY.WRITEPAGES
110560 . 110860) (\PFLOPPY.WRITEPAGE 110862 . 111614) (\PFLOPPY.TRUNCATEFILE 111616 . 112802) (
FLOPPY.CROCK 112804 . 113292)) (113556 132476 (\PFLOPPY.ALLOCATE 113566 . 115645) (
\PFLOPPY.ALLOCATE.LARGEST 115647 . 116347) (\PFLOPPY.TRUNCATE 116349 . 119109) (\PFLOPPY.DEALLOCATE
119111 . 120093) (\PFLOPPY.EXTEND 120095 . 124664) (\PFLOPPY.GAINSPACE 124666 . 125651) (
\PFLOPPY.GAINSPACE.MERGE 125653 . 127661) (FLOPPY.BUG 127663 . 128106) (FRESH.FLOPPY 128108 . 128270)
(FLOPPY.LENGTHS 128272 . 128524) (FLOPPY.STARTS 128526 . 128776) (FLOPPY.ICHECK 128778 . 131609) (
FLOPPY.ALLOCATIONS 131611 . 132474)) (132500 142785 (FLOPPY.FREE.PAGES 132510 . 132656) (
\PFLOPPY.FREE.PAGES 132658 . 133750) (FLOPPY.FORMAT 133752 . 134106) (\PFLOPPY.FORMAT 134108 . 138577)
(\PFLOPPY.CONFIRM 138579 . 139318) (FLOPPY.NAME 139320 . 139513) (FLOPPY.GET.NAME 139515 . 139778) (
\PFLOPPY.GET.NAME 139780 . 140054) (FLOPPY.SET.NAME 140056 . 140324) (\PFLOPPY.SET.NAME 140326 .
140782) (FLOPPY.DRIVE.EXISTSP 140784 . 141035) (FLOPPY.CAN.READP 141037 . 141430) (FLOPPY.CAN.WRITEP
141432 . 141912) (FLOPPY.WAIT.FOR.FLOPPY 141914 . 142783)) (143082 154822 (\SFLOPPY.INIT 143092 .
144679) (\SFLOPPY.GETFILEINFO 144681 . 146084) (\SFLOPPY.OPENHUGEFILE 146086 . 148643) (
\SFLOPPY.READPAGES 148645 . 149056) (\SFLOPPY.READPAGE 149058 . 150327) (\SFLOPPY.WRITEPAGES 150329 .
150629) (\SFLOPPY.WRITEPAGE 150631 . 152489) (\SFLOPPY.CLOSEHUGEFILE 152491 . 153250) (
\SFLOPPY.CLOSESMALLFILE 153252 . 154820)) (155188 167004 (\HFLOPPY.INIT 155198 . 156785) (
\HFLOPPY.GETFILEINFO 156787 . 158190) (\HFLOPPY.OPENHUGEFILE 158192 . 160821) (\HFLOPPY.WRITEPAGES
160823 . 161123) (\HFLOPPY.WRITEPAGE 161125 . 162989) (\HFLOPPY.READPAGES 162991 . 163402) (
\HFLOPPY.READPAGE 163404 . 164671) (\HFLOPPY.CLOSEHUGEFILE 164673 . 165432) (\HFLOPPY.CLOSESMALLFILE
165434 . 167002)) (167068 179226 (FLOPPY.SCAVENGE 167078 . 167262) (\PFLOPPY.SCAVENGE 167264 . 167771)
(\PFLOPPY.SCAVENGE.MPS 167773 . 168485) (\PFLOPPY.SCAVENGE.MP31 168487 . 170453) (
\PFLOPPY.SCAVENGE.MP.AFTER 170455 . 171676) (\PFLOPPY.SCAVENGE.MP.AFTER1 171678 . 174079) (
\PFLOPPY.SCAVENGE.LPS 174081 . 176792) (\PFLOPPY.SCAVENGE.SECTOR9 176794 . 178798) (
\PFLOPPY.SCAVENGE.FILELIST 178800 . 179224)) (179246 182411 (FLOPPY.TO.FILE 179256 . 180721) (
FLOPPY.FROM.FILE 180723 . 182409)) (182434 190198 (FLOPPY.COMPACT 182444 . 182584) (\PFLOPPY.COMPACT
182586 . 184026) (\PFLOPPY.COMPACT.PALLOCS 184028 . 186829) (\PFLOPPY.COMPACT.PALLOC 186831 . 188946)
(\PFLOPPY.COMPACT.SECTOR9 188948 . 189557) (\PFLOPPY.COMPACT.FILELIST 189559 . 190196)) (192143 200718
(\CFLOPPY.FCB.FILENAME 192153 . 192865) (\CFLOPPY.INIT 192867 . 194785) (\CFLOPPY.OPEN 194787 .
195331) (\CFLOPPY.OPEN.DIRECTORY 195333 . 196128) (\CFLOPPY.READPAGES 196130 . 196818) (
\CFLOPPY.READPAGENO 196820 . 197112) (\CFLOPPY.WRITEPAGENO 197114 . 197403) (
\CFLOPPY.PAGENOTODISKADDRESS 197405 . 198161) (\CFLOPPY.OPENFILE 198163 . 198568) (
\CFLOPPY.GETFILEHANDLE 198570 . 199322) (\CFLOPPY.GETFILEFCB 199324 . 199645) (\CFLOPPY.FORMAT 199647
. 200716)))))
STOP