(FILECREATED "23-Jun-86 17:13:32" {ERIS}<LISPCORE>SOURCES>FLOPPY.;99 408334
changes to: (FNS \PFLOPPY.RENAMEFILE \CFLOPPY.RENAMEFILE \PFLOPPY.DELETEFILE
\CFLOPPY.DELETEFILE)
previous date: "19-Jun-86 00:04:02" {ERIS}<LISPCORE>SOURCES>FLOPPY.;97)
(* Copyright (c) 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FLOPPYCOMS)
(RPAQQ FLOPPYCOMS
[(* FLOPPY "-- By Kelly Roach." *)
(COMS (* "FACE" *)
(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))
(FLOPPYIOCB.SIZE 16)
(B128 0)
(B256 1)
(B512 2)
(B1024 3)
(IBM 0)
(TROY 1)
(SINGLE 0)
(DOUBLE 8)
(NoBits 0)
(IDLENGTH 3)
(SEAL.PSECTOR9 49932)
(VERSION.PSECTOR9 1)
(SEAL.PMPAGE 13003)
(VERSION.PMPAGE 1)
(SEAL.PFILELIST 45771)
(VERSION.PFILELIST 1)
(PMPAGEETYPE.FREE 0)
(PMPAGEETYPE.FILE 1)
(PMPAGEETYPE.PFILELIST 2)
(PMPAGEETYPE.BADSECTORS 3)
(SEAL.PLPAGE 43690)
(VERSION.PLPAGE 1)
(VERSION.DATA 2222)
(NAMEMAXLENGTH.PLPAGE 100)
(FILETYPE.FREE 0)
(FILETYPE.FILE 2052)
(FILETYPE.PFILELIST 2054)))
(INITRECORDS DISKADDRESS FLOPPYIOCB FLOPPYRESULT PSECTOR9 PMPAGE PLPAGE PFILELIST PFLE)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS DISKADDRESS FLOPPYIOCB FLOPPYRESULT PSECTOR9
PMPAGE PLPAGE PFILELIST PFLE))
(FNS \FLOPPY.TRANSLATEFLOPPYRESULT \FLOPPY.SEVERE.ERROR \FLOPPY.TRANSLATEPMPAGEETYPE
\FLOPPY.TRANSLATEFILETYPE \FLOPPY.MTL.FIXP \FLOPPY.LTM.FIXP \FLOPPY.MTL.IDATE
\FLOPPY.LTM.IDATE))
(COMS (* "HEAD" *)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS (IBMS128 0)
(IBMS256 1)
(IBMS512 2)
(IBMS1024 3)
(IBMD128 4)
(IBMD256 5)
(IBMD512 6)
(IBMD1024 7)))
(INITVARS (\FLOPPY.DEBUG NIL)
(\FLOPPY.CYLINDERS 77)
(\FLOPPY.TRACKSPERCYLINDER 2)
(\FLOPPY.SECTORSPERTRACK 15)
(\FLOPPYMPERRORS 0)
(\FLOPPYMPERRORSFLG NIL)
(\FLOPPY.MOUNTEDP.DOVETIME NIL)
(\FLOPPY.MOUNTEDP.DOVEANSWER NIL))
(FNS \FLOPPY.TRANSLATESETUP \FLOPPY.SETUP.IOCB \FLOPPY.CHECK.FLOPPYIOCB \FLOPPY.DENSITY
\FLOPPY.SECTORLENGTH \FLOPPY.ENCODEDSECTORLENGTH \FLOPPY.GAP3
\FLOPPY.SECTORSPERTRACK \FLOPPY.RUN \FLOPPY.ERROR \FLOPPY.LOCK.BUFFER
\FLOPPY.UNLOCK.BUFFER \FLOPPY.PREPAREFORCRASH \FLOPPY.COMMAND \FLOPPY.INITIALIZE
\FLOPPY.NOP \FLOPPY.RECALIBRATE \FLOPPY.RECOVER \FLOPPY.TRANSFER
\FLOPPY.READSECTOR \FLOPPY.WRITESECTOR \FLOPPY.FORMATTRACKS
\FLOPPY.DISKCHANGECLEAR \FLOPPY.MOUNTEDP \FLOPPY.CAN.READP \FLOPPY.CAN.WRITEP
\FLOPPY.WRITEABLEP \FLOPPY.TWOSIDEDP \FLOPPY.DUMP \FLOPPY.DEBUG))
(COMS (* "COMMON" *)
(INITVARS (\FLOPPYFDEV NIL)
(\FLOPPYLOCK NIL)
(\FLOPPY.SCRATCH.BUFFER NIL)
(\FLOPPY.SCRATCH.BUFFER2 NIL)
(\FLOPPY.SCRATCH.FLOPPYIOCB NIL)
(\FLOPPY.IBMS128.FLOPPYIOCB NIL)
(\FLOPPY.IBMD256.FLOPPYIOCB NIL)
(\FLOPPY.IBMD512.FLOPPYIOCB NIL)
(\FLOPPYIOCBADDR NIL)
(\FLOPPYIOCB NIL)
(\FLOPPYRESULT NIL))
(GLOBALRESOURCES \FLOPPY.SCRATCH.FLOPPYIOCB \FLOPPY.IBMS128.FLOPPYIOCB
\FLOPPY.IBMD256.FLOPPYIOCB \FLOPPY.IBMD512.FLOPPYIOCB \FLOPPY.SCRATCH.BUFFER
\FLOPPY.SCRATCH.BUFFER2)
(INITRECORDS FLOPPYSTREAM FILEGENOBJ GENFILESTATE)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS FLOPPYSTREAM FILEGENOBJ GENFILESTATE))
(FNS FLOPPY.RESTART FLOPPY.MODE \FLOPPY.SETUP.HARDWARE \FLOPPY.EVENTFN
\FLOPPY.HOSTNAMEP \FLOPPY.ADDDEVICENAME \FLOPPY.ASSUREFILENAME \FLOPPY.OTHERINFO
\FLOPPY.LEXASSOC \FLOPPY.LEXPUTASSOC \FLOPPY.LEXREMOVEASSOC \FLOPPY.CACHED.READ
\FLOPPY.CACHED.WRITE \FLOPPY.OPEN \FLOPPY.CLOSE \FLOPPY.FLUSH
\FLOPPY.UNCACHED.READ \FLOPPY.UNCACHED.WRITE \FLOPPY.EXISTSP \FLOPPY.BREAK
\FLOPPY.MESSAGE \FLOPPY.BUFFER))
(COMS (* "PILOT" *)
(INITVARS (\PFLOPPYPSECTOR9 NIL)
(\PFLOPPYPFILELIST NIL)
(\PFLOPPYINFO NIL)
(\PFLOPPYFDEV NIL))
(INITRECORDS PFALLOC PFINFO PFLOPPYFDEV)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS PFALLOC PFINFO PFLOPPYFDEV))
(FNS \PFLOPPY.INIT \PFLOPPY.OPEN \PFLOPPY.OPEN.PSECTOR9 \PFLOPPY.GET.PSECTOR9
\PFLOPPY.OPEN.PFILELIST \PFLOPPY.DAMAGED \PFLOPPY.OPENFILE \PFLOPPY.OPENFILE1
\PFLOPPY.OPENOLDFILE \PFLOPPY.OPENNEWFILE \PFLOPPY.ASSURESTREAM
\PFLOPPY.GETFILEINFO \PFLOPPY.GETFILEINFO1 \PFLOPPY.SETFILEINFO \PFLOPPY.CLOSEFILE
\PFLOPPY.CLOSEFILE1 \PFLOPPY.DELETEFILE \PFLOPPY.GENERATEFILES \PFLOPPY.NEXTFILEFN
\PFLOPPY.FILEINFOFN \PFLOPPY.RENAMEFILE \PFLOPPY.STREAMS.AGAINST
\PFLOPPY.STREAMS.USING \PFLOPPY.READPAGES \PFLOPPY.READPAGE \PFLOPPY.READPAGENO
\PFLOPPY.WRITEPAGENO \PFLOPPY.PAGENOTODISKADDRESS \PFLOPPY.DISKADDRESSTOPAGENO
\PFLOPPY.DIR.GET \PFLOPPY.DIR.PUT \PFLOPPY.DIR.REMOVE \PFLOPPY.DIR.VERSION
\PFLOPPY.GETFILENAME \PFLOPPY.CREATE.PFILELIST \PFLOPPY.ADD.TO.PFILELIST
\PFLOPPY.DELETE.FROM.PFILELIST \PFLOPPY.SAVE.PFILELIST \PFLOPPY.SAVE.PSECTOR9
\PFLOPPY.WRITEPAGES \PFLOPPY.WRITEPAGE \PFLOPPY.TRUNCATEFILE \PFLOPPY.FORMAT
\PFLOPPY.CONFIRM \PFLOPPY.GET.NAME \PFLOPPY.SET.NAME))
(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
\PFLOPPY.ALLOCATE.WATCHDOG \PFLOPPY.FREE.PAGES \PFLOPPY.LENGTHS \PFLOPPY.STARTS
\PFLOPPY.ICHECK \PFLOPPY.ALLOCATIONS))
(COMS (* "SERVICES" *)
(FNS FLOPPY.FREE.PAGES FLOPPY.FORMAT FLOPPY.NAME FLOPPY.GET.NAME FLOPPY.SET.NAME
FLOPPY.CAN.READP FLOPPY.CAN.WRITEP FLOPPY.WAIT.FOR.FLOPPY))
(COMS (* "SYSOUT" *)
(INITVARS (\SFLOPPYINFO NIL)
(\SFLOPPYFDEV NIL)
(\HFLOPPY.MAXPAGES NIL)
(\SFLOPPY.PAGENO NIL)
(\SFLOPPY.FLOPPYNO NIL)
(\SFLOPPY.PAGES NIL)
(\SFLOPPY.HUGELENGTH NIL)
(\SFLOPPY.HUGEPAGELENGTH NIL)
(\SFLOPPY.IWRITEDATE NIL)
(\SFLOPPY.FLOPPYNAME "Lisp Sysout ")
(\SFLOPPY.FILENAME (QUOTE lisp.sysout))
(\SFLOPPY.RECOG NIL)
(\SFLOPPY.OTHERINFO NIL)
(\SFLOPPY.SLOWFLG T)
(\SFLOPPY.HACK.MODE NIL)
(\SFLOPPY.HACK.STREAM NIL))
(FNS \SFLOPPY.INIT \SFLOPPY.GETFILEINFO \SFLOPPY.OPENHUGEFILE \SFLOPPY.WRITEPAGES
\SFLOPPY.WRITEPAGE \SFLOPPY.READPAGES \SFLOPPY.READPAGE \SFLOPPY.CLOSEHUGEFILE
\SFLOPPY.INPUTFLOPPY \SFLOPPY.OUTPUTFLOPPY \SFLOPPY.CLOSEFLOPPY \SFLOPPY.HACK))
(COMS (* "HUGE" *)
(INITVARS (\HFLOPPYINFO NIL)
(\HFLOPPYFDEV NIL)
(\HFLOPPY.MAXPAGES NIL)
(\HFLOPPY.PAGENO NIL)
(\HFLOPPY.FLOPPYNO NIL)
(\HFLOPPY.HUGELENGTH NIL)
(\HFLOPPY.HUGEPAGELENGTH NIL)
(\HFLOPPY.IWRITEDATE NIL)
(\HFLOPPY.FLOPPYNAME NIL)
(\HFLOPPY.FILENAME NIL)
(\HFLOPPY.RECOG NIL)
(\HFLOPPY.OTHERINFO NIL)
(\HFLOPPY.SLOWFLG T))
(FNS \HFLOPPY.INIT \HFLOPPY.GETFILEINFO \HFLOPPY.OPENHUGEFILE \HFLOPPY.WRITEPAGES
\HFLOPPY.WRITEPAGE \HFLOPPY.READPAGES \HFLOPPY.READPAGE \HFLOPPY.CLOSEHUGEFILE
\HFLOPPY.INPUTFLOPPY \HFLOPPY.OUTPUTFLOPPY \HFLOPPY.CLOSEFLOPPY))
(COMS (* "SCAVENGE" *)
(INITVARS (\FLOPPY.SCAVENGE.IDATE NIL))
(FNS FLOPPY.SCAVENGE \PFLOPPY.SCAVENGE \PFLOPPY.SCAVENGE.PMPAGES
\PFLOPPY.SCAVENGE.PMPAGEA \PFLOPPY.SCAVENGE.PMPAGE.AFTER
\PFLOPPY.SCAVENGE.PMPAGE.AFTER1 \PFLOPPY.SCAVENGE.PLPAGES
\PFLOPPY.SCAVENGE.PSECTOR9 \PFLOPPY.SCAVENGE.PFILELIST))
(COMS (* "COPY" *)
(FNS FLOPPY.TO.FILE FLOPPY.FROM.FILE))
(COMS (* "COMPACT" *)
(FNS FLOPPY.COMPACT \PFLOPPY.COMPACT \PFLOPPY.COMPACT.PFALLOCS \PFLOPPY.COMPACT.PFALLOC
\PFLOPPY.COMPACT.PSECTOR9 \PFLOPPY.COMPACT.PFILELIST))
(COMS (* "ARCHIVE" *)
(FNS FLOPPY.ARCHIVE FLOPPY.UNARCHIVE))
(COMS (* "CPM" *)
(CONSTANTS (CPMDELETEMARK 229)
(CPMFILEMARK 0))
(INITVARS (\CFLOPPYINFO NIL)
(\CFLOPPYCALLOCS NIL)
(\CFLOPPYDIR NIL)
(\CFLOPPYFDEV NIL)
(\CFLOPPYDIRECTORY NIL)
(\CFLOPPYBLANKSECTOR NIL)
(\CFLOPPYSECTORMAP NIL)
(\CFLOPPYDISKMAP NIL)
(CPM.DIRECTORY.WINDOW NIL))
(INITRECORDS CFLOPPYFDEV CINFO CALLOC FCB @FCB)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS CFLOPPYFDEV CINFO CALLOC FCB @FCB))
(FNS \CFLOPPY.GET.FCB.FILENAME \CFLOPPY.SET.FCB.FILENAME \CFLOPPY.INIT \CFLOPPY.OPEN
\CFLOPPY.OPEN.DIRECTORY \CFLOPPY.OPENFILE \CFLOPPY.OPENFILE1 \CFLOPPY.OPENOLDFILE
\CFLOPPY.OPENNEWFILE \CFLOPPY.ASSURESTREAM \CFLOPPY.GETFILEINFO
\CFLOPPY.GETFILEINFO1 \CFLOPPY.SETFILEINFO \CFLOPPY.CLOSEFILE \CFLOPPY.CLOSEFILE1
\CFLOPPY.DELETEFILE \CFLOPPY.GETFILENAME \CFLOPPY.GENERATEFILES
\CFLOPPY.NEXTFILEFN \CFLOPPY.FILEINFOFN \CFLOPPY.RENAMEFILE
\CFLOPPY.STREAMS.AGAINST \CFLOPPY.STREAMS.USING \CFLOPPY.READPAGES
\CFLOPPY.READPAGE \CFLOPPY.PHYSICAL.RECORDNO \CFLOPPY.READRECORDNO
\CFLOPPY.WRITERECORDNO \CFLOPPY.RECORDNOTODISKADDRESS \CFLOPPY.DIR.GET
\CFLOPPY.DIR.PUT \CFLOPPY.DIR.REMOVE \CFLOPPY.WRITEPAGES \CFLOPPY.WRITEPAGE
\CFLOPPY.TRUNCATEFILE \CFLOPPY.ALLOCATE.FCB \CFLOPPY.ALLOCATE.GROUP
\CFLOPPY.ALLOCATE \CFLOPPY.TRUNCATE \CFLOPPY.DEALLOCATE \CFLOPPY.EXTEND
\CFLOPPY.SAVE.CHANGES \CFLOPPY.ICHECK \CFLOPPY.ICHECK.CALLOC \CFLOPPY.FREE.PAGES
\CFLOPPY.FORMAT CPM.DIRECTORY))
(GLOBALVARS \FLOPPY.DEBUG \FLOPPY.INSPECTW \FLOPPYFDEV \FLOPPYLOCK \FLOPPYIOCBADDR
\FLOPPYIOCB \FLOPPYRESULT \FLOPPY.MODE.BEFORE.EVENT \PFLOPPYPSECTOR9 \PFLOPPYPFILELIST
\PFLOPPYINFO \PFLOPPYFDEV \FLOPPY.ALLOCATIONS.BITMAP \SFLOPPYINFO \SFLOPPYFDEV
\HFLOPPY.MAXPAGES \SFLOPPY.PAGENO \SFLOPPY.FLOPPYNO \SFLOPPY.HUGELENGTH
\SFLOPPY.HUGEPAGELENGTH \SFLOPPY.IWRITEDATE \SFLOPPY.FILENAME \SFLOPPY.RECOG
\SFLOPPY.FLOPPYNAME \SFLOPPY.SLOWFLG \HFLOPPYINFO \HFLOPPYFDEV \HFLOPPY.MAXPAGES
\HFLOPPY.PAGENO \HFLOPPY.FLOPPYNO \HFLOPPY.HUGELENGTH \HFLOPPY.HUGEPAGELENGTH
\HFLOPPY.IWRITEDATE \HFLOPPY.RECOG \HFLOPPY.FILENAME \HFLOPPY.SLOWFLG
\FLOPPY.SCAVENGE.IDATE \CFLOPPYINFO \CFLOPPYCALLOCS \CFLOPPYDIR \CFLOPPYFDEV
\CFLOPPYDIRECTORY \CFLOPPYBLANKSECTOR \CFLOPPYSECTORMAP \CFLOPPYDISKMAP
CPM.DIRECTORY.WINDOW)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (FLOPPY.RESTART])
(* FLOPPY "-- By Kelly Roach." *)
(* "FACE" *)
(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 FLOPPYIOCB.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.PSECTOR9 49932)
(RPAQQ VERSION.PSECTOR9 1)
(RPAQQ SEAL.PMPAGE 13003)
(RPAQQ VERSION.PMPAGE 1)
(RPAQQ SEAL.PFILELIST 45771)
(RPAQQ VERSION.PFILELIST 1)
(RPAQQ PMPAGEETYPE.FREE 0)
(RPAQQ PMPAGEETYPE.FILE 1)
(RPAQQ PMPAGEETYPE.PFILELIST 2)
(RPAQQ PMPAGEETYPE.BADSECTORS 3)
(RPAQQ SEAL.PLPAGE 43690)
(RPAQQ VERSION.PLPAGE 1)
(RPAQQ VERSION.DATA 2222)
(RPAQQ NAMEMAXLENGTH.PLPAGE 100)
(RPAQQ FILETYPE.FREE 0)
(RPAQQ FILETYPE.FILE 2052)
(RPAQQ FILETYPE.PFILELIST 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))
(FLOPPYIOCB.SIZE 16)
(B128 0)
(B256 1)
(B512 2)
(B1024 3)
(IBM 0)
(TROY 1)
(SINGLE 0)
(DOUBLE 8)
(NoBits 0)
(IDLENGTH 3)
(SEAL.PSECTOR9 49932)
(VERSION.PSECTOR9 1)
(SEAL.PMPAGE 13003)
(VERSION.PMPAGE 1)
(SEAL.PFILELIST 45771)
(VERSION.PFILELIST 1)
(PMPAGEETYPE.FREE 0)
(PMPAGEETYPE.FILE 1)
(PMPAGEETYPE.PFILELIST 2)
(PMPAGEETYPE.BADSECTORS 3)
(SEAL.PLPAGE 43690)
(VERSION.PLPAGE 1)
(VERSION.DATA 2222)
(NAMEMAXLENGTH.PLPAGE 100)
(FILETYPE.FREE 0)
(FILETYPE.FILE 2052)
(FILETYPE.PFILELIST 2054))
)
)
(/DECLAREDATATYPE (QUOTE FLOPPYIOCB)
(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))
[QUOTE ((FLOPPYIOCB 0 (BITS . 15))
(FLOPPYIOCB 1 (BITS . 15))
(FLOPPYIOCB 2 (BITS . 15))
(FLOPPYIOCB 3 (BITS . 15))
(FLOPPYIOCB 4 (BITS . 11))
(FLOPPYIOCB 4 (BITS . 195))
(FLOPPYIOCB 5 FIXP)
(FLOPPYIOCB 7 (BITS . 15))
(FLOPPYIOCB 8 (BITS . 15))
(FLOPPYIOCB 9 (FLAGBITS . 0))
(FLOPPYIOCB 9 (BITS . 30))
(FLOPPYIOCB 10 (BITS . 15))
(FLOPPYIOCB 11 (BITS . 7))
(FLOPPYIOCB 11 (BITS . 135))
(FLOPPYIOCB 12 (BITS . 7))
(FLOPPYIOCB 12 (BITS . 135))
(FLOPPYIOCB 13 (BITS . 15))
(FLOPPYIOCB 14 (BITS . 15))
(FLOPPYIOCB 15 (BITS . 15]
(QUOTE 16))
(/DECLAREDATATYPE (QUOTE PSECTOR9)
(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))
[QUOTE ((PSECTOR9 0 (BITS . 15))
(PSECTOR9 1 (BITS . 15))
(PSECTOR9 2 (BITS . 15))
(PSECTOR9 3 (BITS . 15))
(PSECTOR9 4 (BITS . 15))
(PSECTOR9 5 (BITS . 15))
(PSECTOR9 6 SWAPPEDFIXP)
(PSECTOR9 8 (BITS . 15))
(PSECTOR9 9 SWAPPEDFIXP)
(PSECTOR9 11 (BITS . 15))
(PSECTOR9 12 (BITS . 15))
(PSECTOR9 13 (BITS . 15))
(PSECTOR9 14 (BITS . 15))
(PSECTOR9 15 (BITS . 15))
(PSECTOR9 16 (BITS . 15))
(PSECTOR9 17 (BITS . 15))
(PSECTOR9 18 SWAPPEDFIXP)
(PSECTOR9 20 (FLAGBITS . 0))
(PSECTOR9 20 (BITS . 30))
(PSECTOR9 21 (BITS . 15))
(PSECTOR9 22 (BITS . 15))
(PSECTOR9 23 (BITS . 15))
(PSECTOR9 24 (BITS . 15))
(PSECTOR9 25 (BITS . 15))
(PSECTOR9 26 (BITS . 15))
(PSECTOR9 27 (BITS . 15))
(PSECTOR9 28 (BITS . 15))
(PSECTOR9 29 (BITS . 15))
(PSECTOR9 30 (BITS . 15))
(PSECTOR9 31 (BITS . 15))
(PSECTOR9 32 (BITS . 15))
(PSECTOR9 33 (BITS . 15))
(PSECTOR9 34 (BITS . 15))
(PSECTOR9 35 (BITS . 15))
(PSECTOR9 36 (BITS . 15))
(PSECTOR9 37 (BITS . 15))
(PSECTOR9 38 (BITS . 15))
(PSECTOR9 39 (BITS . 15))
(PSECTOR9 40 (BITS . 15))
(PSECTOR9 41 (BITS . 15))
(PSECTOR9 42 (BITS . 15))
(PSECTOR9 43 (BITS . 15))
(PSECTOR9 44 (BITS . 15))
(PSECTOR9 45 (BITS . 15))
(PSECTOR9 46 (BITS . 15))
(PSECTOR9 47 (BITS . 15))
(PSECTOR9 48 (BITS . 15))
(PSECTOR9 49 (BITS . 15))
(PSECTOR9 50 (BITS . 15))
(PSECTOR9 51 (BITS . 15))
(PSECTOR9 52 (BITS . 15))
(PSECTOR9 53 (BITS . 15))
(PSECTOR9 54 (BITS . 15))
(PSECTOR9 55 (BITS . 15))
(PSECTOR9 56 (BITS . 15))
(PSECTOR9 57 (BITS . 15))
(PSECTOR9 58 (BITS . 15))
(PSECTOR9 59 (BITS . 15))
(PSECTOR9 60 (BITS . 15))
(PSECTOR9 61 (BITS . 15))
(PSECTOR9 62 (BITS . 15))
(PSECTOR9 63 (BITS . 15))
(PSECTOR9 64 (BITS . 15))
(PSECTOR9 65 (BITS . 15))
(PSECTOR9 66 (BITS . 15))
(PSECTOR9 67 (BITS . 15))
(PSECTOR9 68 (BITS . 15))
(PSECTOR9 69 (BITS . 15))
(PSECTOR9 70 (BITS . 15))
(PSECTOR9 71 (BITS . 15))
(PSECTOR9 72 (BITS . 15))
(PSECTOR9 73 (BITS . 15))
(PSECTOR9 74 (BITS . 15))
(PSECTOR9 75 (BITS . 15))
(PSECTOR9 76 (BITS . 15))
(PSECTOR9 77 (BITS . 15))
(PSECTOR9 78 (BITS . 15))
(PSECTOR9 79 (BITS . 15))
(PSECTOR9 80 (BITS . 15))
(PSECTOR9 81 (BITS . 15))
(PSECTOR9 82 (BITS . 15))
(PSECTOR9 83 (BITS . 15))
(PSECTOR9 84 (BITS . 15))
(PSECTOR9 85 (BITS . 15))
(PSECTOR9 86 (BITS . 15))
(PSECTOR9 87 (BITS . 15))
(PSECTOR9 88 (BITS . 15))
(PSECTOR9 89 (BITS . 15))
(PSECTOR9 90 (BITS . 15))
(PSECTOR9 91 (BITS . 15))
(PSECTOR9 92 (BITS . 15))
(PSECTOR9 93 (BITS . 15))
(PSECTOR9 94 (BITS . 15))
(PSECTOR9 95 (BITS . 15))
(PSECTOR9 96 (BITS . 15))
(PSECTOR9 97 (BITS . 15))
(PSECTOR9 98 (BITS . 15))
(PSECTOR9 99 (BITS . 15))
(PSECTOR9 100 (BITS . 15))
(PSECTOR9 101 (BITS . 15))
(PSECTOR9 102 (BITS . 15))
(PSECTOR9 103 (BITS . 15))
(PSECTOR9 104 (BITS . 15))
(PSECTOR9 105 (BITS . 15))
(PSECTOR9 106 (BITS . 15))
(PSECTOR9 107 (BITS . 15))
(PSECTOR9 108 (BITS . 15))
(PSECTOR9 109 (BITS . 15))
(PSECTOR9 110 (BITS . 15))
(PSECTOR9 111 (BITS . 15))
(PSECTOR9 112 (BITS . 15))
(PSECTOR9 113 (BITS . 15))
(PSECTOR9 114 (BITS . 15))
(PSECTOR9 115 (BITS . 15))
(PSECTOR9 116 (BITS . 15))
(PSECTOR9 117 (BITS . 15))
(PSECTOR9 118 (BITS . 15))
(PSECTOR9 119 (BITS . 15))
(PSECTOR9 120 (BITS . 15))
(PSECTOR9 121 (BITS . 15))
(PSECTOR9 122 (BITS . 15))
(PSECTOR9 123 (BITS . 15))
(PSECTOR9 124 (BITS . 15))
(PSECTOR9 125 (BITS . 15))
(PSECTOR9 126 (BITS . 15))
(PSECTOR9 127 (BITS . 15]
(QUOTE 128))
(/DECLAREDATATYPE (QUOTE PMPAGE)
(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))
[QUOTE ((PMPAGE 0 (BITS . 15))
(PMPAGE 1 (BITS . 15))
(PMPAGE 2 SWAPPEDFIXP)
(PMPAGE 4 (BITS . 15))
(PMPAGE 5 SWAPPEDFIXP)
(PMPAGE 7 (BITS . 15))
(PMPAGE 8 (BITS . 15))
(PMPAGE 9 (BITS . 15))
(PMPAGE 10 (BITS . 15))
(PMPAGE 11 (BITS . 15))
(PMPAGE 12 (BITS . 15))
(PMPAGE 13 (BITS . 15))
(PMPAGE 14 (BITS . 15))
(PMPAGE 15 (BITS . 15))
(PMPAGE 16 (BITS . 15))
(PMPAGE 17 (BITS . 15))
(PMPAGE 18 (BITS . 15))
(PMPAGE 19 (BITS . 15))
(PMPAGE 20 (BITS . 15))
(PMPAGE 21 (BITS . 15))
(PMPAGE 22 (BITS . 15))
(PMPAGE 23 (BITS . 15))
(PMPAGE 24 (BITS . 15))
(PMPAGE 25 (BITS . 15))
(PMPAGE 26 (BITS . 15))
(PMPAGE 27 (BITS . 15))
(PMPAGE 28 (BITS . 15))
(PMPAGE 29 (BITS . 15))
(PMPAGE 30 (BITS . 15))
(PMPAGE 31 (BITS . 15))
(PMPAGE 32 (BITS . 15))
(PMPAGE 33 (BITS . 15))
(PMPAGE 34 (BITS . 15))
(PMPAGE 35 (BITS . 15))
(PMPAGE 36 (BITS . 15))
(PMPAGE 37 (BITS . 15))
(PMPAGE 38 (BITS . 15))
(PMPAGE 39 (BITS . 15))
(PMPAGE 40 (BITS . 15))
(PMPAGE 41 (BITS . 15))
(PMPAGE 42 (BITS . 15))
(PMPAGE 43 (BITS . 15))
(PMPAGE 44 (BITS . 15))
(PMPAGE 45 (BITS . 15))
(PMPAGE 46 (BITS . 15))
(PMPAGE 47 (BITS . 15))
(PMPAGE 48 (BITS . 15))
(PMPAGE 49 (BITS . 15))
(PMPAGE 50 (BITS . 15))
(PMPAGE 51 (BITS . 15))
(PMPAGE 52 (BITS . 15))
(PMPAGE 53 (BITS . 15))
(PMPAGE 54 (BITS . 15))
(PMPAGE 55 (BITS . 15))
(PMPAGE 56 (BITS . 15))
(PMPAGE 57 (BITS . 15))
(PMPAGE 58 (BITS . 15))
(PMPAGE 59 (BITS . 15))
(PMPAGE 60 (BITS . 15))
(PMPAGE 61 (BITS . 15))
(PMPAGE 62 (BITS . 15))
(PMPAGE 63 (BITS . 15))
(PMPAGE 64 (BITS . 15))
(PMPAGE 65 (BITS . 15))
(PMPAGE 66 (BITS . 15))
(PMPAGE 67 (BITS . 15))
(PMPAGE 68 (BITS . 15))
(PMPAGE 69 (BITS . 15))
(PMPAGE 70 (BITS . 15))
(PMPAGE 71 (BITS . 15))
(PMPAGE 72 (BITS . 15))
(PMPAGE 73 (BITS . 15))
(PMPAGE 74 (BITS . 15))
(PMPAGE 75 (BITS . 15))
(PMPAGE 76 (BITS . 15))
(PMPAGE 77 (BITS . 15))
(PMPAGE 78 (BITS . 15))
(PMPAGE 79 (BITS . 15))
(PMPAGE 80 (BITS . 15))
(PMPAGE 81 (BITS . 15))
(PMPAGE 82 (BITS . 15))
(PMPAGE 83 (BITS . 15))
(PMPAGE 84 (BITS . 15))
(PMPAGE 85 (BITS . 15))
(PMPAGE 86 (BITS . 15))
(PMPAGE 87 (BITS . 15))
(PMPAGE 88 (BITS . 15))
(PMPAGE 89 (BITS . 15))
(PMPAGE 90 (BITS . 15))
(PMPAGE 91 (BITS . 15))
(PMPAGE 92 (BITS . 15))
(PMPAGE 93 (BITS . 15))
(PMPAGE 94 (BITS . 15))
(PMPAGE 95 (BITS . 15))
(PMPAGE 96 (BITS . 15))
(PMPAGE 97 (BITS . 15))
(PMPAGE 98 (BITS . 15))
(PMPAGE 99 (BITS . 15))
(PMPAGE 100 (BITS . 15))
(PMPAGE 101 (BITS . 15))
(PMPAGE 102 (BITS . 15))
(PMPAGE 103 (BITS . 15))
(PMPAGE 104 (BITS . 15))
(PMPAGE 105 (BITS . 15))
(PMPAGE 106 (BITS . 15))
(PMPAGE 107 (BITS . 15))
(PMPAGE 108 (BITS . 15))
(PMPAGE 109 (BITS . 15))
(PMPAGE 110 (BITS . 15))
(PMPAGE 111 (BITS . 15))
(PMPAGE 112 (BITS . 15))
(PMPAGE 113 (BITS . 15))
(PMPAGE 114 (BITS . 15))
(PMPAGE 115 (BITS . 15))
(PMPAGE 116 (BITS . 15))
(PMPAGE 117 (BITS . 15))
(PMPAGE 118 (BITS . 15))
(PMPAGE 119 (BITS . 15))
(PMPAGE 120 (BITS . 15))
(PMPAGE 121 (BITS . 15))
(PMPAGE 122 (BITS . 15))
(PMPAGE 123 (BITS . 15))
(PMPAGE 124 (BITS . 15))
(PMPAGE 125 (BITS . 15))
(PMPAGE 126 (BITS . 15))
(PMPAGE 127 (BITS . 15))
(PMPAGE 128 (BITS . 15))
(PMPAGE 129 SWAPPEDFIXP)
(PMPAGE 131 (BITS . 15))
(PMPAGE 132 SWAPPEDFIXP)
(PMPAGE 134 (BITS . 15))
(PMPAGE 135 (BITS . 15))
(PMPAGE 136 (BITS . 15))
(PMPAGE 137 (BITS . 15))
(PMPAGE 138 (BITS . 15))
(PMPAGE 139 (BITS . 15))
(PMPAGE 140 (BITS . 15))
(PMPAGE 141 (BITS . 15))
(PMPAGE 142 (BITS . 15))
(PMPAGE 143 (BITS . 15))
(PMPAGE 144 (BITS . 15))
(PMPAGE 145 (BITS . 15))
(PMPAGE 146 (BITS . 15))
(PMPAGE 147 (BITS . 15))
(PMPAGE 148 (BITS . 15))
(PMPAGE 149 (BITS . 15))
(PMPAGE 150 (BITS . 15))
(PMPAGE 151 (BITS . 15))
(PMPAGE 152 (BITS . 15))
(PMPAGE 153 (BITS . 15))
(PMPAGE 154 (BITS . 15))
(PMPAGE 155 (BITS . 15))
(PMPAGE 156 (BITS . 15))
(PMPAGE 157 (BITS . 15))
(PMPAGE 158 (BITS . 15))
(PMPAGE 159 (BITS . 15))
(PMPAGE 160 (BITS . 15))
(PMPAGE 161 (BITS . 15))
(PMPAGE 162 (BITS . 15))
(PMPAGE 163 (BITS . 15))
(PMPAGE 164 (BITS . 15))
(PMPAGE 165 (BITS . 15))
(PMPAGE 166 (BITS . 15))
(PMPAGE 167 (BITS . 15))
(PMPAGE 168 (BITS . 15))
(PMPAGE 169 (BITS . 15))
(PMPAGE 170 (BITS . 15))
(PMPAGE 171 (BITS . 15))
(PMPAGE 172 (BITS . 15))
(PMPAGE 173 (BITS . 15))
(PMPAGE 174 (BITS . 15))
(PMPAGE 175 (BITS . 15))
(PMPAGE 176 (BITS . 15))
(PMPAGE 177 (BITS . 15))
(PMPAGE 178 (BITS . 15))
(PMPAGE 179 (BITS . 15))
(PMPAGE 180 (BITS . 15))
(PMPAGE 181 (BITS . 15))
(PMPAGE 182 (BITS . 15))
(PMPAGE 183 (BITS . 15))
(PMPAGE 184 (BITS . 15))
(PMPAGE 185 (BITS . 15))
(PMPAGE 186 (BITS . 15))
(PMPAGE 187 (BITS . 15))
(PMPAGE 188 (BITS . 15))
(PMPAGE 189 (BITS . 15))
(PMPAGE 190 (BITS . 15))
(PMPAGE 191 (BITS . 15))
(PMPAGE 192 (BITS . 15))
(PMPAGE 193 (BITS . 15))
(PMPAGE 194 (BITS . 15))
(PMPAGE 195 (BITS . 15))
(PMPAGE 196 (BITS . 15))
(PMPAGE 197 (BITS . 15))
(PMPAGE 198 (BITS . 15))
(PMPAGE 199 (BITS . 15))
(PMPAGE 200 (BITS . 15))
(PMPAGE 201 (BITS . 15))
(PMPAGE 202 (BITS . 15))
(PMPAGE 203 (BITS . 15))
(PMPAGE 204 (BITS . 15))
(PMPAGE 205 (BITS . 15))
(PMPAGE 206 (BITS . 15))
(PMPAGE 207 (BITS . 15))
(PMPAGE 208 (BITS . 15))
(PMPAGE 209 (BITS . 15))
(PMPAGE 210 (BITS . 15))
(PMPAGE 211 (BITS . 15))
(PMPAGE 212 (BITS . 15))
(PMPAGE 213 (BITS . 15))
(PMPAGE 214 (BITS . 15))
(PMPAGE 215 (BITS . 15))
(PMPAGE 216 (BITS . 15))
(PMPAGE 217 (BITS . 15))
(PMPAGE 218 (BITS . 15))
(PMPAGE 219 (BITS . 15))
(PMPAGE 220 (BITS . 15))
(PMPAGE 221 (BITS . 15))
(PMPAGE 222 (BITS . 15))
(PMPAGE 223 (BITS . 15))
(PMPAGE 224 (BITS . 15))
(PMPAGE 225 (BITS . 15))
(PMPAGE 226 (BITS . 15))
(PMPAGE 227 (BITS . 15))
(PMPAGE 228 (BITS . 15))
(PMPAGE 229 (BITS . 15))
(PMPAGE 230 (BITS . 15))
(PMPAGE 231 (BITS . 15))
(PMPAGE 232 (BITS . 15))
(PMPAGE 233 (BITS . 15))
(PMPAGE 234 (BITS . 15))
(PMPAGE 235 (BITS . 15))
(PMPAGE 236 (BITS . 15))
(PMPAGE 237 (BITS . 15))
(PMPAGE 238 (BITS . 15))
(PMPAGE 239 (BITS . 15))
(PMPAGE 240 (BITS . 15))
(PMPAGE 241 (BITS . 15))
(PMPAGE 242 (BITS . 15))
(PMPAGE 243 (BITS . 15))
(PMPAGE 244 (BITS . 15))
(PMPAGE 245 (BITS . 15))
(PMPAGE 246 (BITS . 15))
(PMPAGE 247 (BITS . 15))
(PMPAGE 248 (BITS . 15))
(PMPAGE 249 (BITS . 15))
(PMPAGE 250 (BITS . 15))
(PMPAGE 251 (BITS . 15))
(PMPAGE 252 (BITS . 15))
(PMPAGE 253 (BITS . 15))
(PMPAGE 254 (BITS . 15))
(PMPAGE 255 (BITS . 15]
(QUOTE 256))
(/DECLAREDATATYPE (QUOTE PLPAGE)
(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))
[QUOTE ((PLPAGE 0 (BITS . 15))
(PLPAGE 1 (BITS . 15))
(PLPAGE 2 (BITS . 15))
(PLPAGE 3 SWAPPEDFIXP)
(PLPAGE 5 SWAPPEDFIXP)
(PLPAGE 7 SWAPPEDFIXP)
(PLPAGE 9 SWAPPEDFIXP)
(PLPAGE 11 SWAPPEDFIXP)
(PLPAGE 13 SWAPPEDFIXP)
(PLPAGE 15 (BITS . 15))
(PLPAGE 16 (BITS . 15))
(PLPAGE 17 (BITS . 15))
(PLPAGE 18 (BITS . 15))
(PLPAGE 19 (BITS . 15))
(PLPAGE 20 (BITS . 15))
(PLPAGE 21 (BITS . 15))
(PLPAGE 22 (BITS . 15))
(PLPAGE 23 (BITS . 15))
(PLPAGE 24 (BITS . 15))
(PLPAGE 25 (BITS . 15))
(PLPAGE 26 (BITS . 15))
(PLPAGE 27 (BITS . 15))
(PLPAGE 28 (BITS . 15))
(PLPAGE 29 (BITS . 15))
(PLPAGE 30 (BITS . 15))
(PLPAGE 31 (BITS . 15))
(PLPAGE 32 (BITS . 15))
(PLPAGE 33 (BITS . 15))
(PLPAGE 34 (BITS . 15))
(PLPAGE 35 (BITS . 15))
(PLPAGE 36 (BITS . 15))
(PLPAGE 37 (BITS . 15))
(PLPAGE 38 (BITS . 15))
(PLPAGE 39 (BITS . 15))
(PLPAGE 40 (BITS . 15))
(PLPAGE 41 (BITS . 15))
(PLPAGE 42 (BITS . 15))
(PLPAGE 43 (BITS . 15))
(PLPAGE 44 (BITS . 15))
(PLPAGE 45 (BITS . 15))
(PLPAGE 46 (BITS . 15))
(PLPAGE 47 (BITS . 15))
(PLPAGE 48 (BITS . 15))
(PLPAGE 49 (BITS . 15))
(PLPAGE 50 (BITS . 15))
(PLPAGE 51 (BITS . 15))
(PLPAGE 52 (BITS . 15))
(PLPAGE 53 (BITS . 15))
(PLPAGE 54 (BITS . 15))
(PLPAGE 55 (BITS . 15))
(PLPAGE 56 (BITS . 15))
(PLPAGE 57 (BITS . 15))
(PLPAGE 58 (BITS . 15))
(PLPAGE 59 (BITS . 15))
(PLPAGE 60 (BITS . 15))
(PLPAGE 61 (BITS . 15))
(PLPAGE 62 (BITS . 15))
(PLPAGE 63 (BITS . 15))
(PLPAGE 64 (BITS . 15))
(PLPAGE 65 (BITS . 15))
(PLPAGE 66 (BITS . 15))
(PLPAGE 67 (BITS . 15))
(PLPAGE 68 (BITS . 15))
(PLPAGE 69 (BITS . 15))
(PLPAGE 70 (BITS . 15))
(PLPAGE 71 (BITS . 15))
(PLPAGE 72 (BITS . 15))
(PLPAGE 73 (BITS . 15))
(PLPAGE 74 (BITS . 15))
(PLPAGE 75 (BITS . 15))
(PLPAGE 76 (BITS . 15))
(PLPAGE 77 (BITS . 15))
(PLPAGE 78 (BITS . 15))
(PLPAGE 79 (BITS . 15))
(PLPAGE 80 (BITS . 15))
(PLPAGE 81 (BITS . 15))
(PLPAGE 82 (BITS . 15))
(PLPAGE 83 (BITS . 15))
(PLPAGE 84 (BITS . 15))
(PLPAGE 85 (BITS . 15))
(PLPAGE 86 (BITS . 15))
(PLPAGE 87 (BITS . 15))
(PLPAGE 88 (BITS . 15))
(PLPAGE 89 (BITS . 15))
(PLPAGE 90 (BITS . 15))
(PLPAGE 91 (BITS . 15))
(PLPAGE 92 (BITS . 15))
(PLPAGE 93 (BITS . 15))
(PLPAGE 94 (BITS . 15))
(PLPAGE 95 (BITS . 15))
(PLPAGE 96 (BITS . 15))
(PLPAGE 97 (BITS . 15))
(PLPAGE 98 (BITS . 15))
(PLPAGE 99 (BITS . 15))
(PLPAGE 100 (BITS . 15))
(PLPAGE 101 (BITS . 15))
(PLPAGE 102 (BITS . 15))
(PLPAGE 103 (BITS . 15))
(PLPAGE 104 (BITS . 15))
(PLPAGE 105 (BITS . 15))
(PLPAGE 106 (BITS . 15))
(PLPAGE 107 (BITS . 15))
(PLPAGE 108 (BITS . 15))
(PLPAGE 109 (BITS . 15))
(PLPAGE 110 (BITS . 15))
(PLPAGE 111 (BITS . 15))
(PLPAGE 112 (BITS . 15))
(PLPAGE 113 (BITS . 15))
(PLPAGE 114 (BITS . 15))
(PLPAGE 115 (BITS . 15))
(PLPAGE 116 (BITS . 15))
(PLPAGE 117 (BITS . 15))
(PLPAGE 118 (BITS . 15))
(PLPAGE 119 (BITS . 15))
(PLPAGE 120 (BITS . 15))
(PLPAGE 121 (BITS . 15))
(PLPAGE 122 (BITS . 15))
(PLPAGE 123 (BITS . 15))
(PLPAGE 124 (BITS . 15))
(PLPAGE 125 (BITS . 15))
(PLPAGE 126 (BITS . 15))
(PLPAGE 127 (BITS . 15))
(PLPAGE 128 (BITS . 15))
(PLPAGE 129 (BITS . 15))
(PLPAGE 130 (BITS . 15))
(PLPAGE 131 (BITS . 15))
(PLPAGE 132 (BITS . 15))
(PLPAGE 133 (BITS . 15))
(PLPAGE 134 (BITS . 15))
(PLPAGE 135 (BITS . 15))
(PLPAGE 136 (BITS . 15))
(PLPAGE 137 (BITS . 15))
(PLPAGE 138 (BITS . 15))
(PLPAGE 139 (BITS . 15))
(PLPAGE 140 (BITS . 15))
(PLPAGE 141 (BITS . 15))
(PLPAGE 142 (BITS . 15))
(PLPAGE 143 (BITS . 15))
(PLPAGE 144 (BITS . 15))
(PLPAGE 145 (BITS . 15))
(PLPAGE 146 (BITS . 15))
(PLPAGE 147 (BITS . 15))
(PLPAGE 148 (BITS . 15))
(PLPAGE 149 (BITS . 15))
(PLPAGE 150 (BITS . 15))
(PLPAGE 151 (BITS . 15))
(PLPAGE 152 (BITS . 15))
(PLPAGE 153 (BITS . 15))
(PLPAGE 154 (BITS . 15))
(PLPAGE 155 (BITS . 15))
(PLPAGE 156 (BITS . 15))
(PLPAGE 157 (BITS . 15))
(PLPAGE 158 (BITS . 15))
(PLPAGE 159 (BITS . 15))
(PLPAGE 160 (BITS . 15))
(PLPAGE 161 (BITS . 15))
(PLPAGE 162 (BITS . 15))
(PLPAGE 163 (BITS . 15))
(PLPAGE 164 (BITS . 15))
(PLPAGE 165 (BITS . 15))
(PLPAGE 166 (BITS . 15))
(PLPAGE 167 (BITS . 15))
(PLPAGE 168 (BITS . 15))
(PLPAGE 169 (BITS . 15))
(PLPAGE 170 (BITS . 15))
(PLPAGE 171 (BITS . 15))
(PLPAGE 172 (BITS . 15))
(PLPAGE 173 (BITS . 15))
(PLPAGE 174 (BITS . 15))
(PLPAGE 175 (BITS . 15))
(PLPAGE 176 (BITS . 15))
(PLPAGE 177 (BITS . 15))
(PLPAGE 178 (BITS . 15))
(PLPAGE 179 (BITS . 15))
(PLPAGE 180 (BITS . 15))
(PLPAGE 181 (BITS . 15))
(PLPAGE 182 (BITS . 15))
(PLPAGE 183 (BITS . 15))
(PLPAGE 184 (BITS . 15))
(PLPAGE 185 (BITS . 15))
(PLPAGE 186 (BITS . 15))
(PLPAGE 187 (BITS . 15))
(PLPAGE 188 (BITS . 15))
(PLPAGE 189 (BITS . 15))
(PLPAGE 190 (BITS . 15))
(PLPAGE 191 (BITS . 15))
(PLPAGE 192 (BITS . 15))
(PLPAGE 193 (BITS . 15))
(PLPAGE 194 (BITS . 15))
(PLPAGE 195 (BITS . 15))
(PLPAGE 196 (BITS . 15))
(PLPAGE 197 (BITS . 15))
(PLPAGE 198 (BITS . 15))
(PLPAGE 199 (BITS . 15))
(PLPAGE 200 (BITS . 15))
(PLPAGE 201 (BITS . 15))
(PLPAGE 202 (BITS . 15))
(PLPAGE 203 (BITS . 15))
(PLPAGE 204 (BITS . 15))
(PLPAGE 205 (BITS . 15))
(PLPAGE 206 (BITS . 15))
(PLPAGE 207 (BITS . 15))
(PLPAGE 208 (BITS . 15))
(PLPAGE 209 (BITS . 15))
(PLPAGE 210 (BITS . 15))
(PLPAGE 211 (BITS . 15))
(PLPAGE 212 (BITS . 15))
(PLPAGE 213 (BITS . 15))
(PLPAGE 214 (BITS . 15))
(PLPAGE 215 (BITS . 15))
(PLPAGE 216 (BITS . 15))
(PLPAGE 217 (BITS . 15))
(PLPAGE 218 (BITS . 15))
(PLPAGE 219 (BITS . 15))
(PLPAGE 220 (BITS . 15))
(PLPAGE 221 (BITS . 15))
(PLPAGE 222 (BITS . 15))
(PLPAGE 223 (BITS . 15))
(PLPAGE 224 (BITS . 15))
(PLPAGE 225 (BITS . 15))
(PLPAGE 226 (BITS . 15))
(PLPAGE 227 (BITS . 15))
(PLPAGE 228 (BITS . 15))
(PLPAGE 229 (BITS . 15))
(PLPAGE 230 (BITS . 15))
(PLPAGE 231 (BITS . 15))
(PLPAGE 232 (BITS . 15))
(PLPAGE 233 (BITS . 15))
(PLPAGE 234 (BITS . 15))
(PLPAGE 235 (BITS . 15))
(PLPAGE 236 (BITS . 15))
(PLPAGE 237 (BITS . 15))
(PLPAGE 238 (BITS . 15))
(PLPAGE 239 (BITS . 15))
(PLPAGE 240 (BITS . 15))
(PLPAGE 241 (BITS . 15))
(PLPAGE 242 (BITS . 15))
(PLPAGE 243 (BITS . 15))
(PLPAGE 244 (BITS . 15))
(PLPAGE 245 (BITS . 15))
(PLPAGE 246 (BITS . 15))
(PLPAGE 247 (BITS . 15))
(PLPAGE 248 (BITS . 15))
(PLPAGE 249 (BITS . 15))
(PLPAGE 250 (BITS . 15))
(PLPAGE 251 (BITS . 15))
(PLPAGE 252 (BITS . 15))
(PLPAGE 253 (BITS . 15))
(PLPAGE 254 (BITS . 15]
(QUOTE 256))
(/DECLAREDATATYPE (QUOTE PFLE)
(QUOTE (SWAPPEDFIXP WORD WORD WORD))
[QUOTE ((PFLE 0 SWAPPEDFIXP)
(PFLE 2 (BITS . 15))
(PFLE 3 (BITS . 15))
(PFLE 4 (BITS . 15]
(QUOTE 6))
(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 (LLSH CYLINDER 16)
(LLSH HEAD 8)
SECTOR)))
(DATATYPE FLOPPYIOCB ((\BUFFERLOLOC WORD)
(\BUFFERHILOC WORD)
(NIL WORD)
(SECTORLENGTHDIV2 WORD)
(TROYORIBM BITS 12)
(DENSITY BITS 4)
(DISKADDRESS FIXP)
(SECTORCOUNT WORD)
(FLOPPYRESULT 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.IOCB DATUM IBMD512)
(replace (FLOPPYIOCB DISKADDRESS) of DATUM
with (CREATE DISKADDRESS
CYLINDER ← 0
HEAD ← 0
SECTOR ← 1))
DATUM))
[ACCESSFNS (($COMMAND (SELECT (fetch (FLOPPYIOCB 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 (FLOPPYIOCB SUBCOMMAND) of DATUM)
(SC.NOP (QUOTE NOP))
(SC.DISKCHANGECLEAR (QUOTE DISKCHANGECLEAR))
(QUOTE ?)))
($FLOPPYRESULT (\FLOPPY.TRANSLATEFLOPPYRESULT (fetch (FLOPPYIOCB
FLOPPYRESULT)
of DATUM)))
($TROYORIBM (SELECT (fetch (FLOPPYIOCB TROYORIBM) of DATUM)
(IBM (QUOTE IBM))
(TROY (QUOTE TROY))
(QUOTE ?)))
($DENSITY (SELECT (fetch (FLOPPYIOCB DENSITY) of DATUM)
(SINGLE (QUOTE SINGLE))
(DOUBLE (QUOTE DOUBLE))
(QUOTE ?)))
($ENCODEDSECTORLENGTH (SELECT (fetch (FLOPPYIOCB ENCODEDSECTORLENGTH
) of DATUM)
(B128 128)
(B256 256)
(B512 512)
(B1024 1024)
(QUOTE ?)))
[BUFFER (\VAG2 (fetch (FLOPPYIOCB \BUFFERHILOC) of DATUM)
(fetch (FLOPPYIOCB \BUFFERLOLOC) of DATUM))
(PROGN (replace (FLOPPYIOCB \BUFFERLOLOC) of DATUM
with (\LOLOC NEWVALUE))
(replace (FLOPPYIOCB \BUFFERHILOC) of DATUM
with (\HILOC NEWVALUE]
(CYLINDER (fetch (DISKADDRESS CYLINDER) of (fetch (FLOPPYIOCB
DISKADDRESS
)
of DATUM)))
(HEAD (fetch (DISKADDRESS HEAD) of (fetch (FLOPPYIOCB DISKADDRESS)
of DATUM)))
(SECTOR (fetch (DISKADDRESS SECTOR) of (fetch (FLOPPYIOCB
DISKADDRESS)
of DATUM])
(BLOCKRECORD FLOPPYRESULT ((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 FLOPPYRESULT ((WORD WORD)))
[ACCESSFNS ([$DISKID (COND
((fetch (FLOPPYRESULT DISKID) of DATUM)
(QUOTE SA850))
(T (QUOTE SA800]
[MPCODE (COND
((NOT (fetch (FLOPPYRESULT MPERROR) of DATUM))
0)
(T (LOGXOR (fetch (FLOPPYRESULT WORD) of DATUM)
(LLSH 1 14]
(MPMESSAGE (SELECTQ (fetch (FLOPPYRESULT 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")
(597 "Domino Error In NOOP Patch")
(598 "Domino Error in Reset Patch")
(CONCAT "Domino Error " (fetch (FLOPPYRESULT
MPCODE)
of DATUM])
(DATATYPE PSECTOR9 ((SEAL WORD)
(VERSION WORD)
(CYLINDERS WORD)
(TRACKSPERCYLINDER WORD)
(SECTORSPERTRACK WORD)
(PFILELISTSTART WORD)
(PFILELISTFILEID SWAPPEDFIXP)
(PFILELISTLENGTH 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.PSECTOR9 VERSION ← VERSION.PSECTOR9 CYLINDERS ← \FLOPPY.CYLINDERS
TRACKSPERCYLINDER ← \FLOPPY.TRACKSPERCYLINDER SECTORSPERTRACK ←
\FLOPPY.SECTORSPERTRACK [ACCESSFNS
((INTACT (AND (IEQP (fetch (PSECTOR9 SEAL) of DATUM)
SEAL.PSECTOR9)
(ILEQ (fetch (PSECTOR9 \LABELLENGTH)
of DATUM)
106)))
[$LABEL [MKATOM (CREATE STRINGP
BASE ← (fetch (PSECTOR9
\LABELBASE)
of DATUM)
LENGTH ←
(IMIN 106 (fetch (PSECTOR9
\LABELLENGTH
)
of DATUM]
(PROG (VALUE)
(* NOTE: Can't do SETQ NEWVALUE with
record package. *)
(SETQ VALUE (MKSTRING NEWVALUE))
(replace (PSECTOR9 \LABELLENGTH)
of DATUM with (IMIN 106 (NCHARS VALUE)))
(RPLSTRING (CREATE STRINGP
BASE ←
(fetch (PSECTOR9
\LABELBASE)
of DATUM)
LENGTH ←
(fetch (PSECTOR9
\LABELLENGTH
)
of DATUM))
1
(SUBSTRING VALUE 1
(fetch (PSECTOR9 \LABELLENGTH
) of DATUM]
(\LABELBASE (\ADDBASE DATUM 22])
(DATATYPE PMPAGE ((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.PMPAGE VERSION ← VERSION.PMPAGE
[ACCESSFNS ((INTACT (IEQP (fetch (PMPAGE SEAL) of DATUM)
SEAL.PMPAGE))
($PTYPE (\FLOPPY.TRANSLATEPMPAGEETYPE (fetch (PMPAGE PTYPE) of DATUM)))
($PFILETYPE (\FLOPPY.TRANSLATEFILETYPE (fetch (PMPAGE PFILETYPE)
of DATUM)))
($NTYPE (\FLOPPY.TRANSLATEPMPAGEETYPE (fetch (PMPAGE NTYPE) of DATUM)))
($NFILETYPE (\FLOPPY.TRANSLATEFILETYPE (fetch (PMPAGE NFILETYPE)
of DATUM])
(DATATYPE PLPAGE
((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)
(DATAVERSION WORD)
(\TYPE WORD)
(NIL 183 WORD)
(\BYTESIZE WORD))
SEAL ← SEAL.PLPAGE VERSION ← VERSION.PLPAGE MESATYPE ← 65535 NAMEMAXLENGTH ←
NAMEMAXLENGTH.PLPAGE UFO1 ← 2 UFO2 ← 187 DATAVERSION ← VERSION.DATA \TYPE ← 1
[ACCESSFNS ((INTACT (AND (IEQP (fetch (PLPAGE SEAL) of DATUM)
SEAL.PLPAGE)
(ILEQ (fetch (PLPAGE \NAMELENGTH) of DATUM)
NAMEMAXLENGTH.PLPAGE)))
[$NAME [MKATOM (CREATE STRINGP
BASE ← (fetch (PLPAGE \NAMEBASE) of DATUM)
LENGTH ← (IMIN 100 (fetch (PLPAGE \NAMELENGTH)
of DATUM]
(PROG (VALUE) (* NOTE: Can't do SETQ NEWVALUE with
record package. *)
(SETQ VALUE (MKSTRING NEWVALUE))
(replace (PLPAGE \NAMELENGTH) of DATUM with (IMIN
NAMEMAXLENGTH.PLPAGE
(NCHARS VALUE)))
(RPLSTRING (CREATE STRINGP
BASE ← (fetch (PLPAGE \NAMEBASE) of DATUM)
LENGTH ← (fetch (PLPAGE \NAMELENGTH)
of DATUM))
1
(SUBSTRING VALUE 1 (fetch (PLPAGE \NAMELENGTH) of DATUM]
(\NAMEBASE (\ADDBASE DATUM 17))
(CREATIONDATE (GDATE (fetch (PLPAGE ICREATIONDATE) of DATUM))
(replace (PLPAGE ICREATIONDATE) of DATUM with (IDATE NEWVALUE)))
(ICREATIONDATE (\FLOPPY.MTL.IDATE (fetch (PLPAGE \CREATIONDATE) of DATUM))
(replace (PLPAGE \CREATIONDATE) of DATUM with (\FLOPPY.LTM.IDATE
NEWVALUE)))
(WRITEDATE (GDATE (fetch (PLPAGE IWRITEDATE) of DATUM))
(replace (PLPAGE IWRITEDATE) of DATUM with (IDATE NEWVALUE)))
(IWRITEDATE (\FLOPPY.MTL.IDATE (fetch (PLPAGE \WRITEDATE) of DATUM))
(replace (PLPAGE \WRITEDATE) of DATUM with (\FLOPPY.LTM.IDATE NEWVALUE))
)
[LENGTH [COND
((ILESSP (IPLUS (fetch (PLPAGE HUGEPAGESTART) of DATUM)
(fetch (PLPAGE PAGELENGTH) of DATUM))
(fetch (PLPAGE HUGEPAGELENGTH) of DATUM))
(ITIMES 512 (fetch (PLPAGE PAGELENGTH) of DATUM)))
(T (IDIFFERENCE (fetch (PLPAGE HUGELENGTH) of DATUM)
(ITIMES 512 (fetch (PLPAGE HUGEPAGESTART) of DATUM]
(PROGN (* Works for ordinairy
(not huge) files. *)
(replace (PLPAGE PAGELENGTH) of DATUM
with (IQUOTIENT (IPLUS NEWVALUE 511)
512))
(replace (PLPAGE HUGELENGTH) of DATUM with NEWVALUE)
(replace (PLPAGE HUGEPAGELENGTH) of DATUM
with (fetch (PLPAGE PAGELENGTH) of DATUM]
[TYPE (SELECT (fetch (PLPAGE \TYPE) of DATUM)
(1 (QUOTE TEXT))
(2 (QUOTE BINARY))
(QUOTE TEXT))
(SELECTQ (COND
((LISTP NEWVALUE)
(CAR NEWVALUE))
(T NEWVALUE))
(TEXT (replace (PLPAGE \TYPE) of DATUM with 1))
(PROGN (* Everything else BINARY.
*)
(replace (PLPAGE \TYPE) of DATUM with 2]
(\VALUE DATUM (\BLT DATUM NEWVALUE 256])
(BLOCKRECORD PFILELIST ((SEAL WORD)
(VERSION WORD)
(NENTRIES WORD)
(MAXENTRIES WORD))
[ACCESSFNS ((INTACT (IEQP (fetch (PFILELIST SEAL) of DATUM)
SEAL.PFILELIST))
(NPAGES (FOLDHI (IPLUS 4 (ITIMES 5 (fetch (PFILELIST MAXENTRIES)
of DATUM)))
256))
(\FIRSTPFLE (\ADDBASE DATUM 4])
(DATATYPE PFLE ((FILEID SWAPPEDFIXP)
(TYPE WORD)
(START WORD)
(LENGTH WORD))
[ACCESSFNS (($TYPE (\FLOPPY.TRANSLATEFILETYPE (fetch (PFLE TYPE) of DATUM)))
(\VALUE DATUM (\BLT DATUM NEWVALUE 5])
]
(/DECLAREDATATYPE (QUOTE FLOPPYIOCB)
(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))
[QUOTE ((FLOPPYIOCB 0 (BITS . 15))
(FLOPPYIOCB 1 (BITS . 15))
(FLOPPYIOCB 2 (BITS . 15))
(FLOPPYIOCB 3 (BITS . 15))
(FLOPPYIOCB 4 (BITS . 11))
(FLOPPYIOCB 4 (BITS . 195))
(FLOPPYIOCB 5 FIXP)
(FLOPPYIOCB 7 (BITS . 15))
(FLOPPYIOCB 8 (BITS . 15))
(FLOPPYIOCB 9 (FLAGBITS . 0))
(FLOPPYIOCB 9 (BITS . 30))
(FLOPPYIOCB 10 (BITS . 15))
(FLOPPYIOCB 11 (BITS . 7))
(FLOPPYIOCB 11 (BITS . 135))
(FLOPPYIOCB 12 (BITS . 7))
(FLOPPYIOCB 12 (BITS . 135))
(FLOPPYIOCB 13 (BITS . 15))
(FLOPPYIOCB 14 (BITS . 15))
(FLOPPYIOCB 15 (BITS . 15]
(QUOTE 16))
(/DECLAREDATATYPE (QUOTE PSECTOR9)
(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))
[QUOTE ((PSECTOR9 0 (BITS . 15))
(PSECTOR9 1 (BITS . 15))
(PSECTOR9 2 (BITS . 15))
(PSECTOR9 3 (BITS . 15))
(PSECTOR9 4 (BITS . 15))
(PSECTOR9 5 (BITS . 15))
(PSECTOR9 6 SWAPPEDFIXP)
(PSECTOR9 8 (BITS . 15))
(PSECTOR9 9 SWAPPEDFIXP)
(PSECTOR9 11 (BITS . 15))
(PSECTOR9 12 (BITS . 15))
(PSECTOR9 13 (BITS . 15))
(PSECTOR9 14 (BITS . 15))
(PSECTOR9 15 (BITS . 15))
(PSECTOR9 16 (BITS . 15))
(PSECTOR9 17 (BITS . 15))
(PSECTOR9 18 SWAPPEDFIXP)
(PSECTOR9 20 (FLAGBITS . 0))
(PSECTOR9 20 (BITS . 30))
(PSECTOR9 21 (BITS . 15))
(PSECTOR9 22 (BITS . 15))
(PSECTOR9 23 (BITS . 15))
(PSECTOR9 24 (BITS . 15))
(PSECTOR9 25 (BITS . 15))
(PSECTOR9 26 (BITS . 15))
(PSECTOR9 27 (BITS . 15))
(PSECTOR9 28 (BITS . 15))
(PSECTOR9 29 (BITS . 15))
(PSECTOR9 30 (BITS . 15))
(PSECTOR9 31 (BITS . 15))
(PSECTOR9 32 (BITS . 15))
(PSECTOR9 33 (BITS . 15))
(PSECTOR9 34 (BITS . 15))
(PSECTOR9 35 (BITS . 15))
(PSECTOR9 36 (BITS . 15))
(PSECTOR9 37 (BITS . 15))
(PSECTOR9 38 (BITS . 15))
(PSECTOR9 39 (BITS . 15))
(PSECTOR9 40 (BITS . 15))
(PSECTOR9 41 (BITS . 15))
(PSECTOR9 42 (BITS . 15))
(PSECTOR9 43 (BITS . 15))
(PSECTOR9 44 (BITS . 15))
(PSECTOR9 45 (BITS . 15))
(PSECTOR9 46 (BITS . 15))
(PSECTOR9 47 (BITS . 15))
(PSECTOR9 48 (BITS . 15))
(PSECTOR9 49 (BITS . 15))
(PSECTOR9 50 (BITS . 15))
(PSECTOR9 51 (BITS . 15))
(PSECTOR9 52 (BITS . 15))
(PSECTOR9 53 (BITS . 15))
(PSECTOR9 54 (BITS . 15))
(PSECTOR9 55 (BITS . 15))
(PSECTOR9 56 (BITS . 15))
(PSECTOR9 57 (BITS . 15))
(PSECTOR9 58 (BITS . 15))
(PSECTOR9 59 (BITS . 15))
(PSECTOR9 60 (BITS . 15))
(PSECTOR9 61 (BITS . 15))
(PSECTOR9 62 (BITS . 15))
(PSECTOR9 63 (BITS . 15))
(PSECTOR9 64 (BITS . 15))
(PSECTOR9 65 (BITS . 15))
(PSECTOR9 66 (BITS . 15))
(PSECTOR9 67 (BITS . 15))
(PSECTOR9 68 (BITS . 15))
(PSECTOR9 69 (BITS . 15))
(PSECTOR9 70 (BITS . 15))
(PSECTOR9 71 (BITS . 15))
(PSECTOR9 72 (BITS . 15))
(PSECTOR9 73 (BITS . 15))
(PSECTOR9 74 (BITS . 15))
(PSECTOR9 75 (BITS . 15))
(PSECTOR9 76 (BITS . 15))
(PSECTOR9 77 (BITS . 15))
(PSECTOR9 78 (BITS . 15))
(PSECTOR9 79 (BITS . 15))
(PSECTOR9 80 (BITS . 15))
(PSECTOR9 81 (BITS . 15))
(PSECTOR9 82 (BITS . 15))
(PSECTOR9 83 (BITS . 15))
(PSECTOR9 84 (BITS . 15))
(PSECTOR9 85 (BITS . 15))
(PSECTOR9 86 (BITS . 15))
(PSECTOR9 87 (BITS . 15))
(PSECTOR9 88 (BITS . 15))
(PSECTOR9 89 (BITS . 15))
(PSECTOR9 90 (BITS . 15))
(PSECTOR9 91 (BITS . 15))
(PSECTOR9 92 (BITS . 15))
(PSECTOR9 93 (BITS . 15))
(PSECTOR9 94 (BITS . 15))
(PSECTOR9 95 (BITS . 15))
(PSECTOR9 96 (BITS . 15))
(PSECTOR9 97 (BITS . 15))
(PSECTOR9 98 (BITS . 15))
(PSECTOR9 99 (BITS . 15))
(PSECTOR9 100 (BITS . 15))
(PSECTOR9 101 (BITS . 15))
(PSECTOR9 102 (BITS . 15))
(PSECTOR9 103 (BITS . 15))
(PSECTOR9 104 (BITS . 15))
(PSECTOR9 105 (BITS . 15))
(PSECTOR9 106 (BITS . 15))
(PSECTOR9 107 (BITS . 15))
(PSECTOR9 108 (BITS . 15))
(PSECTOR9 109 (BITS . 15))
(PSECTOR9 110 (BITS . 15))
(PSECTOR9 111 (BITS . 15))
(PSECTOR9 112 (BITS . 15))
(PSECTOR9 113 (BITS . 15))
(PSECTOR9 114 (BITS . 15))
(PSECTOR9 115 (BITS . 15))
(PSECTOR9 116 (BITS . 15))
(PSECTOR9 117 (BITS . 15))
(PSECTOR9 118 (BITS . 15))
(PSECTOR9 119 (BITS . 15))
(PSECTOR9 120 (BITS . 15))
(PSECTOR9 121 (BITS . 15))
(PSECTOR9 122 (BITS . 15))
(PSECTOR9 123 (BITS . 15))
(PSECTOR9 124 (BITS . 15))
(PSECTOR9 125 (BITS . 15))
(PSECTOR9 126 (BITS . 15))
(PSECTOR9 127 (BITS . 15]
(QUOTE 128))
(/DECLAREDATATYPE (QUOTE PMPAGE)
(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))
[QUOTE ((PMPAGE 0 (BITS . 15))
(PMPAGE 1 (BITS . 15))
(PMPAGE 2 SWAPPEDFIXP)
(PMPAGE 4 (BITS . 15))
(PMPAGE 5 SWAPPEDFIXP)
(PMPAGE 7 (BITS . 15))
(PMPAGE 8 (BITS . 15))
(PMPAGE 9 (BITS . 15))
(PMPAGE 10 (BITS . 15))
(PMPAGE 11 (BITS . 15))
(PMPAGE 12 (BITS . 15))
(PMPAGE 13 (BITS . 15))
(PMPAGE 14 (BITS . 15))
(PMPAGE 15 (BITS . 15))
(PMPAGE 16 (BITS . 15))
(PMPAGE 17 (BITS . 15))
(PMPAGE 18 (BITS . 15))
(PMPAGE 19 (BITS . 15))
(PMPAGE 20 (BITS . 15))
(PMPAGE 21 (BITS . 15))
(PMPAGE 22 (BITS . 15))
(PMPAGE 23 (BITS . 15))
(PMPAGE 24 (BITS . 15))
(PMPAGE 25 (BITS . 15))
(PMPAGE 26 (BITS . 15))
(PMPAGE 27 (BITS . 15))
(PMPAGE 28 (BITS . 15))
(PMPAGE 29 (BITS . 15))
(PMPAGE 30 (BITS . 15))
(PMPAGE 31 (BITS . 15))
(PMPAGE 32 (BITS . 15))
(PMPAGE 33 (BITS . 15))
(PMPAGE 34 (BITS . 15))
(PMPAGE 35 (BITS . 15))
(PMPAGE 36 (BITS . 15))
(PMPAGE 37 (BITS . 15))
(PMPAGE 38 (BITS . 15))
(PMPAGE 39 (BITS . 15))
(PMPAGE 40 (BITS . 15))
(PMPAGE 41 (BITS . 15))
(PMPAGE 42 (BITS . 15))
(PMPAGE 43 (BITS . 15))
(PMPAGE 44 (BITS . 15))
(PMPAGE 45 (BITS . 15))
(PMPAGE 46 (BITS . 15))
(PMPAGE 47 (BITS . 15))
(PMPAGE 48 (BITS . 15))
(PMPAGE 49 (BITS . 15))
(PMPAGE 50 (BITS . 15))
(PMPAGE 51 (BITS . 15))
(PMPAGE 52 (BITS . 15))
(PMPAGE 53 (BITS . 15))
(PMPAGE 54 (BITS . 15))
(PMPAGE 55 (BITS . 15))
(PMPAGE 56 (BITS . 15))
(PMPAGE 57 (BITS . 15))
(PMPAGE 58 (BITS . 15))
(PMPAGE 59 (BITS . 15))
(PMPAGE 60 (BITS . 15))
(PMPAGE 61 (BITS . 15))
(PMPAGE 62 (BITS . 15))
(PMPAGE 63 (BITS . 15))
(PMPAGE 64 (BITS . 15))
(PMPAGE 65 (BITS . 15))
(PMPAGE 66 (BITS . 15))
(PMPAGE 67 (BITS . 15))
(PMPAGE 68 (BITS . 15))
(PMPAGE 69 (BITS . 15))
(PMPAGE 70 (BITS . 15))
(PMPAGE 71 (BITS . 15))
(PMPAGE 72 (BITS . 15))
(PMPAGE 73 (BITS . 15))
(PMPAGE 74 (BITS . 15))
(PMPAGE 75 (BITS . 15))
(PMPAGE 76 (BITS . 15))
(PMPAGE 77 (BITS . 15))
(PMPAGE 78 (BITS . 15))
(PMPAGE 79 (BITS . 15))
(PMPAGE 80 (BITS . 15))
(PMPAGE 81 (BITS . 15))
(PMPAGE 82 (BITS . 15))
(PMPAGE 83 (BITS . 15))
(PMPAGE 84 (BITS . 15))
(PMPAGE 85 (BITS . 15))
(PMPAGE 86 (BITS . 15))
(PMPAGE 87 (BITS . 15))
(PMPAGE 88 (BITS . 15))
(PMPAGE 89 (BITS . 15))
(PMPAGE 90 (BITS . 15))
(PMPAGE 91 (BITS . 15))
(PMPAGE 92 (BITS . 15))
(PMPAGE 93 (BITS . 15))
(PMPAGE 94 (BITS . 15))
(PMPAGE 95 (BITS . 15))
(PMPAGE 96 (BITS . 15))
(PMPAGE 97 (BITS . 15))
(PMPAGE 98 (BITS . 15))
(PMPAGE 99 (BITS . 15))
(PMPAGE 100 (BITS . 15))
(PMPAGE 101 (BITS . 15))
(PMPAGE 102 (BITS . 15))
(PMPAGE 103 (BITS . 15))
(PMPAGE 104 (BITS . 15))
(PMPAGE 105 (BITS . 15))
(PMPAGE 106 (BITS . 15))
(PMPAGE 107 (BITS . 15))
(PMPAGE 108 (BITS . 15))
(PMPAGE 109 (BITS . 15))
(PMPAGE 110 (BITS . 15))
(PMPAGE 111 (BITS . 15))
(PMPAGE 112 (BITS . 15))
(PMPAGE 113 (BITS . 15))
(PMPAGE 114 (BITS . 15))
(PMPAGE 115 (BITS . 15))
(PMPAGE 116 (BITS . 15))
(PMPAGE 117 (BITS . 15))
(PMPAGE 118 (BITS . 15))
(PMPAGE 119 (BITS . 15))
(PMPAGE 120 (BITS . 15))
(PMPAGE 121 (BITS . 15))
(PMPAGE 122 (BITS . 15))
(PMPAGE 123 (BITS . 15))
(PMPAGE 124 (BITS . 15))
(PMPAGE 125 (BITS . 15))
(PMPAGE 126 (BITS . 15))
(PMPAGE 127 (BITS . 15))
(PMPAGE 128 (BITS . 15))
(PMPAGE 129 SWAPPEDFIXP)
(PMPAGE 131 (BITS . 15))
(PMPAGE 132 SWAPPEDFIXP)
(PMPAGE 134 (BITS . 15))
(PMPAGE 135 (BITS . 15))
(PMPAGE 136 (BITS . 15))
(PMPAGE 137 (BITS . 15))
(PMPAGE 138 (BITS . 15))
(PMPAGE 139 (BITS . 15))
(PMPAGE 140 (BITS . 15))
(PMPAGE 141 (BITS . 15))
(PMPAGE 142 (BITS . 15))
(PMPAGE 143 (BITS . 15))
(PMPAGE 144 (BITS . 15))
(PMPAGE 145 (BITS . 15))
(PMPAGE 146 (BITS . 15))
(PMPAGE 147 (BITS . 15))
(PMPAGE 148 (BITS . 15))
(PMPAGE 149 (BITS . 15))
(PMPAGE 150 (BITS . 15))
(PMPAGE 151 (BITS . 15))
(PMPAGE 152 (BITS . 15))
(PMPAGE 153 (BITS . 15))
(PMPAGE 154 (BITS . 15))
(PMPAGE 155 (BITS . 15))
(PMPAGE 156 (BITS . 15))
(PMPAGE 157 (BITS . 15))
(PMPAGE 158 (BITS . 15))
(PMPAGE 159 (BITS . 15))
(PMPAGE 160 (BITS . 15))
(PMPAGE 161 (BITS . 15))
(PMPAGE 162 (BITS . 15))
(PMPAGE 163 (BITS . 15))
(PMPAGE 164 (BITS . 15))
(PMPAGE 165 (BITS . 15))
(PMPAGE 166 (BITS . 15))
(PMPAGE 167 (BITS . 15))
(PMPAGE 168 (BITS . 15))
(PMPAGE 169 (BITS . 15))
(PMPAGE 170 (BITS . 15))
(PMPAGE 171 (BITS . 15))
(PMPAGE 172 (BITS . 15))
(PMPAGE 173 (BITS . 15))
(PMPAGE 174 (BITS . 15))
(PMPAGE 175 (BITS . 15))
(PMPAGE 176 (BITS . 15))
(PMPAGE 177 (BITS . 15))
(PMPAGE 178 (BITS . 15))
(PMPAGE 179 (BITS . 15))
(PMPAGE 180 (BITS . 15))
(PMPAGE 181 (BITS . 15))
(PMPAGE 182 (BITS . 15))
(PMPAGE 183 (BITS . 15))
(PMPAGE 184 (BITS . 15))
(PMPAGE 185 (BITS . 15))
(PMPAGE 186 (BITS . 15))
(PMPAGE 187 (BITS . 15))
(PMPAGE 188 (BITS . 15))
(PMPAGE 189 (BITS . 15))
(PMPAGE 190 (BITS . 15))
(PMPAGE 191 (BITS . 15))
(PMPAGE 192 (BITS . 15))
(PMPAGE 193 (BITS . 15))
(PMPAGE 194 (BITS . 15))
(PMPAGE 195 (BITS . 15))
(PMPAGE 196 (BITS . 15))
(PMPAGE 197 (BITS . 15))
(PMPAGE 198 (BITS . 15))
(PMPAGE 199 (BITS . 15))
(PMPAGE 200 (BITS . 15))
(PMPAGE 201 (BITS . 15))
(PMPAGE 202 (BITS . 15))
(PMPAGE 203 (BITS . 15))
(PMPAGE 204 (BITS . 15))
(PMPAGE 205 (BITS . 15))
(PMPAGE 206 (BITS . 15))
(PMPAGE 207 (BITS . 15))
(PMPAGE 208 (BITS . 15))
(PMPAGE 209 (BITS . 15))
(PMPAGE 210 (BITS . 15))
(PMPAGE 211 (BITS . 15))
(PMPAGE 212 (BITS . 15))
(PMPAGE 213 (BITS . 15))
(PMPAGE 214 (BITS . 15))
(PMPAGE 215 (BITS . 15))
(PMPAGE 216 (BITS . 15))
(PMPAGE 217 (BITS . 15))
(PMPAGE 218 (BITS . 15))
(PMPAGE 219 (BITS . 15))
(PMPAGE 220 (BITS . 15))
(PMPAGE 221 (BITS . 15))
(PMPAGE 222 (BITS . 15))
(PMPAGE 223 (BITS . 15))
(PMPAGE 224 (BITS . 15))
(PMPAGE 225 (BITS . 15))
(PMPAGE 226 (BITS . 15))
(PMPAGE 227 (BITS . 15))
(PMPAGE 228 (BITS . 15))
(PMPAGE 229 (BITS . 15))
(PMPAGE 230 (BITS . 15))
(PMPAGE 231 (BITS . 15))
(PMPAGE 232 (BITS . 15))
(PMPAGE 233 (BITS . 15))
(PMPAGE 234 (BITS . 15))
(PMPAGE 235 (BITS . 15))
(PMPAGE 236 (BITS . 15))
(PMPAGE 237 (BITS . 15))
(PMPAGE 238 (BITS . 15))
(PMPAGE 239 (BITS . 15))
(PMPAGE 240 (BITS . 15))
(PMPAGE 241 (BITS . 15))
(PMPAGE 242 (BITS . 15))
(PMPAGE 243 (BITS . 15))
(PMPAGE 244 (BITS . 15))
(PMPAGE 245 (BITS . 15))
(PMPAGE 246 (BITS . 15))
(PMPAGE 247 (BITS . 15))
(PMPAGE 248 (BITS . 15))
(PMPAGE 249 (BITS . 15))
(PMPAGE 250 (BITS . 15))
(PMPAGE 251 (BITS . 15))
(PMPAGE 252 (BITS . 15))
(PMPAGE 253 (BITS . 15))
(PMPAGE 254 (BITS . 15))
(PMPAGE 255 (BITS . 15]
(QUOTE 256))
(/DECLAREDATATYPE (QUOTE PLPAGE)
(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))
[QUOTE ((PLPAGE 0 (BITS . 15))
(PLPAGE 1 (BITS . 15))
(PLPAGE 2 (BITS . 15))
(PLPAGE 3 SWAPPEDFIXP)
(PLPAGE 5 SWAPPEDFIXP)
(PLPAGE 7 SWAPPEDFIXP)
(PLPAGE 9 SWAPPEDFIXP)
(PLPAGE 11 SWAPPEDFIXP)
(PLPAGE 13 SWAPPEDFIXP)
(PLPAGE 15 (BITS . 15))
(PLPAGE 16 (BITS . 15))
(PLPAGE 17 (BITS . 15))
(PLPAGE 18 (BITS . 15))
(PLPAGE 19 (BITS . 15))
(PLPAGE 20 (BITS . 15))
(PLPAGE 21 (BITS . 15))
(PLPAGE 22 (BITS . 15))
(PLPAGE 23 (BITS . 15))
(PLPAGE 24 (BITS . 15))
(PLPAGE 25 (BITS . 15))
(PLPAGE 26 (BITS . 15))
(PLPAGE 27 (BITS . 15))
(PLPAGE 28 (BITS . 15))
(PLPAGE 29 (BITS . 15))
(PLPAGE 30 (BITS . 15))
(PLPAGE 31 (BITS . 15))
(PLPAGE 32 (BITS . 15))
(PLPAGE 33 (BITS . 15))
(PLPAGE 34 (BITS . 15))
(PLPAGE 35 (BITS . 15))
(PLPAGE 36 (BITS . 15))
(PLPAGE 37 (BITS . 15))
(PLPAGE 38 (BITS . 15))
(PLPAGE 39 (BITS . 15))
(PLPAGE 40 (BITS . 15))
(PLPAGE 41 (BITS . 15))
(PLPAGE 42 (BITS . 15))
(PLPAGE 43 (BITS . 15))
(PLPAGE 44 (BITS . 15))
(PLPAGE 45 (BITS . 15))
(PLPAGE 46 (BITS . 15))
(PLPAGE 47 (BITS . 15))
(PLPAGE 48 (BITS . 15))
(PLPAGE 49 (BITS . 15))
(PLPAGE 50 (BITS . 15))
(PLPAGE 51 (BITS . 15))
(PLPAGE 52 (BITS . 15))
(PLPAGE 53 (BITS . 15))
(PLPAGE 54 (BITS . 15))
(PLPAGE 55 (BITS . 15))
(PLPAGE 56 (BITS . 15))
(PLPAGE 57 (BITS . 15))
(PLPAGE 58 (BITS . 15))
(PLPAGE 59 (BITS . 15))
(PLPAGE 60 (BITS . 15))
(PLPAGE 61 (BITS . 15))
(PLPAGE 62 (BITS . 15))
(PLPAGE 63 (BITS . 15))
(PLPAGE 64 (BITS . 15))
(PLPAGE 65 (BITS . 15))
(PLPAGE 66 (BITS . 15))
(PLPAGE 67 (BITS . 15))
(PLPAGE 68 (BITS . 15))
(PLPAGE 69 (BITS . 15))
(PLPAGE 70 (BITS . 15))
(PLPAGE 71 (BITS . 15))
(PLPAGE 72 (BITS . 15))
(PLPAGE 73 (BITS . 15))
(PLPAGE 74 (BITS . 15))
(PLPAGE 75 (BITS . 15))
(PLPAGE 76 (BITS . 15))
(PLPAGE 77 (BITS . 15))
(PLPAGE 78 (BITS . 15))
(PLPAGE 79 (BITS . 15))
(PLPAGE 80 (BITS . 15))
(PLPAGE 81 (BITS . 15))
(PLPAGE 82 (BITS . 15))
(PLPAGE 83 (BITS . 15))
(PLPAGE 84 (BITS . 15))
(PLPAGE 85 (BITS . 15))
(PLPAGE 86 (BITS . 15))
(PLPAGE 87 (BITS . 15))
(PLPAGE 88 (BITS . 15))
(PLPAGE 89 (BITS . 15))
(PLPAGE 90 (BITS . 15))
(PLPAGE 91 (BITS . 15))
(PLPAGE 92 (BITS . 15))
(PLPAGE 93 (BITS . 15))
(PLPAGE 94 (BITS . 15))
(PLPAGE 95 (BITS . 15))
(PLPAGE 96 (BITS . 15))
(PLPAGE 97 (BITS . 15))
(PLPAGE 98 (BITS . 15))
(PLPAGE 99 (BITS . 15))
(PLPAGE 100 (BITS . 15))
(PLPAGE 101 (BITS . 15))
(PLPAGE 102 (BITS . 15))
(PLPAGE 103 (BITS . 15))
(PLPAGE 104 (BITS . 15))
(PLPAGE 105 (BITS . 15))
(PLPAGE 106 (BITS . 15))
(PLPAGE 107 (BITS . 15))
(PLPAGE 108 (BITS . 15))
(PLPAGE 109 (BITS . 15))
(PLPAGE 110 (BITS . 15))
(PLPAGE 111 (BITS . 15))
(PLPAGE 112 (BITS . 15))
(PLPAGE 113 (BITS . 15))
(PLPAGE 114 (BITS . 15))
(PLPAGE 115 (BITS . 15))
(PLPAGE 116 (BITS . 15))
(PLPAGE 117 (BITS . 15))
(PLPAGE 118 (BITS . 15))
(PLPAGE 119 (BITS . 15))
(PLPAGE 120 (BITS . 15))
(PLPAGE 121 (BITS . 15))
(PLPAGE 122 (BITS . 15))
(PLPAGE 123 (BITS . 15))
(PLPAGE 124 (BITS . 15))
(PLPAGE 125 (BITS . 15))
(PLPAGE 126 (BITS . 15))
(PLPAGE 127 (BITS . 15))
(PLPAGE 128 (BITS . 15))
(PLPAGE 129 (BITS . 15))
(PLPAGE 130 (BITS . 15))
(PLPAGE 131 (BITS . 15))
(PLPAGE 132 (BITS . 15))
(PLPAGE 133 (BITS . 15))
(PLPAGE 134 (BITS . 15))
(PLPAGE 135 (BITS . 15))
(PLPAGE 136 (BITS . 15))
(PLPAGE 137 (BITS . 15))
(PLPAGE 138 (BITS . 15))
(PLPAGE 139 (BITS . 15))
(PLPAGE 140 (BITS . 15))
(PLPAGE 141 (BITS . 15))
(PLPAGE 142 (BITS . 15))
(PLPAGE 143 (BITS . 15))
(PLPAGE 144 (BITS . 15))
(PLPAGE 145 (BITS . 15))
(PLPAGE 146 (BITS . 15))
(PLPAGE 147 (BITS . 15))
(PLPAGE 148 (BITS . 15))
(PLPAGE 149 (BITS . 15))
(PLPAGE 150 (BITS . 15))
(PLPAGE 151 (BITS . 15))
(PLPAGE 152 (BITS . 15))
(PLPAGE 153 (BITS . 15))
(PLPAGE 154 (BITS . 15))
(PLPAGE 155 (BITS . 15))
(PLPAGE 156 (BITS . 15))
(PLPAGE 157 (BITS . 15))
(PLPAGE 158 (BITS . 15))
(PLPAGE 159 (BITS . 15))
(PLPAGE 160 (BITS . 15))
(PLPAGE 161 (BITS . 15))
(PLPAGE 162 (BITS . 15))
(PLPAGE 163 (BITS . 15))
(PLPAGE 164 (BITS . 15))
(PLPAGE 165 (BITS . 15))
(PLPAGE 166 (BITS . 15))
(PLPAGE 167 (BITS . 15))
(PLPAGE 168 (BITS . 15))
(PLPAGE 169 (BITS . 15))
(PLPAGE 170 (BITS . 15))
(PLPAGE 171 (BITS . 15))
(PLPAGE 172 (BITS . 15))
(PLPAGE 173 (BITS . 15))
(PLPAGE 174 (BITS . 15))
(PLPAGE 175 (BITS . 15))
(PLPAGE 176 (BITS . 15))
(PLPAGE 177 (BITS . 15))
(PLPAGE 178 (BITS . 15))
(PLPAGE 179 (BITS . 15))
(PLPAGE 180 (BITS . 15))
(PLPAGE 181 (BITS . 15))
(PLPAGE 182 (BITS . 15))
(PLPAGE 183 (BITS . 15))
(PLPAGE 184 (BITS . 15))
(PLPAGE 185 (BITS . 15))
(PLPAGE 186 (BITS . 15))
(PLPAGE 187 (BITS . 15))
(PLPAGE 188 (BITS . 15))
(PLPAGE 189 (BITS . 15))
(PLPAGE 190 (BITS . 15))
(PLPAGE 191 (BITS . 15))
(PLPAGE 192 (BITS . 15))
(PLPAGE 193 (BITS . 15))
(PLPAGE 194 (BITS . 15))
(PLPAGE 195 (BITS . 15))
(PLPAGE 196 (BITS . 15))
(PLPAGE 197 (BITS . 15))
(PLPAGE 198 (BITS . 15))
(PLPAGE 199 (BITS . 15))
(PLPAGE 200 (BITS . 15))
(PLPAGE 201 (BITS . 15))
(PLPAGE 202 (BITS . 15))
(PLPAGE 203 (BITS . 15))
(PLPAGE 204 (BITS . 15))
(PLPAGE 205 (BITS . 15))
(PLPAGE 206 (BITS . 15))
(PLPAGE 207 (BITS . 15))
(PLPAGE 208 (BITS . 15))
(PLPAGE 209 (BITS . 15))
(PLPAGE 210 (BITS . 15))
(PLPAGE 211 (BITS . 15))
(PLPAGE 212 (BITS . 15))
(PLPAGE 213 (BITS . 15))
(PLPAGE 214 (BITS . 15))
(PLPAGE 215 (BITS . 15))
(PLPAGE 216 (BITS . 15))
(PLPAGE 217 (BITS . 15))
(PLPAGE 218 (BITS . 15))
(PLPAGE 219 (BITS . 15))
(PLPAGE 220 (BITS . 15))
(PLPAGE 221 (BITS . 15))
(PLPAGE 222 (BITS . 15))
(PLPAGE 223 (BITS . 15))
(PLPAGE 224 (BITS . 15))
(PLPAGE 225 (BITS . 15))
(PLPAGE 226 (BITS . 15))
(PLPAGE 227 (BITS . 15))
(PLPAGE 228 (BITS . 15))
(PLPAGE 229 (BITS . 15))
(PLPAGE 230 (BITS . 15))
(PLPAGE 231 (BITS . 15))
(PLPAGE 232 (BITS . 15))
(PLPAGE 233 (BITS . 15))
(PLPAGE 234 (BITS . 15))
(PLPAGE 235 (BITS . 15))
(PLPAGE 236 (BITS . 15))
(PLPAGE 237 (BITS . 15))
(PLPAGE 238 (BITS . 15))
(PLPAGE 239 (BITS . 15))
(PLPAGE 240 (BITS . 15))
(PLPAGE 241 (BITS . 15))
(PLPAGE 242 (BITS . 15))
(PLPAGE 243 (BITS . 15))
(PLPAGE 244 (BITS . 15))
(PLPAGE 245 (BITS . 15))
(PLPAGE 246 (BITS . 15))
(PLPAGE 247 (BITS . 15))
(PLPAGE 248 (BITS . 15))
(PLPAGE 249 (BITS . 15))
(PLPAGE 250 (BITS . 15))
(PLPAGE 251 (BITS . 15))
(PLPAGE 252 (BITS . 15))
(PLPAGE 253 (BITS . 15))
(PLPAGE 254 (BITS . 15]
(QUOTE 256))
(/DECLAREDATATYPE (QUOTE PFLE)
(QUOTE (SWAPPEDFIXP WORD WORD WORD))
[QUOTE ((PFLE 0 SWAPPEDFIXP)
(PFLE 2 (BITS . 15))
(PFLE 3 (BITS . 15))
(PFLE 4 (BITS . 15]
(QUOTE 6))
)
(DEFINEQ
(\FLOPPY.TRANSLATEFLOPPYRESULT
[LAMBDA (FLOPPYRESULT) (* kbr: "23-Jul-84 01:08")
(SELECT (LOGAND FLOPPYRESULT R.WRITEERRORMASK)
(R.WRITEPROTECT (QUOTE WRITEPROTECT))
(SELECT (LOGAND FLOPPYRESULT 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: "22-Mar-86 18:09")
(* FLOPPY just tried to do something that would have
crashed lisp. *)
(PROG NIL
(ERROR "Floppy: Severe Error!" MESSAGE)
(COND
(\DOVEFLOPPY.TRACEFLG (STOPTEST))))))
(\FLOPPY.TRANSLATEPMPAGEETYPE
[LAMBDA (PMPAGEETYPE) (* kbr: "23-Jul-84 01:08")
(SELECT PMPAGEETYPE (PMPAGEETYPE.FREE (QUOTE FREE))
(PMPAGEETYPE.FILE (QUOTE FILE))
(PMPAGEETYPE.PFILELIST (QUOTE PFILELIST))
(PMPAGEETYPE.BADSECTORS (QUOTE BADSECTORS))
(QUOTE ?])
(\FLOPPY.TRANSLATEFILETYPE
[LAMBDA (FILETYPE) (* kbr: "23-Jul-84 01:08")
(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.PFILELIST (QUOTE PFILELIST))
(2055 (QUOTE BACKSTOPDEBUGGER))
(2066 (QUOTE BACKSTOPDEBUGGEE))
(QUOTE ?])
(\FLOPPY.MTL.FIXP
[LAMBDA (X) (* kbr: "23-Jul-84 01:08")
(* Mesa FIXP to Lisp FIXP. *)
(ROT X 16 32])
(\FLOPPY.LTM.FIXP
[LAMBDA (X) (* kbr: "23-Jul-84 01:08")
(* Lisp FIXP to Mesa FIXP. *)
(ROT X 16 32])
(\FLOPPY.MTL.IDATE
[LAMBDA (X) (* kbr: "23-Jul-84 01:08")
(* Mesa IDATE to Lisp IDATE.
*)
(LOGXOR -2147483648 X])
(\FLOPPY.LTM.IDATE
[LAMBDA (X) (* kbr: "23-Jul-84 01:08")
(* Lisp IDATE to Mesa IDATE.
*)
(LOGXOR -2147483648 X])
)
(* "HEAD" *)
(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.DEBUG NIL)
(RPAQ? \FLOPPY.CYLINDERS 77)
(RPAQ? \FLOPPY.TRACKSPERCYLINDER 2)
(RPAQ? \FLOPPY.SECTORSPERTRACK 15)
(RPAQ? \FLOPPYMPERRORS 0)
(RPAQ? \FLOPPYMPERRORSFLG NIL)
(RPAQ? \FLOPPY.MOUNTEDP.DOVETIME NIL)
(RPAQ? \FLOPPY.MOUNTEDP.DOVEANSWER NIL)
(DEFINEQ
(\FLOPPY.TRANSLATESETUP
[LAMBDA (SETUP) (* kbr: "22-Jul-84 22:34")
(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.IOCB
[LAMBDA (FLOPPYIOCB SETUP) (* kbr: "22-Jul-84 22:34")
(* Change setup (i.e. manufacturer, density, and
sectorlength info) of FLOPPYIOCB 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 FLOPPYIOCBs
FLOPPYRESULT in 500 PMPAGE series hard crashes.
*)
(UNINTERRUPTABLY
(replace (FLOPPYIOCB SECTORLENGTHDIV2) of FLOPPYIOCB with (LRSH SECTORLENGTH
1))
(replace (FLOPPYIOCB DENSITY) of FLOPPYIOCB with DENSITY)
(replace (FLOPPYIOCB TROYORIBM) of FLOPPYIOCB with IBM)
(replace (FLOPPYIOCB SECTORLENGTHDIV4) of FLOPPYIOCB with (LRSH SECTORLENGTH
2))
(replace (FLOPPYIOCB ENCODEDSECTORLENGTH) of FLOPPYIOCB with
ENCODEDSECTORLENGTH)
(replace (FLOPPYIOCB SECTORSPERTRACK) of FLOPPYIOCB with SECTORSPERTRACK)
(replace (FLOPPYIOCB GAP3) of FLOPPYIOCB with GAP3))
(RETURN FLOPPYIOCB])
(\FLOPPY.CHECK.FLOPPYIOCB
[LAMBDA (FLOPPYIOCB) (* kbr: " 7-Aug-85 19:20")
(* Check FLOPPYIOCB is legal--A better debugging tool
than bletcherous flashing PMPAGE codes.
*)
(PROG (SETUP) (* Check command *)
(COND
((OR (NOT (MEMB (fetch (FLOPPYIOCB COMMAND) of FLOPPYIOCB)
(LIST C.NOP C.INITIALIZE C.RECALIBRATE C.READSECTOR
C.WRITESECTOR C.FORMATTRACK)))
(NOT (IEQP (fetch (FLOPPYIOCB SUBCOMMAND) of FLOPPYIOCB)
SC.NOP))) (* We're not supporting anything besides these.
*)
(\FLOPPY.SEVERE.ERROR "Illegal FLOPPYIOCB Command")))
(* Check diskaddress *)
(create DISKADDRESS
CYLINDER ←(fetch (FLOPPYIOCB CYLINDER) of FLOPPYIOCB)
HEAD ←(fetch (FLOPPYIOCB HEAD) of FLOPPYIOCB)
SECTOR ←(fetch (FLOPPYIOCB SECTOR) of FLOPPYIOCB))
(* Check buffer *)
(COND
([NOT (OR (AND (fetch (FLOPPYIOCB BUFFER) of FLOPPYIOCB)
(IEQP (fetch (FLOPPYIOCB SECTORCOUNT) of FLOPPYIOCB)
1))
(AND (NULL (fetch (FLOPPYIOCB BUFFER) of FLOPPYIOCB))
(ZEROP (fetch (FLOPPYIOCB SECTORCOUNT) of FLOPPYIOCB)))
(AND (IEQP (fetch (FLOPPYIOCB COMMAND) of FLOPPYIOCB)
C.FORMATTRACK)
(ILEQ (IPLUS (fetch (FLOPPYIOCB CYLINDER) of FLOPPYIOCB)
(fetch (FLOPPYIOCB SECTORCOUNT) of FLOPPYIOCB)
)
\FLOPPY.CYLINDERS]
(\FLOPPY.SEVERE.ERROR "Illegal FLOPPYIOCB Buffer")))
(* Check setup *)
(COND
((OR (IEQP (fetch (FLOPPYIOCB TROYORIBM) of FLOPPYIOCB)
TROY)
(fetch (FLOPPYIOCB SAMEPAGE) of FLOPPYIOCB))
(* We're not supporting these.
*)
(\FLOPPY.SEVERE.ERROR "Illegal FLOPPYIOCB Setup 1")))
(SETQ SETUP (SELECTC (fetch (FLOPPYIOCB DENSITY) of FLOPPYIOCB)
(SINGLE (SELECTC (fetch (FLOPPYIOCB ENCODEDSECTORLENGTH)
of FLOPPYIOCB)
(B128 IBMS128)
(B256 IBMS256)
(B512 IBMS512)
(B1024 IBMS1024)
(\FLOPPY.SEVERE.ERROR
"Illegal FLOPPYIOCB Setup 2")))
(DOUBLE (SELECTC (fetch (FLOPPYIOCB ENCODEDSECTORLENGTH)
of FLOPPYIOCB)
(B128 IBMD128)
(B256 IBMD256)
(B512 IBMD512)
(B1024 IBMD1024)
(\FLOPPY.SEVERE.ERROR
"Illegal FLOPPYIOCB Setup 2")))
(\FLOPPY.SEVERE.ERROR "Illegal FLOPPYIOCB Setup 2")))
(COND
([OR (NOT (IEQP (fetch (FLOPPYIOCB SECTORLENGTHDIV2) of FLOPPYIOCB)
(IQUOTIENT (\FLOPPY.SECTORLENGTH SETUP)
2)))
(NOT (IEQP (fetch (FLOPPYIOCB SECTORLENGTHDIV4) of FLOPPYIOCB)
(IQUOTIENT (\FLOPPY.SECTORLENGTH SETUP)
4)))
(NOT (IEQP (fetch (FLOPPYIOCB SECTORSPERTRACK) of FLOPPYIOCB)
(\FLOPPY.SECTORSPERTRACK SETUP)))
(IGREATERP (fetch (FLOPPYIOCB SECTOR) of FLOPPYIOCB)
(fetch (FLOPPYIOCB SECTORSPERTRACK) of FLOPPYIOCB))
(NOT (IEQP (fetch (FLOPPYIOCB GAP3) of FLOPPYIOCB)
(\FLOPPY.GAP3 SETUP]
(\FLOPPY.SEVERE.ERROR "Illegal FLOPPYIOCB Setup 3"])
(\FLOPPY.DENSITY
[LAMBDA (SETUP) (* kbr: "22-Jul-84 22:34")
(SELECT SETUP ((IBMS128 IBMS256 IBMS512 IBMS1024)
SINGLE)
((IBMD128 IBMD256 IBMD512 IBMD1024)
DOUBLE)
(SHOULDNT])
(\FLOPPY.SECTORLENGTH
[LAMBDA (SETUP) (* kbr: "22-Jul-84 22:34")
(SELECT SETUP ((IBMS128 IBMD128)
128)
((IBMS256 IBMD256)
256)
((IBMS512 IBMD512)
512)
((IBMS1024 IBMD1024)
1024)
(SHOULDNT])
(\FLOPPY.ENCODEDSECTORLENGTH
[LAMBDA (SETUP) (* kbr: "22-Jul-84 22:34")
(SELECT SETUP ((IBMS128 IBMD128)
B128)
((IBMS256 IBMD256)
B256)
((IBMS512 IBMD512)
B512)
((IBMS1024 IBMD1024)
B1024)
(SHOULDNT])
(\FLOPPY.GAP3
[LAMBDA (SETUP) (* kbr: "22-Jul-84 22:34")
(SELECT SETUP (IBMS128 27)
(IBMS256 42)
(IBMS512 58)
(IBMS1024 75)
(IBMD128 26)
(IBMD256 54)
(IBMD512 84)
(IBMD1024 116)
(SHOULDNT])
(\FLOPPY.SECTORSPERTRACK
[LAMBDA (SETUP) (* kbr: "22-Jul-84 22:34")
(SELECT SETUP (IBMS128 26)
(IBMS256 15)
(IBMS512 8)
(IBMS1024 4)
(IBMD128 36)
(IBMD256 26)
(IBMD512 15)
(IBMD1024 8)
(SHOULDNT])
(\FLOPPY.RUN
[LAMBDA (FLOPPYIOCB NOERROR) (* kbr: "11-Oct-85 15:21")
(* Returns T if command successfully completed.
*)
(PROG (RETRYFLG)
RETRY
(RESETLST (RESETSAVE (\FLOPPY.LOCK.BUFFER FLOPPYIOCB)
(LIST (FUNCTION \FLOPPY.UNLOCK.BUFFER)
FLOPPYIOCB)) (* 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))
(UNINTERRUPTABLY
(\BLT \FLOPPYIOCB FLOPPYIOCB FLOPPYIOCB.SIZE)
(replace (IOPAGE DLFLOPPYCMD) of \IOPAGE with \FLOPPYIOCBADDR))
(while (NOT (ZEROP (fetch (IOPAGE DLFLOPPYCMD) of \IOPAGE)))
do (BLOCK)))
(COND
((NOT (OR (fetch (FLOPPYRESULT ERROR) of \FLOPPYRESULT)
(fetch (FLOPPYRESULT MPERROR) of \FLOPPYRESULT)))
(RETURN T))
((fetch (FLOPPYRESULT DOOROPENED) of \FLOPPYRESULT)
(* Note: ERROR flag is on whenever DOOROPENED is on.
*)
(* Door opened. Always an error at this deep a level.
(Otherwise user could switch floppies on stream.) *)
(\FLOPPY.ERROR) (* Abandon command. *)
(RETURN NIL))
[[AND (OR (fetch (FLOPPYRESULT RECORDNOTFOUND) of \FLOPPYRESULT)
(fetch (FLOPPYRESULT RECALIBRATEERROR) of \FLOPPYRESULT))
(NOT RETRYFLG)
(NOT (MEMB (fetch (FLOPPYIOCB COMMAND) of FLOPPYIOCB)
(LIST C.INITIALIZE C.RECALIBRATE C.NOP]
(* Try one more time after initializing and
recalibrating. *)
(\FLOPPY.INITIALIZE NOERROR)
(COND
((NOT (fetch (FLOPPYRESULT DOOROPENED) of \FLOPPYRESULT))
(\FLOPPY.RECALIBRATE NOERROR]
[(fetch (FLOPPYRESULT MPERROR) of \FLOPPYRESULT)
(SETQ \FLOPPYMPERRORS (ADD1 \FLOPPYMPERRORS))
(* These should only be generated by still undiagnosed
bugs living in IOP assembly language code.
Reissuing command seems to work.
*)
[COND
(\FLOPPYMPERRORSFLG (\FLOPPY.BREAK (fetch (FLOPPYRESULT MPMESSAGE)
of \FLOPPYRESULT]
(COND
[RETRYFLG (COND
(NOERROR (RETURN NIL))
(T (\FLOPPY.BREAK (fetch (FLOPPYRESULT MPMESSAGE) of
\FLOPPYRESULT]
((FMEMB (fetch (FLOPPYRESULT MPERROR) of \FLOPPYRESULT)
(QUOTE (597 598)))
(* These 597 and 598 pseudo mpcodes were installed by Mitch Lichtenberg to avoid FLOPPY sometimes crashing the
Dandelion with MPC 1108, espesicially when RS232 is also running. See AR291. Supposedly helps to wait 1 or 2
seconds after this kind of spurious error. *)
(BLOCK 2000]
[(fetch (FLOPPYRESULT CRCERROR) of \FLOPPYRESULT)
(* Cyclic Redundancy Check.
Reissuing command seems to work.
*)
(COND
(RETRYFLG (COND
(NOERROR (RETURN NIL))
(T (\FLOPPY.BREAK (QUOTE CRCERROR]
(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.ERROR
[LAMBDA NIL (* kbr: "19-Jul-85 19:28")
(PROG ($FLOPPYRESULT)
(SETQ $FLOPPYRESULT (\FLOPPY.TRANSLATEFLOPPYRESULT (fetch (FLOPPYRESULT WORD)
of \FLOPPYRESULT)))
[COND
((EQ $FLOPPYRESULT (QUOTE DOOROPENED))
(\FLOPPY.CLOSE)
(\FLOPPY.INITIALIZE)
(COND
((NOT (fetch (FLOPPYRESULT DOOROPENED) of \FLOPPYRESULT))
(\FLOPPY.RECALIBRATE]
(* Floppy drive door solenoids will lock drive door in place after a DOOROPENED error. DISKCHANGECLEAR done before
break to unlock the door and allow user to remedy if no floppy present. *)
(\FLOPPY.INITIALIZE)
(\FLOPPY.BREAK $FLOPPYRESULT)
(COND
((MEMB $FLOPPYRESULT (QUOTE (DOOROPENED DOORISOPEN)))
(\FLOPPY.CLOSE))) (* INITIALIZE again, since user may open floppy drive
door during break. *)
(\FLOPPY.INITIALIZE)
(COND
((NOT (fetch (FLOPPYRESULT DOOROPENED) of \FLOPPYRESULT))
(\FLOPPY.RECALIBRATE])
(\FLOPPY.LOCK.BUFFER
[LAMBDA (FLOPPYIOCB) (* kbr: "22-Jul-84 22:34")
(* 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 (FLOPPYIOCB COMMAND) of FLOPPYIOCB)
(LIST C.READSECTOR C.WRITESECTOR))
(SETQ BUFFER (fetch (FLOPPYIOCB BUFFER) of FLOPPYIOCB))
(SETQ COUNT (fetch (FLOPPYIOCB SECTORCOUNT) of FLOPPYIOCB))
(\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 (FLOPPYIOCB) (* kbr: "22-Jul-84 22:34")
(* Unlock floppy buffer. *)
(PROG (BUFFER COUNT)
(COND
((MEMB (fetch (FLOPPYIOCB COMMAND) of FLOPPYIOCB)
(LIST C.READSECTOR C.WRITESECTOR))
(SETQ BUFFER (fetch (FLOPPYIOCB BUFFER) of FLOPPYIOCB))
(SETQ COUNT (fetch (FLOPPYIOCB SECTORCOUNT) of FLOPPYIOCB))
(\UNLOCKPAGES BUFFER COUNT])
(\FLOPPY.PREPAREFORCRASH
[LAMBDA NIL (* kbr: "22-Jul-84 22:34")
(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 (FLOPPYIOCB COMMAND SUBCOMMAND NOERROR) (* kbr: "22-Jul-84 22:34")
(PROG (DISKADDRESS)
(SETQ DISKADDRESS (CONSTANT (create DISKADDRESS
CYLINDER ← 0
HEAD ← 0
SECTOR ← 1)))
(UNINTERRUPTABLY
(replace (FLOPPYIOCB COMMAND) of FLOPPYIOCB with COMMAND)
(replace (FLOPPYIOCB SUBCOMMAND) of FLOPPYIOCB with SUBCOMMAND)
(replace (FLOPPYIOCB DISKADDRESS) of FLOPPYIOCB with DISKADDRESS)
(replace (FLOPPYIOCB BUFFER) of FLOPPYIOCB with NIL)
(replace (FLOPPYIOCB SECTORCOUNT) of FLOPPYIOCB with 0))
(RETURN (\FLOPPY.RUN FLOPPYIOCB NOERROR])
(\FLOPPY.INITIALIZE
[LAMBDA (NOERROR) (* kbr: " 5-Oct-85 20:09")
(SELECTQ (MACHINETYPE)
(DANDELION (GLOBALRESOURCE \FLOPPY.SCRATCH.FLOPPYIOCB (\FLOPPY.COMMAND
\FLOPPY.SCRATCH.FLOPPYIOCB
C.INITIALIZE
SC.NOP
NOERROR)
(* DISKCHANGECLEAR is needed for KIKU machine. KIKU's INITIALIZE doesn't clear DOOROPENED flag in \FLOPPYRESULT and
IOP will not proceed until it is cleared. *)
(\FLOPPY.COMMAND \FLOPPY.SCRATCH.FLOPPYIOCB C.ESCAPE
SC.DISKCHANGECLEAR NOERROR)))
(DOVE (\DOVEFLOPPY.RESET))
NIL])
(\FLOPPY.NOP
[LAMBDA (NOERROR) (* kbr: "22-Jul-84 22:34")
(GLOBALRESOURCE \FLOPPY.SCRATCH.FLOPPYIOCB (\FLOPPY.COMMAND \FLOPPY.SCRATCH.FLOPPYIOCB C.NOP
SC.NOP NOERROR])
(\FLOPPY.RECALIBRATE
[LAMBDA (NOERROR) (* kbr: " 5-Oct-85 20:09")
(SELECTQ (MACHINETYPE)
(DANDELION (GLOBALRESOURCE \FLOPPY.SCRATCH.FLOPPYIOCB (\FLOPPY.COMMAND
\FLOPPY.SCRATCH.FLOPPYIOCB
C.RECALIBRATE
SC.NOP
NOERROR)))
(DOVE T)
NIL])
(\FLOPPY.RECOVER
[LAMBDA (NOERROR) (* kbr: "22-Jul-84 22:34")
(GLOBALRESOURCE \FLOPPY.SCRATCH.FLOPPYIOCB (\FLOPPY.COMMAND \FLOPPY.SCRATCH.FLOPPYIOCB C.ESCAPE
SC.DISKCHANGECLEAR NOERROR])
(\FLOPPY.TRANSFER
(LAMBDA (FLOPPYIOCB COMMAND DISKADDRESS PAGE NOERROR) (* kbr: "17-Apr-86 18:41")
(PROG (MESSAGE ANSWER)
(SETQ ANSWER (SELECTQ (MACHINETYPE)
(DANDELION (SETQ COMMAND (SELECTQ COMMAND
(READ C.READSECTOR)
(WRITE C.WRITESECTOR)
(SHOULDNT)))
(UNINTERRUPTABLY
(replace (FLOPPYIOCB COMMAND) of FLOPPYIOCB
with COMMAND)
(replace (FLOPPYIOCB SUBCOMMAND) of
FLOPPYIOCB
with SC.NOP)
(replace (FLOPPYIOCB DISKADDRESS)
of FLOPPYIOCB with DISKADDRESS)
(replace (FLOPPYIOCB BUFFER) of FLOPPYIOCB
with PAGE)
(replace (FLOPPYIOCB SECTORCOUNT)
of FLOPPYIOCB with 1))
(COND
((\FLOPPY.RUN FLOPPYIOCB NOERROR)
(* Successful coMPletion. *)
PAGE)))
(DOVE (SETQ COMMAND (SELECTQ COMMAND
(READ (QUOTE READDATA))
(WRITE (QUOTE WRITEDATA))
(SHOULDNT)))
(\DOVEFLOPPY.SETCONTEXT (fetch (FLOPPYIOCB $DENSITY)
of FLOPPYIOCB)
(fetch (FLOPPYIOCB
$ENCODEDSECTORLENGTH)
of FLOPPYIOCB))
(COND
((EQ COMMAND (QUOTE WRITEDATA))
(* kbr: "24-Mar-86 01:36" We're going to write a sector on DOVE floppy, but it turns out that DOVE floppy drive
heads vibrate when they move and 1 in 5000 times you smash your floppy if you try to move and write with the same
operation. We get around this problem by first doing our move during a read operation, which is safe since we are
not modifying floppy during a read. After completing the read we do a DISMISS to pass a little time between the
read/move and the coming write. I tried running without the DISMISS and do still find occasional long sequences of
MISSINGADDRESSMARKs or DATAERRORs in the error log in TRACEWINDOW I get with \DOVEFLOPPY.TRACEFLG = T.
After 10 hours of filebanging operations, one of the long sequences finally got long enough to break FLOPPY.
I have not tested yet whether the DISMISS does any good, but I don't think it can hurt. (WHAT A MESS!) *)
(* kbr: "17-Apr-86 18:38" Message from PURVES.OSBUNORTH AND MCQUILKIN.OSBUNORTH recomends 40 ms settling time for
DOVE floppy drive head before writing. Therefore (DISMISS 20) changed to (DISMISS 40) Pray this works.
*)
(GLOBALRESOURCE \FLOPPY.SCRATCH.BUFFER2
(\DOVEFLOPPY.XFERDISK
(fetch (DISKADDRESS CYLINDER)
of DISKADDRESS)
(fetch (DISKADDRESS HEAD)
of DISKADDRESS)
(fetch (DISKADDRESS SECTOR)
of DISKADDRESS)
\FLOPPY.SCRATCH.BUFFER2
(QUOTE READDATA)))
(DISMISS 40)))
(SETQ MESSAGE (\DOVEFLOPPY.XFERDISK
(fetch (DISKADDRESS CYLINDER) of DISKADDRESS)
(fetch (DISKADDRESS HEAD) of DISKADDRESS)
(fetch (DISKADDRESS SECTOR) of DISKADDRESS)
PAGE COMMAND))
(COND
((EQ MESSAGE (QUOTE OK))
PAGE)
((NOT NOERROR)
(\FLOPPY.BREAK MESSAGE))))
NIL))
(RETURN ANSWER))))
(\FLOPPY.READSECTOR
[LAMBDA (FLOPPYIOCB DISKADDRESS PAGE NOERROR) (* kbr: " 7-Aug-85 20:42")
(\FLOPPY.TRANSFER FLOPPYIOCB (QUOTE READ)
DISKADDRESS PAGE NOERROR])
(\FLOPPY.WRITESECTOR
[LAMBDA (FLOPPYIOCB DISKADDRESS PAGE NOERROR) (* kbr: " 7-Aug-85 20:42")
(\FLOPPY.TRANSFER FLOPPYIOCB (QUOTE WRITE)
DISKADDRESS PAGE NOERROR])
(\FLOPPY.FORMATTRACKS
[LAMBDA (FLOPPYIOCB DISKADDRESS KOUNT NOERROR) (* kbr: " 2-Sep-85 16:34")
(PROG (ANSWER MESSAGE)
(SETQ ANSWER (SELECTQ (MACHINETYPE)
(DANDELION (UNINTERRUPTABLY
(replace (FLOPPYIOCB COMMAND) of FLOPPYIOCB
with C.FORMATTRACK)
(replace (FLOPPYIOCB SUBCOMMAND) of
FLOPPYIOCB
with SC.NOP)
(replace (FLOPPYIOCB DISKADDRESS)
of FLOPPYIOCB with DISKADDRESS)
(replace (FLOPPYIOCB BUFFER) of FLOPPYIOCB
with NIL)
(replace (FLOPPYIOCB SECTORCOUNT)
of FLOPPYIOCB with KOUNT))
(\FLOPPY.RUN FLOPPYIOCB NOERROR))
((DOVE DAYBREAK)
(\DOVEFLOPPY.SETCONTEXT (fetch (FLOPPYIOCB $DENSITY)
of FLOPPYIOCB)
(fetch (FLOPPYIOCB
$ENCODEDSECTORLENGTH)
of FLOPPYIOCB))
(for I from 0 to (SUB1 KOUNT)
do (SETQ MESSAGE (\DOVEFLOPPY.XFERDISK
(IPLUS (fetch (DISKADDRESS CYLINDER)
of DISKADDRESS)
I)
(fetch (DISKADDRESS HEAD) of DISKADDRESS)
(fetch (DISKADDRESS SECTOR) of DISKADDRESS)
\FLOPPY.SCRATCH.BUFFER
(QUOTE FORMATTRACK)))
(COND
((EQ MESSAGE (QUOTE OK))
T)
((NOT NOERROR)
(\FLOPPY.BREAK MESSAGE))
(T (RETURN NIL)))
finally (RETURN T)))
NIL))
(RETURN ANSWER])
(\FLOPPY.DISKCHANGECLEAR
[LAMBDA (NOERROR) (* kbr: "25-Apr-85 14:52")
(GLOBALRESOURCE \FLOPPY.SCRATCH.FLOPPYIOCB (\FLOPPY.COMMAND \FLOPPY.SCRATCH.FLOPPYIOCB C.ESCAPE
SC.DISKCHANGECLEAR NOERROR])
(\FLOPPY.MOUNTEDP
[LAMBDA (NOERROR) (* hdj " 5-Jun-86 12:58")
(* Floppy drive contains floppy, door
is shut, door stable since last
\FLOPPY.INITIALIZE? *)
(PROG (ANSWER)
(* There is apparently no way to test these facts independently.
Also, if DOOROPENED bit was set in the past & floppy is now mounted, this
routine treats this as unmounted. Some recovery routine must do a
\FLOPPY.INITIALIZE as one of its actions to clear this bit.
*)
(SETQ ANSWER (SELECTQ (MACHINETYPE)
(DANDELION (UNINTERRUPTABLY
(\FLOPPY.NOP T)
(NOT (fetch (FLOPPYRESULT DOOROPENED) of \FLOPPYRESULT))))
(DOVE (* MORE UGLY CRUFT TO GET AROUND DOVE
DOOROPEN BITS NOT WORKING.
*)
(COND
((\DEVICE-OPEN-STREAMS \FLOPPYFDEV)
(* If the user has streams open on
{FLOPPY} then the user probably hasn't
switched floppies. *)
T)
((AND (NOT (STKPOS (QUOTE FLOPPY.FORMAT)))
(EQ (WITH.MONITOR \FLOPPYLOCK (\DOVEFLOPPY.TRANSFER
20 0 1
\FLOPPY.SCRATCH.BUFFER
(QUOTE READDATA)))
(QUOTE TIMEOUT)))
(* Notice that we obtain \FLOPPYLOCK before doing timeing.
Since TIMEOUT can happen if floppy is not formatted properly, just say T if
we're underneath FLOPPY.FORMAT. *)
NIL)
(T T)))
NIL))
(COND
((OR NOERROR ANSWER)
(RETURN ANSWER)))
(\FLOPPY.BREAK "Door open(ed) or disk missing"])
(\FLOPPY.CAN.READP
[LAMBDA (NOERROR) (* edited: "23-Jul-84 15:33")
(AND (\FLOPPY.EXISTSP NOERROR)
(\FLOPPY.MOUNTEDP NOERROR])
(\FLOPPY.CAN.WRITEP
[LAMBDA (NOERROR) (* edited: "23-Jul-84 15:33")
(AND (\FLOPPY.EXISTSP NOERROR)
(\FLOPPY.MOUNTEDP NOERROR)
(\FLOPPY.WRITEABLEP NOERROR])
(\FLOPPY.WRITEABLEP
[LAMBDA (NOERROR) (* kbr: " 7-Aug-85 20:17")
(* Floppy is write protected *)
(PROG (ANSWER) (* This routine assumes floppy hardware exists.
*)
(SETQ ANSWER (SELECTQ (MACHINETYPE)
[DANDELION (UNINTERRUPTABLY
(\FLOPPY.NOP T)
(NOT (OR (fetch (FLOPPYRESULT DOOROPENED)
of \FLOPPYRESULT)
(fetch (FLOPPYRESULT WRITEPROTECT)
of \FLOPPYRESULT))))]
((DOVE DAYBREAK)
(NOT (\DOVEFLOPPY.WRITEPROTECTED)))
NIL))
(COND
((OR NOERROR ANSWER)
(RETURN ANSWER)))
(\FLOPPY.BREAK "Write protected"])
(\FLOPPY.TWOSIDEDP
[LAMBDA (NOERROR) (* kbr: " 7-Aug-85 20:27")
(* Floppy drive contains floppy, door is shut, door
stable since last \FLOPPY.INITIALIZE? *)
(PROG (ANSWER)
(SETQ ANSWER (SELECTQ (MACHINETYPE)
[DANDELION (UNINTERRUPTABLY
(\FLOPPY.NOP T)
(NOT (fetch (FLOPPYRESULT TWOSIDED)
of \FLOPPYRESULT)))]
((DOVE DAYBREAK)
T)
NIL))
(COND
((OR NOERROR ANSWER)
(RETURN ANSWER)))
(\FLOPPY.BREAK "Not a two sided floppy"])
(\FLOPPY.DUMP
[LAMBDA (DISKADDRESS MODE) (* kbr: "22-Jul-84 22:34")
(PROG (STRING PAGE)
[SETQ PAGE (\FLOPPY.READSECTOR \FLOPPY.SCRATCH.FLOPPYIOCB DISKADDRESS
(NCREATE (QUOTE VMEMPAGEP]
(SETQ STRING (create STRINGP
BASE ← PAGE
LENGTH ←(fetch (FLOPPYIOCB $ENCODEDSECTORLENGTH) of
\FLOPPYIOCB)))
(SELECTQ MODE
(ASCII (SETQ STRING (ASCIITOASCII STRING)))
(EBCDIC (SETQ STRING (EBCDICTOASCII STRING)))
(* STRING ok the way it is.
*))
(RETURN STRING])
(\FLOPPY.DEBUG
[LAMBDA NIL (* kbr: " 7-Aug-85 19:36")
(PROG NIL
(CLOSEINSPECT)
(SELECTQ (MACHINETYPE)
(DANDELION (WINDOWPROP (INSPECT \FLOPPYIOCB (QUOTE FLOPPYIOCB)
(create POSITION
XCOORD ← 20
YCOORD ← 70))
(QUOTE TITLE)
(QUOTE \FLOPPYIOCB))
(WINDOWPROP (INSPECT \FLOPPYRESULT (QUOTE FLOPPYRESULT)
(create POSITION
XCOORD ← 290
YCOORD ← 70))
(QUOTE TITLE)
(QUOTE \FLOPPYRESULT)))
((DOVE DAYBREAK)
NIL)
NIL])
)
(* "COMMON" *)
(RPAQ? \FLOPPYFDEV NIL)
(RPAQ? \FLOPPYLOCK NIL)
(RPAQ? \FLOPPY.SCRATCH.BUFFER NIL)
(RPAQ? \FLOPPY.SCRATCH.BUFFER2 NIL)
(RPAQ? \FLOPPY.SCRATCH.FLOPPYIOCB NIL)
(RPAQ? \FLOPPY.IBMS128.FLOPPYIOCB NIL)
(RPAQ? \FLOPPY.IBMD256.FLOPPYIOCB NIL)
(RPAQ? \FLOPPY.IBMD512.FLOPPYIOCB NIL)
(RPAQ? \FLOPPYIOCBADDR NIL)
(RPAQ? \FLOPPYIOCB NIL)
(RPAQ? \FLOPPYRESULT NIL)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
[PUTDEF (QUOTE \FLOPPY.SCRATCH.FLOPPYIOCB)
(QUOTE RESOURCES)
(QUOTE (NEW (create FLOPPYIOCB]
[PUTDEF (QUOTE \FLOPPY.IBMS128.FLOPPYIOCB)
(QUOTE RESOURCES)
(QUOTE (NEW (\FLOPPY.SETUP.IOCB (create FLOPPYIOCB)
IBMS128]
[PUTDEF (QUOTE \FLOPPY.IBMD256.FLOPPYIOCB)
(QUOTE RESOURCES)
(QUOTE (NEW (\FLOPPY.SETUP.IOCB (create FLOPPYIOCB)
IBMD256]
[PUTDEF (QUOTE \FLOPPY.IBMD512.FLOPPYIOCB)
(QUOTE RESOURCES)
(QUOTE (NEW (\FLOPPY.SETUP.IOCB (create FLOPPYIOCB)
IBMD512]
[PUTDEF (QUOTE \FLOPPY.SCRATCH.BUFFER)
(QUOTE RESOURCES)
(QUOTE (NEW (\FLOPPY.BUFFER 4]
[PUTDEF (QUOTE \FLOPPY.SCRATCH.BUFFER2)
(QUOTE RESOURCES)
(QUOTE (NEW (\FLOPPY.BUFFER 4]
)
)
(/SETTOPVAL (QUOTE \\FLOPPY.SCRATCH.FLOPPYIOCB.GLOBALRESOURCE))
(/SETTOPVAL (QUOTE \\FLOPPY.IBMS128.FLOPPYIOCB.GLOBALRESOURCE))
(/SETTOPVAL (QUOTE \\FLOPPY.IBMD256.FLOPPYIOCB.GLOBALRESOURCE))
(/SETTOPVAL (QUOTE \\FLOPPY.IBMD512.FLOPPYIOCB.GLOBALRESOURCE))
(/SETTOPVAL (QUOTE \\FLOPPY.SCRATCH.BUFFER.GLOBALRESOURCE))
(/SETTOPVAL (QUOTE \\FLOPPY.SCRATCH.BUFFER2.GLOBALRESOURCE))
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(ACCESSFNS FLOPPYSTREAM ((PFALLOC (fetch (STREAM F1) of DATUM)
(replace (STREAM F1) of DATUM with NEWVALUE))
(PLPAGE (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))
(FCBS (fetch (STREAM F2) of DATUM)
(replace (STREAM F2) of DATUM with NEWVALUE))))
(RECORD FILEGENOBJ (NEXTFILEFN FILEINFOFN . GENFILESTATE))
(RECORD GENFILESTATE (ALLOCS DEVICENAME CURRENTALLOC))
]
)
(DEFINEQ
(FLOPPY.RESTART
[LAMBDA NIL (* jds " 6-Nov-85 11:29")
(* Initializes floppy code, setting globals and
creating file devices. *)
(SETQ \FLOPPYLOCK (CREATE.MONITORLOCK (QUOTE FLOPPY)))
(WITH.MONITOR \FLOPPYLOCK (PROG NIL
(SETQ \FLOPPY.SCRATCH.BUFFER (\FLOPPY.BUFFER 4))
(SETQ \FLOPPY.SCRATCH.BUFFER2 (\FLOPPY.BUFFER 4))
(COND
(\FLOPPYFDEV (\FLOPPY.FLUSH)))
(SETQ \PFLOPPYFDEV NIL)
(SETQ \SFLOPPYFDEV NIL)
(SETQ \HFLOPPYFDEV NIL)
(SETQ \CFLOPPYFDEV NIL)
(FLOPPY.MODE (QUOTE PILOT))
(COND
((\FLOPPY.EXISTSP T)
(\FLOPPY.SETUP.HARDWARE])
(FLOPPY.MODE
[LAMBDA (MODE) (* edited: "23-Jul-84 15:33")
(* 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 (NIL NIL)
(\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 (COND
((NULL \PFLOPPYFDEV)
(\PFLOPPY.INIT)))
(SETQ FDEV \PFLOPPYFDEV))
(HUGEPILOT (COND
((NULL \HFLOPPYFDEV)
(\HFLOPPY.INIT)))
(SETQ FDEV \HFLOPPYFDEV))
(SYSOUT (COND
((NULL \SFLOPPYFDEV)
(\SFLOPPY.INIT)))
(SETQ FDEV \SFLOPPYFDEV))
(CPM (COND
((NULL \CFLOPPYFDEV)
(\CFLOPPY.INIT)))
(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.SETUP.HARDWARE
[LAMBDA NIL (* kbr: " 5-Oct-85 20:10")
(PROG NIL
(SELECTQ (MACHINETYPE)
(DANDELION (* DANDELION & KIKU drives.
*)
(* 16 quad aligned words needed for FLOPPYIOCB 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.FLOPPYIOCB (create FLOPPYIOCB))
(SETQ \FLOPPY.IBMS128.FLOPPYIOCB (\FLOPPY.SETUP.IOCB
(create FLOPPYIOCB)
IBMS128))
(SETQ \FLOPPY.IBMD256.FLOPPYIOCB (\FLOPPY.SETUP.IOCB
(create FLOPPYIOCB)
IBMD256))
(SETQ \FLOPPY.IBMD512.FLOPPYIOCB (\FLOPPY.SETUP.IOCB
(create FLOPPYIOCB)
IBMD512))
(SETQ \FLOPPY.CYLINDERS 77)
(SETQ \FLOPPY.TRACKSPERCYLINDER 2)
(SETQ \FLOPPY.SECTORSPERTRACK 15)
(SETQ \HFLOPPY.MAXPAGES 2250))
(DOVE (* DAYBREAK B1 low density drives.
*)
(SETQ \FLOPPY.CYLINDERS 40)
(SETQ \FLOPPY.TRACKSPERCYLINDER 2)
(SETQ \FLOPPY.SECTORSPERTRACK 9)
(SETQ \HFLOPPY.MAXPAGES 684))
(SHOULDNT)) (* PILOT FLOPPY data begins on cylinder 1
(after cylinder 0) and ends on the last cylinder.
*)
(SETQ \PFLOPPYFIRSTDATAPAGE (ADD1 (ITIMES \FLOPPY.TRACKSPERCYLINDER
\FLOPPY.SECTORSPERTRACK)))
(SETQ \PFLOPPYLASTDATAPAGE (ITIMES \FLOPPY.CYLINDERS \FLOPPY.TRACKSPERCYLINDER
\FLOPPY.SECTORSPERTRACK])
(\FLOPPY.EVENTFN
[LAMBDA (FDEV EVENT) (* hdj "23-May-86 16:57")
(PROG NIL
(COND
((NOT (\FLOPPY.EXISTSP T))
(RETURN)))
(SELECTQ EVENT
((AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS)
(\FLOPPY.CLOSE)
(\FLOPPY.SETUP.HARDWARE)
(\FLOPPY.INITIALIZE)
(\PAGED.REVALIDATEFILELST FDEV))
((AFTERSAVEVM)
(\PAGED.REVALIDATEFILELST FDEV))
NIL])
(\FLOPPY.HOSTNAMEP
[LAMBDA (NAME FDEV) (* gbn " 2-Jun-85 16:18")
(* NAME equals name of floppy FDEV? *)
(AND (type? FDEV FDEV)
(EQ NAME (fetch (FDEV DEVICENAME) of FDEV])
(\FLOPPY.ADDDEVICENAME
[LAMBDA (FILENAME) (* edited: "23-Jul-84 15:33")
(* Pack floppy FDEV name onto FILENAME.
*)
(PACK* (QUOTE {)
(fetch (FDEV DEVICENAME) of \FLOPPYFDEV)
(QUOTE })
FILENAME])
(\FLOPPY.ASSUREFILENAME
[LAMBDA (FILE NOERROR) (* kbr: " 2-Sep-85 16:39")
(* Coerce FILE to a litatom FILENAME.
*)
(PROG (UNAME FILENAME)
RETRY
(COND
((type? STREAM FILE)
(SETQ FILENAME (fetch (STREAM FULLFILENAME) of FILE)))
(T (SETQ FILENAME FILE)))
(SETQ UNAME (NLSETQ (UNPACKFILENAME FILENAME)))
(COND
((OR (NULL UNAME)
(NULL (CAR UNAME)))
[COND
(NOERROR (RETURN NIL))
(T (SETQ FILE (LISPERROR "BAD FILE NAME" FILE]
(GO RETRY)))
(SETQ UNAME (CAR UNAME))
(LISTPUT UNAME (QUOTE HOST)
NIL)
(SETQ FILENAME (NLSETQ (PACKFILENAME UNAME)))
(COND
([OR (NULL FILENAME)
(EQ (CAR FILENAME)
(CONSTANT (MKATOM ""]
[COND
(NOERROR (RETURN NIL))
(T (SETQ FILE (LISPERROR "BAD FILE NAME" FILE]
(GO RETRY)))
(SETQ FILENAME (CAR FILENAME))
(RETURN FILENAME])
(\FLOPPY.OTHERINFO
[LAMBDA (OTHERINFO) (* edited: "23-Jul-84 15:33")
(* 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) (* edited: "23-Jul-84 15:33")
(* 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) (* edited: "23-Jul-84 15:33")
(* 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) (* edited: "23-Jul-84 15:33")
(* 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.CACHED.READ
[LAMBDA (NOERROR) (* edited: "23-Jul-84 15:33")
(* Cause or make sure IOP is initialized, floppy is
mounted, and (correct) directory is cached for coming
read operations *)
(PROG (ANSWER)
(COND
((NOT (\FLOPPY.CAN.READP T)) (* Any cached info is no longer guaranteed to be
correct *)
(\FLOPPY.CLOSE)))
(SETQ ANSWER (AND (\FLOPPY.UNCACHED.READ NOERROR)
(\FLOPPY.OPEN NOERROR)))
(RETURN ANSWER])
(\FLOPPY.CACHED.WRITE
[LAMBDA (NOERROR) (* edited: "23-Jul-84 15:33")
(* Cause or make sure IOP is initialized, floppy is
mounted, and (correct) directory is cached for coming
write operations *)
(PROG (ANSWER)
(* In the following COND, we are only verifying that any existing cached info is still correct.
Therefore we do not need to use \FLOPPY.CAN.WRITEP here. Write protection will be handled by \FLOPPY.UNCACHED.WRITE
below. *)
(COND
((NOT (\FLOPPY.CAN.READP T)) (* Any cached info is no longer guaranteed to be
correct *)
(\FLOPPY.CLOSE)))
(SETQ ANSWER (AND (\FLOPPY.UNCACHED.WRITE NOERROR)
(\FLOPPY.OPEN NOERROR)))
(RETURN ANSWER])
(\FLOPPY.OPEN
[LAMBDA (NOERROR) (* edited: "23-Jul-84 15:33")
(SELECT \FLOPPYFDEV ((\PFLOPPYFDEV \HFLOPPYFDEV \SFLOPPYFDEV)
(\PFLOPPY.OPEN NOERROR))
(\CFLOPPYFDEV (\CFLOPPY.OPEN NOERROR))
(SHOULDNT])
(\FLOPPY.CLOSE
[LAMBDA NIL (* kbr: " 5-Oct-85 20:38")
(* Forcibly close floppy. *)
(PROG NIL (* TBW: This function will go away when a wrong floppy
FDEV is implemented. *)
(SELECT \FLOPPYFDEV (\PFLOPPYFDEV (replace (PFINFO OPEN) of \PFLOPPYINFO
with NIL))
(\HFLOPPYFDEV (replace (PFINFO OPEN) of \HFLOPPYINFO with NIL)
(replace (PFINFO OPEN) of \PFLOPPYINFO with NIL))
(\SFLOPPYFDEV (replace (PFINFO OPEN) of \SFLOPPYINFO with NIL)
(replace (PFINFO OPEN) of \PFLOPPYINFO with NIL))
(\CFLOPPYFDEV (replace (CINFO OPEN) of \CFLOPPYINFO with NIL))
NIL)
(\FLOPPY.FLUSH])
(\FLOPPY.FLUSH
[LAMBDA NIL (* hdj " 5-Jun-86 12:57")
(* Forcibly flush streams.
*)
(PROG NIL (* TBW: This function will go away
when a wrong floppy FDEV is
implemented. *)
(COND
((FMEMB (FLOPPY.MODE)
(QUOTE (SYSOUT HUGEPILOT)))
(RETURN)))
(for STREAM in (\DEVICE-OPEN-STREAMS \FLOPPYFDEV)
do (COND
([AND \DOVEFLOPPY.TRACEFLG (NOT (STKPOS (QUOTE FLOPPY.FORMAT]
(STOPTEST)
(BREAK1 NIL T)))
(\DELETE-OPEN-STREAM STREAM \FLOPPYFDEV)
(replace (STREAM STRMBINFN) of STREAM with (QUOTE \STREAM.NOT.OPEN))
(replace (STREAM STRMBOUTFN) of STREAM with (QUOTE \STREAM.NOT.OPEN))
(replace (STREAM ACCESS) of STREAM with NIL])
(\FLOPPY.UNCACHED.READ
[LAMBDA (NOERROR) (* kbr: "19-Jul-85 19:29")
(* Initialize IOP, then verify can read.
Return T or NIL. *)
(PROG NIL
(COND
((NOT (\FLOPPY.EXISTSP NOERROR)) (* Failed *)
(RETURN NIL)))
(COND
((NOT (\FLOPPY.CAN.READP T)) (* DOOROPENED bit on, so must reinitialize IOP &
recalibrate *)
(\FLOPPY.INITIALIZE NOERROR)
(COND
((NOT (\FLOPPY.CAN.READP NOERROR)) (* Failed *)
(RETURN NIL)))
(\FLOPPY.RECALIBRATE NOERROR))) (* Succeeded *)
(RETURN T])
(\FLOPPY.UNCACHED.WRITE
[LAMBDA (NOERROR) (* kbr: " 5-Oct-85 23:52")
(* Initialize IOP, then verify can write.
Return T or NIL. *)
(PROG NIL
(COND
((NOT (\FLOPPY.EXISTSP NOERROR)) (* Failed *)
(RETURN NIL)))
(COND
((NOT (\FLOPPY.CAN.WRITEP T)) (* DOOROPENED bit on, so must reinitialize IOP &
recalibrate *)
(\FLOPPY.INITIALIZE NOERROR)
(COND
((NOT (\FLOPPY.CAN.WRITEP NOERROR)) (* Failed *)
(RETURN NIL)))
(\FLOPPY.RECALIBRATE NOERROR))) (* Succeeded *)
(RETURN T])
(\FLOPPY.EXISTSP
[LAMBDA (NOERROR) (* kbr: " 8-Oct-85 13:30")
(* Floppy drive hardware exists? *)
(PROG NIL
(COND
((FMEMB (MACHINETYPE)
(QUOTE (DANDELION DOVE)))
(RETURN T))
((NOT NOERROR)
(\FLOPPY.BREAK "No floppy drive on this machine"])
(\FLOPPY.BREAK
(LAMBDA (MESSAGE) (* kbr: "22-Mar-86 18:11")
(PROG NIL
(\FLOPPY.MESSAGE MESSAGE T)
(COND
(\DOVEFLOPPY.TRACEFLG (STOPTEST)))
(LISPERROR "HARD DISK ERROR" (QUOTE {FLOPPY})
T))))
(\FLOPPY.MESSAGE
[LAMBDA (MESSAGE STREAM) (* edited: "23-Jul-84 15:33")
(COND
((NULL STREAM)
(SETQ STREAM PROMPTWINDOW)))
(PROG NIL
(FRESHLINE STREAM)
(PRIN1 "Floppy: " STREAM)
(PRIN1 MESSAGE STREAM])
(\FLOPPY.BUFFER
[LAMBDA (N)
(\ALLOCBLOCK (ITIMES N CELLSPERPAGE)
NIL NIL CELLSPERPAGE])
)
(* "PILOT" *)
(RPAQ? \PFLOPPYPSECTOR9 NIL)
(RPAQ? \PFLOPPYPFILELIST NIL)
(RPAQ? \PFLOPPYINFO NIL)
(RPAQ? \PFLOPPYFDEV NIL)
(/DECLAREDATATYPE (QUOTE PFALLOC)
(QUOTE (POINTER FULLXPOINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG))
[QUOTE ((PFALLOC 0 POINTER)
(PFALLOC 2 FULLXPOINTER)
(PFALLOC 4 POINTER)
(PFALLOC 6 POINTER)
(PFALLOC 8 POINTER)
(PFALLOC 10 POINTER)
(PFALLOC 12 POINTER)
(PFALLOC 12 (FLAGBITS . 0))
(PFALLOC 12 (FLAGBITS . 16]
(QUOTE 14))
(/DECLAREDATATYPE (QUOTE PFINFO)
(QUOTE (POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((PFINFO 0 POINTER)
(PFINFO 2 POINTER)
(PFINFO 4 POINTER)
(PFINFO 6 POINTER)
(PFINFO 8 POINTER)))
(QUOTE 10))
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(DATATYPE PFALLOC (FILENAME (PREV FULLXPOINTER)
NEXT START PMPAGE PLPAGE PFLE (WRITEFLG FLAG)
(DELETEFLG FLAG))
[ACCESSFNS ((LENGTH (fetch (PMPAGE NLENGTH) of (fetch (PFALLOC PMPAGE) of DATUM)))
(END (IPLUS (fetch (PFALLOC START) of DATUM)
(fetch (PFALLOC LENGTH) of DATUM)
-1))
(FILETYPE (fetch (PMPAGE NFILETYPE) of (fetch (PFALLOC PMPAGE)
of DATUM])
(DATATYPE PFINFO (OPEN PFILELIST PFALLOCS DIR PSECTOR9))
(ACCESSFNS PFLOPPYFDEV [(OPEN (fetch (PFINFO OPEN) of (fetch (FDEV DEVICEINFO) of DATUM))
(replace (PFINFO OPEN) of (fetch (FDEV DEVICEINFO) of DATUM)
with NEWVALUE))
(PFILELIST (fetch (PFINFO PFILELIST) of (fetch (FDEV DEVICEINFO) of DATUM))
(PROGN (replace (PFINFO PFILELIST) of (fetch (FDEV DEVICEINFO)
of DATUM) with NEWVALUE)
(SETQ \PFLOPPYPFILELIST NEWVALUE)))
(PFALLOCS (fetch (PFINFO PFALLOCS) of (fetch (FDEV DEVICEINFO) of DATUM))
(replace (PFINFO PFALLOCS) of (fetch (FDEV DEVICEINFO) of DATUM)
with NEWVALUE))
(DIR (fetch (PFINFO DIR) of (fetch (FDEV DEVICEINFO) of DATUM))
(replace (PFINFO DIR) of (fetch (FDEV DEVICEINFO) of DATUM) with
NEWVALUE
))
(PSECTOR9 (fetch (PFINFO PSECTOR9) of (fetch (FDEV DEVICEINFO) of DATUM))
(PROGN (replace (PFINFO PSECTOR9) of (fetch (FDEV DEVICEINFO)
of DATUM) with NEWVALUE)
(SETQ \PFLOPPYPSECTOR9 NEWVALUE])
]
(/DECLAREDATATYPE (QUOTE PFALLOC)
(QUOTE (POINTER FULLXPOINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG))
[QUOTE ((PFALLOC 0 POINTER)
(PFALLOC 2 FULLXPOINTER)
(PFALLOC 4 POINTER)
(PFALLOC 6 POINTER)
(PFALLOC 8 POINTER)
(PFALLOC 10 POINTER)
(PFALLOC 12 POINTER)
(PFALLOC 12 (FLAGBITS . 0))
(PFALLOC 12 (FLAGBITS . 16]
(QUOTE 14))
(/DECLAREDATATYPE (QUOTE PFINFO)
(QUOTE (POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((PFINFO 0 POINTER)
(PFINFO 2 POINTER)
(PFINFO 4 POINTER)
(PFINFO 6 POINTER)
(PFINFO 8 POINTER)))
(QUOTE 10))
)
(DEFINEQ
(\PFLOPPY.INIT
[LAMBDA NIL (* hdj "15-May-86 20:44")
(PROG NIL
(SETQ \PFLOPPYINFO (create PFINFO))
(SETQ \PFLOPPYFDEV (create FDEV
DEVICENAME ← (QUOTE FLOPPY)
NODIRECTORIES ← 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)
DEVICEINFO ← \PFLOPPYINFO
RENAMEFILE ← (QUOTE \PFLOPPY.RENAMEFILE)
OPENP ← (FUNCTION \GENERIC.OPENP)
REGISTERFILE ← (FUNCTION \ADD-OPEN-STREAM)))
(\MAKE.PMAP.DEVICE \PFLOPPYFDEV])
(\PFLOPPY.OPEN
[LAMBDA NIL (* edited: "23-Jul-84 15:34")
(* Assume floppy mounted. Cache directory info for
floppy if not already cached.
Return T or NIL. *)
(PROG NIL
(COND
((fetch (PFLOPPYFDEV OPEN) of \FLOPPYFDEV)
(* Already open *)
(RETURN T)))
(replace (PFLOPPYFDEV PFILELIST) of \FLOPPYFDEV with NIL)
(replace (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV with NIL)
(replace (PFLOPPYFDEV DIR) of \FLOPPYFDEV with NIL)
(replace (PFLOPPYFDEV PSECTOR9) of \FLOPPYFDEV with NIL)
(\PFLOPPY.OPEN.PSECTOR9)
(\PFLOPPY.OPEN.PFILELIST)
(replace (PFLOPPYFDEV OPEN) of \FLOPPYFDEV with T)
(RETURN T])
(\PFLOPPY.OPEN.PSECTOR9
[LAMBDA NIL (* edited: "23-Jul-84 15:34")
(PROG (PSECTOR9)
RETRY
(SETQ PSECTOR9 (\PFLOPPY.GET.PSECTOR9))
(COND
((NULL PSECTOR9)
(\FLOPPY.BREAK "Not a pilot floppy")
(GO RETRY)))
(replace (PFLOPPYFDEV PSECTOR9) of \FLOPPYFDEV with PSECTOR9])
(\PFLOPPY.GET.PSECTOR9
[LAMBDA NIL (* edited: "23-Jul-84 15:34")
(* Gets PSECTOR9 of a Pilot floppy.
Returns NIL if not a Pilot floppy.
*)
(PROG (PSECTOR9) (* Read PSECTOR9. *)
(GLOBALRESOURCE \FLOPPY.IBMS128.FLOPPYIOCB
(SETQ PSECTOR9
(\FLOPPY.READSECTOR \FLOPPY.IBMS128.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 0
SECTOR ← 9)
(NCREATE (QUOTE PSECTOR9))
T))) (* Return answer. *)
(COND
((AND PSECTOR9 (fetch (PSECTOR9 INTACT) of PSECTOR9))
(RETURN PSECTOR9))
(T (RETURN NIL])
(\PFLOPPY.OPEN.PFILELIST
(LAMBDA NIL (* kbr: " 7-Aug-85 18:09")
(PROG (PSECTOR9 PFILELIST FILENAME PMPAGE PLPAGE PFALLOC PFALLOCS)
RETRY
(SETQ PSECTOR9 (fetch (PFLOPPYFDEV PSECTOR9) of \FLOPPYFDEV))
(SETQ PFILELIST (\PFLOPPY.CREATE.PFILELIST (fetch (PSECTOR9 PFILELISTLENGTH)
of PSECTOR9)))
(replace (PFLOPPYFDEV PFILELIST) of \FLOPPYFDEV with PFILELIST)
(replace (PSECTOR9 NEXTUNUSEDFILEID) of PSECTOR9 with 1)
(for (START ← (ADD1 \PFLOPPYFIRSTDATAPAGE)) by (IPLUS START (fetch
(PMPAGE NLENGTH)
of PMPAGE)
1)
do (SETQ PMPAGE (NCREATE (QUOTE PMPAGE)))
(\PFLOPPY.READPAGENO (SUB1 START)
PMPAGE)
(COND
((NOT (fetch (PMPAGE INTACT) of PMPAGE))
(\PFLOPPY.DAMAGED)
(SETQ PFALLOCS NIL)
(GO RETRY)))
(COND
((EQ (fetch (PMPAGE NFILETYPE) of PMPAGE)
FILETYPE.FILE)
(SETQ PLPAGE (NCREATE (QUOTE PLPAGE)))
(\PFLOPPY.READPAGENO START PLPAGE)
(COND
((NOT (fetch (PLPAGE INTACT) of PLPAGE))
(\PFLOPPY.DAMAGED)
(SETQ PFALLOCS NIL)
(GO RETRY)))
(SETQ FILENAME (fetch (PLPAGE $NAME) of PLPAGE)))
(T (SETQ PLPAGE NIL)
(SETQ FILENAME (LIST (fetch (PMPAGE $NFILETYPE) of PMPAGE)))))
(SETQ PFALLOC
(create PFALLOC
FILENAME ← FILENAME
START ← START
PMPAGE ← PMPAGE
PLPAGE ← PLPAGE))
(COND
((NOT (EQ (fetch (PMPAGE NFILETYPE) of PMPAGE)
FILETYPE.FREE))
(\PFLOPPY.ADD.TO.PFILELIST PFALLOC)))
(push PFALLOCS PFALLOC)
(COND
((IEQP START (ADD1 \PFLOPPYLASTDATAPAGE))
(RETURN))))
(SETQ PFALLOCS (DREVERSE PFALLOCS))
(for PREV in PFALLOCS as NEXT in (CDR PFALLOCS) while NEXT
do (replace (PFALLOC NEXT) of PREV with NEXT)
(replace (PFALLOC PREV) of NEXT with PREV))
(replace (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV with PFALLOCS)
(* 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 PFALLOC in PFALLOCS when (EQ (fetch (PFALLOC FILETYPE) of PFALLOC)
FILETYPE.FILE)
do (\PFLOPPY.DIR.PUT (fetch (PFALLOC FILENAME) of PFALLOC)
(QUOTE OLD)
PFALLOC)))))
(\PFLOPPY.DAMAGED
[LAMBDA NIL (* kbr: " 2-Sep-85 16:37")
(* Tell user floppy needs scavenging *)
(PROG NIL
(\FLOPPY.BREAK "Damaged floppy. Needs scavenging."])
(\PFLOPPY.OPENFILE
[LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* hdj "17-Jun-86 17:16")
(* * if file is open in conflicting way, barf)
(if (NOT (\FILE-CONFLICT (\RECOGNIZE-HACK FILE RECOG FDEV)
ACCESS FDEV))
then (OR (\SFLOPPY.HACK FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM)
(PROG (STREAM WAIT PFALLOC FULLFILENAME)
(SETQ OTHERINFO (\FLOPPY.OTHERINFO OTHERINFO))
RETRY
(if (\FILE-CONFLICT (\RECOGNIZE-HACK FILE RECOG FDEV)
ACCESS FDEV)
then (RETURN NIL))
(* * Get STREAM *)
(COND
([NULL (NLSETQ (SELECTQ ACCESS
(INPUT (\FLOPPY.CACHED.READ))
(\FLOPPY.CACHED.WRITE]
(LISPERROR "FILE WON'T OPEN" FILE)
(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 PFALLOC (fetch (FLOPPYSTREAM PFALLOC) of STREAM))
[COND
((NOT (EQ ACCESS (QUOTE INPUT))) (* WRITEFLG indicates whether FILE is
currently being written.
IPMPAGEossible 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 (PFALLOC WRITEFLG) of PFALLOC with T))
((fetch (PFALLOC WRITEFLG) of PFALLOC)
(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
ePMPAGEty. *)
(replace (STREAM EPAGE) of STREAM with 0)
(replace (STREAM EOFFSET) of STREAM with 0)))
(RETURN STREAM])
(\PFLOPPY.OPENFILE1
[LAMBDA (FILE RECOG OTHERINFO) (* kbr: "11-Oct-85 16:20")
(WITH.MONITOR \FLOPPYLOCK (PROG (FILENAME EXTENSION PFALLOC PLPAGE IDATE STREAM)
RETRY (* Case where old FILE is being opened for output or
appending to be written *)
(SETQ FILENAME (\FLOPPY.ASSUREFILENAME FILE))
(SETQ PFALLOC (\PFLOPPY.DIR.GET FILENAME RECOG))
(SETQ STREAM (SELECTQ RECOG
[(EXACT OLD/NEW)
(COND
((NULL PFALLOC)
(\PFLOPPY.OPENNEWFILE
FILENAME
RECOG
OTHERINFO))
(T (\PFLOPPY.OPENOLDFILE
PFALLOC]
[NEW (COND
((NULL PFALLOC)
(\PFLOPPY.OPENNEWFILE
FILENAME RECOG OTHERINFO]
((OLD OLDEST)
(\PFLOPPY.OPENOLDFILE PFALLOC))
(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 (PFALLOC) (* edited: "23-Jul-84 15:34")
(PROG (PLPAGE STREAM)
(COND
((NULL PFALLOC) (* Error in calling function.
*)
(RETURN NIL)))
(SETQ PLPAGE (fetch (PFALLOC PLPAGE) of PFALLOC))
(SETQ STREAM (create STREAM
DEVICE ← \FLOPPYFDEV
FULLFILENAME ←(\FLOPPY.ADDDEVICENAME (fetch (PFALLOC
FILENAME)
of PFALLOC))
EPAGE ←(IQUOTIENT (fetch (PLPAGE LENGTH) of PLPAGE)
512)
EOFFSET ←(IREMAINDER (fetch (PLPAGE LENGTH) of PLPAGE)
512)))
(replace (FLOPPYSTREAM PFALLOC) of STREAM with PFALLOC)
(replace (FLOPPYSTREAM PLPAGE) of STREAM with PLPAGE)
(RETURN STREAM])
(\PFLOPPY.OPENNEWFILE
[LAMBDA (FILENAME RECOG OTHERINFO) (* kbr: "31-Dec-85 10:26")
(PROG (LENGTH PFALLOC PLPAGE IDATE STREAM)
(SETQ LENGTH (CDR (ASSOC (QUOTE LENGTH)
OTHERINFO)))
[COND
(LENGTH (SETQ LENGTH (ADD1 (IQUOTIENT (IPLUS LENGTH 511)
512]
(SETQ PFALLOC (\PFLOPPY.ALLOCATE LENGTH))
(\PFLOPPY.DIR.PUT FILENAME RECOG PFALLOC) (* ICREATIONDATE defaults to IWRITEDATE.
TBW: Should put in check for length of FILENAME.
*)
(SETQ IDATE (IDATE))
[SETQ PLPAGE (create PLPAGE
ICREATIONDATE ← IDATE
IWRITEDATE ← IDATE
TYPE ←(CDR (ASSOC (QUOTE TYPE)
OTHERINFO]
(replace (PLPAGE $NAME) of PLPAGE with (fetch (PFALLOC FILENAME) of PFALLOC))
(replace (PFALLOC PLPAGE) of PFALLOC with PLPAGE)
(\PFLOPPY.ADD.TO.PFILELIST PFALLOC) (* File is empty *)
(SETQ STREAM (create STREAM
DEVICE ← \FLOPPYFDEV
FULLFILENAME ←(\FLOPPY.ADDDEVICENAME (fetch (PFALLOC
FILENAME)
of PFALLOC))
EPAGE ← 0
EOFFSET ← 0))
(replace (FLOPPYSTREAM PFALLOC) of STREAM with PFALLOC)
(replace (FLOPPYSTREAM PLPAGE) of STREAM with (fetch (PFALLOC PLPAGE)
of PFALLOC))
(RETURN STREAM])
(\PFLOPPY.ASSURESTREAM
[LAMBDA (FILE) (* edited: "23-Jul-84 15:34")
(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) (* edited: "23-Jul-84 15:34")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM PLPAGE ANSWER)
(\FLOPPY.CACHED.READ)
(SETQ STREAM (\PFLOPPY.ASSURESTREAM FILE))
[COND
(STREAM (SETQ PFALLOC (fetch (FLOPPYSTREAM PFALLOC)
of STREAM))
(SETQ ANSWER (\PFLOPPY.GETFILEINFO1 PFALLOC
ATTRIBUTE]
(RETURN ANSWER])
(\PFLOPPY.GETFILEINFO1
[LAMBDA (PFALLOC ATTRIBUTE) (* kbr: "25-Nov-84 13:02")
(* Used by \PFLOPPY.GETFILEINFO & \PFLOPPY.FILEINFOFN
*)
(PROG (PLPAGE ANSWER)
(SETQ PLPAGE (fetch (PFALLOC PLPAGE) of PFALLOC))
(* Wizard incantations: PAGELENGTH, HUGEPAGESTART,
HUGEPAGELENGTH, HUGELENGTH *)
(SETQ ANSWER (SELECTQ ATTRIBUTE
(WRITEDATE (fetch (PLPAGE WRITEDATE) of PLPAGE))
(CREATIONDATE (fetch (PLPAGE CREATIONDATE) of PLPAGE))
(IWRITEDATE (fetch (PLPAGE IWRITEDATE) of PLPAGE))
(ICREATIONDATE (fetch (PLPAGE ICREATIONDATE) of PLPAGE))
(LENGTH (fetch (PLPAGE LENGTH) of PLPAGE))
(TYPE (fetch (PLPAGE TYPE) of PLPAGE))
(BYTESIZE 8)
(MESATYPE (fetch (PLPAGE MESATYPE) of PLPAGE))
(SIZE (fetch (PLPAGE PAGELENGTH) of PLPAGE))
(HUGEPAGESTART (fetch (PLPAGE HUGEPAGESTART) of PLPAGE))
(HUGEPAGELENGTH (fetch (PLPAGE HUGEPAGELENGTH) of PLPAGE))
(HUGELENGTH (fetch (PLPAGE HUGELENGTH) of PLPAGE))
NIL))
(RETURN ANSWER])
(\PFLOPPY.SETFILEINFO
[LAMBDA (FILE ATTRIBUTE VALUE) (* kbr: "29-Apr-85 16:01")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM PLPAGE SUCCESSFUL)
(\FLOPPY.CACHED.WRITE)
(SETQ STREAM (\PFLOPPY.ASSURESTREAM FILE))
[COND
(STREAM (SETQ PLPAGE (fetch (FLOPPYSTREAM PLPAGE)
of STREAM))
(SETQ SUCCESSFUL T)
(SELECTQ ATTRIBUTE
(WRITEDATE (replace (PLPAGE WRITEDATE)
of PLPAGE with VALUE))
(CREATIONDATE (replace (PLPAGE
CREATIONDATE)
of PLPAGE with VALUE))
(IWRITEDATE (replace (PLPAGE IWRITEDATE)
of PLPAGE with VALUE))
(ICREATIONDATE (replace (PLPAGE
ICREATIONDATE)
of PLPAGE
with VALUE))
(LENGTH
(* Treated specially by FILEIO.
*))
(TYPE (replace (PLPAGE TYPE)
of PLPAGE with VALUE))
(EOL (replace (STREAM EOLCONVENTION)
of STREAM
with (SELECTQ VALUE
(CR CR.EOLC)
(CRLF CRLF.EOLC)
(LF LF.EOLC)
NIL)))
(MESATYPE (replace (PLPAGE MESATYPE)
of PLPAGE with VALUE))
(PAGELENGTH (replace (PLPAGE PAGELENGTH)
of PLPAGE with VALUE))
(HUGEPAGESTART (replace (PLPAGE
HUGEPAGESTART)
of PLPAGE
with VALUE))
(HUGEPAGELENGTH (replace (PLPAGE
HUGEPAGELENGTH)
of PLPAGE
with VALUE))
(HUGELENGTH (replace (PLPAGE HUGELENGTH)
of PLPAGE with VALUE))
(SETQ SUCCESSFUL NIL))
(COND
((OPENP STREAM)
(* PLPAGE will be written out to floppy when STREAM is
closed. *)
)
(T (\PFLOPPY.WRITEPAGENO
(fetch (PFALLOC START)
of (fetch (FLOPPYSTREAM PFALLOC)
of STREAM))
PLPAGE]
(RETURN SUCCESSFUL])
(\PFLOPPY.CLOSEFILE
[LAMBDA (FILE) (* hdj " 8-May-86 15:45")
(WITH.MONITOR \FLOPPYLOCK (*)
(PROG (STREAM FULLFILENAME)
(SETQ STREAM (\PFLOPPY.ASSURESTREAM FILE))
(\CLEARMAP STREAM)
(SETQ FULLFILENAME (\PFLOPPY.CLOSEFILE1 STREAM))
(\DELETE-OPEN-STREAM STREAM (fetch (STREAM DEVICE) of STREAM))
(RETURN FULLFILENAME])
(\PFLOPPY.CLOSEFILE1
[LAMBDA (STREAM) (* hdj " 8-May-86 15:36")
(* The real CLOSEFILE.
*)
(* Part of \PFLOPPY.CLOSEFILE needed
to close subportions of huge files.
*)
(PROG (PFALLOC PMPAGE NEXT NPMPAGE FULLFILENAME)
(SETQ PFALLOC (fetch (FLOPPYSTREAM PFALLOC) 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 PLPAGE. TBW: FILE WON'T CLOSE
error message? *)
(COND
((NULL (\PFLOPPY.WRITEPAGENO (fetch (PFALLOC START) of PFALLOC)
(fetch (PFALLOC PLPAGE) of PFALLOC)))
(RETURN NIL))) (* Ignore any errors now.
*)
(SETQ PMPAGE (fetch (PFALLOC PMPAGE) of PFALLOC))
(SETQ NEXT (fetch (PFALLOC NEXT) of PFALLOC))
(SETQ NPMPAGE (fetch (PFALLOC PMPAGE) of NEXT))
(UNINTERRUPTABLY
(replace (PMPAGE NTYPE) of PMPAGE with PMPAGEETYPE.FILE)
(replace (PMPAGE NFILETYPE) of PMPAGE with FILETYPE.FILE)
(replace (PMPAGE PTYPE) of NPMPAGE with PMPAGEETYPE.FILE)
(replace (PMPAGE PFILETYPE) of NPMPAGE with FILETYPE.FILE)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PFALLOC START) of PFALLOC))
PMPAGE T)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PFALLOC START) of NEXT))
NPMPAGE T)
(\PFLOPPY.SAVE.PFILELIST T)
(\PFLOPPY.SAVE.PSECTOR9 T)) (* Release STREAM. *)
(replace (PFALLOC WRITEFLG) of PFALLOC with NIL)
(RETURN FULLFILENAME])
(\PFLOPPY.DELETEFILE
[LAMBDA (FILE FDEV) (* hdj "23-Jun-86 15:10")
(WITH.MONITOR \FLOPPYLOCK (PROG (FILENAME PFALLOC PMPAGE NEXT NPMPAGE FULLFILENAME)
(\PFLOPPY.OPEN)
(SETQ FILENAME (\FLOPPY.ASSUREFILENAME FILE T))
(COND
((NULL FILENAME) (* Bad filename. *)
(* Returning NIL means unsuccessful.
*)
(RETURN NIL)))
(SETQ PFALLOC (\PFLOPPY.DIR.GET FILENAME (QUOTE OLDEST)))
(COND
((NULL PFALLOC) (* File not found. *)
(* Returning NIL means unsuccessful.
*)
(RETURN NIL)))
(SETQ FULLFILENAME (\FLOPPY.ADDDEVICENAME (fetch (PFALLOC
FILENAME)
of PFALLOC)))
(COND
((FDEVOP (QUOTE OPENP)
FDEV FILE NIL FDEV)
(* file is open -
can't delete it *)
(RETURN NIL))
(T (* Carry out deletion.
*)
(\PFLOPPY.DIR.REMOVE PFALLOC)
(\PFLOPPY.DEALLOCATE PFALLOC)
(\PFLOPPY.DELETE.FROM.PFILELIST PFALLOC)
(\PFLOPPY.SAVE.PFILELIST)))
(RETURN FULLFILENAME])
(\PFLOPPY.GENERATEFILES
[LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS) (* hdj " 5-Jun-86 12:59")
(WITH.MONITOR \FLOPPYLOCK
(PROG (ALLOCS FILTER DESIREDVERSION GENFILESTATE PFALLOC VALIST VERSION FILEGENOBJ)
(* No floppy gives empty directory so
that {FLOPPY} can safely be on
DIRECTORIES search path.
*)
[COND
((EQ (MACHINETYPE)
(QUOTE DOVE)) (* Patch around DOVE IOP assembly
language coded dooropen &
diskchangeclear status flags not
working. *)
(COND
((NOT (\DEVICE-OPEN-STREAMS \FLOPPYFDEV))
(* Don't have any open streams to DOVE
floppy, so assume that user may have
switched floppies. *)
(\FLOPPY.CLOSE]
[COND
((AND (\FLOPPY.EXISTSP T)
(\FLOPPY.CACHED.READ T))
(SETQ FILTER (DIRECTORY.MATCH.SETUP PATTERN))
(SETQ DESIREDVERSION (FILENAMEFIELD PATTERN (QUOTE VERSION)))
(SETQ ALLOCS (for NBUCKET in (fetch (PFLOPPYFDEV DIR) of \FLOPPYFDEV)
join (for EBUCKET in (CDR NBUCKET)
join (COND
[(FIXP DESIREDVERSION)
[SETQ PFALLOC (CDR (ASSOC DESIREDVERSION
(CDR EBUCKET]
(COND
((AND PFALLOC (DIRECTORY.MATCH
FILTER
(fetch (PFALLOC FILENAME)
of PFALLOC)))
(LIST PFALLOC]
((DIRECTORY.MATCH FILTER (CONCAT (CAR NBUCKET)
"."
(CAR EBUCKET)))
(COND
[(NULL DESIREDVERSION)
(* Highest version only *)
(SETQ VALIST (CDR EBUCKET))
(SETQ VERSION (\PFLOPPY.DIR.VERSION
NIL
(QUOTE OLD)
VALIST))
(SETQ PFALLOC (CDR (ASSOC VERSION VALIST)))
(COND
(PFALLOC (LIST PFALLOC]
(T (for VBUCKET in (CDR EBUCKET)
collect (CDR VBUCKET]
[COND
((MEMB (QUOTE SORT)
OPTIONS)
(SORT ALLOCS (FUNCTION (LAMBDA (X Y)
(UALPHORDER (fetch (PFALLOC FILENAME) of X)
(fetch (PFALLOC FILENAME) of Y]
(SETQ GENFILESTATE (create GENFILESTATE
ALLOCS ← ALLOCS
DEVICENAME ← (fetch (FDEV DEVICENAME) of FDEV)))
(SETQ FILEGENOBJ (create FILEGENOBJ
NEXTFILEFN ← (FUNCTION \PFLOPPY.NEXTFILEFN)
FILEINFOFN ← (FUNCTION \PFLOPPY.FILEINFOFN)
GENFILESTATE ← GENFILESTATE))
(RETURN FILEGENOBJ])
(\PFLOPPY.NEXTFILEFN
[LAMBDA (GENFILESTATE NAMEONLY SCRATCHLIST) (* edited: "23-Jul-84 15:35")
(* Generates next file from GENFILESTATE or NIL if
finished. Used by \PFLOPPY.GENERATEFILES.
*)
(PROG (ALLOCS FILENAME DEVICENAME ANSWER)
(SETQ ALLOCS (fetch (GENFILESTATE ALLOCS) of GENFILESTATE))
(COND
((NULL ALLOCS)
(RETURN)))
(replace (GENFILESTATE CURRENTALLOC) of GENFILESTATE with (CAR ALLOCS))
(replace (GENFILESTATE ALLOCS) of GENFILESTATE with (CDR ALLOCS))
(SETQ FILENAME (fetch (PFALLOC FILENAME) of (CAR ALLOCS)))
(SETQ DEVICENAME (fetch (GENFILESTATE DEVICENAME) of GENFILESTATE))
[COND
(NAMEONLY (SETQ ANSWER FILENAME))
(T (SETQ ANSWER (CONCAT "{" (fetch (GENFILESTATE DEVICENAME) of GENFILESTATE)
"}" FILENAME]
(RETURN ANSWER])
(\PFLOPPY.FILEINFOFN
[LAMBDA (GENFILESTATE ATTRIBUTE) (* edited: "23-Jul-84 15:35")
(* Get file info for current file in GENFILESTATE.
*)
(\PFLOPPY.GETFILEINFO1 (fetch (GENFILESTATE CURRENTALLOC) of GENFILESTATE)
ATTRIBUTE])
(\PFLOPPY.RENAMEFILE
[LAMBDA (OLDDEVICE OLDFILE NEWDEVICE NEWFILE OLDRECOG NEWRECOG)
(* hdj "23-Jun-86 16:51")
(if (NEQ OLDDEVICE NEWDEVICE)
then (\GENERIC.RENAMEFILE OLDDEVICE OLDFILE NEWDEVICE NEWFILE)
else [COND
((NULL OLDRECOG)
(SETQ OLDRECOG (QUOTE OLD]
[COND
((NULL NEWRECOG)
(SETQ NEWRECOG (QUOTE NEW]
(WITH.MONITOR \FLOPPYLOCK (*)
(PROG (OLDFILENAME NEWFILENAME PFALLOC PLPAGE FULLFILENAME)
(\PFLOPPY.OPEN)
(SETQ OLDFILENAME (\FLOPPY.ASSUREFILENAME OLDFILE))
(SETQ NEWFILENAME (\FLOPPY.ASSUREFILENAME NEWFILE))
(if (FDEVOP (QUOTE OPENP)
OLDDEVICE OLDFILENAME NIL OLDDEVICE)
then (RETURN))
(SETQ PFALLOC (\PFLOPPY.DIR.GET OLDFILENAME OLDRECOG))
(COND
((OR (NULL PFALLOC)
(FDEVOP (QUOTE OPENP)
OLDDEVICE OLDFILENAME (QUOTE OLD)
OLDDEVICE)) (* File not found or open *)
(* Returning NIL means unsuccessful.
*)
(RETURN NIL)))
(\PFLOPPY.DIR.REMOVE PFALLOC) (* TBW: If new file name too long.
*)
(* Store NEWFILENAME on PFALLOC.
*)
(\PFLOPPY.DIR.PUT NEWFILENAME NEWRECOG PFALLOC)
(* Store NEWFILENAME on PLPAGE.
*)
(SETQ PLPAGE (fetch (PFALLOC PLPAGE) of PFALLOC))
(replace (PLPAGE $NAME) of PLPAGE with (fetch (PFALLOC FILENAME) of PFALLOC))
(* Write changes onto floppy.
*)
(\PFLOPPY.WRITEPAGENO (fetch (PFALLOC START) of PFALLOC)
PLPAGE) (* Return FULLFILENAME.
*)
(SETQ FULLFILENAME (\FLOPPY.ADDDEVICENAME (fetch (PFALLOC FILENAME)
of PFALLOC)))
(RETURN FULLFILENAME])
(\PFLOPPY.STREAMS.AGAINST
[LAMBDA (STREAM) (* hdj " 5-Jun-86 13:01")
(* Return other open floppy streams
with same PFALLOC. *)
(for F in (\DEVICE-OPEN-STREAMS \FLOPPYFDEV) when (AND (EQ (fetch (FLOPPYSTREAM PFALLOC)
of F)
(fetch (FLOPPYSTREAM PFALLOC)
of STREAM))
(NOT (EQ F STREAM))) collect F])
(\PFLOPPY.STREAMS.USING
[LAMBDA (PFALLOC) (* hdj " 5-Jun-86 13:01")
(* Return open floppy streams with
this PFALLOC. *)
(for F in (\DEVICE-OPEN-STREAMS \FLOPPYFDEV) when (EQ (fetch (FLOPPYSTREAM PFALLOC) of F)
PFALLOC) collect F])
(\PFLOPPY.READPAGES
[LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* edited: "23-Jul-84 15:35")
(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: "19-Jul-85 14:24")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM PFALLOC PAGENO)
(SETQ STREAM (\PFLOPPY.ASSURESTREAM FILE))
(SETQ PFALLOC (fetch (FLOPPYSTREAM PFALLOC) of STREAM))
(SETQ PAGENO (IPLUS (fetch (PFALLOC START) of PFALLOC)
1 FIRSTPAGE#))
(COND
((IGREATERP FIRSTPAGE# (FOLDLO (SUB1 (\GETEOFPTR STREAM)
)
BYTESPERPAGE))
(* Don't bother to do actual read.
*)
(COND
((IGREATERP PAGENO (fetch (PFALLOC END) of PFALLOC))
(* 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 PFALLOC)))
(RETURN)))
(\PFLOPPY.READPAGENO PAGENO BUFFER)))
(BLOCK])
(\PFLOPPY.READPAGENO
[LAMBDA (PAGENO PAGE NOERROR) (* kbr: " 7-Aug-85 18:48")
(PROG (ANSWER) (* Read page. *)
[GLOBALRESOURCE \FLOPPY.IBMD512.FLOPPYIOCB (SETQ ANSWER (COND
((OR (ILESSP PAGENO 1)
(IGREATERP PAGENO \PFLOPPYLASTDATAPAGE))
(\FLOPPY.SEVERE.ERROR "Illegal Read Page Number")
NIL)
(T (\FLOPPY.READSECTOR \FLOPPY.IBMD512.FLOPPYIOCB (
\PFLOPPY.PAGENOTODISKADDRESS PAGENO)
PAGE NOERROR]
(* Return ANSWER (PAGE or NIL) *)
(RETURN ANSWER])
(\PFLOPPY.WRITEPAGENO
[LAMBDA (PAGENO PAGE NOERROR) (* kbr: " 7-Aug-85 18:48")
(PROG (ANSWER) (* Write page. *)
[GLOBALRESOURCE \FLOPPY.IBMD512.FLOPPYIOCB (SETQ ANSWER (COND
((OR (ILESSP PAGENO 1)
(IGREATERP PAGENO \PFLOPPYLASTDATAPAGE))
(\FLOPPY.SEVERE.ERROR "Illegal Write Page Number")
NIL)
(T (\FLOPPY.WRITESECTOR \FLOPPY.IBMD512.FLOPPYIOCB (
\PFLOPPY.PAGENOTODISKADDRESS PAGENO)
PAGE NOERROR]
(* Return ANSWER (PAGE or NIL) *)
(RETURN ANSWER])
(\PFLOPPY.PAGENOTODISKADDRESS
[LAMBDA (PAGENO) (* kbr: " 7-Aug-85 17:07")
(PROG (QUOTIENT CYLINDER HEAD SECTOR DISKADDRESS)
(SETQ SECTOR (ADD1 (IREMAINDER (SUB1 PAGENO)
\FLOPPY.SECTORSPERTRACK)))
(SETQ QUOTIENT (IQUOTIENT (SUB1 PAGENO)
\FLOPPY.SECTORSPERTRACK))
(SETQ HEAD (IREMAINDER QUOTIENT \FLOPPY.TRACKSPERCYLINDER))
(SETQ CYLINDER (IQUOTIENT QUOTIENT \FLOPPY.TRACKSPERCYLINDER))
(SETQ DISKADDRESS (create DISKADDRESS
SECTOR ← SECTOR
HEAD ← HEAD
CYLINDER ← CYLINDER))
(RETURN DISKADDRESS])
(\PFLOPPY.DISKADDRESSTOPAGENO
[LAMBDA (DISKADDRESS) (* kbr: " 7-Aug-85 19:26")
(PROG (PAGENO)
[SETQ PAGENO (IPLUS (fetch (DISKADDRESS SECTOR) of DISKADDRESS)
(ITIMES \FLOPPY.SECTORSPERTRACK
(IPLUS (fetch (DISKADDRESS HEAD) of DISKADDRESS)
(ITIMES \FLOPPY.TRACKSPERCYLINDER
(fetch (DISKADDRESS CYLINDER)
of DISKADDRESS]
(RETURN PAGENO])
(\PFLOPPY.DIR.GET
[LAMBDA (FILENAME RECOG) (* kbr: "11-Mar-85 18:28")
(PROG (UNAME NALIST EALIST VALIST NAME EXTENSION VERSION PFALLOC)
(SETQ FILENAME (\FLOPPY.ASSUREFILENAME FILENAME))
[COND
[(NOT (EQ RECOG (QUOTE EXACT)))
(SETQ UNAME (UNPACKFILENAME FILENAME))
[SETQ NAME (U-CASE (PACKFILENAME (LIST (QUOTE DIRECTORY)
(LISTGET UNAME (QUOTE DIRECTORY))
(QUOTE NAME)
(LISTGET UNAME (QUOTE NAME]
[SETQ EXTENSION (U-CASE (LISTGET UNAME (QUOTE EXTENSION]
[SETQ VERSION (U-CASE (LISTGET UNAME (QUOTE VERSION]
(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 FILENAME))
(COND
((EQ RECOG (QUOTE NEW))
(RETURN)))
(SETQ PFALLOC (CDR (ASSOC VERSION VALIST]
(T (SETQ PFALLOC (for PFALLOC in (fetch (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV)
thereis (EQ (fetch (PFALLOC FILENAME) of PFALLOC)
FILENAME]
(RETURN PFALLOC])
(\PFLOPPY.DIR.PUT
[LAMBDA (FILENAME RECOG PFALLOC) (* kbr: "11-Oct-85 16:14")
(PROG (UNAME NALIST EALIST VALIST NAME EXTENSION VERSION)
[SETQ FILENAME (OR (\FLOPPY.ASSUREFILENAME FILENAME T)
(GENSYM (QUOTE BADFILENAME]
(SETQ UNAME (UNPACKFILENAME FILENAME))
[SETQ NAME (U-CASE (PACKFILENAME (LIST (QUOTE DIRECTORY)
(LISTGET UNAME (QUOTE DIRECTORY))
(QUOTE NAME)
(LISTGET UNAME (QUOTE NAME]
[SETQ EXTENSION (U-CASE (LISTGET UNAME (QUOTE EXTENSION]
[SETQ VERSION (U-CASE (LISTGET UNAME (QUOTE VERSION]
(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 (COND
((EQ RECOG (QUOTE EXACT))
(U-CASE FILENAME))
(T (PACKFILENAME UNAME]
(replace (PFALLOC FILENAME) of PFALLOC with FILENAME)
(SETQ VALIST (\FLOPPY.LEXPUTASSOC VERSION PFALLOC VALIST))
(SETQ EALIST (\FLOPPY.LEXPUTASSOC EXTENSION VALIST EALIST))
(SETQ NALIST (\FLOPPY.LEXPUTASSOC NAME EALIST NALIST))
(replace (PFLOPPYFDEV DIR) of \FLOPPYFDEV with NALIST)
(RETURN PFALLOC])
(\PFLOPPY.DIR.REMOVE
[LAMBDA (PFALLOC) (* kbr: "11-Mar-85 18:30")
(PROG (FILENAME UNAME NALIST EALIST VALIST NAME EXTENSION VERSION)
(SETQ FILENAME (fetch (PFALLOC FILENAME) of PFALLOC))
(SETQ UNAME (UNPACKFILENAME FILENAME))
[SETQ NAME (U-CASE (PACKFILENAME (LIST (QUOTE DIRECTORY)
(LISTGET UNAME (QUOTE DIRECTORY))
(QUOTE NAME)
(LISTGET UNAME (QUOTE NAME]
[SETQ EXTENSION (U-CASE (LISTGET UNAME (QUOTE EXTENSION]
[SETQ VERSION (U-CASE (LISTGET UNAME (QUOTE VERSION]
(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 PFALLOC])
(\PFLOPPY.DIR.VERSION
[LAMBDA (VERSION RECOG VALIST FILENAME) (* kbr: "13-Feb-85 15:39")
(PROG (PFALLOC)
(SETQ VALIST (for BUCKET in VALIST when (NUMBERP (CAR BUCKET)) collect
BUCKET))
[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)))
((AND (EQ RECOG (QUOTE NEW))
FILENAME)
(SETQ PFALLOC (\PFLOPPY.DIR.GET FILENAME (QUOTE OLD)))
(COND
(PFALLOC (\PFLOPPY.DIR.REMOVE PFALLOC)
(\PFLOPPY.DEALLOCATE PFALLOC)
(\PFLOPPY.DELETE.FROM.PFILELIST PFALLOC)
(\PFLOPPY.SAVE.PFILELIST]
(RETURN VERSION])
(\PFLOPPY.GETFILENAME
[LAMBDA (FILE RECOG FDEV) (* kbr: "11-Mar-85 18:26")
(WITH.MONITOR \FLOPPYLOCK (PROG (FILENAME UNAME NAME EXTENSION VERSION NALIST EALIST VALIST
PFALLOC)
[COND
((type? STREAM FILE)
(RETURN (fetch (STREAM FULLFILENAME) of FILE]
(COND
((NOT (AND (\FLOPPY.EXISTSP T)
(\FLOPPY.CACHED.READ T)))
(* NIL is returned if there is no floppy.
*)
(RETURN NIL)))
(SETQ FILENAME (NLSETQ (\FLOPPY.ASSUREFILENAME FILE)))
[COND
((NULL FILENAME) (* Bad filename *)
(RETURN NIL))
(T (SETQ FILENAME (CAR FILENAME]
[COND
((NOT (EQ RECOG (QUOTE EXACT)))
(SETQ UNAME (UNPACKFILENAME FILENAME))
[SETQ NAME (U-CASE (PACKFILENAME
(LIST (QUOTE DIRECTORY)
(LISTGET UNAME
(QUOTE
DIRECTORY))
(QUOTE NAME)
(LISTGET UNAME
(QUOTE NAME]
[SETQ EXTENSION (U-CASE (LISTGET UNAME (QUOTE
EXTENSION]
[SETQ VERSION (U-CASE (LISTGET UNAME (QUOTE VERSION]
(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))
(COND
((EQ RECOG (QUOTE NEW))
(LISTPUT UNAME (QUOTE VERSION)
VERSION)
(SETQ FILENAME (PACKFILENAME UNAME)))
(T (SETQ PFALLOC (CDR (ASSOC VERSION VALIST)))
(COND
((NULL PFALLOC)
(* INFILEP returns NIL if filename not found *)
(RETURN NIL))
(T (SETQ FILENAME (fetch (PFALLOC FILENAME)
of PFALLOC]
(SETQ FILENAME (\FLOPPY.ADDDEVICENAME FILENAME))
(RETURN FILENAME])
(\PFLOPPY.CREATE.PFILELIST
[LAMBDA (NPAGES) (* lmm "13-Aug-84 15:46")
(PROG (PFILELIST) (* Must be page aligned integral number of pages.
*)
(SETQ PFILELIST (\FLOPPY.BUFFER NPAGES))
(replace (PFILELIST SEAL) of PFILELIST with SEAL.PFILELIST)
(replace (PFILELIST VERSION) of PFILELIST with VERSION.PFILELIST)
(replace (PFILELIST MAXENTRIES) of PFILELIST with (IQUOTIENT (IDIFFERENCE
(ITIMES
WORDSPERPAGE
NPAGES)
4)
5))
(RETURN PFILELIST])
(\PFLOPPY.ADD.TO.PFILELIST
[LAMBDA (PFALLOC) (* mjs "29-Nov-84 16:08")
(PROG (PSECTOR9 PFILELIST PFLE NENTRIES NPAGES NEWPFILELIST NEXT PMPAGE NPMPAGE NEWMAXENTRIES
NEWNPAGES)
(SETQ PSECTOR9 (fetch (PFLOPPYFDEV PSECTOR9) of \FLOPPYFDEV))
(SETQ PFILELIST (fetch (PFLOPPYFDEV PFILELIST) of \FLOPPYFDEV))
(* Create PFLE. *)
(SETQ PFLE (create PFLE
FILEID ←(fetch (PSECTOR9 NEXTUNUSEDFILEID) of PSECTOR9)
TYPE ←(fetch (PFALLOC FILETYPE) of PFALLOC)
START ←(fetch (PFALLOC START) of PFALLOC)
LENGTH ←(fetch (PFALLOC LENGTH) of PFALLOC)))
(replace (PSECTOR9 NEXTUNUSEDFILEID) of PSECTOR9 with (ADD1 (fetch
(PSECTOR9
NEXTUNUSEDFILEID)
of PSECTOR9)))
(replace (PFALLOC PFLE) of PFALLOC with PFLE)
(* Add PFLE to PFILELIST. *)
(SETQ NENTRIES (fetch (PFILELIST NENTRIES) of PFILELIST))
[COND
((IEQP NENTRIES (fetch (PFILELIST MAXENTRIES) of PFILELIST))
(* First increase size of PFILELIST)
(SETQ NPAGES (fetch (PFILELIST NPAGES) of PFILELIST))
(SETQ NEWPFILELIST (\PFLOPPY.CREATE.PFILELIST (ADD1 NPAGES)))
(SETQ NEWMAXENTRIES (fetch (PFILELIST MAXENTRIES) of NEWPFILELIST))
(SETQ NEWNPAGES (fetch (PFILELIST NPAGES) of NEWPFILELIST))
(\BLT NEWPFILELIST PFILELIST (ITIMES 256 NPAGES))
(* update the MAXENTRIES field of the new PFILELIST)
(replace (PFILELIST MAXENTRIES) of NEWPFILELIST with NEWMAXENTRIES)
(* note: don't need to update NPAGES field since it is
calculated from MAXENTRIES field)
(SETQ PFILELIST NEWPFILELIST)
(SETQ NPAGES NEWNPAGES)
(replace (PFLOPPYFDEV PFILELIST) of \FLOPPYFDEV with PFILELIST)
(* Now allocate larger block on floppy.
*)
(SETQ PFALLOC (\PFLOPPY.ALLOCATE NPAGES))
[\PFLOPPY.DEALLOCATE (for PFALLOC in (fetch (PFLOPPYFDEV PFALLOCS)
of \FLOPPYFDEV)
thereis (EQUAL (fetch (PFALLOC FILENAME)
of PFALLOC)
(QUOTE (PFILELIST]
(SETQ NEXT (fetch (PFALLOC NEXT) of PFALLOC))
(SETQ PMPAGE (fetch (PFALLOC PMPAGE) of PFALLOC))
(SETQ NPMPAGE (fetch (PFALLOC PMPAGE) of NEXT))
(SETQ PSECTOR9 (fetch (PFLOPPYFDEV PSECTOR9) of \FLOPPYFDEV))
(UNINTERRUPTABLY
(replace (PFALLOC FILENAME) of PFALLOC with (QUOTE (PFILELIST)))
(replace (PMPAGE NTYPE) of PMPAGE with PMPAGEETYPE.PFILELIST)
(replace (PMPAGE NFILETYPE) of PMPAGE with FILETYPE.PFILELIST)
(replace (PMPAGE PTYPE) of NPMPAGE with PMPAGEETYPE.PFILELIST)
(replace (PMPAGE PFILETYPE) of NPMPAGE with FILETYPE.PFILELIST)
(replace (PSECTOR9 PFILELISTSTART) of PSECTOR9 with (fetch (PFALLOC
START)
of PFALLOC))
(replace (PSECTOR9 PFILELISTLENGTH) of PSECTOR9 with NPAGES)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PFALLOC START) of PFALLOC))
PMPAGE T)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PFALLOC START) of NEXT))
NPMPAGE T)
(\PFLOPPY.SAVE.PFILELIST T)
(\PFLOPPY.SAVE.PSECTOR9 T))]
(\MOVEWORDS PFLE 0 PFILELIST (IPLUS 4 (ITIMES 5 NENTRIES))
5)
(replace (PFILELIST NENTRIES) of PFILELIST with (ADD1 NENTRIES])
(\PFLOPPY.DELETE.FROM.PFILELIST
[LAMBDA (PFALLOC) (* edited: "23-Jul-84 15:35")
(PROG (PFILELIST PFLE FILEID NENTRIES)
(SETQ PFILELIST (fetch (PFLOPPYFDEV PFILELIST) of \FLOPPYFDEV))
(SETQ PFLE (fetch (PFALLOC PFLE) of PFALLOC))
(SETQ FILEID (fetch (PFLE FILEID) of PFLE))
(SETQ NENTRIES (fetch (PFILELIST NENTRIES) of PFILELIST))
(* Delete PFLE from PFILELIST.
*)
(for I from 1 to NENTRIES when (IEQP [\FLOPPY.MTL.FIXP
(\GETBASEFIXP PFILELIST
(IPLUS 4
(ITIMES
5 I]
FILEID)
do (SETQ NENTRIES (SUB1 NENTRIES))
(\MOVEWORDS PFILELIST (IPLUS 4 (ITIMES 5 NENTRIES))
PFILELIST
(IPLUS 4 (ITIMES 5 I))
5)
[\ZEROWORDS (\ADDBASE PFILELIST (IPLUS 4 (ITIMES 5 NENTRIES)))
(\ADDBASE PFILELIST (IPLUS 8 (ITIMES 5 NENTRIES]
(replace (PFILELIST NENTRIES) of PFILELIST with NENTRIES))
(* TBW: Could try to shorten PFILELIST after a delete.
Not a crucial problem. *)
(replace (PFALLOC PFLE) of PFALLOC with NIL])
(\PFLOPPY.SAVE.PFILELIST
[LAMBDA (NOERROR) (* kbr: " 1-Nov-85 18:23")
(PROG (PFILELIST)
(SETQ PFILELIST (fetch (PFLOPPYFDEV PFILELIST) of \FLOPPYFDEV))
(for I from 0 to (SUB1 (fetch (PFILELIST NPAGES) of PFILELIST))
do (\PFLOPPY.WRITEPAGENO (IPLUS (fetch (PSECTOR9 PFILELISTSTART)
of (fetch (PFLOPPYFDEV PSECTOR9)
of \FLOPPYFDEV))
I)
(\ADDBASE PFILELIST (ITIMES I 256))
NOERROR])
(\PFLOPPY.SAVE.PSECTOR9
[LAMBDA (NOERROR) (* edited: "23-Jul-84 15:35")
(PROG NIL
(GLOBALRESOURCE \FLOPPY.IBMS128.FLOPPYIOCB
(\FLOPPY.WRITESECTOR \FLOPPY.IBMS128.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 0
SECTOR ← 9)
(fetch (PFLOPPYFDEV PSECTOR9) of \FLOPPYFDEV)
NOERROR])
(\PFLOPPY.WRITEPAGES
[LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* edited: "23-Jul-84 15:35")
(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) (* edited: "23-Jul-84 15:35")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM PFALLOC PAGENO)
(SETQ STREAM (\PFLOPPY.ASSURESTREAM FILE))
(* Put in a check to see that we have not exceeded our
allocation. *)
(SETQ PFALLOC (fetch (FLOPPYSTREAM PFALLOC) of STREAM))
RETRY
(SETQ PAGENO (IPLUS (fetch (PFALLOC START) of PFALLOC)
1 FIRSTPAGE#))
(COND
((IGREATERP PAGENO (fetch (PFALLOC END) of PFALLOC))
(\PFLOPPY.EXTEND PFALLOC)
(GO RETRY)))
(\PFLOPPY.WRITEPAGENO PAGENO BUFFER)))
(BLOCK])
(\PFLOPPY.TRUNCATEFILE
[LAMBDA (FILE LASTPAGE LASTOFFSET) (* kbr: "25-Nov-84 13:25")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM EPAGE EOFFSET PFALLOC PLPAGE)
(* TBW: Can't extend files only shorten files with
this function as it stands.
*)
(SETQ STREAM (\PFLOPPY.ASSURESTREAM FILE))
(* Split PFALLOC into file block and free block.
*)
(SETQ EPAGE (fetch (STREAM EPAGE) of STREAM))
(SETQ EOFFSET (fetch (STREAM EOFFSET) of STREAM))
(COND
((NULL LASTPAGE) (* LASTPAGE = NIL means to truncate to the current
length. *)
(SETQ LASTPAGE EPAGE)
(SETQ LASTOFFSET EOFFSET)))
(SETQ PFALLOC (fetch (FLOPPYSTREAM PFALLOC) of STREAM))
(replace (PLPAGE LENGTH) of (fetch (PFALLOC PLPAGE)
of PFALLOC)
with (IPLUS (ITIMES 512 LASTPAGE)
LASTOFFSET))
(* Convert remaining pages into free block.
*)
(COND
((ZEROP LASTOFFSET)
(* Special case LASTOFFSET = 0.0 *)
(\PFLOPPY.TRUNCATE PFALLOC (IPLUS 1 LASTPAGE)))
(T (\PFLOPPY.TRUNCATE PFALLOC (IPLUS 1 (ADD1 LASTPAGE])
(\PFLOPPY.FORMAT
(LAMBDA (NAME AUTOCONFIRMFLG SLOWFLG) (* kbr: "18-Jun-86 16:53")
(* Return T if formatted, NIL if user abort.
*)
(PROG (CONFIRM PSECTOR9 PMPAGEA PMPAGEB PMPAGEC PFILELIST PFLE NATTEMPTS NTIMES)
(SETQ NTIMES 1)
(\FLOPPY.UNCACHED.WRITE) (* Confirmation. *)
(SETQ CONFIRM (\PFLOPPY.CONFIRM "Destroy contents of floppy" AUTOCONFIRMFLG T))
(COND
((NOT CONFIRM)
(RETURN NIL))) (* Forcibly close floppy. *)
(\FLOPPY.CLOSE) (* Create critical records.
*)
(SETQ PFILELIST (\FLOPPY.BUFFER 2))
(replace (PFILELIST SEAL) of PFILELIST with SEAL.PFILELIST)
(replace (PFILELIST VERSION) of PFILELIST with VERSION.PFILELIST)
(replace (PFILELIST NENTRIES) of PFILELIST with 1)
(replace (PFILELIST MAXENTRIES) of PFILELIST with (IQUOTIENT (IDIFFERENCE
512 4)
5))
(SETQ PFLE (create PFLE
FILEID ← 1
TYPE ← FILETYPE.PFILELIST
START ← (ADD1 \PFLOPPYFIRSTDATAPAGE)
LENGTH ← 2))
(\MOVEWORDS PFLE 0 PFILELIST 4 5)
(SETQ PMPAGEA
(create PMPAGE
PTYPE ← PMPAGEETYPE.FREE
PFILEID ← 0
PFILETYPE ← FILETYPE.FREE
PLENGTH ← 0
NTYPE ← PMPAGEETYPE.PFILELIST
NFILETYPE ← FILETYPE.PFILELIST
NFILEID ← 1
NLENGTH ← 2))
(SETQ PMPAGEB
(create PMPAGE
PTYPE ← PMPAGEETYPE.PFILELIST
PFILETYPE ← FILETYPE.PFILELIST
PFILEID ← 1
PLENGTH ← 2
NTYPE ← PMPAGEETYPE.FREE
NFILETYPE ← FILETYPE.FREE
NFILEID ← 0
NLENGTH ← (IDIFFERENCE \PFLOPPYLASTDATAPAGE (IPLUS \PFLOPPYFIRSTDATAPAGE
4))))
(SETQ PMPAGEC (create PMPAGE
PTYPE ← PMPAGEETYPE.FREE
PFILEID ← 0
PFILETYPE ← FILETYPE.FREE
PLENGTH ← (IDIFFERENCE \PFLOPPYLASTDATAPAGE (IPLUS
\PFLOPPYFIRSTDATAPAGE 4))
NTYPE ← PMPAGEETYPE.FREE
NFILEID ← 0
NFILETYPE ← FILETYPE.FREE
NLENGTH ← 0))
(SETQ PSECTOR9 (create PSECTOR9
PFILELISTSTART ← (ADD1 \PFLOPPYFIRSTDATAPAGE)
PFILELISTFILEID ← 1
PFILELISTLENGTH ← 2
ROOTFILEID ← 0
NEXTUNUSEDFILEID ← 2))
(replace (PSECTOR9 $LABEL) of PSECTOR9 with NAME)
(* Check floppy can write. *)
(SETQ NATTEMPTS 0)
RETRY
(SETQ NATTEMPTS (ADD1 NATTEMPTS))
(COND
((IGREATERP NATTEMPTS 5)
(\FLOPPY.MESSAGE "Couldn't format floppy")
(RETURN NIL)))
(COND
((NOT (AND (\FLOPPY.INITIALIZE T)
(\FLOPPY.WRITEABLEP)))
(GO ERROR))) (* Configure floppy. *)
(COND
((OR SLOWFLG (NULL PSECTOR9)) (* Format tracks. *)
(COND
((NOT (AND (\FLOPPY.INITIALIZE T)
(\FLOPPY.RECALIBRATE T)
(GLOBALRESOURCE \FLOPPY.IBMS128.FLOPPYIOCB
(\FLOPPY.FORMATTRACKS \FLOPPY.IBMS128.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 0
SECTOR ← 1)
1 T))
(GLOBALRESOURCE \FLOPPY.IBMD256.FLOPPYIOCB
(\FLOPPY.FORMATTRACKS \FLOPPY.IBMD256.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 1
SECTOR ← 1)
1 T))
(\FLOPPY.RECALIBRATE T)
(GLOBALRESOURCE \FLOPPY.IBMD512.FLOPPYIOCB
(\FLOPPY.FORMATTRACKS \FLOPPY.IBMD512.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← 1
HEAD ← 0
SECTOR ← 1)
(SUB1 \FLOPPY.CYLINDERS)
T)
(\FLOPPY.FORMATTRACKS \FLOPPY.IBMD512.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← 1
HEAD ← 1
SECTOR ← 1)
(SUB1 \FLOPPY.CYLINDERS)
T))))
(GO ERROR)))
(* Check that we can read from each page. We need to do this because FORMATTRACKS (espescially DOVE) is unreliable.
If we find a bad page, it usually works to try again a few times. We know from experience that the tendency is for
an unformatted floppy to become better the more times you format it. *)
(COND
((GLOBALRESOURCE \FLOPPY.IBMD512.FLOPPYIOCB
(for I from \PFLOPPYFIRSTDATAPAGE to \PFLOPPYLASTDATAPAGE
by (SELECTQ (MACHINETYPE)
(DOVE 1)
(DANDELION (COND
((type? PSECTOR9 CONFIRM)
(* Formatted before. Spot check output of formatting.
*)
19)
(T
(* Never formatted before. Be more careful.
*)
1)))
NIL)
thereis (NULL (\PFLOPPY.READPAGENO I
\FLOPPY.SCRATCH.BUFFER T)))
)
(\FLOPPY.MESSAGE "Retrying format." PROMPTWINDOW)
(GO ERROR))))) (* Write PMPAGEs, PFILELIST, and PSECTOR9.
Write PSECTOR9 last. We check for it first when we
open floppy. *)
(COND
((NOT (AND (\PFLOPPY.WRITEPAGENO \PFLOPPYFIRSTDATAPAGE PMPAGEA T)
(\PFLOPPY.WRITEPAGENO (ADD1 \PFLOPPYFIRSTDATAPAGE)
PFILELIST T)
(\PFLOPPY.WRITEPAGENO (IPLUS \PFLOPPYFIRSTDATAPAGE 2)
(\ADDBASE PFILELIST 256)
T)
(\PFLOPPY.WRITEPAGENO (IPLUS \PFLOPPYFIRSTDATAPAGE 3)
PMPAGEB T)
(\PFLOPPY.WRITEPAGENO \PFLOPPYLASTDATAPAGE PMPAGEC T)
(GLOBALRESOURCE \FLOPPY.IBMS128.FLOPPYIOCB
(\FLOPPY.WRITESECTOR \FLOPPY.IBMS128.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 0
SECTOR ← 9)
PSECTOR9 T))))
(GO ERROR)))
(SETQ NTIMES (SUB1 NTIMES))
(COND
((EQ NTIMES 0) (* Successful Return. *)
(RETURN T))
(T (GO RETRY)))
ERROR
(SETQ SLOWFLG T)
(COND
((EQ (MACHINETYPE)
(QUOTE DOVE))
(* DOVEFLOPPY formatting is so flakey that if we find any indication of problems in formatting that we then insist
that we keep formatting until we can successfully format twice in a row. *)
(SETQ NTIMES 2)))
(GO RETRY))))
(\PFLOPPY.CONFIRM
[LAMBDA (MESSAGE AUTOCONFIRMFLG NOERROR) (* kbr: "10-Dec-85 15:23")
(PROG (PSECTOR9 STRING ANSWER)
RETRY
[COND
((OR (NOT NOERROR)
(NOT AUTOCONFIRMFLG))
(SETQ PSECTOR9 (\PFLOPPY.GET.PSECTOR9]
(COND
((AND (NOT NOERROR)
(NULL PSECTOR9))
(\FLOPPY.BREAK "Not a pilot floppy")
(GO RETRY)))
(COND
[(NOT AUTOCONFIRMFLG)
[SETQ STRING (COND
(PSECTOR9 (CONCAT MESSAGE " " (fetch (PSECTOR9 $LABEL) of PSECTOR9)
"? "))
(T (CONCAT MESSAGE "? "]
(SELECTQ (ASKUSER NIL NIL STRING)
(Y (SETQ ANSWER T))
(N (SETQ ANSWER NIL))
(SHOULDNT)) (* Now check that user didn't switch floppies during
ASKUSER *)
(COND
((NOT (\FLOPPY.UNCACHED.WRITE))
(GO RETRY]
(T (SETQ ANSWER T)))
(COND
((AND (NOT NOERROR)
(NOT ANSWER))
(\FLOPPY.BREAK "User confirmation required.")
(GO RETRY)))
(COND
((AND ANSWER PSECTOR9) (* Not only indicate confirmation, but also that this
is a PILOT floppy. *)
(SETQ ANSWER PSECTOR9)))
(RETURN ANSWER])
(\PFLOPPY.GET.NAME
[LAMBDA NIL (* kbr: "13-Feb-85 16:24")
(PROG NIL
(\FLOPPY.CACHED.READ)
(\PFLOPPY.OPEN.PSECTOR9)
(RETURN (fetch (PSECTOR9 $LABEL) of (fetch (PFLOPPYFDEV PSECTOR9) of
\FLOPPYFDEV])
(\PFLOPPY.SET.NAME
[LAMBDA (NAME) (* kbr: "13-Feb-85 16:24")
(PROG NIL
(\FLOPPY.CACHED.WRITE)
(\PFLOPPY.OPEN.PSECTOR9)
(UNINTERRUPTABLY
(replace (PSECTOR9 $LABEL) of (fetch (PFLOPPYFDEV PSECTOR9) of \FLOPPYFDEV)
with NAME)
(\PFLOPPY.SAVE.PSECTOR9))
(RETURN (fetch (PSECTOR9 $LABEL) of (fetch (PFLOPPYFDEV PSECTOR9) of
\FLOPPYFDEV])
)
(* "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: "22-Jul-84 22:34")
(* Return a PFALLOC pointing to a free block.
*)
(PROG (FREE PFLENGTH PMPAGE NEXT NPMPAGE)
RETRY
(SETQ FREE (\PFLOPPY.ALLOCATE.LARGEST))
(COND
((NULL FREE)
(\PFLOPPY.GAINSPACE LENGTH)
(GO RETRY)))
(SETQ PFLENGTH (fetch (PFALLOC LENGTH) of FREE))
[COND
[LENGTH (* Required LENGTH. *)
(COND
((ILESSP PFLENGTH LENGTH)
(\PFLOPPY.GAINSPACE LENGTH)
(GO RETRY))
((ILESSP PFLENGTH (IPLUS LENGTH MINIMUM.ALLOCATION)))
(T (\PFLOPPY.TRUNCATE FREE LENGTH]
(T (* Defaulted LENGTH. *)
(COND
((ILESSP PFLENGTH MINIMUM.ALLOCATION)
(\PFLOPPY.GAINSPACE MINIMUM.ALLOCATION)
(GO RETRY))
((ILESSP PFLENGTH (IPLUS DEFAULT.ALLOCATION MINIMUM.ALLOCATION)))
(T (\PFLOPPY.TRUNCATE FREE DEFAULT.ALLOCATION]
(replace (PFALLOC FILENAME) of FREE with (QUOTE (FILE)))
(SETQ PMPAGE (fetch (PFALLOC PMPAGE) of FREE))
[COND
((NOT (EQ (fetch (PMPAGE NTYPE) of PMPAGE)
PMPAGEETYPE.FILE)) (* Marker pages need to be updated.
*)
(SETQ NEXT (fetch (PFALLOC NEXT) of FREE))
(SETQ NPMPAGE (fetch (PFALLOC PMPAGE) of NEXT))
(UNINTERRUPTABLY
(replace (PMPAGE NTYPE) of PMPAGE with PMPAGEETYPE.FILE)
(replace (PMPAGE NFILETYPE) of PMPAGE with FILETYPE.FILE)
(replace (PMPAGE PTYPE) of NPMPAGE with PMPAGEETYPE.FILE)
(replace (PMPAGE PFILETYPE) of NPMPAGE with FILETYPE.FILE)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PFALLOC START) of FREE))
PMPAGE T)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PFALLOC START) of NEXT))
NPMPAGE T))]
(\PFLOPPY.ALLOCATE.WATCHDOG)
(\PFLOPPY.ICHECK)
(RETURN FREE])
(\PFLOPPY.ALLOCATE.LARGEST
[LAMBDA NIL (* kbr: "22-Jul-84 22:34")
(* Return largest free PFALLOC.
*)
(PROG (LENGTH ANSWER)
(SETQ LENGTH 0)
(for PFALLOC in (fetch (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV)
when (AND (EQUAL (fetch (PFALLOC FILENAME) of PFALLOC)
(QUOTE (FREE)))
(IGREATERP (fetch (PFALLOC LENGTH) of PFALLOC)
LENGTH))
do (SETQ ANSWER PFALLOC)
(SETQ LENGTH (fetch (PFALLOC LENGTH) of PFALLOC)))
(\PFLOPPY.ICHECK)
(RETURN ANSWER])
(\PFLOPPY.TRUNCATE
[LAMBDA (PFALLOC LENGTH) (* kbr: "22-Jul-84 22:34")
(* Trunctate PFALLOC to LENGTH pages.
*)
(PROG (PMPAGE NEXT NPMPAGE FREE FPMPAGE TAIL) (* Trivial case = already the right length.
*)
(COND
((IGEQ LENGTH (fetch (PMPAGE NLENGTH) of (fetch (PFALLOC PMPAGE) of PFALLOC)))
(* No remaining pages, so no free block.
*)
(\PFLOPPY.ICHECK)
(RETURN))) (* Nontrivial case. *)
(SETQ PMPAGE (fetch (PFALLOC PMPAGE) of PFALLOC))
(SETQ NEXT (fetch (PFALLOC NEXT) of PFALLOC))
(SETQ NPMPAGE (fetch (PFALLOC PMPAGE) of NEXT))
(* Create FREE block. *)
(SETQ FPMPAGE (create PMPAGE
PLENGTH ← LENGTH
PTYPE ←(fetch (PMPAGE NTYPE) of PMPAGE)
PFILETYPE ←(fetch (PMPAGE NFILETYPE) of PMPAGE)
NLENGTH ←(IPLUS (fetch (PMPAGE NLENGTH) of PMPAGE)
(IMINUS (ADD1 LENGTH)))
NTYPE ← PMPAGEETYPE.FREE
NFILETYPE ← FILETYPE.FREE))
(SETQ FREE (create PFALLOC
FILENAME ←(QUOTE (FREE))
START ←(IPLUS (fetch (PFALLOC START) of PFALLOC)
(ADD1 LENGTH))
PMPAGE ← FPMPAGE))
(SETQ TAIL (MEMB PFALLOC (fetch (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV)))
(UNINTERRUPTABLY (* Fix PMPAGE and NPMPAGE fields.
*)
(replace (PMPAGE NLENGTH) of PMPAGE with (fetch (PMPAGE PLENGTH)
of FPMPAGE))
(replace (PMPAGE PLENGTH) of NPMPAGE with (fetch (PMPAGE NLENGTH)
of FPMPAGE))
(replace (PMPAGE PTYPE) of NPMPAGE with (fetch (PMPAGE NTYPE) of FPMPAGE))
(replace (PMPAGE PFILETYPE) of NPMPAGE with (fetch (PMPAGE NFILETYPE)
of FPMPAGE))
(* Insert FREE between PFALLOC and NEXT.
*)
(push (CDR TAIL)
FREE)
(replace (PFALLOC NEXT) of PFALLOC with FREE)
(replace (PFALLOC PREV) of FREE with PFALLOC)
(replace (PFALLOC NEXT) of FREE with NEXT)
(replace (PFALLOC PREV) of NEXT with FREE)
(* Write new marker pages out to floppy.
*)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PFALLOC START) of PFALLOC))
PMPAGE T)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PFALLOC START) of FREE))
FPMPAGE T)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PFALLOC START) of NEXT))
NPMPAGE T))
(\PFLOPPY.ICHECK])
(\PFLOPPY.DEALLOCATE
[LAMBDA (PFALLOC) (* kbr: "22-Jul-84 22:34")
(PROG (PMPAGE NEXT NPMPAGE)
(replace (PFALLOC PLPAGE) of PFALLOC with NIL)
(SETQ PMPAGE (fetch (PFALLOC PMPAGE) of PFALLOC))
(SETQ NEXT (fetch (PFALLOC NEXT) of PFALLOC))
(SETQ NPMPAGE (fetch (PFALLOC PMPAGE) of NEXT))
(UNINTERRUPTABLY
(replace (PFALLOC FILENAME) of PFALLOC with (QUOTE (FREE)))
(replace (PMPAGE NFILETYPE) of PMPAGE with FILETYPE.FREE)
(replace (PMPAGE NTYPE) of PMPAGE with PMPAGEETYPE.FREE)
(replace (PMPAGE PFILETYPE) of NPMPAGE with FILETYPE.FREE)
(replace (PMPAGE PTYPE) of NPMPAGE with PMPAGEETYPE.FREE)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PFALLOC START) of PFALLOC))
PMPAGE T)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PFALLOC START) of NEXT))
NPMPAGE T))
(\PFLOPPY.ICHECK])
(\PFLOPPY.EXTEND
[LAMBDA (PFALLOC) (* kbr: "22-Jul-84 22:34")
(PROG (NEXT PMPAGE NNEXT NNPMPAGE OLDLENGTH LENGTH TAIL NEW START1 START2 PMPAGE1 PMPAGE2 PREV1
PREV2 NEXT1 NEXT2 TAIL1 TAIL2)
(SETQ NEXT (fetch (PFALLOC NEXT) of PFALLOC))
(COND
((AND (EQUAL (fetch (PFALLOC FILENAME) of NEXT)
(QUOTE (FREE)))
(fetch (PFALLOC NEXT) of NEXT)) (* Cannibalize following free block.
*)
(SETQ PMPAGE (fetch (PFALLOC PMPAGE) of PFALLOC))
(SETQ NNEXT (fetch (PFALLOC NEXT) of NEXT))
(SETQ NNPMPAGE (fetch (PFALLOC PMPAGE) of NNEXT))
(SETQ OLDLENGTH (fetch (PFALLOC LENGTH) of PFALLOC))
(SETQ LENGTH (IPLUS (fetch (PFALLOC START) of NNEXT)
(IMINUS (fetch (PFALLOC START) of PFALLOC))
-1))
(SETQ TAIL (MEMB PFALLOC (fetch (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV)))
(UNINTERRUPTABLY
(replace (PMPAGE NLENGTH) of PMPAGE with LENGTH)
(replace (PMPAGE PLENGTH) of NNPMPAGE with LENGTH)
(replace (PMPAGE PTYPE) of NNPMPAGE with PMPAGEETYPE.FILE)
(replace (PMPAGE PFILETYPE) of NNPMPAGE with FILETYPE.FILE)
(pop (CDR TAIL))
(replace (PFALLOC NEXT) of PFALLOC with NNEXT)
(replace (PFALLOC PREV) of NNEXT with PFALLOC)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PFALLOC START) of PFALLOC))
PMPAGE T)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PFALLOC START) of NNEXT))
NNPMPAGE T))
[COND
((IGREATERP LENGTH (IPLUS OLDLENGTH DEFAULT.ALLOCATION MINIMUM.ALLOCATION))
(\PFLOPPY.TRUNCATE PFALLOC (IPLUS OLDLENGTH DEFAULT.ALLOCATION]
(\PFLOPPY.ICHECK)
(RETURN))) (* Have to reallocate. *)
(SETQ NEW (\PFLOPPY.ALLOCATE (IPLUS (fetch (PFALLOC LENGTH) of PFALLOC)
DEFAULT.ALLOCATION)))
(* Copy contents from PFALLOC to NEW.
*)
(\FLOPPY.MESSAGE "Reallocating")
[GLOBALRESOURCE \FLOPPY.SCRATCH.BUFFER (for I from (fetch (PFALLOC START)
of PFALLOC)
to (fetch (PFALLOC END) of PFALLOC)
as J from (fetch (PFALLOC START)
of NEW)
do (\PFLOPPY.WRITEPAGENO J
(
\PFLOPPY.READPAGENO
I
\FLOPPY.SCRATCH.BUFFER]
(\FLOPPY.MESSAGE "Finished Reallocating") (* Make PFALLOC and NEW switch places in
(fetch (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV) *)
(\PFLOPPY.DELETE.FROM.PFILELIST PFALLOC)
(SETQ START1 (fetch (PFALLOC START) of PFALLOC))
(SETQ START2 (fetch (PFALLOC START) of NEW))
(SETQ PMPAGE1 (fetch (PFALLOC PMPAGE) of PFALLOC))
(SETQ PMPAGE2 (fetch (PFALLOC PMPAGE) of NEW))
(SETQ PREV1 (fetch (PFALLOC PREV) of PFALLOC))
(SETQ PREV2 (fetch (PFALLOC PREV) of NEW))
(SETQ NEXT1 (fetch (PFALLOC NEXT) of PFALLOC))
(SETQ NEXT2 (fetch (PFALLOC NEXT) of NEW))
(SETQ TAIL1 (MEMB PFALLOC (fetch (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV)))
(SETQ TAIL2 (MEMB NEW (fetch (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV)))
(UNINTERRUPTABLY
(replace (PFALLOC START) of PFALLOC with START2)
(replace (PFALLOC START) of NEW with START1)
(replace (PFALLOC PMPAGE) of PFALLOC with PMPAGE2)
(replace (PFALLOC PMPAGE) of NEW with PMPAGE1)
(COND
(PREV1 (replace (PFALLOC NEXT) of PREV1 with NEW)))
(COND
(PREV2 (replace (PFALLOC NEXT) of PREV2 with PFALLOC)))
(COND
(NEXT1 (replace (PFALLOC PREV) of NEXT1 with NEW)))
(COND
(NEXT2 (replace (PFALLOC PREV) of NEXT2 with PFALLOC)))
(replace (PFALLOC PREV) of PFALLOC with PREV2)
(replace (PFALLOC PREV) of NEW with PREV1)
(replace (PFALLOC NEXT) of PFALLOC with NEXT2)
(replace (PFALLOC NEXT) of NEW with NEXT1)
(RPLACA TAIL1 NEW)
(RPLACA TAIL2 PFALLOC))
(\PFLOPPY.ADD.TO.PFILELIST PFALLOC) (* Now that PFALLOC points to extended block and NEW
points to old block, we can deallocate NEW.
*)
(\PFLOPPY.DEALLOCATE NEW)
(\PFLOPPY.ICHECK])
(\PFLOPPY.GAINSPACE
[LAMBDA (LENGTH) (* kbr: " 1-Nov-85 16:17")
(* Returns after a free block of length LENGTH has
been made available. *)
(PROG (PFALLOCS)
RETRY
(\PFLOPPY.GAINSPACE.MERGE) (* See if we have a long enough block yet.
*)
(COND
((for PFALLOC in (fetch (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV)
thereis (AND (EQUAL (fetch (PFALLOC FILENAME) of PFALLOC)
(QUOTE (FREE)))
(IGEQ (fetch (PFALLOC LENGTH) of PFALLOC)
LENGTH)))
(RETURN))) (* Punt to user. *)
(COND
((AND (IGEQ (FLOPPY.FREE.PAGES)
(IPLUS LENGTH MINIMUM.ALLOCATION))
(FLOPPY.COMPACT))
(GO RETRY)))
(LISPERROR "FILE SYSTEM RESOURCES EXCEEDED" (QUOTE {FLOPPY})
T)
(GO RETRY])
(\PFLOPPY.GAINSPACE.MERGE
[LAMBDA NIL (* kbr: "22-Jul-84 22:34")
(* Merge adjacent free blocks.
*)
(PROG (PFALLOCS FREE OTHERS LAST NEXT PMPAGE NPMPAGE LENGTH)
(SETQ PFALLOCS (fetch (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV))
(\PFLOPPY.ICHECK)
(do [SETQ FREE (for P in PFALLOCS
thereis (AND (EQUAL (fetch (PFALLOC FILENAME) of P)
(QUOTE (FREE)))
(fetch (PFALLOC NEXT) of P)
(EQUAL (fetch (PFALLOC FILENAME)
of (fetch (PFALLOC NEXT)
of P))
(QUOTE (FREE)))
(fetch (PFALLOC NEXT)
of (fetch (PFALLOC NEXT) of P]
(COND
((NULL FREE)
(RETURN)))
(SETQ OTHERS (for (P ←(fetch (PFALLOC NEXT) of FREE))
by (fetch (PFALLOC NEXT) of P)
while (AND (EQUAL (fetch (PFALLOC FILENAME) of P)
(QUOTE (FREE)))
(fetch (PFALLOC NEXT) of P))
collect P))
(SETQ LAST (CAR (LAST OTHERS)))
(SETQ NEXT (fetch (PFALLOC NEXT) of LAST))
(SETQ PMPAGE (fetch (PFALLOC PMPAGE) of FREE))
(SETQ NPMPAGE (fetch (PFALLOC PMPAGE) of NEXT))
(SETQ LENGTH (IPLUS (fetch (PFALLOC START) of NEXT)
(IMINUS (fetch (PFALLOC START) of FREE))
-1))
(UNINTERRUPTABLY
(for P in OTHERS do (DREMOVE P PFALLOCS))
(replace (PFALLOC NEXT) of FREE with NEXT)
(replace (PFALLOC PREV) of NEXT with FREE)
(replace (PMPAGE NLENGTH) of PMPAGE with LENGTH)
(replace (PMPAGE PLENGTH) of NPMPAGE with LENGTH)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PFALLOC START) of FREE))
PMPAGE T)
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PFALLOC START) of NEXT))
NPMPAGE T))
(\PFLOPPY.ICHECK])
(\PFLOPPY.ALLOCATE.WATCHDOG
[LAMBDA NIL (* kbr: "30-Sep-84 10:01")
(* Bark bark *)
(PROG (FREEPAGES)
(COND
((NOT (EQ \FLOPPYFDEV \PFLOPPYFDEV)) (* Must be sysout or huge mode.
Having little space after an allocation is what we
expect. *)
(RETURN)))
(SETQ FREEPAGES (\PFLOPPY.FREE.PAGES))
(COND
((ILESSP FREEPAGES 200)
(\FLOPPY.MESSAGE (CONCAT FREEPAGES " pages left."])
(\PFLOPPY.FREE.PAGES
[LAMBDA NIL (* kbr: "22-Jul-84 22:34")
(* Assume floppy is mounted.
Return number of free pages on floppy.
*)
(PROG (ANSWER) (* Answer is calculated as if all free blocks were
concentrated into one large free block.
*)
(SETQ ANSWER 0)
[for PFALLOC in (fetch (PFINFO PFALLOCS) of (fetch (FDEV DEVICEINFO)
of \FLOPPYFDEV))
when (EQUAL (fetch (PFALLOC FILENAME) of PFALLOC)
(QUOTE (FREE)))
do (* Add in 1 here for overhead pages that could be
reclaimed. *)
(SETQ ANSWER (IPLUS ANSWER 1 (fetch (PFALLOC LENGTH) of PFALLOC]
(* Lose 1 for overhead on large free block.
*)
(SETQ ANSWER (SUB1 ANSWER))
(RETURN ANSWER])
(\PFLOPPY.LENGTHS
[LAMBDA NIL (* kbr: "22-Jul-84 22:34")
(for P in (fetch (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV) collect (fetch (PFALLOC
LENGTH)
of P])
(\PFLOPPY.STARTS
[LAMBDA NIL (* kbr: "22-Jul-84 22:34")
(for P in (fetch (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV) collect (fetch (PFALLOC
START)
of P])
(\PFLOPPY.ICHECK
[LAMBDA NIL (* hdj " 5-Jun-86 13:00")
(* Integrity check. *)
(PROG (STARTS LENGTHS PFALLOCS PMPAGE1 PMPAGE2)
(SETQ STARTS (\PFLOPPY.STARTS))
(SETQ LENGTHS (\PFLOPPY.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))
(IPLUS \PFLOPPYLASTDATAPAGE (IMINUS \PFLOPPYFIRSTDATAPAGE)
1)))
(\FLOPPY.SEVERE.ERROR "Lengths2 Allocation Error")))
(SETQ PFALLOCS (fetch (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV))
(for P1 in PFALLOCS when [OR (AND (fetch (PFALLOC PREV) of P1)
(NOT (MEMB (fetch (PFALLOC PREV) of P1)
PFALLOCS)))
(AND (fetch (PFALLOC NEXT) of P1)
(NOT (MEMB (fetch (PFALLOC NEXT) of P1)
PFALLOCS] do (\FLOPPY.SEVERE.ERROR
"Links Allocation Error"))
(for P1 in PFALLOCS as P2 in (CDR PFALLOCS)
when (OR (NOT (EQ (fetch (PFALLOC NEXT) of P1)
P2))
(NOT (EQ (fetch (PFALLOC PREV) of P2)
P1))) do (\FLOPPY.SEVERE.ERROR "Links2 Allocation Error"))
(for P1 in PFALLOCS as P2 in (CDR PFALLOCS)
when (NOT (IEQP (IPLUS (fetch (PFALLOC END) of P1)
2)
(fetch (PFALLOC START) of P2))) do (\FLOPPY.SEVERE.ERROR
"Lengths3 Allocation Error"))
(* Patch around FUGUE disaster *)
[OR (QUOTE POSSIBLY.FUGUE.FLOPPY)
(for P1 in PFALLOCS as P2 in (CDR PFALLOCS)
do (SETQ PMPAGE1 (fetch (PFALLOC PMPAGE) of P1))
(SETQ PMPAGE2 (fetch (PFALLOC PMPAGE) of P2))
(COND
([OR (NOT (IEQP (fetch (PMPAGE NLENGTH) of PMPAGE1)
(fetch (PMPAGE PLENGTH) of PMPAGE2)))
(NOT (IEQP (fetch (PMPAGE NTYPE) of PMPAGE1)
(fetch (PMPAGE PTYPE) of PMPAGE2)))
(NOT (IEQP (fetch (PMPAGE NFILEID) of PMPAGE1)
(fetch (PMPAGE PFILEID) of PMPAGE2)))
(NOT (IEQP (fetch (PMPAGE NFILETYPE) of PMPAGE1)
(fetch (PMPAGE PFILETYPE) of PMPAGE2]
(\FLOPPY.SEVERE.ERROR "PMPAGEs Allocation Error"]
(COND
([NOT (FMEMB (FLOPPY.MODE)
(QUOTE (SYSOUT HUGEPILOT]
(for F in (\DEVICE-OPEN-STREAMS \FLOPPYFDEV)
when [AND (EQ (fetch (STREAM DEVICE) of F)
\FLOPPYFDEV)
(NOT (MEMB (fetch (FLOPPYSTREAM PFALLOC) of F)
(fetch (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV]
do (\FLOPPY.SEVERE.ERROR "Streams Allocation Error"])
(\PFLOPPY.ALLOCATIONS
[LAMBDA NIL (* kbr: " 7-Aug-85 19:19")
(* Debugging fn. Puts up a bitmap representation of
allocations on floppy. *)
(PROG (SECTORSPERCYLINDER REGION)
(SETQ SECTORSPERCYLINDER (ITIMES \FLOPPY.TRACKSPERCYLINDER \FLOPPY.SECTORSPERTRACK))
[COND
((NULL \FLOPPY.ALLOCATIONS.BITMAP)
(SETQ \FLOPPY.ALLOCATIONS.BITMAP (BITMAPCREATE SECTORSPERCYLINDER
\FLOPPY.CYLINDERS]
(BITBLT NIL NIL NIL \FLOPPY.ALLOCATIONS.BITMAP NIL NIL NIL NIL (QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE)
(for PFALLOC in (fetch (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV)
when [NOT (EQUAL (fetch (PFALLOC FILENAME) of PFALLOC)
(QUOTE (FREE]
do (for I from (fetch (PFALLOC START) of PFALLOC)
to (fetch (PFALLOC END) of PFALLOC) do (BITMAPBIT
\FLOPPY.ALLOCATIONS.BITMAP
(IREMAINDER (SUB1 I)
SECTORSPERCYLINDER)
(IQUOTIENT (SUB1 I)
SECTORSPERCYLINDER)
1)))
(EDITBM \FLOPPY.ALLOCATIONS.BITMAP])
)
(* "SERVICES" *)
(DEFINEQ
(FLOPPY.FREE.PAGES
[LAMBDA NIL (* kbr: "22-Jul-84 22:40")
(WITH.MONITOR \FLOPPYLOCK (\FLOPPY.CACHED.READ)
(SELECTQ (FLOPPY.MODE)
((PILOT HUGEPILOT SYSOUT)
(\PFLOPPY.FREE.PAGES))
(CPM (\CFLOPPY.FREE.PAGES))
(SHOULDNT])
(FLOPPY.FORMAT
[LAMBDA (NAME AUTOCONFIRMFLG SLOWFLG) (* kbr: "22-Jul-84 22:40")
(WITH.MONITOR \FLOPPYLOCK (SELECTQ (FLOPPY.MODE)
((PILOT HUGEPILOT SYSOUT)
(\PFLOPPY.FORMAT NAME AUTOCONFIRMFLG SLOWFLG))
(CPM (\CFLOPPY.FORMAT NAME AUTOCONFIRMFLG SLOWFLG))
(SHOULDNT])
(FLOPPY.NAME
[LAMBDA (NAME) (* kbr: "22-Jul-84 22:40")
(COND
(NAME (FLOPPY.SET.NAME NAME))
(T (FLOPPY.GET.NAME])
(FLOPPY.GET.NAME
[LAMBDA NIL (* kbr: "22-Jul-84 22:40")
(WITH.MONITOR \FLOPPYLOCK (SELECTQ (FLOPPY.MODE)
((PILOT HUGEPILOT SYSOUT)
(\PFLOPPY.GET.NAME))
(SHOULDNT])
(FLOPPY.SET.NAME
[LAMBDA (NAME) (* kbr: "22-Jul-84 22:40")
(WITH.MONITOR \FLOPPYLOCK (SELECTQ (FLOPPY.MODE)
((PILOT HUGEPILOT SYSOUT)
(\PFLOPPY.SET.NAME NAME))
(SHOULDNT])
(FLOPPY.CAN.READP
[LAMBDA NIL (* kbr: "11-Oct-85 17:43")
(WITH.MONITOR \FLOPPYLOCK (PROG (ANSWER)
[COND
((\FLOPPY.EXISTSP T)
(SETQ ANSWER (\FLOPPY.MOUNTEDP T))
(COND
((NOT ANSWER)
(* Possibly the user switched floppies.
*)
(\FLOPPY.CLOSE)
(\FLOPPY.INITIALIZE T)
(SETQ ANSWER (\FLOPPY.MOUNTEDP T]
(RETURN ANSWER])
(FLOPPY.CAN.WRITEP
[LAMBDA NIL (* kbr: "11-Oct-85 18:30")
(WITH.MONITOR \FLOPPYLOCK (PROG (ANSWER)
[COND
((\FLOPPY.EXISTSP T)
(SETQ ANSWER (\FLOPPY.CAN.WRITEP T))
(COND
((NOT ANSWER)
(* Possibly the user switched floppies.
*)
(\FLOPPY.CLOSE)
(\FLOPPY.INITIALIZE T)
(SETQ ANSWER (\FLOPPY.CAN.WRITEP T]
(RETURN ANSWER])
(FLOPPY.WAIT.FOR.FLOPPY
[LAMBDA (NEWFLG) (* bvm: "22-Nov-85 01:01")
(* Wait until floppy drive contains
(new) floppy. *)
(WITH.MONITOR \FLOPPYLOCK (PROG NIL (* NOTE: Wait 2 seconds to guarantee drive door is
secure. *)
(\FLOPPY.CLOSE)
(COND
((EQ (MACHINETYPE)
(QUOTE DOVE))
(SETQ NEWFLG T)))
(COND
(NEWFLG (SELECTQ (MACHINETYPE)
(DANDELION (DISMISS 5000)
(until (NOT (
FLOPPY.CAN.READP))
do (BLOCK)))
(DOVE
(* GODDAMN DAYBREAK DOOROPEN BIT DOESN'T WORK *)
(\FLOPPY.MESSAGE
"Type any character after inserting new floppy."
T)
(\GETKEY))
NIL)))
DEBOUNCE
(until (FLOPPY.CAN.READP) do (BLOCK))
(COND
(NEWFLG (DISMISS 2000)))
(COND
((NOT (\FLOPPY.CAN.READP T))
(* Drive door probably didn't stick.
*)
(GO DEBOUNCE])
)
(* "SYSOUT" *)
(RPAQ? \SFLOPPYINFO NIL)
(RPAQ? \SFLOPPYFDEV NIL)
(RPAQ? \HFLOPPY.MAXPAGES NIL)
(RPAQ? \SFLOPPY.PAGENO NIL)
(RPAQ? \SFLOPPY.FLOPPYNO NIL)
(RPAQ? \SFLOPPY.PAGES NIL)
(RPAQ? \SFLOPPY.HUGELENGTH NIL)
(RPAQ? \SFLOPPY.HUGEPAGELENGTH NIL)
(RPAQ? \SFLOPPY.IWRITEDATE NIL)
(RPAQ? \SFLOPPY.FLOPPYNAME "Lisp Sysout ")
(RPAQ? \SFLOPPY.FILENAME (QUOTE lisp.sysout))
(RPAQ? \SFLOPPY.RECOG NIL)
(RPAQ? \SFLOPPY.OTHERINFO NIL)
(RPAQ? \SFLOPPY.SLOWFLG T)
(RPAQ? \SFLOPPY.HACK.MODE NIL)
(RPAQ? \SFLOPPY.HACK.STREAM NIL)
(DEFINEQ
(\SFLOPPY.INIT
[LAMBDA NIL (* hdj "15-May-86 20:53")
(PROG NIL
(SETQ \SFLOPPYINFO (create PFINFO))
(SETQ \SFLOPPYFDEV (create FDEV
DEVICENAME ← (QUOTE FLOPPY)
NODIRECTORIES ← T
CLOSEFILE ← (FUNCTION \SFLOPPY.CLOSEHUGEFILE)
DELETEFILE ← (FUNCTION NILL)
DIRECTORYNAMEP ← (FUNCTION TRUE)
EVENTFN ← (FUNCTION \FLOPPY.EVENTFN)
GENERATEFILES ← (FUNCTION \PFLOPPY.GENERATEFILES)
GETFILEINFO ← (FUNCTION \SFLOPPY.GETFILEINFO)
GETFILENAME ← (FUNCTION \PFLOPPY.GETFILENAME)
HOSTNAMEP ← (FUNCTION \FLOPPY.HOSTNAMEP)
OPENFILE ← (FUNCTION \SFLOPPY.OPENHUGEFILE)
READPAGES ← (FUNCTION \SFLOPPY.READPAGES)
REOPENFILE ← (FUNCTION \SFLOPPY.OPENHUGEFILE)
SETFILEINFO ← (FUNCTION NILL)
TRUNCATEFILE ← (FUNCTION NILL)
WRITEPAGES ← (FUNCTION \SFLOPPY.WRITEPAGES)
DEVICEINFO ← \SFLOPPYINFO
RENAMEFILE ← (FUNCTION NILL)
REGISTERFILE ← (FUNCTION \ADD-OPEN-STREAM)))
(\MAKE.PMAP.DEVICE \SFLOPPYFDEV])
(\SFLOPPY.GETFILEINFO
[LAMBDA (FILE ATTRIBUTE FDEV) (* kbr: "25-Nov-84 13:02")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM PLPAGE ANSWER)
(\FLOPPY.CACHED.READ)
(SETQ STREAM (\PFLOPPY.ASSURESTREAM FILE))
(SETQ PLPAGE (fetch (FLOPPYSTREAM PLPAGE) of STREAM))
(* Wizard incantations: PAGELENGTH, HUGEPAGESTART,
HUGEPAGELENGTH, HUGELENGTH *)
(SETQ ANSWER (SELECTQ ATTRIBUTE
(WRITEDATE (fetch (PLPAGE WRITEDATE)
of PLPAGE))
(CREATIONDATE (fetch (PLPAGE
CREATIONDATE)
of PLPAGE))
(IWRITEDATE (fetch (PLPAGE
IWRITEDATE)
of PLPAGE))
(ICREATIONDATE (fetch (PLPAGE
ICREATIONDATE)
of PLPAGE))
(LENGTH
(* We want hugelength. *)
(fetch (PLPAGE HUGELENGTH)
of PLPAGE))
(TYPE (fetch (PLPAGE TYPE)
of PLPAGE))
(BYTESIZE 8)
(MESATYPE (fetch (PLPAGE MESATYPE)
of PLPAGE))
(PAGELENGTH (fetch (PLPAGE
PAGELENGTH)
of PLPAGE))
(HUGEPAGESTART (fetch (PLPAGE
HUGEPAGESTART)
of PLPAGE))
(HUGEPAGELENGTH (fetch
(PLPAGE
HUGEPAGELENGTH)
of PLPAGE))
(HUGELENGTH (fetch (PLPAGE
HUGELENGTH)
of PLPAGE))
NIL))
(RETURN ANSWER])
(\SFLOPPY.OPENHUGEFILE
[LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* hdj "16-May-86 21:52")
(* * if file is open in conflicting way, barf)
(if (NOT (\FILE-CONFLICT FILE ACCESS FDEV))
then (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.OTHERINFO (\FLOPPY.OTHERINFO OTHERINFO))
[COND
((EQ RECOG (QUOTE NEW))
(SETQ \SFLOPPY.IWRITEDATE (IDATE))
(SETQ \SFLOPPY.HUGELENGTH (CDR (ASSOC (QUOTE LENGTH)
\SFLOPPY.OTHERINFO
)))
(COND
((NULL \SFLOPPY.HUGELENGTH)
(\FLOPPY.MESSAGE
"Can't open file without LENGTH parameter in SYSOUT mode."
T)
(LISPERROR "FILE WON'T OPEN" "")))
(SETQ \SFLOPPY.HUGEPAGELENGTH
(IQUOTIENT (IPLUS \SFLOPPY.HUGELENGTH 511)
512))
(printout T (IQUOTIENT (IPLUS
\SFLOPPY.HUGEPAGELENGTH
\HFLOPPY.MAXPAGES -1)
\HFLOPPY.MAXPAGES)
" floppies will be required." T)
(RPLACD (OR (ASSOC (QUOTE LENGTH)
\SFLOPPY.OTHERINFO)
(PROGN (push \SFLOPPY.OTHERINFO
(LIST (QUOTE LENGTH)))
(CAR \SFLOPPY.OTHERINFO)))
(ITIMES \HFLOPPY.MAXPAGES 512))
(SETQ STREAM (\SFLOPPY.OUTPUTFLOPPY
\SFLOPPY.FLOPPYNAME
\SFLOPPY.FILENAME
\SFLOPPY.OTHERINFO)))
(T (SETQ STREAM (\SFLOPPY.INPUTFLOPPY
\SFLOPPY.FLOPPYNAME
\SFLOPPY.FILENAME
\SFLOPPY.OTHERINFO]
(RETURN STREAM])
(\SFLOPPY.WRITEPAGES
[LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* kbr: "26-Aug-84 11:20")
(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: "26-Aug-84 11:20")
(WITH.MONITOR \FLOPPYLOCK (PROG (NEWSTREAM)
[COND
((IGEQ \SFLOPPY.PAGENO \HFLOPPY.MAXPAGES)
(\SFLOPPY.CLOSEFLOPPY STREAM)
(RINGBELLS)
[RPLACD (OR (ASSOC (QUOTE LENGTH)
\SFLOPPY.OTHERINFO)
(PROGN (push \SFLOPPY.OTHERINFO
(LIST (QUOTE LENGTH)))
(CAR \SFLOPPY.OTHERINFO)))
(IMIN (ITIMES \HFLOPPY.MAXPAGES 512)
(IDIFFERENCE \SFLOPPY.HUGELENGTH
(ITIMES
\SFLOPPY.FLOPPYNO
\HFLOPPY.MAXPAGES 512]
(SETQ STREAM (\SFLOPPY.OUTPUTFLOPPY \SFLOPPY.FLOPPYNAME
\SFLOPPY.FILENAME
\SFLOPPY.OTHERINFO
STREAM]
(* Write page \SFLOPPY.PAGENO.
*)
(GLOBALRESOURCE \FLOPPY.SCRATCH.BUFFER (\BLT
\FLOPPY.SCRATCH.BUFFER
BUFFER 256)
(\PFLOPPY.WRITEPAGE STREAM \SFLOPPY.PAGENO
\FLOPPY.SCRATCH.BUFFER))
(SETQ \SFLOPPY.PAGENO (ADD1 \SFLOPPY.PAGENO])
(\SFLOPPY.READPAGES
[LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* kbr: "26-Aug-84 11:20")
(PROG NIL
(COND
((EQ \SFLOPPY.RECOG (QUOTE NEW))
(RETURN)))
(for BUFFER in (MKLIST BUFFERS) as I from 0 do (\SFLOPPY.READPAGE
STREAM
(IPLUS FIRSTPAGE# I)
BUFFER])
(\SFLOPPY.READPAGE
[LAMBDA (STREAM FIRSTPAGE# BUFFER) (* bvm: "22-Nov-85 01:05")
(WITH.MONITOR \FLOPPYLOCK (PROG (NEWSTREAM)
[COND
((IGEQ \SFLOPPY.PAGENO \SFLOPPY.PAGES)
(\SFLOPPY.CLOSEFLOPPY STREAM)
(RINGBELLS)
(SETQ STREAM (\SFLOPPY.INPUTFLOPPY \SFLOPPY.FLOPPYNAME
\SFLOPPY.FILENAME
\SFLOPPY.OTHERINFO
STREAM]
(* Read page \SFLOPPY.PAGENO.
*)
(\PFLOPPY.READPAGE STREAM \SFLOPPY.PAGENO BUFFER)
(SETQ \SFLOPPY.PAGENO (ADD1 \SFLOPPY.PAGENO])
(\SFLOPPY.CLOSEHUGEFILE
[LAMBDA (STREAM) (* hdj "15-May-86 20:57")
(WITH.MONITOR \FLOPPYLOCK (PROG (FULLFILENAME)
(COND
((EQ \SFLOPPY.RECOG (QUOTE OLD))
(RETURN)))
(\CLEARMAP STREAM) (* Following 2 SETQ's patch around
SYSOUT not passing us right HUGELENGTH
in orignal OTHERINFO.
I think this may be fixed now.
*)
(COND
((NOT (IEQP (IPLUS (ITIMES 512 (fetch (STREAM EPAGE)
of STREAM))
(fetch (STREAM EOFFSET) of STREAM))
\SFLOPPY.HUGELENGTH))
(\FLOPPY.MESSAGE
"Warning. Predicted file length disagrees with actual length."
)
(\FLOPPY.MESSAGE "Proceeding anyway.")))
(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))
(SETQ FULLFILENAME (\SFLOPPY.CLOSEFLOPPY STREAM T))
(COND
((EQ STREAM \SFLOPPY.HACK.STREAM)
(* This was a sysout *)
(FLOPPY.MODE \SFLOPPY.HACK.MODE)
(SETQ \SFLOPPY.HACK.STREAM NIL)))
(\DELETE-OPEN-STREAM STREAM (fetch (STREAM DEVICE) of STREAM))
(RETURN FULLFILENAME])
(\SFLOPPY.INPUTFLOPPY
[LAMBDA (FLOPPYNAME FILENAME OTHERINFO OLDSTREAM) (* kbr: "26-Aug-84 11:20")
(PROG (FLOPPYNAME#I STREAM)
[COND
((NULL OLDSTREAM)
(SETQ \SFLOPPY.FLOPPYNO 1))
(T (SETQ \SFLOPPY.FLOPPYNO (ADD1 \SFLOPPY.FLOPPYNO]
(SETQ FLOPPYNAME#I (CONCAT FLOPPYNAME "#" \SFLOPPY.FLOPPYNO))
(COND
((OR (IGREATERP \SFLOPPY.FLOPPYNO 1)
(NOT (\FLOPPY.UNCACHED.READ T)))
(printout T "Insert floppy " FLOPPYNAME#I T)
(FLOPPY.WAIT.FOR.FLOPPY T)))
(SETQ STREAM (\PFLOPPY.OPENFILE FILENAME (QUOTE INPUT)
(QUOTE OLD)
OTHERINFO))
(SETQ \SFLOPPY.PAGENO 0)
(COND
((NULL OLDSTREAM)
(SETQ \SFLOPPY.HUGELENGTH (fetch (PLPAGE HUGELENGTH) of (fetch (FLOPPYSTREAM
PLPAGE)
of STREAM)))
(SETQ \SFLOPPY.HUGEPAGELENGTH (fetch (PLPAGE HUGEPAGELENGTH)
of (fetch (FLOPPYSTREAM PLPAGE) of STREAM)))
(replace (STREAM EPAGE) of STREAM with (IQUOTIENT \SFLOPPY.HUGELENGTH 512))
(replace (STREAM EOFFSET) of STREAM with (IREMAINDER \SFLOPPY.HUGELENGTH 512))
)
(T (replace (FLOPPYSTREAM PFALLOC) of OLDSTREAM with (fetch (FLOPPYSTREAM
PFALLOC)
of STREAM))
(replace (FLOPPYSTREAM PLPAGE) of OLDSTREAM with (fetch (FLOPPYSTREAM PLPAGE)
of STREAM))
(SETQ STREAM OLDSTREAM)))
(SETQ \SFLOPPY.PAGES (fetch (PLPAGE PAGELENGTH) of (fetch (FLOPPYSTREAM PLPAGE)
of STREAM)))
(RETURN STREAM])
(\SFLOPPY.OUTPUTFLOPPY
[LAMBDA (FLOPPYNAME FILENAME OTHERINFO OLDSTREAM) (* kbr: "13-Oct-84 17:04")
(PROG (FLOPPYNAME#I STREAM)
[COND
((NULL OLDSTREAM)
(SETQ \SFLOPPY.FLOPPYNO 1))
(T (SETQ \SFLOPPY.FLOPPYNO (ADD1 \SFLOPPY.FLOPPYNO]
(SETQ FLOPPYNAME#I (CONCAT FLOPPYNAME "#" \SFLOPPY.FLOPPYNO))
(COND
((AND (IEQP \SFLOPPY.FLOPPYNO 1)
(\FLOPPY.UNCACHED.READ T)) (* Don't prompt if first floppy already ready for us.
*)
(GO FORMAT)))
RETRY
(printout T "Insert floppy to become " FLOPPYNAME#I T)
(FLOPPY.WAIT.FOR.FLOPPY T)
FORMAT
(COND
((NOT (\FLOPPY.UNCACHED.WRITE T))
(printout T "Can't proceed. This floppy is writeprotected." T)
(GO RETRY))
((NOT (\PFLOPPY.FORMAT FLOPPYNAME#I NIL \SFLOPPY.SLOWFLG))
(* Didn't format *)
(GO RETRY)))
(SETQ STREAM (\PFLOPPY.OPENFILE FILENAME (QUOTE OUTPUT)
(QUOTE NEW)
OTHERINFO))
(SETQ \SFLOPPY.PAGENO 0)
(SETQ \SFLOPPY.PAGES (IQUOTIENT (IPLUS (CDR (ASSOC (QUOTE LENGTH)
OTHERINFO))
511)
512))
(COND
(OLDSTREAM (replace (FLOPPYSTREAM PFALLOC) of OLDSTREAM with (fetch
(FLOPPYSTREAM
PFALLOC)
of STREAM))
(replace (FLOPPYSTREAM PLPAGE) of OLDSTREAM with (fetch
(FLOPPYSTREAM
PLPAGE)
of STREAM))
(SETQ STREAM OLDSTREAM)))
(replace (STREAM FULLFILENAME) of STREAM with (PACK* (QUOTE {FLOPPY})
FILENAME))
(replace (PLPAGE $NAME) of (fetch (FLOPPYSTREAM PLPAGE) of STREAM) with
FILENAME)
(replace (PFALLOC FILENAME) of (fetch (FLOPPYSTREAM PFALLOC) of STREAM)
with FILENAME)
(RETURN STREAM])
(\SFLOPPY.CLOSEFLOPPY
[LAMBDA (STREAM LASTFLOPPYFLG) (* kbr: "25-Feb-85 12:18")
(* The same as \PFLOPPY.CLOSEFILE but without
releasing STREAM. Called only by \SFLOPPY.WRITEPAGE.
*)
(PROG (PFALLOC PLPAGE PMPAGE NEXT NPMPAGE)
(COND
((EQ (\GETACCESS STREAM)
(QUOTE INPUT))
(RETURN)))
[\PFLOPPY.TRUNCATEFILE STREAM [COND
((NOT LASTFLOPPYFLG)
\HFLOPPY.MAXPAGES)
(T (IDIFFERENCE (fetch (STREAM EPAGE) of STREAM)
(ITIMES \HFLOPPY.MAXPAGES (SUB1
\SFLOPPY.FLOPPYNO]
(COND
((NOT LASTFLOPPYFLG)
0)
(T (fetch (STREAM EOFFSET) of STREAM]
(SETQ PFALLOC (fetch (FLOPPYSTREAM PFALLOC) of STREAM))
(SETQ PLPAGE (fetch (PFALLOC PLPAGE) of PFALLOC))
(replace (PLPAGE IWRITEDATE) of PLPAGE with \SFLOPPY.IWRITEDATE)
(replace (PLPAGE ICREATIONDATE) of PLPAGE with \SFLOPPY.IWRITEDATE)
(replace (PLPAGE HUGEPAGESTART) of PLPAGE with (ITIMES \HFLOPPY.MAXPAGES
(SUB1 \SFLOPPY.FLOPPYNO))
)
(replace (PLPAGE HUGEPAGELENGTH) of PLPAGE with \SFLOPPY.HUGEPAGELENGTH)
(replace (PLPAGE HUGELENGTH) of PLPAGE with \SFLOPPY.HUGELENGTH)
(\PFLOPPY.WRITEPAGENO (fetch (PFALLOC START) of PFALLOC)
PLPAGE)
(\PFLOPPY.SAVE.PFILELIST)
(\PFLOPPY.SAVE.PSECTOR9])
(\SFLOPPY.HACK
[LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* kbr: " 2-Dec-84 11:58")
(COND
([AND (STKPOS (QUOTE \COPYSYS))
(NOT (EQ (FLOPPY.MODE)
(QUOTE SYSOUT] (* Sysouting to {FLOPPY} *)
(SETQ \SFLOPPY.HACK.MODE (FLOPPY.MODE (QUOTE SYSOUT)))
(SETQ \SFLOPPY.HACK.STREAM (\SFLOPPY.OPENHUGEFILE FILE ACCESS RECOG OTHERINFO \FLOPPYFDEV
OLDSTREAM))
\SFLOPPY.HACK.STREAM)
(T (* The usual case is to return NIL telling OPENFILE fn
to proceed normally *)
NIL])
)
(* "HUGE" *)
(RPAQ? \HFLOPPYINFO NIL)
(RPAQ? \HFLOPPYFDEV NIL)
(RPAQ? \HFLOPPY.MAXPAGES NIL)
(RPAQ? \HFLOPPY.PAGENO NIL)
(RPAQ? \HFLOPPY.FLOPPYNO NIL)
(RPAQ? \HFLOPPY.HUGELENGTH NIL)
(RPAQ? \HFLOPPY.HUGEPAGELENGTH NIL)
(RPAQ? \HFLOPPY.IWRITEDATE NIL)
(RPAQ? \HFLOPPY.FLOPPYNAME NIL)
(RPAQ? \HFLOPPY.FILENAME NIL)
(RPAQ? \HFLOPPY.RECOG NIL)
(RPAQ? \HFLOPPY.OTHERINFO NIL)
(RPAQ? \HFLOPPY.SLOWFLG T)
(DEFINEQ
(\HFLOPPY.INIT
[LAMBDA NIL (* hdj "15-May-86 20:52")
(PROG NIL
(SETQ \HFLOPPYINFO (create PFINFO))
(SETQ \HFLOPPYFDEV (create FDEV
DEVICENAME ← (QUOTE FLOPPY)
NODIRECTORIES ← T
CLOSEFILE ← (FUNCTION \HFLOPPY.CLOSEHUGEFILE)
DELETEFILE ← (FUNCTION NILL)
DIRECTORYNAMEP ← (FUNCTION TRUE)
EVENTFN ← (FUNCTION \FLOPPY.EVENTFN)
GENERATEFILES ← (FUNCTION \PFLOPPY.GENERATEFILES)
GETFILEINFO ← (FUNCTION \HFLOPPY.GETFILEINFO)
GETFILENAME ← (FUNCTION \PFLOPPY.GETFILENAME)
HOSTNAMEP ← (FUNCTION \FLOPPY.HOSTNAMEP)
OPENFILE ← (FUNCTION \HFLOPPY.OPENHUGEFILE)
READPAGES ← (FUNCTION \HFLOPPY.READPAGES)
REOPENFILE ← (FUNCTION \HFLOPPY.OPENHUGEFILE)
SETFILEINFO ← (FUNCTION NILL)
TRUNCATEFILE ← (FUNCTION NILL)
WRITEPAGES ← (FUNCTION \HFLOPPY.WRITEPAGES)
DEVICEINFO ← \HFLOPPYINFO
RENAMEFILE ← (FUNCTION NILL)
REGISTERFILE ← (FUNCTION \ADD-OPEN-STREAM)))
(\MAKE.PMAP.DEVICE \HFLOPPYFDEV])
(\HFLOPPY.GETFILEINFO
[LAMBDA (FILE ATTRIBUTE FDEV) (* kbr: "25-Nov-84 13:03")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM PLPAGE ANSWER)
(\FLOPPY.CACHED.READ)
(SETQ STREAM (\PFLOPPY.ASSURESTREAM FILE))
(SETQ PLPAGE (fetch (FLOPPYSTREAM PLPAGE) of STREAM))
(* Wizard incantations: PAGELENGTH, HUGEPAGESTART,
HUGEPAGELENGTH, HUGELENGTH *)
(SETQ ANSWER (SELECTQ ATTRIBUTE
(WRITEDATE (fetch (PLPAGE WRITEDATE)
of PLPAGE))
(CREATIONDATE (fetch (PLPAGE
CREATIONDATE)
of PLPAGE))
(IWRITEDATE (fetch (PLPAGE
IWRITEDATE)
of PLPAGE))
(ICREATIONDATE (fetch (PLPAGE
ICREATIONDATE)
of PLPAGE))
(LENGTH
(* We want hugelength. *)
(fetch (PLPAGE HUGELENGTH)
of PLPAGE))
(TYPE (fetch (PLPAGE TYPE)
of PLPAGE))
(BYTESIZE 8)
(MESATYPE (fetch (PLPAGE MESATYPE)
of PLPAGE))
(PAGELENGTH (fetch (PLPAGE
PAGELENGTH)
of PLPAGE))
(HUGEPAGESTART (fetch (PLPAGE
HUGEPAGESTART)
of PLPAGE))
(HUGEPAGELENGTH (fetch
(PLPAGE
HUGEPAGELENGTH)
of PLPAGE))
(HUGELENGTH (fetch (PLPAGE
HUGELENGTH)
of PLPAGE))
NIL))
(RETURN ANSWER])
(\HFLOPPY.OPENHUGEFILE
[LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* hdj "16-May-86 21:50")
(* * if file is open in conflicting way, barf)
(if (NOT (\FILE-CONFLICT FILE ACCESS FDEV))
then (OR (\SFLOPPY.HACK FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM)
(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.FILENAME (\FLOPPY.ASSUREFILENAME
FILE))
(SETQ \HFLOPPY.FLOPPYNAME \HFLOPPY.FILENAME)
(SETQ \HFLOPPY.RECOG RECOG)
(SETQ \HFLOPPY.OTHERINFO (\FLOPPY.OTHERINFO
OTHERINFO))
[COND
((EQ RECOG (QUOTE NEW))
(SETQ \HFLOPPY.IWRITEDATE (IDATE))
(SETQ \HFLOPPY.HUGELENGTH
(CDR (ASSOC (QUOTE LENGTH)
\HFLOPPY.OTHERINFO)))
(COND
((NULL \HFLOPPY.HUGELENGTH)
(\FLOPPY.MESSAGE
"Can't open file without LENGTH parameter in HUGE mode."
T)
(LISPERROR "FILE WON'T OPEN" "")))
(SETQ \HFLOPPY.HUGEPAGELENGTH
(IQUOTIENT (IPLUS \HFLOPPY.HUGELENGTH 511)
512))
(printout T (IQUOTIENT (IPLUS
\HFLOPPY.HUGEPAGELENGTH
\HFLOPPY.MAXPAGES
-1)
\HFLOPPY.MAXPAGES)
" floppies will be required." T)
(RPLACD (OR (ASSOC (QUOTE LENGTH)
\HFLOPPY.OTHERINFO)
(PROGN (push \HFLOPPY.OTHERINFO
(LIST (QUOTE LENGTH)))
(CAR \HFLOPPY.OTHERINFO)))
(ITIMES \HFLOPPY.MAXPAGES 512))
(SETQ STREAM (\HFLOPPY.OUTPUTFLOPPY
\HFLOPPY.FLOPPYNAME
\HFLOPPY.FILENAME
\HFLOPPY.OTHERINFO)))
(T (SETQ STREAM (\HFLOPPY.INPUTFLOPPY
\HFLOPPY.FLOPPYNAME
\HFLOPPY.FILENAME
\HFLOPPY.OTHERINFO]
(RETURN STREAM])
(\HFLOPPY.WRITEPAGES
[LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* kbr: "26-Aug-84 11:19")
(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: "26-Aug-84 11:20")
(WITH.MONITOR \FLOPPYLOCK (PROG (NEWSTREAM)
[COND
((IGEQ \HFLOPPY.PAGENO \HFLOPPY.MAXPAGES)
(\HFLOPPY.CLOSEFLOPPY STREAM)
(RINGBELLS)
[RPLACD (OR (ASSOC (QUOTE LENGTH)
\HFLOPPY.OTHERINFO)
(PROGN (push \HFLOPPY.OTHERINFO
(LIST (QUOTE LENGTH)))
(CAR \HFLOPPY.OTHERINFO)))
(IMIN (ITIMES \HFLOPPY.MAXPAGES 512)
(IDIFFERENCE \HFLOPPY.HUGELENGTH
(ITIMES
\HFLOPPY.FLOPPYNO
\HFLOPPY.MAXPAGES 512]
(SETQ STREAM (\HFLOPPY.OUTPUTFLOPPY \HFLOPPY.FLOPPYNAME
\HFLOPPY.FILENAME
\HFLOPPY.OTHERINFO
STREAM]
(* Write page \HFLOPPY.PAGENO.
*)
(GLOBALRESOURCE \FLOPPY.SCRATCH.BUFFER (\BLT
\FLOPPY.SCRATCH.BUFFER
BUFFER 256)
(\PFLOPPY.WRITEPAGE STREAM \HFLOPPY.PAGENO
\FLOPPY.SCRATCH.BUFFER))
(SETQ \HFLOPPY.PAGENO (ADD1 \HFLOPPY.PAGENO])
(\HFLOPPY.READPAGES
[LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* kbr: "26-Aug-84 11:20")
(PROG NIL
(COND
((EQ \HFLOPPY.RECOG (QUOTE NEW))
(RETURN)))
(for BUFFER in (MKLIST BUFFERS) as I from 0 do (\HFLOPPY.READPAGE
STREAM
(IPLUS FIRSTPAGE# I)
BUFFER])
(\HFLOPPY.READPAGE
[LAMBDA (STREAM FIRSTPAGE# BUFFER) (* bvm: "22-Nov-85 00:21")
(WITH.MONITOR \FLOPPYLOCK (PROG (NEWSTREAM)
[COND
((IGEQ \HFLOPPY.PAGENO \HFLOPPY.PAGES)
(\HFLOPPY.CLOSEFLOPPY STREAM)
(RINGBELLS)
(SETQ STREAM (\HFLOPPY.INPUTFLOPPY \HFLOPPY.FLOPPYNAME
\HFLOPPY.FILENAME
\HFLOPPY.OTHERINFO
STREAM]
(* Read page \HFLOPPY.PAGENO.
*)
(\PFLOPPY.READPAGE STREAM \HFLOPPY.PAGENO BUFFER)
(SETQ \HFLOPPY.PAGENO (ADD1 \HFLOPPY.PAGENO])
(\HFLOPPY.CLOSEHUGEFILE
[LAMBDA (STREAM) (* hdj "15-May-86 20:58")
(WITH.MONITOR \FLOPPYLOCK (PROG (FULLFILENAME)
(COND
((EQ \HFLOPPY.RECOG (QUOTE OLD))
(RETURN)))
(\CLEARMAP STREAM) (* Following 2 SETQ's patch around
SYSOUT not passing us right HUGELENGTH
in orignal OTHERINFO.
I think this may be fixed now.
*)
(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))
(SETQ FULLFILENAME (\HFLOPPY.CLOSEFLOPPY STREAM T))
(\DELETE-OPEN-STREAM STREAM (fetch (STREAM DEVICE) of STREAM))
(RETURN FULLFILENAME])
(\HFLOPPY.INPUTFLOPPY
[LAMBDA (FLOPPYNAME FILENAME OTHERINFO OLDSTREAM) (* kbr: "26-Aug-84 11:20")
(PROG (FLOPPYNAME#I STREAM)
[COND
((NULL OLDSTREAM)
(SETQ \HFLOPPY.FLOPPYNO 1))
(T (SETQ \HFLOPPY.FLOPPYNO (ADD1 \HFLOPPY.FLOPPYNO]
(SETQ FLOPPYNAME#I (CONCAT FLOPPYNAME "#" \HFLOPPY.FLOPPYNO))
(COND
((OR (IGREATERP \HFLOPPY.FLOPPYNO 1)
(NOT (\FLOPPY.UNCACHED.READ T)))
(printout T "Insert floppy " FLOPPYNAME#I T)
(FLOPPY.WAIT.FOR.FLOPPY T)))
(SETQ STREAM (\PFLOPPY.OPENFILE FILENAME (QUOTE INPUT)
(QUOTE OLD)
OTHERINFO))
(SETQ \HFLOPPY.PAGENO 0)
(COND
((NULL OLDSTREAM)
(SETQ \HFLOPPY.HUGELENGTH (fetch (PLPAGE HUGELENGTH) of (fetch (FLOPPYSTREAM
PLPAGE)
of STREAM)))
(SETQ \HFLOPPY.HUGEPAGELENGTH (fetch (PLPAGE HUGEPAGELENGTH)
of (fetch (FLOPPYSTREAM PLPAGE) of STREAM)))
(replace (STREAM EPAGE) of STREAM with (IQUOTIENT \HFLOPPY.HUGELENGTH 512))
(replace (STREAM EOFFSET) of STREAM with (IREMAINDER \HFLOPPY.HUGELENGTH 512))
)
(T (replace (FLOPPYSTREAM PFALLOC) of OLDSTREAM with (fetch (FLOPPYSTREAM
PFALLOC)
of STREAM))
(replace (FLOPPYSTREAM PLPAGE) of OLDSTREAM with (fetch (FLOPPYSTREAM PLPAGE)
of STREAM))
(SETQ STREAM OLDSTREAM)))
(SETQ \HFLOPPY.PAGES (fetch (PLPAGE PAGELENGTH) of (fetch (FLOPPYSTREAM PLPAGE)
of STREAM)))
(RETURN STREAM])
(\HFLOPPY.OUTPUTFLOPPY
[LAMBDA (FLOPPYNAME FILENAME OTHERINFO OLDSTREAM) (* kbr: "13-Oct-84 17:04")
(PROG (FLOPPYNAME#I STREAM)
[COND
((NULL OLDSTREAM)
(SETQ \HFLOPPY.FLOPPYNO 1))
(T (SETQ \HFLOPPY.FLOPPYNO (ADD1 \HFLOPPY.FLOPPYNO]
(SETQ FLOPPYNAME#I (CONCAT FLOPPYNAME "#" \HFLOPPY.FLOPPYNO))
(COND
((AND (IEQP \HFLOPPY.FLOPPYNO 1)
(\FLOPPY.UNCACHED.READ T)) (* Don't prompt if first floppy already ready for us.
*)
(GO FORMAT)))
RETRY
(printout T "Insert floppy to become " FLOPPYNAME#I T)
(FLOPPY.WAIT.FOR.FLOPPY T)
FORMAT
(COND
((NOT (\FLOPPY.UNCACHED.WRITE T))
(printout T "Can't proceed. This floppy is writeprotected." T)
(GO RETRY))
((NOT (\PFLOPPY.FORMAT FLOPPYNAME#I NIL \HFLOPPY.SLOWFLG))
(* Didn't format *)
(GO RETRY)))
(SETQ STREAM (\PFLOPPY.OPENFILE FILENAME (QUOTE OUTPUT)
(QUOTE NEW)
OTHERINFO))
(SETQ \HFLOPPY.PAGENO 0)
(SETQ \HFLOPPY.PAGES (IQUOTIENT (IPLUS (CDR (ASSOC (QUOTE LENGTH)
OTHERINFO))
511)
512))
(COND
(OLDSTREAM (replace (FLOPPYSTREAM PFALLOC) of OLDSTREAM with (fetch
(FLOPPYSTREAM
PFALLOC)
of STREAM))
(replace (FLOPPYSTREAM PLPAGE) of OLDSTREAM with (fetch
(FLOPPYSTREAM
PLPAGE)
of STREAM))
(SETQ STREAM OLDSTREAM)))
(RETURN STREAM])
(\HFLOPPY.CLOSEFLOPPY
[LAMBDA (STREAM LASTFLOPPYFLG) (* kbr: "25-Feb-85 12:23")
(* The same as \PFLOPPY.CLOSEFILE but without
releasing STREAM. Called only by \HFLOPPY.WRITEPAGE.
*)
(PROG (PFALLOC PLPAGE PMPAGE NEXT NPMPAGE)
(COND
((EQ (\GETACCESS STREAM)
(QUOTE INPUT))
(RETURN))) (* At this point \HFLOPPY.PAGENO is the next page we
would write. *)
[\PFLOPPY.TRUNCATEFILE STREAM [COND
((NOT LASTFLOPPYFLG)
\HFLOPPY.MAXPAGES)
(T (IDIFFERENCE (fetch (STREAM EPAGE) of STREAM)
(ITIMES \HFLOPPY.MAXPAGES (SUB1
\HFLOPPY.FLOPPYNO]
(COND
((NOT LASTFLOPPYFLG)
0)
(T (fetch (STREAM EOFFSET) of STREAM]
(SETQ PFALLOC (fetch (FLOPPYSTREAM PFALLOC) of STREAM))
(SETQ PLPAGE (fetch (PFALLOC PLPAGE) of PFALLOC))
(replace (PLPAGE IWRITEDATE) of PLPAGE with \HFLOPPY.IWRITEDATE)
(replace (PLPAGE ICREATIONDATE) of PLPAGE with \HFLOPPY.IWRITEDATE)
(replace (PLPAGE HUGEPAGESTART) of PLPAGE with (ITIMES \HFLOPPY.MAXPAGES
(SUB1 \HFLOPPY.FLOPPYNO))
)
(replace (PLPAGE HUGEPAGELENGTH) of PLPAGE with \HFLOPPY.HUGEPAGELENGTH)
(replace (PLPAGE HUGELENGTH) of PLPAGE with \HFLOPPY.HUGELENGTH)
(\PFLOPPY.WRITEPAGENO (fetch (PFALLOC START) of PFALLOC)
PLPAGE)
(\PFLOPPY.SAVE.PFILELIST)
(\PFLOPPY.SAVE.PSECTOR9])
)
(* "SCAVENGE" *)
(RPAQ? \FLOPPY.SCAVENGE.IDATE NIL)
(DEFINEQ
(FLOPPY.SCAVENGE
[LAMBDA NIL (* kbr: "22-Jul-84 22:40")
(SETQ \FLOPPY.SCAVENGE.IDATE (IDATE))
(\PFLOPPY.SCAVENGE])
(\PFLOPPY.SCAVENGE
[LAMBDA NIL (* kbr: "22-Jul-84 22:40")
(PROG NIL
(\FLOPPY.UNCACHED.WRITE)
(COND
((NOT (\PFLOPPY.CONFIRM "Scavenge contents of floppy"))
(RETURN NIL)))
(\FLOPPY.CLOSE)
(\PFLOPPY.SCAVENGE.PMPAGES)
(\PFLOPPY.SCAVENGE.PLPAGES)
(\FLOPPY.CACHED.WRITE)
(\PFLOPPY.SCAVENGE.PSECTOR9)
(\PFLOPPY.SCAVENGE.PFILELIST)
(RETURN T])
(\PFLOPPY.SCAVENGE.PMPAGES
[LAMBDA NIL (* kbr: " 2-Sep-85 21:37")
(* Scavenge the marker pages.
*)
(PROG (LOCATION PMPAGE NPMPAGE)
(SETQ LOCATION \PFLOPPYFIRSTDATAPAGE)
(SETQ PMPAGE (\PFLOPPY.SCAVENGE.PMPAGEA))
(while (ILESSP LOCATION \PFLOPPYLASTDATAPAGE)
do (SETQ NPMPAGE (\PFLOPPY.SCAVENGE.PMPAGE.AFTER PMPAGE LOCATION))
(SETQ LOCATION (IPLUS LOCATION (fetch (PMPAGE NLENGTH) of PMPAGE)
1))
(SETQ PMPAGE NPMPAGE))
(\PFLOPPY.WRITEPAGENO \PFLOPPYLASTDATAPAGE PMPAGE])
(\PFLOPPY.SCAVENGE.PMPAGEA
[LAMBDA NIL (* kbr: "11-Sep-85 17:24")
(PROG (PMPAGE) (* Try to believe marker page A *)
(SETQ PMPAGE (NCREATE (QUOTE PMPAGE)))
RETRY
(COND
((NOT (\PFLOPPY.READPAGENO \PFLOPPYFIRSTDATAPAGE PMPAGE T))
(* Couldn't read this LOCATION.
Assume misformatted track. *)
(GLOBALRESOURCE \FLOPPY.IBMD512.FLOPPYIOCB (\FLOPPY.FORMATTRACKS
\FLOPPY.IBMD512.FLOPPYIOCB
(
\PFLOPPY.PAGENOTODISKADDRESS
LOCATION)
1 T))
(GO RETRY)))
(replace (PMPAGE SEAL) of PMPAGE with SEAL.PMPAGE)
(replace (PMPAGE VERSION) of PMPAGE with VERSION.PMPAGE)
(replace (PMPAGE PLENGTH) of PMPAGE with 0)
(replace (PMPAGE PTYPE) of PMPAGE with PMPAGEETYPE.FREE)
(replace (PMPAGE PFILETYPE) of PMPAGE with FILETYPE.FREE)
(replace (PMPAGE PFILEID) of PMPAGE with 0)
(RETURN PMPAGE])
(\PFLOPPY.SCAVENGE.PMPAGE.AFTER
[LAMBDA (PPMPAGE PLOCATION) (* kbr: " 2-Sep-85 23:30")
(* Come up with a plausible PMPAGE between
(ADD1 PLOCATION) and \PFLOPPYLASTDATAPAGE inclusive
where PPMPAGE at PLOCATION is the preceding marker
page. *)
(PROG (PMPAGE LOCATION)
(SETQ PMPAGE (NCREATE (QUOTE PMPAGE))) (* Hunt for first plausible PMPAGE after PPMPAGE.
Smash PMPAGE into correctness and make PPMPAGE tell
the new truth. *)
[for LOCATION from (ADD1 PLOCATION) to \PFLOPPYLASTDATAPAGE
do (PRIN1 "." T)
(COND
((EQ (IMOD LOCATION 20)
0)
(PRIN1 LOCATION T)))
(\PFLOPPY.SCAVENGE.PMPAGE.AFTER1 PLOCATION PPMPAGE LOCATION PMPAGE)
(COND
((fetch (PMPAGE INTACT) of PMPAGE)
(RETURN]
(RETURN PMPAGE])
(\PFLOPPY.SCAVENGE.PMPAGE.AFTER1
(LAMBDA (PLOCATION PPMPAGE LOCATION PMPAGE) (* edited: "23-Mar-86 20:05")
(PROG (TRIEDWRITING TRIEDFORMATTING OLDPAGES LENGTH TYPE FILETYPE FILEID)
RETRY
(COND
((NOT (\PFLOPPY.READPAGENO LOCATION PMPAGE T))
(* Couldn't read this LOCATION.
Assume misformatted track. *)
(COND
((NOT TRIEDWRITING)
(for I from 0 to 511 do (\PUTBASEBYTE PMPAGE I (CHARCODE " ")))
(\PFLOPPY.WRITEPAGENO LOCATION PMPAGE T)
(SETQ TRIEDWRITING T)
(GO RETRY))
((NOT TRIEDFORMATTING)
(GLOBALRESOURCE \FLOPPY.IBMD512.FLOPPYIOCB (SETQ DISKADDRESS (
\PFLOPPY.PAGENOTODISKADDRESS LOCATION))
(SETQ OLDPAGES (for SECTOR from 1 to
\FLOPPY.SECTORSPERTRACK
collect
(PROG (OLDPAGE)
(SETQ OLDPAGE (NCREATE
(QUOTE VMEMPAGEP)))
(\FLOPPY.READSECTOR
\FLOPPY.IBMD512.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ←
(fetch (DISKADDRESS
CYLINDER)
of DISKADDRESS)
HEAD ←
(fetch (DISKADDRESS
HEAD)
of DISKADDRESS)
SECTOR ← SECTOR)
OLDPAGE T)
(RETURN OLDPAGE))))
(* Since formatting is unreliable, repeat format twice
in a row. *)
(\FLOPPY.FORMATTRACKS \FLOPPY.IBMD512.FLOPPYIOCB DISKADDRESS 1
T)
(\FLOPPY.FORMATTRACKS \FLOPPY.IBMD512.FLOPPYIOCB DISKADDRESS 1
T)
(* Restore what we could salvage before reformatting.
*)
(for SECTOR from 1 to \FLOPPY.SECTORSPERTRACK as OLDPAGE
in OLDPAGES do (\FLOPPY.WRITESECTOR
\FLOPPY.IBMD512.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← (fetch
(DISKADDRESS CYLINDER)
of DISKADDRESS)
HEAD ← (fetch (DISKADDRESS
HEAD)
of DISKADDRESS)
SECTOR ← SECTOR)
OLDPAGE T)))
(SETQ TRIEDFORMATTING T)
(GO RETRY))
(T (\FLOPPY.MESSAGE (CONCAT "Couldn't read or reformat page " LOCATION))
(\FLOPPY.MESSAGE "User should not trust this floppy.")
(* At this point PMPAGE is blank.
*)
(RETURN PMPAGE)))))
(COND
((NOT (OR (fetch (PMPAGE INTACT) of PMPAGE)
(IEQP LOCATION \PFLOPPYLASTDATAPAGE)))
(RETURN))) (* Force PMPAGE to be a legal marker page.
*)
(replace (PMPAGE SEAL) of PMPAGE with SEAL.PMPAGE)
(replace (PMPAGE VERSION) of PMPAGE with VERSION.PMPAGE)
(SETQ LENGTH (IPLUS LOCATION (IMINUS PLOCATION)
-1))
(COND
((ZEROP LENGTH)
(SETQ TYPE PMPAGEETYPE.FREE)
(SETQ FILETYPE FILETYPE.FREE)
(SETQ FILEID 0))
(T (SETQ TYPE (fetch (PMPAGE NTYPE) of PPMPAGE))
(SETQ FILETYPE (fetch (PMPAGE NFILETYPE) of PPMPAGE))
(SETQ FILEID (COND
((EQ TYPE PMPAGEETYPE.PFILELIST)
1)
(T 0)))))
(replace (PMPAGE PLENGTH) of PMPAGE with LENGTH)
(replace (PMPAGE PTYPE) of PMPAGE with TYPE)
(replace (PMPAGE PFILETYPE) of PMPAGE with FILETYPE)
(replace (PMPAGE PFILEID) of PMPAGE with FILEID)
(* Fix PPMPAGE wrt PMPAGE now *)
(replace (PMPAGE NLENGTH) of PPMPAGE with LENGTH)
(replace (PMPAGE NTYPE) of PPMPAGE with TYPE)
(replace (PMPAGE NFILETYPE) of PPMPAGE with FILETYPE)
(replace (PMPAGE NFILEID) of PPMPAGE with FILEID)
(\PFLOPPY.WRITEPAGENO PLOCATION PPMPAGE))))
(\PFLOPPY.SCAVENGE.PLPAGES
[LAMBDA NIL (* kbr: " 8-Nov-85 11:16")
(* Scavenge the leader pages.
*)
(PROG (LOCATION NLOCATION PMPAGE NPMPAGE PLPAGE LENGTH START)
(SETQ LOCATION \PFLOPPYFIRSTDATAPAGE)
(SETQ PMPAGE (NCREATE (QUOTE PMPAGE)))
(SETQ NPMPAGE (NCREATE (QUOTE PMPAGE)))
(SETQ PLPAGE (create PLPAGE))
(\PFLOPPY.READPAGENO \PFLOPPYFIRSTDATAPAGE NPMPAGE)
(while (ILESSP LOCATION \PFLOPPYLASTDATAPAGE)
do (swap PMPAGE NPMPAGE)
(SETQ LENGTH (SUB1 (fetch (PMPAGE NLENGTH) of PMPAGE)))
(SETQ NLOCATION (IPLUS LOCATION (ADD1 LENGTH)
1))
(\PFLOPPY.READPAGENO NLOCATION NPMPAGE)
(COND
((AND (IGEQ LENGTH 0)
(OR (IEQP (fetch (PMPAGE NTYPE) of PMPAGE)
PMPAGEETYPE.FILE)
(IEQP (fetch (PMPAGE NTYPE) of PMPAGE)
PMPAGEETYPE.FREE)))
(SETQ START (ADD1 LOCATION))
(\PFLOPPY.READPAGENO START PLPAGE)
[COND
[(for I from 0 to 511 always (EQ (\GETBASEBYTE PLPAGE I)
(SELECTQ (MACHINETYPE)
(DANDELION
(CHARCODE @))
(DOVE 255)
NIL)))
(* Looks like we haven't written on this page since it
was formatted. Assume we are looking at a free block.
*)
(COND
((IEQP (fetch (PMPAGE NTYPE) of PMPAGE)
PMPAGEETYPE.FILE) (* Become a FREE block. *)
(replace (PMPAGE NTYPE) of PMPAGE with PMPAGEETYPE.FREE)
(replace (PMPAGE NFILETYPE) of PMPAGE with FILETYPE.FREE)
(replace (PMPAGE PTYPE) of NPMPAGE with PMPAGEETYPE.FREE)
(replace (PMPAGE PFILETYPE) of NPMPAGE with FILETYPE.FREE)
(\PFLOPPY.WRITEPAGENO LOCATION PMPAGE)
(\PFLOPPY.WRITEPAGENO NLOCATION NPMPAGE]
(T (* Assume there is a whole file or a partial file to
be recovered. *)
[COND
((fetch (PLPAGE INTACT) of PLPAGE)
(* Proper beginning of a whole or truncated file.
*)
[replace (PLPAGE HUGELENGTH) of PLPAGE
with (COND
((EQ (FOLDHI (fetch (PLPAGE HUGELENGTH)
of PLPAGE)
512)
LENGTH)
(* What we expect. Treat extra bytes on last page as
true garbage. *)
(fetch (PLPAGE HUGELENGTH) of PLPAGE))
(T (* Either HUGELENGTH is too big or too small for the
number of pages allotted, so make HUGELENGTH 512 x
pages allotted. *)
(ITIMES LENGTH 512]
(replace (PLPAGE PAGELENGTH) of PLPAGE with LENGTH)
(replace (PLPAGE HUGEPAGESTART) of PLPAGE with 0)
(replace (PLPAGE HUGEPAGELENGTH) of PLPAGE with LENGTH))
(T (* Front end of file gone. *)
(replace (PLPAGE \CREATIONDATE) of PLPAGE with
\FLOPPY.SCAVENGE.IDATE)
(replace (PLPAGE \WRITEDATE) of PLPAGE with
\FLOPPY.SCAVENGE.IDATE)
(replace (PLPAGE HUGELENGTH) of PLPAGE with (ITIMES LENGTH
512))
(replace (PLPAGE PAGELENGTH) of PLPAGE with LENGTH)
(replace (PLPAGE HUGEPAGESTART) of PLPAGE with 0)
(replace (PLPAGE HUGEPAGELENGTH) of PLPAGE with LENGTH)
(replace (PLPAGE $NAME) of PLPAGE with (GENSYM
(QUOTE OLDFILE]
(replace (PLPAGE SEAL) of PLPAGE with SEAL.PLPAGE)
(replace (PLPAGE VERSION) of PLPAGE with VERSION.PLPAGE)
(replace (PLPAGE MESATYPE) of PLPAGE with 65535)
(replace (PLPAGE NAMEMAXLENGTH) of PLPAGE with
NAMEMAXLENGTH.PLPAGE)
(replace (PLPAGE UFO1) of PLPAGE with 2)
(replace (PLPAGE UFO2) of PLPAGE with 187)
(replace (PLPAGE DATAVERSION) of PLPAGE with VERSION.DATA)
(replace (PLPAGE \TYPE) of PLPAGE with 1)
(COND
((IEQP (fetch (PMPAGE NTYPE) of PMPAGE)
PMPAGEETYPE.FREE) (* Become a FILE block. *)
(replace (PMPAGE NTYPE) of PMPAGE with PMPAGEETYPE.FILE)
(replace (PMPAGE NFILETYPE) of PMPAGE with FILETYPE.FILE)
(replace (PMPAGE PTYPE) of NPMPAGE with PMPAGEETYPE.FILE)
(replace (PMPAGE PFILETYPE) of NPMPAGE with FILETYPE.FILE)
(\PFLOPPY.WRITEPAGENO LOCATION PMPAGE)
(\PFLOPPY.WRITEPAGENO NLOCATION NPMPAGE]
(\PFLOPPY.WRITEPAGENO START PLPAGE)))
(SETQ LOCATION NLOCATION])
(\PFLOPPY.SCAVENGE.PSECTOR9
[LAMBDA NIL (* kbr: " 7-Aug-85 19:27")
(PROG (PSECTOR9 PFALLOC)
(SETQ PSECTOR9 (fetch (PFLOPPYFDEV PSECTOR9) of \FLOPPYFDEV))
(replace (PSECTOR9 SEAL) of PSECTOR9 with SEAL.PSECTOR9)
(replace (PSECTOR9 VERSION) of PSECTOR9 with VERSION.PSECTOR9)
(replace (PSECTOR9 CYLINDERS) of PSECTOR9 with \FLOPPY.CYLINDERS)
(replace (PSECTOR9 TRACKSPERCYLINDER) of PSECTOR9 with \FLOPPY.TRACKSPERCYLINDER)
(replace (PSECTOR9 SECTORSPERTRACK) of PSECTOR9 with \FLOPPY.SECTORSPERTRACK)
[SETQ PFALLOC (for P in (fetch (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV)
thereis (EQUAL (fetch (PFALLOC FILENAME) of P)
(QUOTE (PFILELIST]
(COND
((NULL PFALLOC)
(\FLOPPY.BREAK "Can't find PFILELIST")))
(replace (PSECTOR9 PFILELISTSTART) of PSECTOR9 with (fetch (PFALLOC START)
of PFALLOC))
(replace (PSECTOR9 PFILELISTFILEID) of PSECTOR9 with 1)
(replace (PSECTOR9 PFILELISTLENGTH) of PSECTOR9 with (fetch (PFALLOC LENGTH)
of PFALLOC))
(replace (PSECTOR9 ROOTFILEID) of PSECTOR9 with 0)
(replace (PSECTOR9 PILOTMICROCODE) of PSECTOR9 with 0)
(replace (PSECTOR9 DIAGNOSTICMICROCODE) of PSECTOR9 with 0)
(replace (PSECTOR9 GERM) of PSECTOR9 with 0)
(replace (PSECTOR9 PILOTBOOTFILE) of PSECTOR9 with 0)
(replace (PSECTOR9 FIRSTALTERNATESECTOR) of PSECTOR9 with 0)
(replace (PSECTOR9 COUNTBADSECTORS) of PSECTOR9 with 0)
(replace (PSECTOR9 CHANGING) of PSECTOR9 with 0)
(replace (PSECTOR9 \LABELLENGTH) of PSECTOR9 with (IMIN (fetch (PSECTOR9
\LABELLENGTH)
of PSECTOR9)
20))
(\PFLOPPY.SAVE.PSECTOR9])
(\PFLOPPY.SCAVENGE.PFILELIST
[LAMBDA NIL (* kbr: "22-Jul-84 22:40")
(PROG (PFILELIST)
(SETQ PFILELIST (fetch (PFLOPPYFDEV PFILELIST) of \FLOPPYFDEV))
(COND
((ILEQ (fetch (PFILELIST NENTRIES) of PFILELIST)
49)
(replace (PFILELIST MAXENTRIES) of PFILELIST with 49)))
(\PFLOPPY.SAVE.PFILELIST])
)
(* "COPY" *)
(DEFINEQ
(FLOPPY.TO.FILE
[LAMBDA (TOFILE) (* kbr: " 7-Aug-85 18:54")
(WITH.MONITOR \FLOPPYLOCK
(PROG (TOSTREAM PSECTOR9)
RETRY
(COND
((NOT (\FLOPPY.UNCACHED.READ))
(GO RETRY)))
[SETQ TOSTREAM (OPENSTREAM
TOFILE
(QUOTE OUTPUT)
(QUOTE NEW)
NIL
(LIST (LIST (QUOTE LENGTH)
(ITIMES (IPLUS 1 1 (ITIMES
\FLOPPY.TRACKSPERCYLINDER
\FLOPPY.SECTORSPERTRACK
(SUB1
\FLOPPY.CYLINDERS)))
512]
(* First page. *)
(PRIN1 "PILOT" TOSTREAM)
(for I from 6 to 512 do (\BOUT TOSTREAM 0))
(* PSECTOR9 page. *)
(GLOBALRESOURCE (\FLOPPY.SCRATCH.BUFFER \FLOPPY.IBMS128.FLOPPYIOCB)
(\FLOPPY.READSECTOR \FLOPPY.IBMS128.FLOPPYIOCB
(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 \PFLOPPYFIRSTDATAPAGE to
\PFLOPPYLASTDATAPAGE
do (\PFLOPPY.READPAGENO I \FLOPPY.SCRATCH.BUFFER)
(\BOUTS TOSTREAM \FLOPPY.SCRATCH.BUFFER 0 512)))
(CLOSEF TOSTREAM])
(FLOPPY.FROM.FILE
[LAMBDA (FROMFILE) (* edited: "12-Dec-85 16:54")
(WITH.MONITOR \FLOPPYLOCK
(PROG (FROMSTREAM PSECTOR9)
(SETQ FROMSTREAM (OPENSTREAM FROMFILE (QUOTE INPUT)
(QUOTE OLD)))
(* GODDAMN FILEIO *)
(SETFILEPTR FROMSTREAM 0)
RETRY
(COND
((NOT (IEQP (GETFILEINFO FROMSTREAM (QUOTE LENGTH))
(ITIMES (IPLUS 1 1 (ITIMES
\FLOPPY.TRACKSPERCYLINDER
\FLOPPY.SECTORSPERTRACK
(SUB1
\FLOPPY.CYLINDERS)))
512)))
(\FLOPPY.BREAK "Wrong length form FROMFILE")
(GO RETRY)))
(COND
((NOT (\FLOPPY.UNCACHED.WRITE))
(GO RETRY)))
(COND
((NOT (\PFLOPPY.FORMAT))
(GO RETRY))) (* Throw away first page. *)
(for I from 1 to 512 do (\BIN FROMSTREAM))
(* PSECTOR9 page. *)
(GLOBALRESOURCE (\FLOPPY.SCRATCH.BUFFER \FLOPPY.IBMS128.FLOPPYIOCB)
(\BINS FROMSTREAM \FLOPPY.SCRATCH.BUFFER 0 512)
(\FLOPPY.WRITESECTOR \FLOPPY.IBMS128.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 0
SECTOR ← 9)
\FLOPPY.SCRATCH.BUFFER))
(* Remaining pages. *)
(GLOBALRESOURCE \FLOPPY.SCRATCH.BUFFER
(for I from \PFLOPPYFIRSTDATAPAGE to
\PFLOPPYLASTDATAPAGE
do (\BINS FROMSTREAM \FLOPPY.SCRATCH.BUFFER 0 512)
(\PFLOPPY.WRITEPAGENO I \FLOPPY.SCRATCH.BUFFER)))
(CLOSEF FROMSTREAM])
)
(* "COMPACT" *)
(DEFINEQ
(FLOPPY.COMPACT
[LAMBDA NIL (* kbr: "22-Jul-84 22:34")
(WITH.MONITOR \FLOPPYLOCK (SELECTQ (FLOPPY.MODE)
((PILOT HUGEPILOT SYSOUT)
(\PFLOPPY.COMPACT))
(CPM (* Do nothing *)
NIL)
(SHOULDNT])
(\PFLOPPY.COMPACT
[LAMBDA NIL (* kbr: "18-Nov-85 11:25")
(WITH.MONITOR \FLOPPYLOCK (* COMPACT scattered free blocks into large free block
at end of floppy. *)
(PROG (PFINFO PFALLOCS)
(\FLOPPY.CACHED.WRITE) (* Confirmation. *)
(COND
((NOT (\PFLOPPY.CONFIRM "COMPACT contents of floppy" NIL T))
(RETURN NIL))) (* Trivial case = floppy is already COMPACT.
*)
(SETQ PFINFO (fetch (FDEV DEVICEINFO) of \FLOPPYFDEV))
(SETQ PFALLOCS (fetch (PFINFO PFALLOCS) of PFINFO))
(SELECT [for PFALLOC in PFALLOCS count (EQUAL
(fetch (PFALLOC FILENAME)
of PFALLOC)
(QUOTE (FREE]
(1 (RETURN T))
[2 (COND
((EQUAL [fetch (PFALLOC FILENAME)
of (fetch (PFALLOC PREV)
of (CAR (LAST PFALLOCS]
(QUOTE (FREE)))
(RETURN T] (* Need to COMPACT. *)
) (* Nontrivial case. *)
(\FLOPPY.MESSAGE "COMPACTing floppy")
(\PFLOPPY.COMPACT.PFALLOCS)
(\PFLOPPY.COMPACT.PSECTOR9)
(\PFLOPPY.COMPACT.PFILELIST)
(\FLOPPY.MESSAGE "Finished COMPACTing floppy")
(RETURN T])
(\PFLOPPY.COMPACT.PFALLOCS
[LAMBDA NIL (* kbr: " 7-Aug-85 18:46")
(PROG (PFINFO PREV NEXT NPMPAGE LAST)
(SETQ PFINFO (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 (PFINFO PFALLOCS) of PFINFO]
(SETQ NEXT (CAR (fetch (PFINFO PFALLOCS) of PFINFO)))
(while [NOT (EQUAL (fetch (PFALLOC FILENAME) of NEXT)
(QUOTE (FREE]
do (SETQ NEXT (fetch (PFALLOC NEXT) of NEXT)))
(SETQ PREV (fetch (PFALLOC PREV) of NEXT))
LOOP (* Get NEXT non free block.
*)
(while [AND NEXT (EQUAL (fetch (PFALLOC FILENAME) of NEXT)
(QUOTE (FREE]
do (SETQ NEXT (fetch (PFALLOC 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 PFILELIST block.
*)
(COND
((ILESSP (fetch (PFALLOC END) of PREV)
(SUB1 \PFLOPPYLASTDATAPAGE))
(* Create next to LAST free block.
*)
(SETQ NPMPAGE (create PMPAGE
SEAL ← SEAL.PMPAGE
VERSION ← VERSION.PMPAGE
PFILEID ←(fetch (PMPAGE NFILEID)
of (fetch (PFALLOC PMPAGE)
of PREV))
NLENGTH ←(IDIFFERENCE \PFLOPPYLASTDATAPAGE
(IPLUS (fetch (PFALLOC
END)
of PREV)
2))
NTYPE ← PMPAGEETYPE.FREE
NFILEID ← 0
NFILETYPE ← FILETYPE.FREE))
(SETQ NEXT (create PFALLOC
FILENAME ←(QUOTE (FREE))
START ←(IPLUS (fetch (PFALLOC END) of PREV)
2)
PMPAGE ← NPMPAGE
NEXT ← LAST))
(replace (PFALLOC PREV) of LAST with NEXT))
((IEQP (fetch (PFALLOC END) of PREV)
(SUB1 \PFLOPPYLASTDATAPAGE)) (* Zero length LAST block. *)
(SETQ NEXT LAST))
((IEQP (fetch (PFALLOC END) of PREV)
\PFLOPPYLASTDATAPAGE) (* No more blocks. *)
(GO EXIT))
(T (SHOULDNT]
(\PFLOPPY.COMPACT.PFALLOC PREV NEXT)
(SETQ PREV NEXT)
(SETQ NEXT (fetch (PFALLOC NEXT) of PREV))
(GO LOOP)
EXIT(replace (PFINFO PFALLOCS) of PFINFO with (DREVERSE (for (PFALLOC ← LAST)
by (fetch
(PFALLOC PREV)
of PFALLOC)
while PFALLOC
collect PFALLOC])
(\PFLOPPY.COMPACT.PFALLOC
[LAMBDA (PREV NEXT) (* kbr: " 1-Nov-85 17:21")
(* Smash NEXT PFALLOC start location and fields on NPMPAGE between PREV and NEXT. Write new NPMPAGE out to floppy.
Move contents of NEXT block. *)
(PROG (NPMPAGE NSTART PPMPAGE)
(SETQ NPMPAGE (fetch (PFALLOC PMPAGE) of NEXT))
(SETQ NSTART (fetch (PFALLOC START) of NEXT))
(replace (PFALLOC PREV) of NEXT with PREV)
(COND
(PREV (replace (PFALLOC NEXT) of PREV with NEXT)
(replace (PFALLOC START) of NEXT with (IPLUS (fetch (PFALLOC END)
of PREV)
2))
(SETQ PPMPAGE (fetch (PFALLOC PMPAGE) of PREV))
(replace (PMPAGE PLENGTH) of NPMPAGE with (fetch (PMPAGE NLENGTH)
of PPMPAGE))
(replace (PMPAGE PFILEID) of NPMPAGE with (fetch (PMPAGE NFILEID)
of PPMPAGE))
(replace (PMPAGE PTYPE) of NPMPAGE with (fetch (PMPAGE NTYPE)
of PPMPAGE))
(replace (PMPAGE PFILETYPE) of NPMPAGE with (fetch (PMPAGE NFILETYPE)
of PPMPAGE)))
(T (replace (PFALLOC START) of NEXT with (ADD1 \PFLOPPYFIRSTDATAPAGE))
(replace (PMPAGE PLENGTH) of NPMPAGE with 0)
(replace (PMPAGE PFILEID) of NPMPAGE with 0)
(replace (PMPAGE PTYPE) of NPMPAGE with PMPAGEETYPE.FREE)
(replace (PMPAGE PFILETYPE) of NPMPAGE with FILETYPE.FREE)))
[COND
((LITATOM (fetch (PFALLOC FILENAME) of NEXT))
(* Real file, not a file list or free block.
*)
(replace (PFLE START) of (fetch (PFALLOC PFLE) of NEXT)
with (fetch (PFALLOC START) of NEXT]
(\PFLOPPY.WRITEPAGENO (SUB1 (fetch (PFALLOC START) of NEXT))
NPMPAGE)
(COND
((EQUAL (fetch (PFALLOC FILENAME) of NEXT)
(QUOTE (FREE)))
(RETURN)))
(for I from 0 to (SUB1 (fetch (PFALLOC LENGTH) of NEXT))
do (\PFLOPPY.WRITEPAGENO (IPLUS (fetch (PFALLOC START) of NEXT)
I)
(\PFLOPPY.READPAGENO (IPLUS NSTART I)
\FLOPPY.SCRATCH.BUFFER])
(\PFLOPPY.COMPACT.PSECTOR9
[LAMBDA NIL (* kbr: "22-Jul-84 22:34")
(PROG (PFINFO PSECTOR9)
(SETQ PFINFO (fetch (FDEV DEVICEINFO) of \FLOPPYFDEV))
(SETQ PSECTOR9 (fetch (PFINFO PSECTOR9) of PFINFO))
[replace (PSECTOR9 PFILELISTSTART) of PSECTOR9
with (fetch (PFALLOC START) of (for PFALLOC in (fetch (PFINFO PFALLOCS)
of PFINFO)
thereis (EQUAL (fetch (PFALLOC FILENAME)
of PFALLOC)
(QUOTE (PFILELIST]
(\PFLOPPY.SAVE.PSECTOR9])
(\PFLOPPY.COMPACT.PFILELIST
[LAMBDA NIL (* kbr: "22-Jul-84 22:34")
(PROG (PFINFO PFILELIST)
(SETQ PFINFO (fetch (FDEV DEVICEINFO) of \FLOPPYFDEV))
(SETQ PFILELIST (fetch (PFINFO PFILELIST) of PFINFO))
(replace (PFILELIST NENTRIES) of PFILELIST with 0)
(for PFALLOC in (fetch (PFINFO PFALLOCS) of PFINFO)
when [NOT (EQUAL (fetch (PFALLOC FILENAME) of PFALLOC)
(QUOTE (FREE]
do (\PFLOPPY.ADD.TO.PFILELIST PFALLOC))
(\PFLOPPY.SAVE.PFILELIST])
)
(* "ARCHIVE" *)
(DEFINEQ
(FLOPPY.ARCHIVE
(LAMBDA (FILES NAME) (* kbr: "18-Jan-86 11:38")
(COND
((LITATOM FILES) (* Assume FILES is a directory pattern.
*)
(SETQ FILES (DIRECTORY FILES))))
(COND
((NULL NAME)
(SETQ NAME (QUOTE ARCHIVE))))
(PROG (NAME#I FLOPPYFILE SIZE FILE)
(for I from 1 while FILES
do (SETQ NAME#I (CONCAT NAME (QUOTE #)
I))
(printout T "Insert floppy " NAME#I T)
(FLOPPY.WAIT.FOR.FLOPPY (NOT (IEQP I 1)))
(FLOPPY.FORMAT NAME#I NIL T)
(while FILES
do (SETQ FILE (CAR FILES))
(SETQ SIZE (GETFILEINFO FILE (QUOTE SIZE)))
(COND
((ILESSP (FLOPPY.FREE.PAGES)
(IPLUS SIZE 50))
(* Go to next floppy *)
(RETURN)))
(SETQ FLOPPYFILE (UNPACKFILENAME FILE))
(LISTPUT FLOPPYFILE (QUOTE HOST)
(QUOTE FLOPPY))
(SETQ FLOPPYFILE (PACKFILENAME FLOPPYFILE))
(COPYFILE FILE FLOPPYFILE)
(pop FILES))))))
(FLOPPY.UNARCHIVE
(LAMBDA (HOST/DIRECTORY) (* kbr: "18-Jan-86 11:50")
(PROG (FLOPPYFILES NAME HOST DIRECTORY FILE)
(SETQ HOST/DIRECTORY (UNPACKFILENAME HOST/DIRECTORY))
(SETQ HOST (LISTGET HOST/DIRECTORY (QUOTE HOST)))
(SETQ DIRECTORY (LISTGET HOST/DIRECTORY (QUOTE DIRECTORY)))
(FLOPPY.WAIT.FOR.FLOPPY)
(SETQ NAME (FLOPPY.GET.NAME))
(printout T "Unarchiving floppy " NAME T)
(SETQ FLOPPYFILES (DIRECTORY (QUOTE {FLOPPY}*)))
(for FLOPPYFILE in FLOPPYFILES
do (SETQ FILE (UNPACKFILENAME FLOPPYFILE))
(LISTPUT FILE (QUOTE HOST)
HOST)
(COND
(DIRECTORY (LISTPUT FILE (QUOTE DIRECTORY)
DIRECTORY)))
(SETQ FILE (PACKFILENAME FILE))
(COPYFILE FLOPPYFILE FILE)))))
)
(* "CPM" *)
(DECLARE: EVAL@COMPILE
(RPAQQ CPMDELETEMARK 229)
(RPAQQ CPMFILEMARK 0)
(CONSTANTS (CPMDELETEMARK 229)
(CPMFILEMARK 0))
)
(RPAQ? \CFLOPPYINFO NIL)
(RPAQ? \CFLOPPYCALLOCS NIL)
(RPAQ? \CFLOPPYDIR NIL)
(RPAQ? \CFLOPPYFDEV NIL)
(RPAQ? \CFLOPPYDIRECTORY NIL)
(RPAQ? \CFLOPPYBLANKSECTOR NIL)
(RPAQ? \CFLOPPYSECTORMAP NIL)
(RPAQ? \CFLOPPYDISKMAP NIL)
(RPAQ? CPM.DIRECTORY.WINDOW NIL)
(/DECLAREDATATYPE (QUOTE CINFO)
(QUOTE (POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((CINFO 0 POINTER)
(CINFO 2 POINTER)
(CINFO 4 POINTER)
(CINFO 6 POINTER)
(CINFO 8 POINTER)))
(QUOTE 10))
(/DECLAREDATATYPE (QUOTE CALLOC)
(QUOTE (POINTER POINTER POINTER POINTER FLAG FLAG))
[QUOTE ((CALLOC 0 POINTER)
(CALLOC 2 POINTER)
(CALLOC 4 POINTER)
(CALLOC 6 POINTER)
(CALLOC 6 (FLAGBITS . 0))
(CALLOC 6 (FLAGBITS . 16]
(QUOTE 8))
(/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 FIXP))
(QUOTE ((FCB 0 (BITS . 7))
(FCB 0 (BITS . 135))
(FCB 1 (BITS . 7))
(FCB 1 (BITS . 135))
(FCB 2 (BITS . 7))
(FCB 2 (BITS . 135))
(FCB 3 (BITS . 7))
(FCB 3 (BITS . 135))
(FCB 4 (BITS . 7))
(FCB 4 (BITS . 135))
(FCB 5 (BITS . 7))
(FCB 5 (BITS . 135))
(FCB 6 (BITS . 7))
(FCB 6 (BITS . 135))
(FCB 7 (BITS . 7))
(FCB 7 (BITS . 135))
(FCB 8 (BITS . 7))
(FCB 8 (BITS . 135))
(FCB 9 (BITS . 7))
(FCB 9 (BITS . 135))
(FCB 10 (BITS . 7))
(FCB 10 (BITS . 135))
(FCB 11 (BITS . 7))
(FCB 11 (BITS . 135))
(FCB 12 (BITS . 7))
(FCB 12 (BITS . 135))
(FCB 13 (BITS . 7))
(FCB 13 (BITS . 135))
(FCB 14 (BITS . 7))
(FCB 14 (BITS . 135))
(FCB 15 (BITS . 7))
(FCB 15 (BITS . 135))
(FCB 16 FIXP)))
(QUOTE 18))
(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))
(CALLOCS (fetch (CINFO CALLOCS) of (fetch (FDEV DEVICEINFO) of DATUM))
(PROGN (replace (CINFO CALLOCS) of (fetch (FDEV DEVICEINFO)
of DATUM) with NEWVALUE)
(SETQ \CFLOPPYCALLOCS NEWVALUE)))
(DIR (fetch (CINFO DIR) of (fetch (FDEV DEVICEINFO) of DATUM))
(PROGN (replace (CINFO DIR) of (fetch (FDEV DEVICEINFO) of DATUM)
with NEWVALUE)
(SETQ \CFLOPPYDIR NEWVALUE)))
(FREEFCBS (fetch (CINFO FREEFCBS) of (fetch (FDEV DEVICEINFO) of DATUM))
(PROGN (replace (CINFO FREEFCBS) of (fetch (FDEV DEVICEINFO)
of DATUM) with NEWVALUE)
(SETQ \CFLOPPYFREEFCBS NEWVALUE)))
(FREEGROUPS (fetch (CINFO FREEGROUPS) of (fetch (FDEV DEVICEINFO)
of DATUM))
(PROGN (replace (CINFO FREEGROUPS) of (fetch (FDEV DEVICEINFO)
of DATUM) with NEWVALUE)
(SETQ \CFLOPPYFREEGROUPS NEWVALUE])
(DATATYPE CINFO (OPEN CALLOCS DIR FREEFCBS FREEGROUPS))
(DATATYPE CALLOC (FCBS FILENAME CHANGEDFCBS CHANGEDGROUPS (WRITEFLG FLAG)
(DELETEFLG FLAG))
[ACCESSFNS ((RECORDCOUNT (COND
[(fetch (CALLOC FCBS) of DATUM)
(* This isn't a file in the midst of
deletion *)
(IPLUS [ITIMES 128 (SUB1 (LENGTH (fetch (CALLOC FCBS)
of DATUM]
(fetch (FCB RECORDCOUNT)
of (CAR (LAST (fetch (CALLOC FCBS)
of DATUM]
(T 0)))
(GROUPCOUNT (IQUOTIENT (IPLUS (fetch (CALLOC RECORDCOUNT) of DATUM)
7)
8))
(GROUPS (PROG (ANSWER)
[for FCB in (fetch (CALLOC FCBS) of DATUM)
do (SETQ ANSWER (NCONC ANSWER (fetch (FCB GROUPS)
of FCB]
(RETURN ANSWER)))
(LENGTH (ITIMES 128 (fetch (CALLOC RECORDCOUNT) of DATUM)))
(PAGELENGTH (IQUOTIENT (IPLUS (fetch (CALLOC RECORDCOUNT) of DATUM)
3)
4])
(DATATYPE FCB ((ET BYTE)
(\NAME 8 BYTE)
(\EXTENSION 3 BYTE)
(EXTENT BYTE)
(\UNUSEDHI BYTE)
(\UNUSEDLO BYTE)
(RECORDCOUNT BYTE)
(\DISKMAP0 BYTE)
(\DISKMAP1 BYTE)
(\DISKMAP2 BYTE)
(\DISKMAP3 BYTE)
(\DISKMAP4 BYTE)
(\DISKMAP5 BYTE)
(\DISKMAP6 BYTE)
(\DISKMAP7 BYTE)
(\DISKMAP8 BYTE)
(\DISKMAP9 BYTE)
(\DISKMAP10 BYTE)
(\DISKMAP11 BYTE)
(\DISKMAP12 BYTE)
(\DISKMAP13 BYTE)
(\DISKMAP14 BYTE)
(\DISKMAP15 BYTE)
(NUMBER FIXP))
[ACCESSFNS ((FILENAME (\CFLOPPY.GET.FCB.FILENAME DATUM)
(\CFLOPPY.SET.FCB.FILENAME DATUM NEWVALUE))
[NAME (create STRINGP
BASE ← DATUM
LENGTH ← 8
OFFST ← 1)
(PROGN (RPLSTRING (fetch (FCB NAME) of DATUM)
1 " ")
(RPLSTRING (fetch (FCB NAME) of DATUM)
1
(OR (SUBSTRING NEWVALUE 1 (IMIN (NCHARS NEWVALUE)
8))
""]
[EXTENSION (create STRINGP
BASE ← DATUM
LENGTH ← 3
OFFST ← 9)
(PROGN (RPLSTRING (fetch (FCB EXTENSION) of DATUM)
1 " ")
(RPLSTRING (fetch (FCB EXTENSION) of DATUM)
1
(OR (SUBSTRING NEWVALUE 1 (IMIN (NCHARS NEWVALUE)
3))
""]
(UNUSED (IPLUS (ITIMES 256 (fetch (FCB \UNUSEDHI) of DATUM))
(fetch (FCB \UNUSEDLO) of DATUM)))
[GROUPCOUNT (COND
((EQ (fetch (FCB ET) of DATUM)
CPMDELETEMARK)
0)
(T (FOLDHI (fetch (FCB RECORDCOUNT) of DATUM)
8]
(GROUPS (for I from 0 to (SUB1 (fetch (FCB GROUPCOUNT) of DATUM))
collect (\GETBASEBYTE (fetch (FCB DISKMAP) of DATUM)
I)))
(DISKMAP (\ADDBASE (\DTEST DATUM (QUOTE FCB))
8))
(\VALUE DATUM (\BLT DATUM NEWVALUE 16])
(BLOCKRECORD @FCB ((ET BYTE)
(\NAME 8 BYTE)
(\EXTENSION 3 BYTE)
(EXTENT BYTE)
(\UNUSEDHI BYTE)
(\UNUSEDLO BYTE)
(RECORDCOUNT BYTE)
(\DISKMAP0 BYTE)
(\DISKMAP1 BYTE)
(\DISKMAP2 BYTE)
(\DISKMAP3 BYTE)
(\DISKMAP4 BYTE)
(\DISKMAP5 BYTE)
(\DISKMAP6 BYTE)
(\DISKMAP7 BYTE)
(\DISKMAP8 BYTE)
(\DISKMAP9 BYTE)
(\DISKMAP10 BYTE)
(\DISKMAP11 BYTE)
(\DISKMAP12 BYTE)
(\DISKMAP13 BYTE)
(\DISKMAP14 BYTE)
(\DISKMAP15 BYTE)
(NUMBER FIXP))
[ACCESSFNS ((FILENAME (\CFLOPPY.GET.FCB.FILENAME DATUM)
(\CFLOPPY.SET.FCB.FILENAME DATUM NEWVALUE))
[NAME (CREATE STRINGP
BASE ← DATUM
LENGTH ← 8
OFFST ← 1)
(PROGN (RPLSTRING (fetch (FCB NAME) of DATUM)
1 " ")
(RPLSTRING (fetch (FCB NAME) of DATUM)
1
(OR (SUBSTRING NEWVALUE 1 (IMIN (NCHARS NEWVALUE)
8))
""]
[EXTENSION (CREATE STRINGP
BASE ← DATUM
LENGTH ← 3
OFFST ← 9)
(PROGN (RPLSTRING (fetch (FCB EXTENSION) of DATUM)
1 " ")
(RPLSTRING (fetch (FCB EXTENSION) of DATUM)
1
(OR (SUBSTRING NEWVALUE 1 (IMIN (NCHARS NEWVALUE)
3))
""]
(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 POINTER POINTER POINTER))
(QUOTE ((CINFO 0 POINTER)
(CINFO 2 POINTER)
(CINFO 4 POINTER)
(CINFO 6 POINTER)
(CINFO 8 POINTER)))
(QUOTE 10))
(/DECLAREDATATYPE (QUOTE CALLOC)
(QUOTE (POINTER POINTER POINTER POINTER FLAG FLAG))
[QUOTE ((CALLOC 0 POINTER)
(CALLOC 2 POINTER)
(CALLOC 4 POINTER)
(CALLOC 6 POINTER)
(CALLOC 6 (FLAGBITS . 0))
(CALLOC 6 (FLAGBITS . 16]
(QUOTE 8))
(/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 FIXP))
(QUOTE ((FCB 0 (BITS . 7))
(FCB 0 (BITS . 135))
(FCB 1 (BITS . 7))
(FCB 1 (BITS . 135))
(FCB 2 (BITS . 7))
(FCB 2 (BITS . 135))
(FCB 3 (BITS . 7))
(FCB 3 (BITS . 135))
(FCB 4 (BITS . 7))
(FCB 4 (BITS . 135))
(FCB 5 (BITS . 7))
(FCB 5 (BITS . 135))
(FCB 6 (BITS . 7))
(FCB 6 (BITS . 135))
(FCB 7 (BITS . 7))
(FCB 7 (BITS . 135))
(FCB 8 (BITS . 7))
(FCB 8 (BITS . 135))
(FCB 9 (BITS . 7))
(FCB 9 (BITS . 135))
(FCB 10 (BITS . 7))
(FCB 10 (BITS . 135))
(FCB 11 (BITS . 7))
(FCB 11 (BITS . 135))
(FCB 12 (BITS . 7))
(FCB 12 (BITS . 135))
(FCB 13 (BITS . 7))
(FCB 13 (BITS . 135))
(FCB 14 (BITS . 7))
(FCB 14 (BITS . 135))
(FCB 15 (BITS . 7))
(FCB 15 (BITS . 135))
(FCB 16 FIXP)))
(QUOTE 18))
)
(DEFINEQ
(\CFLOPPY.GET.FCB.FILENAME
[LAMBDA (FCB) (* edited: "23-Jul-84 15:31")
(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)))
(SETQ NAME (OR (SUBSTRING NAME 1 POS)
""))
(SETQ POS (SUB1 (OR (STRPOS " " EXTENSION)
4)))
(SETQ EXTENSION (OR (SUBSTRING EXTENSION 1 POS)
""))
(SETQ FILENAME (PACK* NAME "." EXTENSION))
(RETURN FILENAME])
(\CFLOPPY.SET.FCB.FILENAME
[LAMBDA (FCB FILENAME) (* edited: "23-Jul-84 15:31")
(PROG (UNAME)
(SETQ UNAME (UNPACKFILENAME FILENAME))
(replace (FCB NAME) of FCB with (OR (LISTGET UNAME (QUOTE NAME))
""))
(replace (FCB EXTENSION) of FCB with (OR (LISTGET UNAME (QUOTE EXTENSION))
""])
(\CFLOPPY.INIT
[LAMBDA NIL (* hdj "15-May-86 20:49")
(PROG NIL
(SETQ \CFLOPPYDIRECTORY (\FLOPPY.BUFFER 4))
(SETQ \CFLOPPYSECTORMAP (ARRAY 26 (QUOTE BYTE)
0 0))
(SETQ \CFLOPPYDISKMAP (ARRAY 250 (QUOTE POINTER)
NIL 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 (\FLOPPY.BUFFER 1))
(for I from 0 to (SUB1 BYTESPERPAGE) do (* change all bytes on page to be the
cpm delete mark, 229)
(\PUTBASEBYTE \CFLOPPYBLANKSECTOR I 229))
(SETQ \CFLOPPYINFO (create CINFO))
(SETQ \CFLOPPYFDEV (create FDEV
DEVICENAME ← (QUOTE FLOPPY)
NODIRECTORIES ← T
CLOSEFILE ← (FUNCTION \CFLOPPY.CLOSEFILE)
DELETEFILE ← (FUNCTION \CFLOPPY.DELETEFILE)
DIRECTORYNAMEP ← (FUNCTION TRUE)
EVENTFN ← (FUNCTION \FLOPPY.EVENTFN)
GENERATEFILES ← (FUNCTION \CFLOPPY.GENERATEFILES)
GETFILEINFO ← (FUNCTION \CFLOPPY.GETFILEINFO)
GETFILENAME ← (FUNCTION \CFLOPPY.GETFILENAME)
HOSTNAMEP ← (FUNCTION \FLOPPY.HOSTNAMEP)
OPENFILE ← (FUNCTION \CFLOPPY.OPENFILE)
READPAGES ← (FUNCTION \CFLOPPY.READPAGES)
REOPENFILE ← (FUNCTION \CFLOPPY.OPENFILE)
SETFILEINFO ← (FUNCTION NILL)
TRUNCATEFILE ← (FUNCTION \CFLOPPY.TRUNCATEFILE)
WRITEPAGES ← (FUNCTION \CFLOPPY.WRITEPAGES)
DEVICEINFO ← \CFLOPPYINFO
RENAMEFILE ← (FUNCTION \CFLOPPY.RENAMEFILE)
REGISTERFILE ← (FUNCTION \ADD-OPEN-STREAM)))
(\MAKE.PMAP.DEVICE \CFLOPPYFDEV])
(\CFLOPPY.OPEN
[LAMBDA NIL (* edited: "23-Jul-84 15:31")
(* Assume floppy mounted. Cache directory info for
floppy if not already cached.
Return T or NIL. *)
(PROG NIL
(COND
((fetch (CFLOPPYFDEV OPEN) of \FLOPPYFDEV)
(* Already open *)
(RETURN T)))
(replace (CFLOPPYFDEV CALLOCS) of \FLOPPYFDEV with NIL)
(replace (CFLOPPYFDEV DIR) of \FLOPPYFDEV with NIL)
(\CFLOPPY.OPEN.DIRECTORY)
(replace (CFLOPPYFDEV OPEN) of \FLOPPYFDEV with T)
(RETURN T])
(\CFLOPPY.OPEN.DIRECTORY
[LAMBDA NIL (* edited: "23-Jul-84 15:31")
(PROG (FCB FREEFCBS FREEGROUPS FILENAME ALIST CALLOC CALLOCS)
(* Use \CFLOPPYDISKMAP to temporarily keep track of occupied groups while reading in FCBs. FREEFCBS will then be
calculated from \CFLOPPYDISKMAP. Groups 0 & 1 contain directory. *)
(SETA \CFLOPPYDISKMAP 0 T)
(SETA \CFLOPPYDISKMAP 1 T)
(for I from 2 to 249 do (SETA \CFLOPPYDISKMAP I NIL))
(* Read in FCBs. Calc FREEFCBS.
ALIST keeps track of which extents go with which
filenames. *)
[for I from 0 to 15 do (\CFLOPPY.READRECORDNO I (\ADDBASE \CFLOPPYDIRECTORY
(ITIMES I 64]
[for I from 0 to 63
do (SETQ FCB (create FCB
\VALUE ←(\ADDBASE \CFLOPPYDIRECTORY (ITIMES I 16))
NUMBER ← I))
(COND
((IEQP (fetch (FCB ET) of FCB)
CPMDELETEMARK)
(push FREEFCBS FCB))
(T (SETQ FILENAME (fetch (FCB FILENAME) of FCB))
[RPLACD (OR (ASSOC FILENAME ALIST)
(PROGN (push ALIST (LIST FILENAME))
(CAR ALIST)))
(CONS FCB (CDR (ASSOC FILENAME ALIST]
(for J from 0 to 15 do (SETA \CFLOPPYDISKMAP
(\GETBASEBYTE (fetch
(FCB DISKMAP)
of FCB)
J)
T]
(SETQ FREEFCBS (DREVERSE FREEFCBS)) (* Calc FREEGROUPS. *)
(SETQ FREEGROUPS (for I from 2 to 249 when (NOT (ELT \CFLOPPYDISKMAP I))
collect I)) (* Calc CALLOCS. *)
(for BUCKET in ALIST
do (SETQ FILENAME (CAR BUCKET))
(SETQ FCBS (CDR BUCKET))
[SORT FCBS (FUNCTION (LAMBDA (FCB1 FCB2)
(ILEQ (fetch (FCB EXTENT) of FCB1)
(fetch (FCB EXTENT) of FCB2]
(SETQ CALLOC (create CALLOC
FILENAME ← FILENAME
FCBS ← FCBS))
(push CALLOCS CALLOC))
[SETQ CALLOCS (SORT CALLOCS (FUNCTION (LAMBDA (CALLOC1 CALLOC2)
(ALPHORDER (fetch (CALLOC FILENAME) of CALLOC1)
(fetch (CALLOC FILENAME) of CALLOC2]
(* Store CALLOCS, FREEFCBS, & FREEGROUPS.
*)
(replace (CINFO CALLOCS) of \CFLOPPYINFO with CALLOCS)
(replace (CINFO FREEFCBS) of \CFLOPPYINFO with FREEFCBS)
(replace (CINFO FREEGROUPS) of \CFLOPPYINFO with FREEGROUPS)
(* 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 CALLOC in CALLOCS when (LITATOM (fetch (CALLOC FILENAME) of CALLOC))
do (\CFLOPPY.DIR.PUT (fetch (CALLOC FILENAME) of CALLOC)
(QUOTE OLD)
CALLOC])
(\CFLOPPY.OPENFILE
[LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* hdj "17-Jun-86 17:17")
(* * if file is open in conflicting way, barf)
(if (NOT (\FILE-CONFLICT (\RECOGNIZE-HACK FILE RECOG FDEV)
ACCESS FDEV))
then (OR (\SFLOPPY.HACK FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM)
(PROG (STREAM WAIT CALLOC FULLFILENAME)
(SETQ OTHERINFO (\FLOPPY.OTHERINFO OTHERINFO))
RETRY
(if (\FILE-CONFLICT (\RECOGNIZE-HACK FILE RECOG FDEV)
ACCESS FDEV)
then (RETURN NIL)) (* Get STREAM *)
(COND
([NULL (NLSETQ (SELECTQ ACCESS
(INPUT (\FLOPPY.CACHED.READ))
(\FLOPPY.CACHED.WRITE]
(LISPERROR "FILE WON'T OPEN" FILE)
(GO RETRY)))
(COND
((NOT (type? STREAM FILE))
(SETQ STREAM (\CFLOPPY.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 CALLOC (fetch (FLOPPYSTREAM CALLOC) 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 (\CFLOPPY.STREAMS.AGAINST STREAM) do (BLOCK))
(replace (CALLOC WRITEFLG) of CALLOC with T))
((fetch (CALLOC WRITEFLG) of CALLOC)
(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 (\CFLOPPY.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])
(\CFLOPPY.OPENFILE1
[LAMBDA (FILE RECOG OTHERINFO) (* kbr: "17-Jul-85 19:04")
(WITH.MONITOR \FLOPPYLOCK (PROG (FILENAME EXTENSION CALLOC FCB IDATE STREAM)
RETRY (* Case where old FILE is being opened for output or
appending to be written *)
(SETQ FILENAME (\FLOPPY.ASSUREFILENAME FILE))
(SETQ CALLOC (\CFLOPPY.DIR.GET FILENAME RECOG))
(SETQ STREAM (SELECTQ RECOG
[(EXACT OLD/NEW)
(COND
((NULL CALLOC)
(\CFLOPPY.OPENNEWFILE
FILENAME
OTHERINFO))
(T (\CFLOPPY.OPENOLDFILE CALLOC
OTHERINFO]
[NEW
(* CPM doesn't support version numbers.
*)
(COND
((NULL CALLOC)
(\CFLOPPY.OPENNEWFILE
FILENAME OTHERINFO]
((OLD OLDEST)
(\CFLOPPY.OPENOLDFILE CALLOC
OTHERINFO))
(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])
(\CFLOPPY.OPENOLDFILE
[LAMBDA (CALLOC OTHERINFO) (* kbr: "19-Jul-85 14:06")
(PROG (LENGTH RECORDCOUNT LASTRECORDNO EPAGE EOFFSET FCBS STREAM)
(COND
((NULL CALLOC) (* Error in calling function.
*)
(RETURN NIL)))
[COND
((EQ (CDR (ASSOC (QUOTE TYPE)
OTHERINFO))
(QUOTE BINARY)) (* File is binary, can't be sure ↑Zs are part of file
or are padding, so treat as if no padding.
*)
(SETQ LENGTH (fetch (CALLOC LENGTH) of CALLOC)))
(T
(* File is text. The convention is to pad files out with ↑Zs. Therefore, look in the last sector for a ↑Z to
indicate end of file. *)
(SETQ RECORDCOUNT (fetch (CALLOC RECORDCOUNT) of CALLOC))
(COND
((EQ RECORDCOUNT 0) (* There are no records. This is an empty file.
*)
(SETQ LENGTH 0))
(T (SETQ LASTRECORDNO (\CFLOPPY.PHYSICAL.RECORDNO CALLOC (SUB1 RECORDCOUNT)))
(\CFLOPPY.READRECORDNO LASTRECORDNO \FLOPPY.SCRATCH.BUFFER)
(SETQ LENGTH (IPLUS (ITIMES 128 (SUB1 RECORDCOUNT))
(for I from 0 to 127
when (EQ (\GETBASEBYTE \FLOPPY.SCRATCH.BUFFER
I)
(CHARCODE ↑Z))
do (RETURN I) finally (RETURN 128]
(SETQ EPAGE (IQUOTIENT LENGTH 512))
(SETQ EOFFSET (IREMAINDER LENGTH 512))
(SETQ FCBS (fetch (CALLOC FCBS) of CALLOC))
(SETQ STREAM (create STREAM
DEVICE ← \FLOPPYFDEV
FULLFILENAME ←(\FLOPPY.ADDDEVICENAME (fetch (CALLOC FILENAME)
of CALLOC))
EOLCONVENTION ← CRLF.EOLC
EPAGE ← EPAGE
EOFFSET ← EOFFSET))
(replace (FLOPPYSTREAM CALLOC) of STREAM with CALLOC)
(replace (FLOPPYSTREAM FCBS) of STREAM with FCBS)
(RETURN STREAM])
(\CFLOPPY.OPENNEWFILE
[LAMBDA (FILENAME OTHERINFO) (* kbr: "29-Apr-85 15:49")
(PROG (LENGTH CALLOC FCBS STREAM)
(SETQ LENGTH (CDR (ASSOC (QUOTE LENGTH)
OTHERINFO)))
[COND
(LENGTH (SETQ LENGTH (ADD1 (IQUOTIENT (IPLUS LENGTH 127)
128]
(SETQ CALLOC (\CFLOPPY.ALLOCATE LENGTH))
(SETQ FCBS (fetch (CALLOC FCBS) of CALLOC))
(\CFLOPPY.DIR.PUT FILENAME (QUOTE NEW)
CALLOC)
(for FCB in FCBS do (replace (FCB FILENAME) of FCB with FILENAME))
(* File is empty *)
(SETQ STREAM (create STREAM
DEVICE ← \FLOPPYFDEV
FULLFILENAME ←(\FLOPPY.ADDDEVICENAME (fetch (CALLOC FILENAME)
of CALLOC))
EOLCONVENTION ← CRLF.EOLC
EPAGE ← 0
EOFFSET ← 0))
(replace (FLOPPYSTREAM CALLOC) of STREAM with CALLOC)
(replace (FLOPPYSTREAM FCBS) of STREAM with FCBS)
(RETURN STREAM])
(\CFLOPPY.ASSURESTREAM
[LAMBDA (FILE) (* edited: "23-Jul-84 15:31")
(PROG (STREAM)
RETRY
(COND
((type? STREAM FILE)
(RETURN FILE)))
(SETQ STREAM (\CFLOPPY.OPENFILE1 FILE (QUOTE OLD)))
(COND
((NULL STREAM)
(SETQ FILE (LISPERROR "FILE NOT FOUND" FILE))
(GO RETRY)))
(RETURN STREAM])
(\CFLOPPY.GETFILEINFO
[LAMBDA (FILE ATTRIBUTE FDEV) (* kbr: "18-Jul-85 15:28")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM LP ANSWER)
[COND
((AND (EQ ATTRIBUTE (QUOTE LENGTH))
(type? STREAM FILE))
(RETURN (\GETEOFPTR FILE]
(\FLOPPY.CACHED.READ)
(SETQ STREAM (\CFLOPPY.ASSURESTREAM FILE))
[COND
(STREAM (SETQ CALLOC (fetch (FLOPPYSTREAM CALLOC)
of STREAM))
(SETQ ANSWER (\CFLOPPY.GETFILEINFO1 CALLOC
ATTRIBUTE]
(RETURN ANSWER])
(\CFLOPPY.GETFILEINFO1
[LAMBDA (CALLOC ATTRIBUTE) (* kbr: "18-Jul-85 15:30")
(* Used by \CFLOPPY.GETFILEINFO & \CFLOPPY.FILEINFOFN
*)
(PROG (ANSWER)
(SETQ ANSWER (SELECTQ ATTRIBUTE
(LENGTH
(* Don't know if file is supposed to be TEXT or BINARY if we are asked to determine LENGTH in this function instead
of \CFLOPPY.GETFILEINFO. We make a rough estimate, returning the value BINARY would return.
*)
(fetch (CALLOC LENGTH) of CALLOC))
(SIZE (fetch (CALLOC PAGELENGTH) of CALLOC))
NIL))
(RETURN ANSWER])
(\CFLOPPY.SETFILEINFO
[LAMBDA (FILE ATTRIBUTE VALUE) (* kbr: "29-Apr-85 16:13")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM SUCCESSFUL)
(\FLOPPY.CACHED.WRITE)
(SETQ STREAM (\CFLOPPY.ASSURESTREAM FILE))
[COND
(STREAM (SETQ SUCCESSFUL T)
(SELECTQ ATTRIBUTE
(EOL (replace (STREAM EOLCONVENTION)
of STREAM
with (SELECTQ VALUE
(CR CR.EOLC)
(CRLF CRLF.EOLC)
(LF LF.EOLC)
NIL)))
(SETQ SUCCESSFUL NIL]
(RETURN SUCCESSFUL])
(\CFLOPPY.CLOSEFILE
[LAMBDA (FILE) (* hdj " 8-May-86 16:04")
(WITH.MONITOR \FLOPPYLOCK (*)
(PROG (STREAM FULLFILENAME)
(SETQ STREAM (\CFLOPPY.ASSURESTREAM FILE))
(\CLEARMAP STREAM)
(SETQ FULLFILENAME (\CFLOPPY.CLOSEFILE1 STREAM))
(\DELETE-OPEN-STREAM STREAM (fetch (STREAM DEVICE) of STREAM))
(RETURN FULLFILENAME])
(\CFLOPPY.CLOSEFILE1
[LAMBDA (STREAM) (* hdj " 8-May-86 15:43")
(* The real CLOSEFILE.
*)
(* Part of \CFLOPPY.CLOSEFILE needed
to close subportions of huge files.
*)
(PROG (CALLOC MP NEXT NMP FULLFILENAME)
(SETQ CALLOC (fetch (FLOPPYSTREAM CALLOC) of STREAM))
(SETQ FULLFILENAME (fetch (STREAM FULLFILENAME) of STREAM))
(COND
((EQ (fetch (STREAM ACCESS) of STREAM)
(QUOTE INPUT))
(RETURN FULLFILENAME)))
(\CFLOPPY.SAVE.CHANGES CALLOC) (* Release STREAM. *)
(replace (CALLOC WRITEFLG) of CALLOC with NIL)
(RETURN FULLFILENAME])
(\CFLOPPY.DELETEFILE
[LAMBDA (FILE FDEV RECOG) (* hdj "23-Jun-86 15:11")
[COND
((NULL RECOG)
(SETQ RECOG (QUOTE OLDEST]
(WITH.MONITOR \FLOPPYLOCK (PROG (FILENAME CALLOC MP NEXT NMP FULLFILENAME)
(\CFLOPPY.OPEN)
(SETQ FILENAME (\FLOPPY.ASSUREFILENAME FILE))
(SETQ CALLOC (\CFLOPPY.DIR.GET FILENAME RECOG))
(COND
((OR (NULL CALLOC)
(FDEVOP (QUOTE OPENP)
FDEV FILENAME (QUOTE OLDEST)
FDEV)) (* File is open or not found.
*)
(* Returning NIL means unsuccessful.
*)
(RETURN NIL)))
(SETQ FULLFILENAME (\FLOPPY.ADDDEVICENAME (fetch (CALLOC FILENAME
)
of CALLOC)))
(COND
((FDEVOP (QUOTE OPENP)
FDEV FILE NIL FDEV)
(* file is open -
can't delete *)
(RETURN NIL))
(T (* Carry out deletion.
*)
(\CFLOPPY.DIR.REMOVE CALLOC)
(\CFLOPPY.DEALLOCATE CALLOC)
(\CFLOPPY.SAVE.CHANGES CALLOC)))
(RETURN FULLFILENAME])
(\CFLOPPY.GETFILENAME
[LAMBDA (FILE RECOG FDEV) (* edited: "23-Jul-84 15:31")
(WITH.MONITOR \FLOPPYLOCK (PROG (FILENAME CALLOC)
[COND
((type? STREAM FILE)
(RETURN (fetch (STREAM FULLFILENAME) of FILE]
[COND
((AND (\FLOPPY.EXISTSP)
(\FLOPPY.CACHED.READ))
(SETQ FILENAME (\FLOPPY.ASSUREFILENAME FILE))
(SETQ CALLOC (\CFLOPPY.DIR.GET FILENAME RECOG))
(COND
((NULL CALLOC)
(RETURN NIL)))
(RETURN (\FLOPPY.ADDDEVICENAME (fetch (CALLOC
FILENAME)
of CALLOC]
(* NIL is returned if there is no floppy.
*)
])
(\CFLOPPY.GENERATEFILES
[LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS) (* edited: "23-Jul-84 15:31")
(WITH.MONITOR \FLOPPYLOCK (PROG (ALLOCS FILTER GENFILESTATE FILEGENOBJ)
(* No floppy gives empty directory so that {FLOPPY}
can safely be on DIRECTORIES search path.
*)
[COND
((AND (\FLOPPY.EXISTSP)
(\FLOPPY.CACHED.READ))
(SETQ FILTER (DIRECTORY.MATCH.SETUP PATTERN))
(SETQ ALLOCS (for CALLOC in (fetch (CFLOPPYFDEV
CALLOCS)
of \FLOPPYFDEV)
when (AND (LITATOM
(fetch (CALLOC FILENAME)
of CALLOC))
(DIRECTORY.MATCH
FILTER
(fetch (CALLOC FILENAME)
of CALLOC)))
collect CALLOC]
[COND
((MEMB (QUOTE SORT)
OPTIONS)
(SORT ALLOCS (FUNCTION (LAMBDA (X Y)
(UALPHORDER (fetch (CALLOC FILENAME)
of X)
(fetch (CALLOC FILENAME)
of Y]
(SETQ GENFILESTATE (create GENFILESTATE
ALLOCS ← ALLOCS
DEVICENAME ←(fetch
(FDEV DEVICENAME)
of FDEV)))
(SETQ FILEGENOBJ (create FILEGENOBJ
NEXTFILEFN ←(FUNCTION
\CFLOPPY.NEXTFILEFN)
FILEINFOFN ←(FUNCTION
\CFLOPPY.FILEINFOFN)
GENFILESTATE ← GENFILESTATE))
(RETURN FILEGENOBJ])
(\CFLOPPY.NEXTFILEFN
[LAMBDA (GENFILESTATE NAMEONLY SCRATCHLIST) (* edited: "23-Jul-84 15:31")
(* Generates next file from GENFILESTATE or NIL if
finished. Used by \CFLOPPY.GENERATEFILES.
*)
(PROG (ALLOCS FILENAME DEVICENAME ANSWER)
(SETQ ALLOCS (fetch (GENFILESTATE ALLOCS) of GENFILESTATE))
(COND
((NULL ALLOCS)
(RETURN)))
(replace (GENFILESTATE CURRENTALLOC) of GENFILESTATE with (CAR ALLOCS))
(replace (GENFILESTATE ALLOCS) of GENFILESTATE with (CDR ALLOCS))
(SETQ FILENAME (fetch (CALLOC FILENAME) of (CAR ALLOCS)))
(SETQ DEVICENAME (fetch (GENFILESTATE DEVICENAME) of GENFILESTATE))
[COND
(NAMEONLY (SETQ ANSWER FILENAME))
(T (SETQ ANSWER (CONCAT "{" (fetch (GENFILESTATE DEVICENAME) of GENFILESTATE)
"}" FILENAME]
(RETURN ANSWER])
(\CFLOPPY.FILEINFOFN
[LAMBDA (GENFILESTATE ATTRIBUTE) (* edited: "23-Jul-84 15:31")
(* Get file info for current file in GENFILESTATE.
*)
(\CFLOPPY.GETFILEINFO1 (fetch (GENFILESTATE CURRENTALLOC) of GENFILESTATE)
ATTRIBUTE])
(\CFLOPPY.RENAMEFILE
[LAMBDA (OLDDEVICE OLDFILE NEWDEVICE NEWFILE OLDRECOG NEWRECOG)
(* hdj "23-Jun-86 16:52")
[COND
((NULL OLDRECOG)
(SETQ OLDRECOG (QUOTE OLD]
[COND
((NULL NEWRECOG)
(SETQ NEWRECOG (QUOTE NEW]
(WITH.MONITOR \FLOPPYLOCK (PROG (OLDFILENAME NEWFILENAME CALLOC FCBS FULLFILENAME)
(\FLOPPY.CACHED.READ)
(SETQ OLDFILENAME (\FLOPPY.ASSUREFILENAME OLDFILE))
(SETQ NEWFILENAME (\FLOPPY.ASSUREFILENAME NEWFILE))
(if (FDEVOP (QUOTE OPENP)
OLDDEVICE OLDFILENAME NIL OLDDEVICE)
then (RETURN))
(SETQ CALLOC (\CFLOPPY.DIR.GET OLDFILENAME OLDRECOG))
(COND
((OR (NULL CALLOC)
(FDEVOP (QUOTE OPENP)
OLDDEVICE OLDFILENAME (QUOTE OLD)
OLDDEVICE))
(* File is open or not found.
*)
(* Returning NIL means unsuccessful.
*)
(RETURN NIL)))
(\CFLOPPY.DIR.REMOVE CALLOC)
(* Store NEWFILENAME on FCBS.
*)
(\CFLOPPY.DIR.PUT NEWFILENAME NEWRECOG CALLOC)
(for FCB in (fetch (CALLOC FCBS) of CALLOC)
do (replace (FCB FILENAME) of FCB with NEWFILENAME))
(replace (CALLOC CHANGEDFCBS) of CALLOC
with (UNION (fetch (CALLOC CHANGEDFCBS) of CALLOC)
(fetch (CALLOC FCBS) of CALLOC)))
(* Write changes out to floppy.
*)
(\CFLOPPY.SAVE.CHANGES CALLOC)
(* Return FULLFILENAME.
*)
(SETQ FULLFILENAME (\FLOPPY.ADDDEVICENAME (fetch (CALLOC FILENAME
)
of CALLOC)))
(RETURN FULLFILENAME])
(\CFLOPPY.STREAMS.AGAINST
[LAMBDA (STREAM) (* hdj " 5-Jun-86 12:56")
(* Return other open floppy streams
with same CALLOC. *)
(for F in (\DEVICE-OPEN-STREAMS \FLOPPYFDEV) when (AND (EQ (fetch (FLOPPYSTREAM CALLOC)
of F)
(fetch (FLOPPYSTREAM CALLOC)
of STREAM))
(NOT (EQ F STREAM))) collect F])
(\CFLOPPY.STREAMS.USING
[LAMBDA (CALLOC) (* hdj " 5-Jun-86 12:57")
(* Return open floppy streams with
this CALLOC. *)
(for F in (\DEVICE-OPEN-STREAMS \FLOPPYFDEV) when (EQ (fetch (FLOPPYSTREAM CALLOC) of F)
CALLOC) collect F])
(\CFLOPPY.READPAGES
[LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* edited: "23-Jul-84 15:31")
(PROG NIL
(for BUFFER in (MKLIST BUFFERS) as I from 0 do (\CFLOPPY.READPAGE
STREAM
(IPLUS FIRSTPAGE# I)
BUFFER])
(\CFLOPPY.READPAGE
[LAMBDA (FILE FIRSTPAGE# BUFFER) (* kbr: "19-Jul-85 17:56")
[WITH.MONITOR \FLOPPYLOCK (PROG (STREAM CALLOC RECORDNO)
(SETQ STREAM (\CFLOPPY.ASSURESTREAM FILE))
(SETQ CALLOC (fetch (FLOPPYSTREAM CALLOC) of STREAM))
(COND
((IGREATERP FIRSTPAGE# (FOLDLO (SUB1 (\GETEOFPTR STREAM)
)
BYTESPERPAGE))
(* Don't bother to do actual read.
*)
(COND
((IGEQ FIRSTPAGE# (fetch (CALLOC PAGELENGTH)
of CALLOC))
(* Typically (because of lisp page buffering) we will try to write to RECORDNO in the very near future.
It's easier for the user to confront FILE SYSTEM RESOURCES EXCEEDED if we reallocate now instead of later.
*)
(\CFLOPPY.EXTEND CALLOC)))
(RETURN)))
(SETQ RECORDNO (\CFLOPPY.PHYSICAL.RECORDNO CALLOC
(ITIMES 4
FIRSTPAGE#)))
(for I from 0 to 3 do (\CFLOPPY.READRECORDNO
(IPLUS RECORDNO I)
(\ADDBASE BUFFER
(ITIMES 64 I]
(BLOCK])
(\CFLOPPY.PHYSICAL.RECORDNO
[LAMBDA (CALLOC N) (* kbr: "19-Jul-85 17:31")
(* Return the Nth physical RECORDNO of CALLOC.
0th is first. *)
(PROG (FCBS FCB GROUP RECORDNO)
(SETQ FCBS (fetch (CALLOC FCBS) of CALLOC))
[SETQ FCB (CAR (NTH FCBS (ADD1 (IQUOTIENT N 128]
(SETQ N (IREMAINDER N 128))
(SETQ GROUP (\GETBASEBYTE (fetch (FCB DISKMAP) of FCB)
(IQUOTIENT N 8)))
(COND
((EQ GROUP 0) (* Didn't find a legal group.
*)
(SHOULDNT)))
(SETQ RECORDNO (IPLUS (ITIMES 8 GROUP)
(IREMAINDER N 8)))
(RETURN RECORDNO])
(\CFLOPPY.READRECORDNO
[LAMBDA (RECORDNO RECORD NOERROR) (* edited: "23-Jul-84 15:31")
(PROG (ANSWER) (* Read RECORD. *)
[GLOBALRESOURCE \FLOPPY.IBMS128.FLOPPYIOCB (SETQ ANSWER (COND
((OR (ILESSP RECORDNO 0)
(IGREATERP RECORDNO 4003))
(\FLOPPY.SEVERE.ERROR "Illegal Read RECORD Number")
NIL)
(T (\FLOPPY.READSECTOR \FLOPPY.IBMS128.FLOPPYIOCB (
\CFLOPPY.RECORDNOTODISKADDRESS RECORDNO)
RECORD NOERROR]
(* Return ANSWER (RECORD or NIL) *)
(RETURN ANSWER])
(\CFLOPPY.WRITERECORDNO
[LAMBDA (RECORDNO RECORD NOERROR) (* edited: "23-Jul-84 15:31")
(PROG (ANSWER) (* Write RECORD. *)
[GLOBALRESOURCE \FLOPPY.IBMS128.FLOPPYIOCB (SETQ ANSWER (COND
((OR (ILESSP RECORDNO 0)
(IGREATERP RECORDNO 4003))
(\FLOPPY.SEVERE.ERROR "Illegal Write RECORD Number")
NIL)
(T (\FLOPPY.WRITESECTOR \FLOPPY.IBMS128.FLOPPYIOCB (
\CFLOPPY.RECORDNOTODISKADDRESS RECORDNO)
RECORD NOERROR]
(* Return ANSWER (RECORD or NIL) *)
(RETURN ANSWER])
(\CFLOPPY.RECORDNOTODISKADDRESS
[LAMBDA (RECORDNO) (* edited: "23-Jul-84 15:31")
(PROG (CPMSECTORSPERTRACK CPMTRACKSPERCYLINDER QUOTIENT CYLINDER HEAD SECTOR DISKADDRESS)
(SETQ CPMSECTORSPERTRACK 26)
(SETQ CPMTRACKSPERCYLINDER 1)
(SETQ SECTOR (ELT \CFLOPPYSECTORMAP (IREMAINDER RECORDNO CPMSECTORSPERTRACK)))
(SETQ QUOTIENT (IQUOTIENT RECORDNO 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.DIR.GET
[LAMBDA (FILENAME RECOG) (* edited: "23-Jul-84 15:31")
(PROG (UNAME NALIST EALIST NAME EXTENSION CALLOC)
[COND
[(NOT (EQ RECOG (QUOTE EXACT)))
(SETQ UNAME (UNPACKFILENAME FILENAME))
(SETQ NAME (LISTGET UNAME (QUOTE NAME)))
(SETQ EXTENSION (LISTGET UNAME (QUOTE EXTENSION)))
[SETQ NAME (SUBATOM NAME 1 (IMIN 8 (NCHARS NAME]
[SETQ EXTENSION (SUBATOM EXTENSION 1 (IMIN 3 (NCHARS EXTENSION]
(SETQ NAME (U-CASE NAME))
(SETQ EXTENSION (U-CASE EXTENSION))
(SETQ NALIST (fetch (CFLOPPYFDEV DIR) of \FLOPPYFDEV))
(SETQ EALIST (CDR (ASSOC NAME NALIST)))
(SETQ CALLOC (CDR (ASSOC EXTENSION EALIST]
(T (SETQ CALLOC (for CALLOC in (fetch (CFLOPPYFDEV CALLOCS) of \FLOPPYFDEV)
thereis (EQ (fetch (CALLOC FILENAME) of CALLOC)
FILENAME]
(RETURN CALLOC])
(\CFLOPPY.DIR.PUT
[LAMBDA (FILENAME RECOG CALLOC) (* edited: "23-Jul-84 15:31")
(PROG (UNAME NALIST EALIST NAME EXTENSION)
(SETQ UNAME (UNPACKFILENAME FILENAME))
(SETQ NAME (LISTGET UNAME (QUOTE NAME)))
(SETQ EXTENSION (LISTGET UNAME (QUOTE EXTENSION)))
[SETQ NAME (SUBATOM NAME 1 (IMIN 8 (NCHARS NAME]
[SETQ EXTENSION (SUBATOM EXTENSION 1 (IMIN 3 (NCHARS EXTENSION]
(LISTPUT UNAME (QUOTE NAME)
NAME)
(LISTPUT UNAME (QUOTE EXTENSION)
EXTENSION)
(LISTPUT UNAME (QUOTE VERSION)
NIL)
(LISTPUT UNAME (QUOTE HOST)
NIL)
(SETQ FILENAME (PACKFILENAME UNAME))
(SETQ NAME (U-CASE NAME))
(SETQ EXTENSION (U-CASE EXTENSION))
(replace (CALLOC FILENAME) of CALLOC with FILENAME)
(SETQ NALIST (fetch (CFLOPPYFDEV DIR) of \FLOPPYFDEV))
(SETQ EALIST (CDR (ASSOC NAME NALIST)))
(SETQ EALIST (\FLOPPY.LEXPUTASSOC EXTENSION CALLOC EALIST))
(SETQ NALIST (\FLOPPY.LEXPUTASSOC NAME EALIST NALIST))
(replace (CFLOPPYFDEV DIR) of \FLOPPYFDEV with NALIST)
(RETURN CALLOC])
(\CFLOPPY.DIR.REMOVE
[LAMBDA (CALLOC) (* edited: "23-Jul-84 15:31")
(PROG (FILENAME UNAME NALIST EALIST NAME EXTENSION)
(SETQ FILENAME (fetch (CALLOC FILENAME) of CALLOC))
(SETQ UNAME (UNPACKFILENAME FILENAME))
(SETQ NAME (LISTGET UNAME (QUOTE NAME)))
(SETQ EXTENSION (LISTGET UNAME (QUOTE EXTENSION)))
[SETQ NAME (SUBATOM NAME 1 (IMIN 8 (NCHARS NAME]
[SETQ EXTENSION (SUBATOM EXTENSION 1 (IMIN 3 (NCHARS EXTENSION]
(SETQ NAME (U-CASE NAME))
(SETQ EXTENSION (U-CASE EXTENSION))
(SETQ NALIST (fetch (CFLOPPYFDEV DIR) of \FLOPPYFDEV))
(SETQ EALIST (CDR (ASSOC NAME NALIST)))
(SETQ EALIST (\FLOPPY.LEXREMOVEASSOC EXTENSION EALIST))
[COND
(EALIST (SETQ NALIST (\FLOPPY.LEXPUTASSOC NAME EALIST NALIST)))
(T (SETQ NALIST (\FLOPPY.LEXREMOVEASSOC NAME NALIST]
(replace (CFLOPPYFDEV DIR) of \FLOPPYFDEV with NALIST)
(RETURN CALLOC])
(\CFLOPPY.WRITEPAGES
[LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* edited: "23-Jul-84 15:31")
(PROG NIL
(for BUFFER in (MKLIST BUFFERS) as I from 0 do (\CFLOPPY.WRITEPAGE
STREAM
(IPLUS FIRSTPAGE# I)
BUFFER])
(\CFLOPPY.WRITEPAGE
[LAMBDA (FILE FIRSTPAGE# BUFFER) (* edited: "23-Jul-84 15:32")
[WITH.MONITOR \FLOPPYLOCK (PROG (STREAM CALLOC RECORDNO)
(SETQ STREAM (\CFLOPPY.ASSURESTREAM FILE))
(* Put in a check to see that we have not exceeded our
allocation. *)
(SETQ CALLOC (fetch (FLOPPYSTREAM CALLOC) of STREAM))
RETRY
(COND
((IGREATERP FIRSTPAGE# (fetch (CALLOC PAGELENGTH)
of CALLOC))
(\CFLOPPY.EXTEND CALLOC)
(GO RETRY)))
(SETQ RECORDNO (\CFLOPPY.PHYSICAL.RECORDNO CALLOC
(ITIMES 4
FIRSTPAGE#)))
(for I from 0 to 3 do (\CFLOPPY.WRITERECORDNO
(IPLUS RECORDNO I)
(\ADDBASE BUFFER
(ITIMES 64 I]
(BLOCK])
(\CFLOPPY.TRUNCATEFILE
[LAMBDA (FILE LASTPAGE LASTPOFFSET) (* kbr: "19-Jul-85 17:57")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM CALLOC NRECORDS LASTRECORD LASTROFFSET)
(SETQ STREAM (\CFLOPPY.ASSURESTREAM FILE))
(* Split CALLOC 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 LASTPOFFSET (fetch (STREAM EOFFSET) of STREAM]
(SETQ CALLOC (fetch (FLOPPYSTREAM CALLOC) of STREAM))
(* Convert remaining pages into free block.
*)
(SETQ LASTROFFSET (IREMAINDER LASTPOFFSET 128))
[COND
[(ZEROP LASTROFFSET)
(* Special case LASTROFFSET = 0 *)
(SETQ NRECORDS (IPLUS (ITIMES 4 LASTPAGE)
(IQUOTIENT LASTPOFFSET 128]
(T (* Pad out with ↑Zs. *)
[SETQ NRECORDS (ADD1 (IPLUS (ITIMES 4 LASTPAGE)
(IQUOTIENT LASTPOFFSET
128]
(SETQ LASTRECORD (\CFLOPPY.PHYSICAL.RECORDNO
CALLOC
(SUB1 NRECORDS)))
(GLOBALRESOURCE \FLOPPY.SCRATCH.BUFFER (
\CFLOPPY.READRECORDNO LASTRECORD
\FLOPPY.SCRATCH.BUFFER)
(for I from LASTROFFSET to 127
do (\PUTBASEBYTE
\FLOPPY.SCRATCH.BUFFER I
(CHARCODE ↑Z)))
(\CFLOPPY.WRITERECORDNO LASTRECORD
\FLOPPY.SCRATCH.BUFFER]
(\CFLOPPY.TRUNCATE CALLOC NRECORDS])
(\CFLOPPY.ALLOCATE.FCB
[LAMBDA NIL (* edited: "23-Jul-84 15:32")
(PROG (FREEFCBS FCB)
RETRY
(SETQ FREEFCBS (fetch (CINFO FREEFCBS) of \CFLOPPYINFO))
(COND
((NULL FREEFCBS)
(LISPERROR "FILE SYSTEM RESOURCES EXCEEDED")
(GO RETRY)))
(SETQ FCB (CAR FREEFCBS))
(replace (CINFO FREEFCBS) of \CFLOPPYINFO with (CDR FREEFCBS))
(* NAME & EXTENSION become blanks.
Rest of FCB--not including NUMBER--is zeroed.
*)
(replace (FCB ET) of FCB with CPMFILEMARK)
(for I from 1 to 12 do (\PUTBASEBYTE FCB I (CHARCODE SP)))
(for I from 13 to 32 do (\PUTBASEBYTE FCB I 0))
(RETURN FCB])
(\CFLOPPY.ALLOCATE.GROUP
[LAMBDA NIL (* edited: "23-Jul-84 15:32")
(PROG (FREEGROUPS GROUP)
RETRY
(SETQ FREEGROUPS (fetch (CINFO FREEGROUPS) of \CFLOPPYINFO))
(COND
((NULL FREEGROUPS)
(LISPERROR "FILE SYSTEM RESOURCES EXCEEDED")
(GO RETRY)))
(SETQ GROUP (CAR FREEGROUPS))
(replace (CINFO FREEGROUPS) of \CFLOPPYINFO with (CDR FREEGROUPS))
(RETURN GROUP])
(\CFLOPPY.ALLOCATE
[LAMBDA (NRECORDS) (* kbr: "19-Jul-85 16:06")
(COND
((NULL NRECORDS)
(SETQ NRECORDS 8)))
(PROG (NFCBS NGROUPS FCBS GROUPS CALLOC) (* Get sufficient numbers of FCBS & GROUPS for the
allocation. Always at least one FCB even if no groups.
*)
(* FCB = directory entry. Group = group of pages on
floppy. *)
(SETQ NGROUPS (IQUOTIENT (IPLUS NRECORDS 7)
8))
(SETQ NFCBS (IMAX 1 (IQUOTIENT (IPLUS NGROUPS 15)
16)))
RETRY
(COND
((OR (ILESSP (LENGTH (fetch (CINFO FREEFCBS) of \CFLOPPYINFO))
NFCBS)
(ILESSP (LENGTH (fetch (CINFO FREEGROUPS) of \CFLOPPYINFO))
NGROUPS))
(LISPERROR "FILE SYSTEM RESOURCES EXCEEDED")
(GO RETRY)))
(UNINTERRUPTABLY
(SETQ FCBS (for I from 1 to NFCBS collect (\CFLOPPY.ALLOCATE.FCB)))
(SETQ GROUPS (for I from 1 to NGROUPS collect (\CFLOPPY.ALLOCATE.GROUP)))
(* Fill in fields of FCBS. *)
[for FCB in FCBS as EXTENT from 0
do (replace (FCB EXTENT) of FCB with EXTENT)
[COND
((NOT (IEQP EXTENT (SUB1 NFCBS)))
(replace (FCB RECORDCOUNT) of FCB with 128))
(T (replace (FCB RECORDCOUNT) of FCB with (IDIFFERENCE
NRECORDS
(ITIMES 128
(SUB1 NFCBS]
(for (DMINDEX ← 0) to 15 while GROUPS
do (\PUTBASEBYTE (fetch (FCB DISKMAP) of FCB)
DMINDEX
(pop GROUPS]
(* Create CALLOC. *)
(SETQ CALLOC (create CALLOC
FCBS ← FCBS
CHANGEDFCBS ← FCBS))
(replace (CINFO CALLOCS) of \CFLOPPYINFO with (CONS CALLOC
(fetch (CINFO CALLOCS)
of \CFLOPPYINFO))))
(* OKEY DOKEY. *)
(\CFLOPPY.ICHECK)
(RETURN CALLOC])
(\CFLOPPY.TRUNCATE
[LAMBDA (CALLOC NRECORDS) (* kbr: "19-Jul-85 17:22")
(PROG (OLDNGROUPS NGROUPS NFCBS FREEFCBS FREEGROUPS CHANGEDFCBS CHANGEDGROUPS)
(COND
((ILEQ (fetch (CALLOC RECORDCOUNT) of CALLOC)
NRECORDS) (* Nothing to do. *)
(RETURN)))
(UNINTERRUPTABLY
(SETQ OLDNGROUPS (FOLDHI (fetch (CALLOC RECORDCOUNT) of CALLOC)
8))
(SETQ NGROUPS (FOLDHI NRECORDS 8))
(SETQ NFCBS (FOLDHI NGROUPS 16))
(SETQ FREEFCBS (fetch (CINFO FREEFCBS) of \CFLOPPYINFO))
(SETQ FREEGROUPS (fetch (CINFO FREEGROUPS) of \CFLOPPYINFO))
(* Mark existing FCBs. *)
[for FCB in (fetch (CALLOC FCBS) of CALLOC) as I from 1
do (COND
((ILESSP I NFCBS) (* No changes to this FCB. *)
)
((IEQP I NFCBS)
[replace (FCB RECORDCOUNT) of FCB with (IDIFFERENCE
NRECORDS
(ITIMES 128
(SUB1 NFCBS]
(push CHANGEDFCBS FCB))
(T (COND
((IGREATERP I 1)
(* I = 1 implies empty file, but we never delete first FCB, even if it is empty. Otherwise an empty file would mean
no file. *)
(replace (FCB ET) of FCB with CPMDELETEMARK)
(push FREEFCBS FCB)))
(push CHANGEDFCBS FCB)))
(for DMINDEX from 0 to 15
when (AND (IGEQ (IPLUS (ITIMES 16 (SUB1 I))
DMINDEX)
NGROUPS)
(ILEQ (IPLUS (ITIMES 16 (SUB1 I))
DMINDEX)
(SUB1 OLDNGROUPS)))
do (push CHANGEDGROUPS (\GETBASEBYTE (fetch (FCB DISKMAP)
of FCB)
I]
(* Update CALLOC. *)
(RPLACD (NTH (fetch (CALLOC FCBS) of CALLOC)
(IMAX 1 NFCBS))
NIL)
(replace (CALLOC CHANGEDFCBS) of CALLOC with (UNION CHANGEDFCBS
(fetch (CALLOC
CHANGEDFCBS)
of CALLOC)))
(replace (CALLOC CHANGEDGROUPS) of CALLOC with (UNION CHANGEDGROUPS
(fetch (CALLOC
CHANGEDGROUPS)
of CALLOC))))
(* Update floppy. *)
(\CFLOPPY.SAVE.CHANGES CALLOC])
(\CFLOPPY.DEALLOCATE
[LAMBDA (CALLOC) (* kbr: "13-Sep-85 16:36")
(PROG (FCBS) (* FCB = directory entry. Group = group of pages on
floppy. *)
(SETQ FCBS (fetch (CALLOC FCBS) of CALLOC))
(UNINTERRUPTABLY
(replace (CALLOC CHANGEDFCBS) of CALLOC with FCBS)
(replace (CALLOC CHANGEDGROUPS) of CALLOC with (fetch (CALLOC GROUPS)
of CALLOC))
(* Changing FCBS of CALLOC to NIL changes ACCESSFN
GROUPS to NIL. *)
(replace (CALLOC FCBS) of CALLOC with NIL)
(replace (CINFO CALLOCS) of \CFLOPPYINFO with (DREMOVE CALLOC
(fetch (CINFO
CALLOCS)
of \CFLOPPYINFO)))
)
(\CFLOPPY.ICHECK])
(\CFLOPPY.EXTEND
[LAMBDA (CALLOC) (* edited: "23-Jul-84 15:32")
(PROG (FCB GROUP RECORDCOUNT DMINDEX)
[SETQ FCB (CAR (LAST (fetch (CALLOC FCBS) of CALLOC]
(SETQ RECORDCOUNT (fetch (FCB RECORDCOUNT) of FCB))
(* Adding fcbs. *)
[COND
((IEQP RECORDCOUNT 128) (* FCB full. Get a new one.
*)
(SETQ FCB (\CFLOPPY.ALLOCATE.FCB))
(replace (FCB FILENAME) of FCB with (fetch (CALLOC FILENAME) of CALLOC))
(replace (FCB EXTENT) of FCB with (LENGTH (fetch (CALLOC FCBS)
of CALLOC)))
(replace (FCB RECORDCOUNT) of FCB with 0)
(SETQ RECORDCOUNT 0)
(replace (CALLOC FCBS) of CALLOC with (NCONC (fetch (CALLOC FCBS)
of CALLOC)
(LIST FCB]
(* Adding records or groups.
DMINDEX = current Disk Map INDEX.
*)
(SETQ DMINDEX (SUB1 (IQUOTIENT (IPLUS RECORDCOUNT 7)
8)))
[COND
[(NOT (IEQP (IREMAINDER RECORDCOUNT 8)
0)) (* Add records by using remainder of last group.
*)
(replace (FCB RECORDCOUNT) of FCB with (ITIMES 8 (ADD1 DMINDEX]
(T (* Add a group. *)
(SETQ GROUP (\CFLOPPY.ALLOCATE.GROUP))
(\PUTBASEBYTE (fetch (FCB DISKMAP) of FCB)
(ADD1 DMINDEX)
GROUP)
(replace (FCB RECORDCOUNT) of FCB with (ITIMES 8 (IPLUS 2 DMINDEX]
(* Remember changed FCB. *)
(COND
((NOT (MEMB FCB (fetch (CALLOC CHANGEDFCBS) of CALLOC)))
(replace (CALLOC CHANGEDFCBS) of CALLOC with (CONS FCB (fetch (CALLOC
CHANGEDFCBS)
of CALLOC])
(\CFLOPPY.SAVE.CHANGES
[LAMBDA (CALLOC) (* kbr: "13-Sep-85 16:37")
(PROG (FREEFCBS FREEGROUPS RECORDNO RECORDNOS) (* Determine new FREEFCBS & FREEGROUPS for
\CFLOPPYINFO. Calc which directory records need to be
rewritten. *)
(\FLOPPY.CACHED.WRITE)
(UNINTERRUPTABLY
(SETQ FREEFCBS (fetch (CINFO FREEFCBS) of \CFLOPPYINFO))
(SETQ FREEGROUPS (fetch (CINFO FREEGROUPS) of \CFLOPPYINFO))
[for FCB in (fetch (CALLOC CHANGEDFCBS) of CALLOC)
do [COND
((fetch (CALLOC DELETEFLG) of CALLOC)
(replace (CINFO FREEFCBS) of \CFLOPPYINFO with (SETQ FREEFCBS
(CONS FCB
FREEFCBS)))
(replace (CINFO FREEGROUPS) of \CFLOPPYINFO
with (SETQ FREEGROUPS (NCONC (fetch (FCB GROUPS) of FCB)
FREEGROUPS)))
(for I from 0 to 31 do (\PUTBASEBYTE FCB I CPMDELETEMARK]
(\BLT (\ADDBASE \CFLOPPYDIRECTORY (ITIMES 16 (fetch (FCB NUMBER)
of FCB)))
FCB 16)
(SETQ RECORDNO (IQUOTIENT (fetch (FCB NUMBER) of FCB)
4))
(COND
((NOT (FMEMB RECORDNO RECORDNOS))
(push RECORDNOS RECORDNO] (* Write out changed directory records *)
(for RECORDNO in RECORDNOS do (\CFLOPPY.WRITERECORDNO RECORDNO
(\ADDBASE
\CFLOPPYDIRECTORY
(ITIMES 64 RECORDNO)
)
T))
(* Update CALLOC & \CFLOPPYINFO *)
(replace (CALLOC CHANGEDFCBS) of CALLOC with NIL)
(replace (CALLOC CHANGEDGROUPS) of CALLOC with NIL)
(replace (CINFO FREEFCBS) of \CFLOPPYINFO with FREEFCBS)
(replace (CINFO FREEGROUPS) of \CFLOPPYINFO with FREEGROUPS))
(\CFLOPPY.ICHECK])
(\CFLOPPY.ICHECK
[LAMBDA NIL (* hdj " 5-Jun-86 12:55")
(* Integrity check. *)
(PROG (USEDFCBS USEDGROUPS FREEFCBS FREEGROUPS FCBS GROUPS)
(* Check each CALLOC for
plausibleness. Groups 0 & 1 contain
directory. *)
(SETQ USEDGROUPS (QUOTE (0 1)))
(for CALLOC in (fetch (CFLOPPYFDEV CALLOCS) of \FLOPPYFDEV)
do (\CFLOPPY.ICHECK.CALLOC CALLOC)
(SETQ USEDFCBS (APPEND (fetch (CALLOC FCBS) of CALLOC)
USEDFCBS))
(SETQ USEDGROUPS (APPEND (fetch (CALLOC GROUPS) of CALLOC)
USEDGROUPS))) (* Check that we have accounted for
all GROUPS and FCBS *)
(SETQ FREEFCBS (fetch (CFLOPPYFDEV FREEFCBS) of \FLOPPYFDEV))
(SETQ FREEGROUPS (fetch (CFLOPPYFDEV FREEGROUPS) of \FLOPPYFDEV))
(COND
((INTERSECTION USEDFCBS FREEFCBS)
(\FLOPPY.SEVERE.ERROR "USEDFCBS & FREEFCBS intersect")))
(COND
((INTERSECTION USEDGROUPS FREEGROUPS)
(\FLOPPY.SEVERE.ERROR "USEDGROUPS & FREEGROUPS intersect")))
(SETQ FCBS (APPEND FREEFCBS USEDFCBS))
(SETQ GROUPS (APPEND FREEGROUPS USEDGROUPS))
(COND
((NOT (ILEQ (LENGTH FCBS)
64))
(\FLOPPY.SEVERE.ERROR "Wrong number of FCBS")))
(COND
((NOT (ILEQ (LENGTH GROUPS)
250))
(\FLOPPY.SEVERE.ERROR "Wrong number of GROUPS")))
(* Check FLOPPY streams ok *)
(for F in (\DEVICE-OPEN-STREAMS \FLOPPYFDEV) when (NOT (MEMB (fetch (FLOPPYSTREAM CALLOC)
of F)
(fetch (CFLOPPYFDEV CALLOCS)
of \FLOPPYFDEV)))
do (\FLOPPY.SEVERE.ERROR "Streams Allocation Error"])
(\CFLOPPY.ICHECK.CALLOC
[LAMBDA (CALLOC) (* kbr: "19-Jul-85 15:56")
(* CALLOC Integrity Check *)
(PROG NIL
(for I from 1 as FCB in (fetch (CALLOC FCBS) of CALLOC)
when [NOT (IEQP I (ADD1 (fetch (FCB EXTENT) of FCB] do (
\FLOPPY.SEVERE.ERROR
"Unexpected FCB extent number"))
(COND
((OR (INTERSECTION (QUOTE (0 1))
(fetch (CALLOC GROUPS) of CALLOC))
(INTERSECTION (QUOTE (0 1))
(fetch (CALLOC CHANGEDGROUPS) of CALLOC)))
(\FLOPPY.SEVERE.ERROR "Unexpected group number"])
(\CFLOPPY.FREE.PAGES
[LAMBDA NIL (* edited: "23-Jul-84 15:32")
(WITH.MONITOR \FLOPPYLOCK (PROG (ANSWER)
(\FLOPPY.CACHED.READ)
[SETQ ANSWER (ITIMES 2 (LENGTH (fetch (CINFO FREEGROUPS)
of \CFLOPPYINFO]
(RETURN ANSWER])
(\CFLOPPY.FORMAT
[LAMBDA (NAME AUTOCONFIRMFLG SLOWFLG) (* kbr: "13-Sep-85 16:55")
(WITH.MONITOR \FLOPPYLOCK
(PROG NIL
(\FLOPPY.CLOSE)
RETRY
(COND
((NOT (\FLOPPY.UNCACHED.WRITE))
(GO RETRY))) (* Configure floppy. *)
[COND
(SLOWFLG (GLOBALRESOURCE
\FLOPPY.IBMS128.FLOPPYIOCB
(* Format tracks. *)
(COND
([NOT (AND (\FLOPPY.INITIALIZE T)
(\FLOPPY.RECALIBRATE T)
(\FLOPPY.FORMATTRACKS
\FLOPPY.IBMS128.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ←
0
HEAD ← 0
SECTOR ← 1)
\FLOPPY.CYLINDERS T)
(OR (NOT (\FLOPPY.TWOSIDEDP T))
(AND (\FLOPPY.RECALIBRATE T)
(\FLOPPY.FORMATTRACKS
\FLOPPY.IBMS128.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 1
SECTOR ← 1)
\FLOPPY.CYLINDERS T]
(GO RETRY)))
(* Check that we can read from each cylinder. We need to do this because FORMATTRACKS is unreliable.
If we find a bad cylinder, it usually works to try again a few times. *)
(COND
((for I from 0 to (SUB1 \FLOPPY.CYLINDERS)
thereis (NULL (\FLOPPY.READSECTOR
\FLOPPY.IBMS128.FLOPPYIOCB
(create
DISKADDRESS
CYLINDER ← I
HEAD ←
0
SECTOR
← 1)
\FLOPPY.SCRATCH.BUFFER T)))
(GO RETRY]
(for I from 0 to 15 do (COND
((NULL (\CFLOPPY.WRITERECORDNO I
\CFLOPPYBLANKSECTOR T))
(* Unsuccessful write. *)
(SETQ SLOWFLG T)
(GO RETRY])
(CPM.DIRECTORY
[LAMBDA NIL (* edited: "23-Jul-84 15:32")
(PROG (H W FONT @FCB)
(COND
[(NULL CPM.DIRECTORY.WINDOW)
(SETQ FONT (FONTCREATE (QUOTE GACHA)
8))
(SETQ H (HEIGHTIFWINDOW (ITIMES (FONTPROP FONT (QUOTE HEIGHT))
64)
T))
[SETQ W (WIDTHIFWINDOW (ITIMES (STRINGWIDTH "A" FONT)
(IPLUS 2 1 12 1 1 1 2 1 3 64]
(SETQ CPM.DIRECTORY.WINDOW (CREATEW (GETBOXREGION W H)
"CPM DIRECTORY WINDOW"))
(DSPFONT FONT CPM.DIRECTORY.WINDOW)
(WINDOWPROP CPM.DIRECTORY.WINDOW (QUOTE REPAINTFN)
(QUOTE (CPM.DIRECTORY]
(T (OPENW CPM.DIRECTORY.WINDOW)))
(CLEARW CPM.DIRECTORY.WINDOW)
(for I from 0 to 63
do (SETQ @FCB (\ADDBASE \CFLOPPYDIRECTORY (ITIMES 16 I)))
(printout CPM.DIRECTORY.WINDOW .I2 I .TAB0 3
(COND
((IEQP (CHCON1 (fetch (@FCB FILENAME) of @FCB))
CPMDELETEMARK)
"********.***")
(T (fetch (@FCB FILENAME) of @FCB)))
.TAB0 16 (SELECT (fetch (@FCB ET) of @FCB)
(CPMDELETEMARK " ")
(CPMFILEMARK "F")
"?")
.I3
(fetch (@FCB EXTENT) of @FCB)
.I4
(fetch (@FCB RECORDCOUNT) of @FCB)
.I4
(fetch (@FCB \DISKMAP0) of @FCB)
.I4
(fetch (@FCB \DISKMAP1) of @FCB)
.I4
(fetch (@FCB \DISKMAP2) of @FCB)
.I4
(fetch (@FCB \DISKMAP3) of @FCB)
.I4
(fetch (@FCB \DISKMAP4) of @FCB)
.I4
(fetch (@FCB \DISKMAP5) of @FCB)
.I4
(fetch (@FCB \DISKMAP6) of @FCB)
.I4
(fetch (@FCB \DISKMAP7) of @FCB)
.I4
(fetch (@FCB \DISKMAP8) of @FCB)
.I4
(fetch (@FCB \DISKMAP9) of @FCB)
.I4
(fetch (@FCB \DISKMAP10) of @FCB)
.I4
(fetch (@FCB \DISKMAP11) of @FCB)
.I4
(fetch (@FCB \DISKMAP12) of @FCB)
.I4
(fetch (@FCB \DISKMAP13) of @FCB)
.I4
(fetch (@FCB \DISKMAP14) of @FCB)
.I4
(fetch (@FCB \DISKMAP15) of @FCB])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \FLOPPY.DEBUG \FLOPPY.INSPECTW \FLOPPYFDEV \FLOPPYLOCK \FLOPPYIOCBADDR \FLOPPYIOCB
\FLOPPYRESULT \FLOPPY.MODE.BEFORE.EVENT \PFLOPPYPSECTOR9 \PFLOPPYPFILELIST \PFLOPPYINFO
\PFLOPPYFDEV \FLOPPY.ALLOCATIONS.BITMAP \SFLOPPYINFO \SFLOPPYFDEV \HFLOPPY.MAXPAGES
\SFLOPPY.PAGENO \SFLOPPY.FLOPPYNO \SFLOPPY.HUGELENGTH \SFLOPPY.HUGEPAGELENGTH
\SFLOPPY.IWRITEDATE \SFLOPPY.FILENAME \SFLOPPY.RECOG \SFLOPPY.FLOPPYNAME \SFLOPPY.SLOWFLG
\HFLOPPYINFO \HFLOPPYFDEV \HFLOPPY.MAXPAGES \HFLOPPY.PAGENO \HFLOPPY.FLOPPYNO
\HFLOPPY.HUGELENGTH \HFLOPPY.HUGEPAGELENGTH \HFLOPPY.IWRITEDATE \HFLOPPY.RECOG
\HFLOPPY.FILENAME \HFLOPPY.SLOWFLG \FLOPPY.SCAVENGE.IDATE \CFLOPPYINFO \CFLOPPYCALLOCS
\CFLOPPYDIR \CFLOPPYFDEV \CFLOPPYDIRECTORY \CFLOPPYBLANKSECTOR \CFLOPPYSECTORMAP
\CFLOPPYDISKMAP CPM.DIRECTORY.WINDOW)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(FLOPPY.RESTART)
)
(PUTPROPS FLOPPY COPYRIGHT ("Xerox Corporation" 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (104730 107839 (\FLOPPY.TRANSLATEFLOPPYRESULT 104740 . 105499) (\FLOPPY.SEVERE.ERROR
105501 . 105901) (\FLOPPY.TRANSLATEPMPAGEETYPE 105903 . 106265) (\FLOPPY.TRANSLATEFILETYPE 106267 .
106849) (\FLOPPY.MTL.FIXP 106851 . 107082) (\FLOPPY.LTM.FIXP 107084 . 107315) (\FLOPPY.MTL.IDATE
107317 . 107576) (\FLOPPY.LTM.IDATE 107578 . 107837)) (108569 137776 (\FLOPPY.TRANSLATESETUP 108579 .
109036) (\FLOPPY.SETUP.IOCB 109038 . 110572) (\FLOPPY.CHECK.FLOPPYIOCB 110574 . 114395) (
\FLOPPY.DENSITY 114397 . 114665) (\FLOPPY.SECTORLENGTH 114667 . 114981) (\FLOPPY.ENCODEDSECTORLENGTH
114983 . 115308) (\FLOPPY.GAP3 115310 . 115620) (\FLOPPY.SECTORSPERTRACK 115622 . 115939) (\FLOPPY.RUN
115941 . 120060) (\FLOPPY.ERROR 120062 . 121236) (\FLOPPY.LOCK.BUFFER 121238 . 122269) (
\FLOPPY.UNLOCK.BUFFER 122271 . 122822) (\FLOPPY.PREPAREFORCRASH 122824 . 123355) (\FLOPPY.COMMAND
123357 . 124093) (\FLOPPY.INITIALIZE 124095 . 124785) (\FLOPPY.NOP 124787 . 125024) (
\FLOPPY.RECALIBRATE 125026 . 125405) (\FLOPPY.RECOVER 125407 . 125663) (\FLOPPY.TRANSFER 125665 .
129221) (\FLOPPY.READSECTOR 129223 . 129422) (\FLOPPY.WRITESECTOR 129424 . 129625) (
\FLOPPY.FORMATTRACKS 129627 . 131297) (\FLOPPY.DISKCHANGECLEAR 131299 . 131563) (\FLOPPY.MOUNTEDP
131565 . 134317) (\FLOPPY.CAN.READP 134319 . 134515) (\FLOPPY.CAN.WRITEP 134517 . 134751) (
\FLOPPY.WRITEABLEP 134753 . 135658) (\FLOPPY.TWOSIDEDP 135660 . 136403) (\FLOPPY.DUMP 136405 . 137100)
(\FLOPPY.DEBUG 137102 . 137774)) (140261 157014 (FLOPPY.RESTART 140271 . 141132) (FLOPPY.MODE 141134
. 143027) (\FLOPPY.SETUP.HARDWARE 143029 . 145054) (\FLOPPY.EVENTFN 145056 . 145635) (
\FLOPPY.HOSTNAMEP 145637 . 145949) (\FLOPPY.ADDDEVICENAME 145951 . 146317) (\FLOPPY.ASSUREFILENAME
146319 . 147490) (\FLOPPY.OTHERINFO 147492 . 148003) (\FLOPPY.LEXASSOC 148005 . 148370) (
\FLOPPY.LEXPUTASSOC 148372 . 149467) (\FLOPPY.LEXREMOVEASSOC 149469 . 150263) (\FLOPPY.CACHED.READ
150265 . 150937) (\FLOPPY.CACHED.WRITE 150939 . 151867) (\FLOPPY.OPEN 151869 . 152161) (\FLOPPY.CLOSE
152163 . 153071) (\FLOPPY.FLUSH 153073 . 154320) (\FLOPPY.UNCACHED.READ 154322 . 155099) (
\FLOPPY.UNCACHED.WRITE 155101 . 155880) (\FLOPPY.EXISTSP 155882 . 156299) (\FLOPPY.BREAK 156301 .
156596) (\FLOPPY.MESSAGE 156598 . 156900) (\FLOPPY.BUFFER 156902 . 157012)) (161206 232614 (
\PFLOPPY.INIT 161216 . 162954) (\PFLOPPY.OPEN 162956 . 163912) (\PFLOPPY.OPEN.PSECTOR9 163914 . 164306
) (\PFLOPPY.GET.PSECTOR9 164308 . 165159) (\PFLOPPY.OPEN.PFILELIST 165161 . 167888) (\PFLOPPY.DAMAGED
167890 . 168189) (\PFLOPPY.OPENFILE 168191 . 171968) (\PFLOPPY.OPENFILE1 171970 . 173431) (
\PFLOPPY.OPENOLDFILE 173433 . 174342) (\PFLOPPY.OPENNEWFILE 174344 . 175867) (\PFLOPPY.ASSURESTREAM
175869 . 176300) (\PFLOPPY.GETFILEINFO 176302 . 176806) (\PFLOPPY.GETFILEINFO1 176808 . 178190) (
\PFLOPPY.SETFILEINFO 178192 . 180545) (\PFLOPPY.CLOSEFILE 180547 . 181071) (\PFLOPPY.CLOSEFILE1 181073
. 183602) (\PFLOPPY.DELETEFILE 183604 . 185983) (\PFLOPPY.GENERATEFILES 185985 . 191035) (
\PFLOPPY.NEXTFILEFN 191037 . 192088) (\PFLOPPY.FILEINFOFN 192090 . 192455) (\PFLOPPY.RENAMEFILE 192457
. 195487) (\PFLOPPY.STREAMS.AGAINST 195489 . 196262) (\PFLOPPY.STREAMS.USING 196264 . 196766) (
\PFLOPPY.READPAGES 196768 . 197074) (\PFLOPPY.READPAGE 197076 . 198221) (\PFLOPPY.READPAGENO 198223 .
198922) (\PFLOPPY.WRITEPAGENO 198924 . 199629) (\PFLOPPY.PAGENOTODISKADDRESS 199631 . 200310) (
\PFLOPPY.DISKADDRESSTOPAGENO 200312 . 200813) (\PFLOPPY.DIR.GET 200815 . 202154) (\PFLOPPY.DIR.PUT
202156 . 203751) (\PFLOPPY.DIR.REMOVE 203753 . 205275) (\PFLOPPY.DIR.VERSION 205277 . 206532) (
\PFLOPPY.GETFILENAME 206534 . 208833) (\PFLOPPY.CREATE.PFILELIST 208835 . 209542) (
\PFLOPPY.ADD.TO.PFILELIST 209544 . 213585) (\PFLOPPY.DELETE.FROM.PFILELIST 213587 . 215013) (
\PFLOPPY.SAVE.PFILELIST 215015 . 215587) (\PFLOPPY.SAVE.PSECTOR9 215589 . 216021) (\PFLOPPY.WRITEPAGES
216023 . 216331) (\PFLOPPY.WRITEPAGE 216333 . 217147) (\PFLOPPY.TRUNCATEFILE 217149 . 218727) (
\PFLOPPY.FORMAT 218729 . 230424) (\PFLOPPY.CONFIRM 230426 . 231781) (\PFLOPPY.GET.NAME 231783 . 232105
) (\PFLOPPY.SET.NAME 232107 . 232612)) (232881 255807 (\PFLOPPY.ALLOCATE 232891 . 235149) (
\PFLOPPY.ALLOCATE.LARGEST 235151 . 235890) (\PFLOPPY.TRUNCATE 235892 . 238943) (\PFLOPPY.DEALLOCATE
238945 . 239979) (\PFLOPPY.EXTEND 239981 . 244775) (\PFLOPPY.GAINSPACE 244777 . 245834) (
\PFLOPPY.GAINSPACE.MERGE 245836 . 248049) (\PFLOPPY.ALLOCATE.WATCHDOG 248051 . 248666) (
\PFLOPPY.FREE.PAGES 248668 . 249824) (\PFLOPPY.LENGTHS 249826 . 250089) (\PFLOPPY.STARTS 250091 .
250352) (\PFLOPPY.ICHECK 250354 . 254451) (\PFLOPPY.ALLOCATIONS 254453 . 255805)) (255833 259803 (
FLOPPY.FREE.PAGES 255843 . 256183) (FLOPPY.FORMAT 256185 . 256531) (FLOPPY.NAME 256533 . 256727) (
FLOPPY.GET.NAME 256729 . 256989) (FLOPPY.SET.NAME 256991 . 257256) (FLOPPY.CAN.READP 257258 . 257841)
(FLOPPY.CAN.WRITEP 257843 . 258431) (FLOPPY.WAIT.FOR.FLOPPY 258433 . 259801)) (260410 280618 (
\SFLOPPY.INIT 260420 . 262082) (\SFLOPPY.GETFILEINFO 262084 . 263863) (\SFLOPPY.OPENHUGEFILE 263865 .
268933) (\SFLOPPY.WRITEPAGES 268935 . 269240) (\SFLOPPY.WRITEPAGE 269242 . 270512) (\SFLOPPY.READPAGES
270514 . 270897) (\SFLOPPY.READPAGE 270899 . 271594) (\SFLOPPY.CLOSEHUGEFILE 271596 . 274542) (
\SFLOPPY.INPUTFLOPPY 274544 . 276239) (\SFLOPPY.OUTPUTFLOPPY 276241 . 278306) (\SFLOPPY.CLOSEFLOPPY
278308 . 279941) (\SFLOPPY.HACK 279943 . 280616)) (281090 299935 (\HFLOPPY.INIT 281100 . 282762) (
\HFLOPPY.GETFILEINFO 282764 . 284543) (\HFLOPPY.OPENHUGEFILE 284545 . 290214) (\HFLOPPY.WRITEPAGES
290216 . 290521) (\HFLOPPY.WRITEPAGE 290523 . 291793) (\HFLOPPY.READPAGES 291795 . 292178) (
\HFLOPPY.READPAGE 292180 . 292875) (\HFLOPPY.CLOSEHUGEFILE 292877 . 294768) (\HFLOPPY.INPUTFLOPPY
294770 . 296465) (\HFLOPPY.OUTPUTFLOPPY 296467 . 298176) (\HFLOPPY.CLOSEFLOPPY 298178 . 299933)) (
300001 315720 (FLOPPY.SCAVENGE 300011 . 300202) (\PFLOPPY.SCAVENGE 300204 . 300706) (
\PFLOPPY.SCAVENGE.PMPAGES 300708 . 301429) (\PFLOPPY.SCAVENGE.PMPAGEA 301431 . 302632) (
\PFLOPPY.SCAVENGE.PMPAGE.AFTER 302634 . 303677) (\PFLOPPY.SCAVENGE.PMPAGE.AFTER1 303679 . 307981) (
\PFLOPPY.SCAVENGE.PLPAGES 307983 . 313224) (\PFLOPPY.SCAVENGE.PSECTOR9 313226 . 315283) (
\PFLOPPY.SCAVENGE.PFILELIST 315285 . 315718)) (315742 319348 (FLOPPY.TO.FILE 315752 . 317413) (
FLOPPY.FROM.FILE 317415 . 319346)) (319373 328191 (FLOPPY.COMPACT 319383 . 319704) (\PFLOPPY.COMPACT
319706 . 321237) (\PFLOPPY.COMPACT.PFALLOCS 321239 . 324416) (\PFLOPPY.COMPACT.PFALLOC 324418 . 326891
) (\PFLOPPY.COMPACT.PSECTOR9 326893 . 327544) (\PFLOPPY.COMPACT.PFILELIST 327546 . 328189)) (328216
330419 (FLOPPY.ARCHIVE 328226 . 329494) (FLOPPY.UNARCHIVE 329496 . 330417)) (345078 407289 (
\CFLOPPY.GET.FCB.FILENAME 345088 . 345762) (\CFLOPPY.SET.FCB.FILENAME 345764 . 346190) (\CFLOPPY.INIT
346192 . 348705) (\CFLOPPY.OPEN 348707 . 349479) (\CFLOPPY.OPEN.DIRECTORY 349481 . 352678) (
\CFLOPPY.OPENFILE 352680 . 356432) (\CFLOPPY.OPENFILE1 356434 . 358026) (\CFLOPPY.OPENOLDFILE 358028
. 360166) (\CFLOPPY.OPENNEWFILE 360168 . 361311) (\CFLOPPY.ASSURESTREAM 361313 . 361744) (
\CFLOPPY.GETFILEINFO 361746 . 362384) (\CFLOPPY.GETFILEINFO1 362386 . 363130) (\CFLOPPY.SETFILEINFO
363132 . 363789) (\CFLOPPY.CLOSEFILE 363791 . 364315) (\CFLOPPY.CLOSEFILE1 364317 . 365398) (
\CFLOPPY.DELETEFILE 365400 . 367663) (\CFLOPPY.GETFILENAME 367665 . 368495) (\CFLOPPY.GENERATEFILES
368497 . 370180) (\CFLOPPY.NEXTFILEFN 370182 . 371232) (\CFLOPPY.FILEINFOFN 371234 . 371599) (
\CFLOPPY.RENAMEFILE 371601 . 374818) (\CFLOPPY.STREAMS.AGAINST 374820 . 375590) (
\CFLOPPY.STREAMS.USING 375592 . 376091) (\CFLOPPY.READPAGES 376093 . 376399) (\CFLOPPY.READPAGE 376401
. 377706) (\CFLOPPY.PHYSICAL.RECORDNO 377708 . 378557) (\CFLOPPY.READRECORDNO 378559 . 379263) (
\CFLOPPY.WRITERECORDNO 379265 . 379975) (\CFLOPPY.RECORDNOTODISKADDRESS 379977 . 380763) (
\CFLOPPY.DIR.GET 380765 . 381804) (\CFLOPPY.DIR.PUT 381806 . 383116) (\CFLOPPY.DIR.REMOVE 383118 .
384245) (\CFLOPPY.WRITEPAGES 384247 . 384555) (\CFLOPPY.WRITEPAGE 384557 . 385535) (
\CFLOPPY.TRUNCATEFILE 385537 . 387470) (\CFLOPPY.ALLOCATE.FCB 387472 . 388364) (
\CFLOPPY.ALLOCATE.GROUP 388366 . 388878) (\CFLOPPY.ALLOCATE 388880 . 391222) (\CFLOPPY.TRUNCATE 391224
. 393813) (\CFLOPPY.DEALLOCATE 393815 . 394763) (\CFLOPPY.EXTEND 394765 . 396922) (
\CFLOPPY.SAVE.CHANGES 396924 . 398973) (\CFLOPPY.ICHECK 398975 . 401528) (\CFLOPPY.ICHECK.CALLOC
401530 . 402321) (\CFLOPPY.FREE.PAGES 402323 . 402677) (\CFLOPPY.FORMAT 402679 . 404848) (
CPM.DIRECTORY 404850 . 407287)))))
STOP