(FILECREATED " 7-Aug-85 16:12:20" {ERIS}<LISPCORE>SOURCES>FLOPPY.;53 330602
changes to: (FNS \PFLOPPY.FORMAT)
previous date: " 3-Aug-85 16:28:33" {ERIS}<LISPCORE>SOURCES>FLOPPY.;52)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FLOPPYCOMS)
(RPAQQ FLOPPYCOMS ((* FLOPPY "-- By Kelly Roach." *)
(COMS (* "SA800FACE" *)
(DECLARE: EVAL@COMPILE DONTCOPY
(CONSTANTS (C.NOP 0)
(C.READSECTOR 1)
(C.WRITESECTOR 2)
(C.WRITEDELETEDSECTOR 3)
(C.READID 4)
(C.FORMATTRACK 5)
(C.RECALIBRATE 6)
(C.INITIALIZE 7)
(C.ESCAPE 8)
(SC.NOP 0)
(SC.DISKCHANGECLEAR 1)
(S.DOOROPENED 32768)
(S.TWOSIDED 8192)
(S.DISKID 4096)
(S.ERROR 2048)
(S.RECALIBRATEERROR 512)
(S.DATALOST 256)
(S.NOTREADY 128)
(S.WRITEPROTECT 64)
(S.DELETEDDATA 32)
(S.RECORDNOTFOUND 16)
(S.CRCERROR 8)
(S.TRACK0 4)
(S.INDEX 2)
(S.BUSY 1)
(R.OK 0)
(R.BUSY S.BUSY)
(R.CRCERROR (LOGOR S.ERROR S.CRCERROR))
(R.DATALOST (LOGOR S.ERROR S.DATALOST))
(R.DOOROPENED (LOGOR S.ERROR S.DOOROPENED))
(R.DOORISOPEN (LOGOR S.ERROR S.DOOROPENED S.NOTREADY))
(R.DOORISOPEN2 (LOGOR S.DOOROPENED S.NOTREADY))
(R.NOTREADY (LOGOR S.ERROR S.NOTREADY))
(R.RECALIBRATEERROR (LOGOR S.ERROR S.RECALIBRATEERROR))
(R.RECORDNOTFOUND (LOGOR S.ERROR S.RECORDNOTFOUND))
(R.WRITEPROTECT (LOGOR S.ERROR S.WRITEPROTECT))
(R.READERRORMASK (LOGOR S.DOOROPENED S.ERROR S.RECALIBRATEERROR
S.DATALOST S.NOTREADY S.RECORDNOTFOUND
S.CRCERROR))
(R.WRITEERRORMASK (LOGOR R.READERRORMASK S.WRITEPROTECT))
(R.INFOMASK (LOGOR S.TWOSIDED S.WRITEPROTECT S.TRACK0))
(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)
(BADSPOTSECTORS 2)
(BADSPOTSECTOR 10)
(SEAL.PMPAGE 13003)
(VERSION.PMPAGE 1)
(SEAL.PFILELIST 45771)
(VERSION.PFILELIST 1)
(CYLINDERS.PSECTOR9 77)
(TRACKSPERCYLINDER.PSECTOR9 2)
(SECTORSPERTRACK.PSECTOR9 15)
(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 (* "SA800HEAD" *)
(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.INSPECTW NIL))
(FNS \FLOPPY.TRANSLATESETUP \FLOPPY.SETUP \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.DUMP \FLOPPY.DEBUG))
(COMS (* "COMMON" *)
(INITVARS (\FLOPPYFDEV NIL)
(\FLOPPYLOCK NIL)
(\FLOPPY.SCRATCH.BUFFER 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)
(INITRECORDS FLOPPYSTREAM FILEGENOBJ GENFILESTATE)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS FLOPPYSTREAM FILEGENOBJ GENFILESTATE))
(FNS FLOPPY.RESTART FLOPPY.MODE \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.MOUNTEDP \FLOPPY.WRITEABLEP \FLOPPY.CAN.READP
\FLOPPY.CAN.WRITEP \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.PMPAGE31 \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." *)
(* "SA800FACE" *)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ C.NOP 0)
(RPAQQ C.READSECTOR 1)
(RPAQQ C.WRITESECTOR 2)
(RPAQQ C.WRITEDELETEDSECTOR 3)
(RPAQQ C.READID 4)
(RPAQQ C.FORMATTRACK 5)
(RPAQQ C.RECALIBRATE 6)
(RPAQQ C.INITIALIZE 7)
(RPAQQ C.ESCAPE 8)
(RPAQQ SC.NOP 0)
(RPAQQ SC.DISKCHANGECLEAR 1)
(RPAQQ S.DOOROPENED 32768)
(RPAQQ S.TWOSIDED 8192)
(RPAQQ S.DISKID 4096)
(RPAQQ S.ERROR 2048)
(RPAQQ S.RECALIBRATEERROR 512)
(RPAQQ S.DATALOST 256)
(RPAQQ S.NOTREADY 128)
(RPAQQ S.WRITEPROTECT 64)
(RPAQQ S.DELETEDDATA 32)
(RPAQQ S.RECORDNOTFOUND 16)
(RPAQQ S.CRCERROR 8)
(RPAQQ S.TRACK0 4)
(RPAQQ S.INDEX 2)
(RPAQQ S.BUSY 1)
(RPAQQ R.OK 0)
(RPAQ R.BUSY S.BUSY)
(RPAQ R.CRCERROR (LOGOR S.ERROR S.CRCERROR))
(RPAQ R.DATALOST (LOGOR S.ERROR S.DATALOST))
(RPAQ R.DOOROPENED (LOGOR S.ERROR S.DOOROPENED))
(RPAQ R.DOORISOPEN (LOGOR S.ERROR S.DOOROPENED S.NOTREADY))
(RPAQ R.DOORISOPEN2 (LOGOR S.DOOROPENED S.NOTREADY))
(RPAQ R.NOTREADY (LOGOR S.ERROR S.NOTREADY))
(RPAQ R.RECALIBRATEERROR (LOGOR S.ERROR S.RECALIBRATEERROR))
(RPAQ R.RECORDNOTFOUND (LOGOR S.ERROR S.RECORDNOTFOUND))
(RPAQ R.WRITEPROTECT (LOGOR S.ERROR S.WRITEPROTECT))
(RPAQ R.READERRORMASK (LOGOR S.DOOROPENED S.ERROR S.RECALIBRATEERROR S.DATALOST S.NOTREADY
S.RECORDNOTFOUND S.CRCERROR))
(RPAQ R.WRITEERRORMASK (LOGOR R.READERRORMASK S.WRITEPROTECT))
(RPAQ R.INFOMASK (LOGOR S.TWOSIDED S.WRITEPROTECT S.TRACK0))
(RPAQQ 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 BADSPOTSECTORS 2)
(RPAQQ BADSPOTSECTOR 10)
(RPAQQ SEAL.PMPAGE 13003)
(RPAQQ VERSION.PMPAGE 1)
(RPAQQ SEAL.PFILELIST 45771)
(RPAQQ VERSION.PFILELIST 1)
(RPAQQ CYLINDERS.PSECTOR9 77)
(RPAQQ TRACKSPERCYLINDER.PSECTOR9 2)
(RPAQQ SECTORSPERTRACK.PSECTOR9 15)
(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)
(BADSPOTSECTORS 2)
(BADSPOTSECTOR 10)
(SEAL.PMPAGE 13003)
(VERSION.PMPAGE 1)
(SEAL.PFILELIST 45771)
(VERSION.PFILELIST 1)
(CYLINDERS.PSECTOR9 77)
(TRACKSPERCYLINDER.PSECTOR9 2)
(SECTORSPERTRACK.PSECTOR9 15)
(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 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")
"Unknown Domino Error")))))
(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 ← CYLINDERS.PSECTOR9
TRACKSPERCYLINDER ← TRACKSPERCYLINDER.PSECTOR9 SECTORSPERTRACK ←
SECTORSPERTRACK.PSECTOR9 (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 (IQUOTIENT (IPLUS 8 (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: "23-Jul-84 01:08")
(* FLOPPY just tried to do something that would have
crashed lisp. *)
(PROG NIL
(ERROR "Floppy: Severe Error!" MESSAGE))))
(\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)))
)
(* "SA800HEAD" *)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ IBMS128 0)
(RPAQQ IBMS256 1)
(RPAQQ IBMS512 2)
(RPAQQ IBMS1024 3)
(RPAQQ IBMD128 4)
(RPAQQ IBMD256 5)
(RPAQQ IBMD512 6)
(RPAQQ IBMD1024 7)
(CONSTANTS (IBMS128 0)
(IBMS256 1)
(IBMS512 2)
(IBMS1024 3)
(IBMD128 4)
(IBMD256 5)
(IBMD512 6)
(IBMD1024 7))
)
)
(RPAQ? \FLOPPY.DEBUG NIL)
(RPAQ? \FLOPPY.INSPECTW 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
(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: "22-Jul-84 22:34")
(* 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))
77))))
(\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: "25-Apr-85 14:49")
(* 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 MPERROR) of \FLOPPYRESULT)
(* These should only be generated by still undiagnosed
bugs living in IOP assembly language code.
Reissuing command seems to work.
*)
(COND
((OR RETRYFLG \FLOPPY.DEBUG)
(\FLOPPY.MESSAGE (fetch (FLOPPYRESULT MPMESSAGE) of \FLOPPYRESULT)))))
((fetch (FLOPPYRESULT DOOROPENED) of \FLOPPYRESULT)
(* Door opened. Always an error at this deep a level.
(Otherwise user could switch floppies on stream.) *)
(\FLOPPY.ERROR) (* Abandon command. *)
(RETURN NIL))
((fetch (FLOPPYRESULT CRCERROR) of \FLOPPYRESULT)
(* Cyclic Redundancy Check. Reissuing command seems to
work. *)
(COND
((AND RETRYFLG NOERROR) (* Abandon command. *)
(RETURN NIL)))
(COND
((OR RETRYFLG \FLOPPY.DEBUG)
(\FLOPPY.MESSAGE (QUOTE CRCERROR)))))
((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. TBW: Make \FLOPPY.SCRATCH.FLOPPYIOCB a
global resource. *)
(\FLOPPY.INITIALIZE NOERROR)
(COND
((NOT (fetch (FLOPPYRESULT DOOROPENED) of \FLOPPYRESULT))
(\FLOPPY.RECALIBRATE NOERROR))))
(NOERROR (* Abandon command. Calling routine will handle
(or ignore) error. *)
(RETURN NIL))
(T (* Hit the user with the bad news.
*)
(\FLOPPY.ERROR)))
(SETQ RETRYFLG T)
(GO RETRY))))
(\FLOPPY.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: " 3-Aug-85 15:26")
(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)))
)
(\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: "22-Jul-84 22:34")
(GLOBALRESOURCE \FLOPPY.SCRATCH.FLOPPYIOCB (\FLOPPY.COMMAND \FLOPPY.SCRATCH.FLOPPYIOCB
C.RECALIBRATE SC.NOP NOERROR))))
(\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: "22-Jul-84 22:34")
(PROG NIL
(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. *)
(RETURN PAGE))))))
(\FLOPPY.READSECTOR
(LAMBDA (FLOPPYIOCB DISKADDRESS PAGE NOERROR) (* kbr: "22-Jul-84 22:34")
(\FLOPPY.TRANSFER FLOPPYIOCB C.READSECTOR DISKADDRESS PAGE NOERROR)))
(\FLOPPY.WRITESECTOR
(LAMBDA (FLOPPYIOCB DISKADDRESS PAGE NOERROR) (* kbr: "22-Jul-84 22:34")
(\FLOPPY.TRANSFER FLOPPYIOCB C.WRITESECTOR DISKADDRESS PAGE NOERROR)))
(\FLOPPY.FORMATTRACKS
(LAMBDA (FLOPPYIOCB DISKADDRESS COUNT NOERROR) (* kbr: "22-Jul-84 22:34")
(PROG NIL
(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 COUNT))
(RETURN (\FLOPPY.RUN FLOPPYIOCB NOERROR)))))
(\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.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: "22-Jul-84 22:34")
(PROG NIL
(CLOSEINSPECT)
(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)))))
)
(* "COMMON" *)
(RPAQ? \FLOPPYFDEV NIL)
(RPAQ? \FLOPPYLOCK NIL)
(RPAQ? \FLOPPY.SCRATCH.BUFFER 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 (CREATE FLOPPYIOCB)
IBMS128))))
(PUTDEF (QUOTE \FLOPPY.IBMD256.FLOPPYIOCB)
(QUOTE RESOURCES)
(QUOTE (NEW (\FLOPPY.SETUP (CREATE FLOPPYIOCB)
IBMD256))))
(PUTDEF (QUOTE \FLOPPY.IBMD512.FLOPPYIOCB)
(QUOTE RESOURCES)
(QUOTE (NEW (\FLOPPY.SETUP (CREATE FLOPPYIOCB)
IBMD512))))
(PUTDEF (QUOTE \FLOPPY.SCRATCH.BUFFER)
(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))
(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 (* kbr: "19-Jul-85 19:28")
(* Initializes floppy code, setting globals and creating
file devices. *)
(SETQ \FLOPPYLOCK (CREATE.MONITORLOCK (QUOTE FLOPPY)))
(WITH.MONITOR \FLOPPYLOCK (PROG NIL (* 16 quad aligned words needed for 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.BUFFER (\FLOPPY.BUFFER 4))
(SETQ \FLOPPY.SCRATCH.FLOPPYIOCB (create FLOPPYIOCB))
(SETQ \FLOPPY.IBMS128.FLOPPYIOCB (\FLOPPY.SETUP (create
FLOPPYIOCB)
IBMS128))
(SETQ \FLOPPY.IBMD256.FLOPPYIOCB (\FLOPPY.SETUP (create
FLOPPYIOCB)
IBMD256))
(SETQ \FLOPPY.IBMD512.FLOPPYIOCB (\FLOPPY.SETUP (create
FLOPPYIOCB)
IBMD512))
(SETQ \HFLOPPY.MAXPAGES 2250)
(COND
(\FLOPPYFDEV (\FLOPPY.FLUSH)))
(SETQ \PFLOPPYFDEV NIL)
(SETQ \SFLOPPYFDEV NIL)
(SETQ \HFLOPPYFDEV NIL)
(SETQ \CFLOPPYFDEV NIL)
(FLOPPY.MODE (QUOTE PILOT))
(COND
((\FLOPPY.EXISTSP (QUOTE NOERROR))
(\FLOPPY.INITIALIZE)))))))
(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.EVENTFN
[LAMBDA (FDEV EVENT) (* lmm "29-Jul-85 20:40")
(PROG NIL
(COND
((NOT (\FLOPPY.EXISTSP T))
(RETURN)))
(SELECTQ EVENT
(AFTERLOGOUT (\FLOPPY.CLOSE)
(\FLOPPY.INITIALIZE))
((AFTERSYSOUT AFTERMAKESYS)
(\FLOPPY.INITIALIZE))
((BEFOREMAKESYS BEFORESYSOUT))
(* NOP *)])
(\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: "13-Feb-85 16:20")
(* 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 (* edited: "23-Jul-84 15:33")
(* 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))
(\SFLOPPYFDEV (replace (PFINFO OPEN) of \SFLOPPYINFO with NIL))
(\CFLOPPYFDEV (replace (CINFO OPEN) of \CFLOPPYINFO with NIL))
NIL)
(\FLOPPY.FLUSH))))
(\FLOPPY.FLUSH
(LAMBDA NIL (* kbr: "16-Mar-85 11:27")
(* 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 \OPENFILES when (EQ (fetch (STREAM DEVICE) of STREAM)
\FLOPPYFDEV)
do (SETQ \OPENFILES (DREMOVE STREAM \OPENFILES))
(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: "19-Jul-85 19:30")
(* Initialize IOP, then verify can write.
Return T or NIL. *)
(PROG NIL
(COND
((NOT (\FLOPPY.EXISTSP NOERROR)) (* Failed *)
(RETURN NIL)))
(\FLOPPY.NOP T)
(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) (* edited: "23-Jul-84 15:33")
(* Floppy drive hardware exists? *)
(PROG (ANSWER)
(SETQ ANSWER (EQ (MACHINETYPE)
(QUOTE DANDELION)))
(COND
((OR NOERROR ANSWER)
(RETURN ANSWER)))
(\FLOPPY.BREAK "No floppy drive on this machine"))))
(\FLOPPY.MOUNTEDP
(LAMBDA (NOERROR) (* edited: "23-Jul-84 15:33")
(* 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. *)
(UNINTERRUPTABLY
(\FLOPPY.NOP T)
(SETQ ANSWER (NOT (fetch (FLOPPYRESULT DOOROPENED) of \FLOPPYRESULT))))
(COND
((OR NOERROR ANSWER)
(RETURN ANSWER)))
(\FLOPPY.BREAK "Door open(ed) or disk missing"))))
(\FLOPPY.WRITEABLEP
(LAMBDA (NOERROR) (* edited: "23-Jul-84 15:33")
(* Floppy is write protected *)
(PROG (ANSWER) (* This routine assumes there is a mounted floppy.
Otherwise, ANSWER is garbage *)
(UNINTERRUPTABLY
(\FLOPPY.NOP T)
(SETQ ANSWER (NOT (fetch (FLOPPYRESULT WRITEPROTECT) of \FLOPPYRESULT))))
(COND
((OR NOERROR ANSWER)
(RETURN ANSWER)))
(\FLOPPY.BREAK "Write protected"))))
(\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.BREAK
(LAMBDA (MESSAGE) (* edited: "23-Jul-84 15:33")
(PROG NIL
(\FLOPPY.MESSAGE MESSAGE T)
(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 (* edited: "23-Jul-84 15:34")
(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)))
(\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 (* mjs "29-Nov-84 13:55")
(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 ← 32) 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 2310))
(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 (* edited: "23-Jul-84 15:34")
(* Tell user floppy needs scavenging *)
(PROG NIL
(\FLOPPY.BREAK (CONCAT "Damaged floppy. " (\PFLOPPY.GET.NAME)
" needs scavenging.")))))
(\PFLOPPY.OPENFILE
[LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* edited: "23-Jul-84 15:34")
(OR (\SFLOPPY.HACK FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM)
(PROG (STREAM WAIT PFALLOC FULLFILENAME)
(SETQ OTHERINFO (\FLOPPY.OTHERINFO OTHERINFO))
RETRY (* 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) (* edited: "23-Jul-84 15:34")
(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
OTHERINFO))
(T (\PFLOPPY.OPENOLDFILE PFALLOC))))
(NEW (COND
((NULL PFALLOC)
(\PFLOPPY.OPENNEWFILE FILENAME
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 OTHERINFO) (* edited: "23-Jul-84 15:34")
(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 (QUOTE NEW)
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 (MKSTRING (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) (* edited: "23-Jul-84 15:34")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM FULLFILENAME)
(SETQ STREAM (\PFLOPPY.ASSURESTREAM FILE))
(\CLEARMAP STREAM)
(SETQ FULLFILENAME (\PFLOPPY.CLOSEFILE1 STREAM))
(RETURN FULLFILENAME)))))
(\PFLOPPY.CLOSEFILE1
(LAMBDA (STREAM) (* kbr: "25-Nov-84 13:05")
(* 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)
(COND
((fetch (PFALLOC DELETEFLG) of PFALLOC)
(\PFLOPPY.DELETEFILE STREAM)))
(RETURN FULLFILENAME))))
(\PFLOPPY.DELETEFILE
(LAMBDA (FILE FDEV) (* kbr: "13-Feb-85 16:17")
(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
((\PFLOPPY.STREAMS.USING PFALLOC)
(* Make deletion pending. *)
(replace (PFALLOC DELETEFLG) of PFALLOC with T))
(T (* Carry out deletion. *)
(replace (PFALLOC DELETEFLG) of PFALLOC with NIL)
(\PFLOPPY.DIR.REMOVE PFALLOC)
(\PFLOPPY.DEALLOCATE PFALLOC)
(\PFLOPPY.DELETE.FROM.PFILELIST PFALLOC)
(\PFLOPPY.SAVE.PFILELIST)))
(RETURN FULLFILENAME)))))
(\PFLOPPY.GENERATEFILES
(LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS) (* kbr: "13-Feb-85 17:16")
(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
((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 (OLDFILE NEWFILE FDEV OLDRECOG NEWRECOG) (* edited: "23-Jul-84 15:35")
(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))
(SETQ PFALLOC (\PFLOPPY.DIR.GET OLDFILENAME OLDRECOG))
(COND
((NULL PFALLOC) (* File not found. *)
(* Returning NIL means unsuccessful.
*)
(RETURN NIL)))
(\PFLOPPY.DIR.REMOVE PFALLOC)
(* TBW: If new file name too long.
*)
(* Store NEWFILENAME on PLPAGE.
*)
(SETQ PLPAGE (fetch (PFALLOC PLPAGE) of PFALLOC))
(replace (PLPAGE $NAME) of PLPAGE with NEWFILENAME)
(* Store NEWFILENAME on PFALLOC.
*)
(SETQ NEWFILENAME (fetch (PLPAGE $NAME) of PLPAGE))
(\PFLOPPY.DIR.PUT NEWFILENAME NEWRECOG PFALLOC)
(* Write changes onto floppy.
*)
(\PFLOPPY.WRITEPAGENO (fetch (PFALLOC START) of PFALLOC)
PLPAGE)
(* Return FULLFILENAME. *)
(SETQ FULLFILENAME (\FLOPPY.ADDDEVICENAME NEWFILENAME))
(RETURN FULLFILENAME)))))
(\PFLOPPY.STREAMS.AGAINST
(LAMBDA (STREAM) (* edited: "23-Jul-84 15:35")
(* Return other open floppy streams with same PFALLOC.
*)
(FOR F IN \OPENFILES WHEN (AND (EQ (fetch (STREAM DEVICE) of F)
\FLOPPYFDEV)
(EQ (fetch (FLOPPYSTREAM PFALLOC) of F)
(fetch (FLOPPYSTREAM PFALLOC) of STREAM))
(NOT (EQ F STREAM)))
COLLECT F)))
(\PFLOPPY.STREAMS.USING
(LAMBDA (PFALLOC) (* edited: "23-Jul-84 15:35")
(* Return open floppy streams with this PFALLOC.
*)
(FOR F IN \OPENFILES WHEN (AND (EQ (fetch (STREAM DEVICE) of F)
\FLOPPYFDEV)
(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) (* edited: "23-Jul-84 15:35")
(PROG (ANSWER) (* Read page. *)
(GLOBALRESOURCE \FLOPPY.IBMD512.FLOPPYIOCB (SETQ ANSWER (COND
((OR (ILESSP PAGENO 1)
(IGREATERP PAGENO 2310))
(\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) (* edited: "23-Jul-84 15:35")
(PROG (ANSWER) (* Write page. *)
(GLOBALRESOURCE \FLOPPY.IBMD512.FLOPPYIOCB (SETQ ANSWER (COND
((OR (ILESSP PAGENO 1)
(IGREATERP PAGENO 2310))
(\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: "29-Jul-84 20:05")
(PROG (QUOTIENT CYLINDER HEAD SECTOR DISKADDRESS)
(SETQ SECTOR (ADD1 (IREMAINDER (SUB1 PAGENO)
SECTORSPERTRACK.PSECTOR9)))
(SETQ QUOTIENT (IQUOTIENT (SUB1 PAGENO)
SECTORSPERTRACK.PSECTOR9))
(SETQ HEAD (IREMAINDER QUOTIENT TRACKSPERCYLINDER.PSECTOR9))
(SETQ CYLINDER (IQUOTIENT QUOTIENT TRACKSPERCYLINDER.PSECTOR9))
(SETQ DISKADDRESS (create DISKADDRESS
SECTOR ← SECTOR
HEAD ← HEAD
CYLINDER ← CYLINDER))
(RETURN DISKADDRESS))))
(\PFLOPPY.DISKADDRESSTOPAGENO
(LAMBDA (DISKADDRESS) (* kbr: "29-Jul-84 20:07")
(PROG (PAGENO)
(SETQ PAGENO (IPLUS (fetch (DISKADDRESS SECTOR) of DISKADDRESS)
(ITIMES SECTORSPERTRACK.PSECTOR9 (IPLUS (fetch (DISKADDRESS HEAD)
of DISKADDRESS)
(ITIMES
TRACKSPERCYLINDER.PSECTOR9
(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-Mar-85 18:29")
(PROG (UNAME NALIST EALIST VALIST NAME EXTENSION VERSION)
(SETQ FILENAME (\FLOPPY.ASSUREFILENAME FILENAME))
(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 (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) (* edited: "23-Jul-84 15:35")
(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: " 7-Aug-85 16:11")
(* Return T if formatted, NIL if user abort.
*)
(PROG (PSECTOR9 PMPAGE31 PMPAGE34 PMPAGE2310 PFILELIST PFLE NATTEMPTS)
(\FLOPPY.UNCACHED.WRITE) (* Confirmation. *)
(COND
((NOT (\PFLOPPY.CONFIRM "Destroy contents of floppy" AUTOCONFIRMFLG T))
(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 ← 32
LENGTH ← 2))
(\MOVEWORDS PFLE 0 PFILELIST 4 5)
(SETQ PMPAGE31
(create PMPAGE
PTYPE ← PMPAGEETYPE.FREE
PFILEID ← 0
PFILETYPE ← FILETYPE.FREE
PLENGTH ← 0
NTYPE ← PMPAGEETYPE.PFILELIST
NFILETYPE ← FILETYPE.PFILELIST
NFILEID ← 1
NLENGTH ← 2))
(SETQ PMPAGE34
(create PMPAGE
PTYPE ← PMPAGEETYPE.PFILELIST
PFILETYPE ← FILETYPE.PFILELIST
PFILEID ← 1
PLENGTH ← 2
NTYPE ← PMPAGEETYPE.FREE
NFILETYPE ← FILETYPE.FREE
NFILEID ← 0
NLENGTH ← 2275))
(SETQ PMPAGE2310
(create PMPAGE
PTYPE ← PMPAGEETYPE.FREE
PFILEID ← 0
PFILETYPE ← FILETYPE.FREE
PLENGTH ← 2275
NTYPE ← PMPAGEETYPE.FREE
NFILEID ← 0
NFILETYPE ← FILETYPE.FREE
NLENGTH ← 0))
(SETQ PSECTOR9
(create PSECTOR9
PFILELISTSTART ← 32
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 (\FLOPPY.CAN.WRITEP))
(GO RETRY))) (* 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)
76 T)
(\FLOPPY.FORMATTRACKS \FLOPPY.IBMD512.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← 1
HEAD ← 1
SECTOR ← 1)
76 T))))
(SETQ SLOWFLG T)
(\FLOPPY.MESSAGE "RETRYING FORMAT")
(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
((GLOBALRESOURCE \FLOPPY.IBMD512.FLOPPYIOCB
(OR (for I from 1 to 76
thereis (NULL (\FLOPPY.READSECTOR \FLOPPY.IBMD512.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← I
HEAD ← 0
SECTOR ← 1)
\FLOPPY.SCRATCH.BUFFER T)))
(for I from 1 to 76
thereis (NULL (\FLOPPY.READSECTOR \FLOPPY.IBMD512.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← I
HEAD ← 1
SECTOR ← 1)
\FLOPPY.SCRATCH.BUFFER T))))
)
(\FLOPPY.MESSAGE "RETRYING FORMAT")
(GO RETRY))))) (* Write PMPAGEs, PFILELIST, and PSECTOR9.
Write PSECTOR9 last. We check for it first when we open
floppy. *)
(COND
((NOT (AND (\PFLOPPY.WRITEPAGENO 31 PMPAGE31 T)
(\PFLOPPY.WRITEPAGENO 32 PFILELIST T)
(\PFLOPPY.WRITEPAGENO 33 (\ADDBASE PFILELIST 256)
T)
(\PFLOPPY.WRITEPAGENO 34 PMPAGE34 T)
(\PFLOPPY.WRITEPAGENO 2310 PMPAGE2310 T)
(GLOBALRESOURCE \FLOPPY.IBMS128.FLOPPYIOCB
(\FLOPPY.WRITESECTOR \FLOPPY.IBMS128.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 0
SECTOR ← 9)
PSECTOR9 T))))
(SETQ SLOWFLG T)
(\FLOPPY.MESSAGE "RETRYING FORMAT")
(GO RETRY))) (* Successful Return. *)
(RETURN T))))
(\PFLOPPY.CONFIRM
(LAMBDA (MESSAGE AUTOCONFIRMFLG NOERROR) (* edited: "29-Jul-84 18:58")
(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)))
(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: "22-Jul-84 22:34")
(* Returns after a free block of length LENGTH has been
made available. *)
(PROG (PFALLOCS) (* TBW: Hook in coPMPAGEaction algorithm.
*)
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. *)
(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 (* kbr: "18-Mar-85 13:22")
(* 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))
2280))
(\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 \OPENFILES 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: "22-Jul-84 22:34")
(PROG (REGION)
(COND
((NULL \FLOPPY.ALLOCATIONS.BITMAP)
(SETQ \FLOPPY.ALLOCATIONS.BITMAP (BITMAPCREATE 30 77))))
(BITBLT NIL NIL NIL \FLOPPY.ALLOCATIONS.BITMAP NIL NIL NIL NIL (QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE)
(FOR 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)
30)
(IQUOTIENT (SUB1 I)
30)
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: "19-Jul-85 19:30")
(WITH.MONITOR \FLOPPYLOCK (PROG (ANSWER)
(\FLOPPY.INITIALIZE)
(SETQ ANSWER (\FLOPPY.CAN.READP T))
(RETURN ANSWER)))))
(FLOPPY.CAN.WRITEP
(LAMBDA NIL (* kbr: "19-Jul-85 19:30")
(WITH.MONITOR \FLOPPYLOCK (PROG (ANSWER)
(\FLOPPY.INITIALIZE)
(SETQ ANSWER (\FLOPPY.CAN.WRITEP T))
(RETURN ANSWER)))))
(FLOPPY.WAIT.FOR.FLOPPY
[LAMBDA (NEWFLG) (* kbr: "22-Jul-84 22:40")
(* 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
(NEWFLG (until (NOT (FLOPPY.CAN.READP)) do (BLOCK]
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 (* kbr: "26-Aug-84 11:20")
(PROG NIL
(SETQ \SFLOPPYINFO (create PFINFO))
(SETQ \SFLOPPYFDEV (create FDEV
DEVICENAME ←(QUOTE FLOPPY)
NODIRECTORIES ← T
CLOSEFILE ←(QUOTE \SFLOPPY.CLOSEHUGEFILE)
DELETEFILE ←(QUOTE NILL)
DIRECTORYNAMEP ←(QUOTE TRUE)
EVENTFN ←(QUOTE \FLOPPY.EVENTFN)
GENERATEFILES ←(QUOTE \PFLOPPY.GENERATEFILES)
GETFILEINFO ←(QUOTE \SFLOPPY.GETFILEINFO)
GETFILENAME ←(QUOTE \PFLOPPY.GETFILENAME)
HOSTNAMEP ←(QUOTE \FLOPPY.HOSTNAMEP)
OPENFILE ←(QUOTE \SFLOPPY.OPENHUGEFILE)
READPAGES ←(QUOTE \SFLOPPY.READPAGES)
REOPENFILE ←(QUOTE \SFLOPPY.OPENHUGEFILE)
SETFILEINFO ←(QUOTE NILL)
TRUNCATEFILE ←(QUOTE NILL)
WRITEPAGES ←(QUOTE \SFLOPPY.WRITEPAGES)
DEVICEINFO ← \SFLOPPYINFO
RENAMEFILE ←(QUOTE NILL)))
(\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) (* kbr: "25-Nov-84 11:39")
(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) (* kbr: "26-Aug-84 11:20")
(WITH.MONITOR \FLOPPYLOCK (PROG (NEWSTREAM)
[COND
((IGEQ \SFLOPPY.PAGENO \HFLOPPY.MAXPAGES)
(\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)
(* kbr: "25-Feb-85 12:18")
(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.BREAK
"BVM error. OTHERINFO length and actual length do not agree.")))
(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)))
(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 (* kbr: "26-Aug-84 11:19")
(PROG NIL
(SETQ \HFLOPPYINFO (CREATE PFINFO))
(SETQ \HFLOPPYFDEV (CREATE FDEV
DEVICENAME ← (QUOTE FLOPPY)
NODIRECTORIES ← T
CLOSEFILE ← (QUOTE \HFLOPPY.CLOSEHUGEFILE)
DELETEFILE ← (QUOTE NILL)
DIRECTORYNAMEP ← (QUOTE TRUE)
EVENTFN ← (QUOTE \FLOPPY.EVENTFN)
GENERATEFILES ← (QUOTE \PFLOPPY.GENERATEFILES)
GETFILEINFO ← (QUOTE \HFLOPPY.GETFILEINFO)
GETFILENAME ← (QUOTE \PFLOPPY.GETFILENAME)
HOSTNAMEP ← (QUOTE \FLOPPY.HOSTNAMEP)
OPENFILE ← (QUOTE \HFLOPPY.OPENHUGEFILE)
READPAGES ← (QUOTE \HFLOPPY.READPAGES)
REOPENFILE ← (QUOTE \HFLOPPY.OPENHUGEFILE)
SETFILEINFO ← (QUOTE NILL)
TRUNCATEFILE ← (QUOTE NILL)
WRITEPAGES ← (QUOTE \HFLOPPY.WRITEPAGES)
DEVICEINFO ← \HFLOPPYINFO
RENAMEFILE ← (QUOTE NILL)))
(\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) (* kbr: "25-Nov-84 11:40")
(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) (* kbr: "26-Aug-84 11:20")
(WITH.MONITOR \FLOPPYLOCK (PROG (NEWSTREAM)
[COND
((IGEQ \HFLOPPY.PAGENO \HFLOPPY.MAXPAGES)
(\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)
(* kbr: "25-Feb-85 12:21")
(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))
(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: "22-Jul-84 22:40")
(* Scavenge the marker pages.
*)
(PROG (LOCATION PMPAGE NPMPAGE)
(SETQ LOCATION 31)
(SETQ PMPAGE (\PFLOPPY.SCAVENGE.PMPAGE31))
(WHILE (ILESSP LOCATION 2310)
DO (SETQ NPMPAGE (\PFLOPPY.SCAVENGE.PMPAGE.AFTER PMPAGE LOCATION))
(\PFLOPPY.WRITEPAGENO LOCATION PMPAGE)
(SETQ LOCATION (IPLUS LOCATION (fetch (PMPAGE NLENGTH) of PMPAGE)
1))
(SETQ PMPAGE NPMPAGE))
(COND
((NOT (IEQP LOCATION 2310))
(SHOULDNT)))
(\PFLOPPY.WRITEPAGENO LOCATION PMPAGE))))
(\PFLOPPY.SCAVENGE.PMPAGE31
(LAMBDA NIL (* kbr: "22-Jul-84 22:40")
(PROG (PMPAGE LOCATION) (* Try to believe page 31.0 *)
(SETQ LOCATION 31)
(SETQ PMPAGE (\PFLOPPY.READPAGENO LOCATION (NCREATE (QUOTE PMPAGE))))
(COND
((fetch (PMPAGE INTACT) of 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)
(replace (PMPAGE NLENGTH) of PMPAGE with (IMAX 0 (IMIN (IDIFFERENCE 2309 LOCATION)
(fetch (PMPAGE NLENGTH)
of PMPAGE))))
(COND
((ZEROP (fetch (PMPAGE NLENGTH) of PMPAGE))
(replace (PMPAGE NTYPE) of PMPAGE with PMPAGEETYPE.FREE)
(replace (PMPAGE NFILETYPE) of PMPAGE with FILETYPE.FREE)
(replace (PMPAGE NFILEID) of PMPAGE with 0))
((OR (IEQP (fetch (PMPAGE NTYPE) of PMPAGE)
PMPAGEETYPE.PFILELIST)
(IEQP (fetch (PMPAGE NFILETYPE) of PMPAGE)
FILETYPE.PFILELIST))
(replace (PMPAGE NTYPE) of PMPAGE with PMPAGEETYPE.PFILELIST)
(replace (PMPAGE NFILETYPE) of PMPAGE with FILETYPE.PFILELIST)
(replace (PMPAGE NFILEID) of PMPAGE with 1))
(T (replace (PMPAGE NTYPE) of PMPAGE with PMPAGEETYPE.FILE)
(replace (PMPAGE NFILETYPE) of PMPAGE with FILETYPE.FILE)
(replace (PMPAGE NFILEID) of PMPAGE with 0)))
(RETURN PMPAGE))) (* Page 31 lied. *)
(SETQ PMPAGE
(CREATE PMPAGE
SEAL ← SEAL.PMPAGE
VERSION ← VERSION.PMPAGE
PLENGTH ← 0
PTYPE ← PMPAGEETYPE.FREE
PFILEID ← 0
PFILETYPE ← FILETYPE.FREE
NLENGTH ← 0
NTYPE ← PMPAGEETYPE.FILE
NFILEID ← 0
NFILETYPE ← FILETYPE.FILE))
(RETURN PMPAGE))))
(\PFLOPPY.SCAVENGE.PMPAGE.AFTER
(LAMBDA (PPMPAGE PLOCATION) (* kbr: "22-Jul-84 22:40")
(* Come up with a plausible PMPAGE between
(ADD1 PLOCATION) and 2310 inclusive where PPMPAGE at
PLOCATION is the preceding marker page.
*)
(PROG (PMPAGE LOCATION) (* First we try to believe PPMPAGE about where the next
PMPAGE will be. *)
(SETQ PMPAGE (NCREATE (QUOTE PMPAGE)))
(SETQ LOCATION (IPLUS PLOCATION (fetch (PMPAGE NLENGTH) of PPMPAGE)
1))
(\PFLOPPY.SCAVENGE.PMPAGE.AFTER1 PLOCATION PPMPAGE LOCATION PMPAGE)
(COND
((fetch (PMPAGE INTACT) of PMPAGE)
(RETURN PMPAGE))) (* PPMPAGE lied. Hunt for first plausible PMPAGE after
PPMPAGE. Smash PMPAGE into correctness and make PPMPAGE
tell the new truth. *)
(FOR LOCATION FROM (ADD1 PLOCATION) TO 2310
DO (PRIN1 "." 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) (* kbr: "22-Jul-84 22:40")
(PROG NIL
(COND
((OR (ILESSP PLOCATION 31)
(IGEQ PLOCATION 2310))
(SHOULDNT)))
(COND
((OR (ILESSP LOCATION PLOCATION)
(IGREATERP LOCATION 2310))
(SHOULDNT)))
(\PFLOPPY.READPAGENO LOCATION PMPAGE)
(COND
((OR (fetch (PMPAGE INTACT) of PMPAGE)
(IEQP LOCATION 2310)) (* Force PMPAGE to be a legal marker page.
*)
(replace (PMPAGE SEAL) of PMPAGE with SEAL.PMPAGE)
(replace (PMPAGE VERSION) of PMPAGE with VERSION.PMPAGE)
(replace (PMPAGE PLENGTH) of PMPAGE with (IPLUS LOCATION (IMINUS PLOCATION)
-1))
(replace (PMPAGE PTYPE) of PMPAGE with (fetch (PMPAGE NTYPE) of PPMPAGE))
(replace (PMPAGE PFILETYPE) of PMPAGE with (fetch (PMPAGE NFILETYPE) of PPMPAGE))
(replace (PMPAGE PFILEID) of PMPAGE with (fetch (PMPAGE NFILEID) of PPMPAGE))
(replace (PMPAGE NLENGTH) of PMPAGE with (IMAX 0 (IMIN (IDIFFERENCE 2309 LOCATION)
(fetch (PMPAGE NLENGTH)
of PMPAGE))))
(COND
((ZEROP (fetch (PMPAGE NLENGTH) of PMPAGE))
(replace (PMPAGE NTYPE) of PMPAGE with PMPAGEETYPE.FREE)
(replace (PMPAGE NFILETYPE) of PMPAGE with FILETYPE.FREE)
(replace (PMPAGE NFILEID) of PMPAGE with 0))
((OR (IEQP (fetch (PMPAGE NTYPE) of PMPAGE)
PMPAGEETYPE.PFILELIST)
(IEQP (fetch (PMPAGE NFILETYPE) of PMPAGE)
FILETYPE.PFILELIST))
(replace (PMPAGE NTYPE) of PMPAGE with PMPAGEETYPE.PFILELIST)
(replace (PMPAGE NFILETYPE) of PMPAGE with FILETYPE.PFILELIST)
(replace (PMPAGE NFILEID) of PMPAGE with 1))
(T (replace (PMPAGE NTYPE) of PMPAGE with PMPAGEETYPE.FILE)
(replace (PMPAGE NFILETYPE) of PMPAGE with FILETYPE.FILE)
(replace (PMPAGE NFILEID) of PMPAGE with 0)))
(RETURN))) (* Fix PPMPAGE wrt PMPAGE now *)
(replace (PMPAGE NLENGTH) of PPMPAGE with (fetch (PMPAGE PLENGTH) of PMPAGE))
(replace (PMPAGE NTYPE) of PPMPAGE with (fetch (PMPAGE PTYPE) of PMPAGE))
(replace (PMPAGE NFILEID) of PPMPAGE with (fetch (PMPAGE PFILEID) of PMPAGE))
(replace (PMPAGE NFILETYPE) of PPMPAGE with (fetch (PMPAGE PFILETYPE) of PMPAGE)))))
(\PFLOPPY.SCAVENGE.PLPAGES
(LAMBDA NIL (* kbr: "22-Jul-84 22:40")
(* Scavenge the leader pages.
*)
(PROG (LOCATION PMPAGE PLPAGE LENGTH START)
(SETQ LOCATION 31)
(SETQ PMPAGE (NCREATE (QUOTE PMPAGE)))
(SETQ PLPAGE (CREATE PLPAGE))
(WHILE (ILESSP LOCATION 2310)
DO (\PFLOPPY.READPAGENO LOCATION PMPAGE)
(COND
((NOT (fetch (PMPAGE INTACT) of PMPAGE)) (* Huh? We just scavenged the marker pages.
*)
(SHOULDNT)))
(SETQ LENGTH (SUB1 (fetch (PMPAGE NLENGTH) of PMPAGE)))
(COND
((IEQP (fetch (PMPAGE NTYPE) of PMPAGE)
PMPAGEETYPE.FILE)
(SETQ START (ADD1 LOCATION))
(\PFLOPPY.READPAGENO START PLPAGE)
(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
((fetch (PLPAGE INTACT) of PLPAGE) (* Try to save as much info as we can about file.
*)
(replace (PLPAGE PAGELENGTH) of PLPAGE with (IMIN (fetch (PLPAGE PAGELENGTH)
of PLPAGE)
LENGTH))
(replace (PLPAGE HUGEPAGELENGTH) of PLPAGE
with (IMAX (fetch (PLPAGE PAGELENGTH) of PLPAGE)
(fetch (PLPAGE HUGEPAGELENGTH) of PLPAGE)
(fetch (PLPAGE HUGEPAGESTART) of PLPAGE)
(IQUOTIENT (IPLUS (fetch (PLPAGE HUGELENGTH) of PLPAGE)
511)
512)))
(replace (PLPAGE HUGELENGTH) of PLPAGE
with (IMAX (IDIFFERENCE (ITIMES (fetch (PLPAGE HUGEPAGELENGTH)
of PLPAGE)
512)
511)
(fetch (PLPAGE HUGELENGTH) of PLPAGE))))
(T (* Meef *)
(replace (PLPAGE \CREATIONDATE) of PLPAGE with \FLOPPY.SCAVENGE.IDATE)
(replace (PLPAGE \WRITEDATE) of PLPAGE with \FLOPPY.SCAVENGE.IDATE)
(replace (PLPAGE PAGELENGTH) of PLPAGE with LENGTH)
(replace (PLPAGE HUGEPAGESTART) of PLPAGE with 0)
(replace (PLPAGE HUGEPAGELENGTH) of PLPAGE with LENGTH)
(replace (PLPAGE PAGELENGTH) of PLPAGE with (ITIMES LENGTH 512))
(replace (PLPAGE $NAME) of PLPAGE with (GENSYM (QUOTE ?)))))
(\PFLOPPY.WRITEPAGENO START PLPAGE)))
(SETQ LOCATION (IPLUS LOCATION (ADD1 LENGTH)
1))))))
(\PFLOPPY.SCAVENGE.PSECTOR9
(LAMBDA NIL (* kbr: "29-Jul-84 20:09")
(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 CYLINDERS.PSECTOR9)
(replace (PSECTOR9 TRACKSPERCYLINDER) of PSECTOR9 with TRACKSPERCYLINDER.PSECTOR9)
(replace (PSECTOR9 SECTORSPERTRACK) of PSECTOR9 with SECTORSPERTRACK.PSECTOR9)
(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: "22-Jul-84 22:34")
(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 2 15 76))
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 31 TO 2310
DO (\PFLOPPY.READPAGENO I
\FLOPPY.SCRATCH.BUFFER)
(\BOUTS TOSTREAM
\FLOPPY.SCRATCH.BUFFER 0
512)))
(CLOSEF TOSTREAM)))))
(FLOPPY.FROM.FILE
(LAMBDA (FROMFILE) (* kbr: "22-Jul-84 22:34")
(WITH.MONITOR \FLOPPYLOCK
(PROG (FROMSTREAM PSECTOR9)
(SETQ FROMSTREAM (OPENSTREAM FROMFILE (QUOTE INPUT)
(QUOTE OLD)))
RETRY
(COND
((NOT (IEQP (GETFILEINFO FROMSTREAM (QUOTE LENGTH))
(ITIMES (IPLUS 1 1 (ITIMES 2 15 76))
512)))
(\FLOPPY.BREAK "Wrong length form FROMFILE")
(GO RETRY)))
(COND
((NOT (\FLOPPY.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 31 TO 2310
DO (\BINS FROMSTREAM
\FLOPPY.SCRATCH.BUFFER 0
512)
(\PFLOPPY.WRITEPAGENO I
\FLOPPY.SCRATCH.BUFFER)))
(CLOSEF FROMSTREAM)))))
)
(* "COMPACT" *)
(DEFINEQ
(FLOPPY.COMPACT
(LAMBDA NIL (* kbr: "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: "22-Jul-84 22:34")
(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))) (* Forcibly close floppy. *)
(\FLOPPY.CLOSE) (* 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))
(2 (COND
((EQUAL (fetch (PFALLOC FILENAME)
of (fetch (PFALLOC PREV) of (CAR (LAST PFALLOCS))))
(QUOTE (FREE)))
(RETURN)))) (* Need to COMPACT. *)
) (* Nontrivial case. *)
(\FLOPPY.MESSAGE "COMPACTing floppy")
(\PFLOPPY.COMPACT.PFALLOCS)
(\PFLOPPY.COMPACT.PSECTOR9)
(\PFLOPPY.COMPACT.PFILELIST)
(\FLOPPY.MESSAGE "Finished COMPACTing floppy")))))
(\PFLOPPY.COMPACT.PFALLOCS
(LAMBDA NIL (* kbr: "22-Jul-84 22:34")
(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)
2309) (* 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 2308 (fetch (PFALLOC END)
of PREV))
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)
2309) (* Zero length LAST block. *)
(SETQ NEXT LAST))
((IEQP (fetch (PFALLOC END) of PREV)
2310) (* 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: "22-Jul-84 22:34")
(* 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 32)
(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
((NOT (EQUAL (fetch (PFALLOC FILENAME) of NEXT)
(QUOTE (FREE))))
(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: "26-Aug-84 11:20")
(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))
(LISTPUT FLOPPYFILE (QUOTE DIRECTORY)
NIL)
(SETQ FLOPPYFILE (PACKFILENAME FLOPPYFILE))
(COPYFILE FILE FLOPPYFILE)
(POP FILES))))))
(FLOPPY.UNARCHIVE
(LAMBDA (HOST/DIRECTORY) (* kbr: "15-Feb-85 15:38")
(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)
(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 (PROG (ANSWER)
(COND
((IEQP (fetch (FCB ET) of DATUM)
CPMDELETEMARK)
(RETURN 0)))
(SETQ ANSWER (IQUOTIENT (IPLUS (fetch (FCB RECORDCOUNT)
of DATUM)
7)
8))
(COND
((IGREATERP ANSWER 16)
(SHOULDNT)))
(RETURN ANSWER)))
(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 (* lmm "13-Aug-84 15:53")
(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 ← (QUOTE \CFLOPPY.CLOSEFILE)
DELETEFILE ← (QUOTE \CFLOPPY.DELETEFILE)
DIRECTORYNAMEP ← (QUOTE TRUE)
EVENTFN ← (QUOTE \FLOPPY.EVENTFN)
GENERATEFILES ← (QUOTE \CFLOPPY.GENERATEFILES)
GETFILEINFO ← (QUOTE \CFLOPPY.GETFILEINFO)
GETFILENAME ← (QUOTE \CFLOPPY.GETFILENAME)
HOSTNAMEP ← (QUOTE \FLOPPY.HOSTNAMEP)
OPENFILE ← (QUOTE \CFLOPPY.OPENFILE)
READPAGES ← (QUOTE \CFLOPPY.READPAGES)
REOPENFILE ← (QUOTE \CFLOPPY.OPENFILE)
SETFILEINFO ← (QUOTE NILL)
TRUNCATEFILE ← (QUOTE \CFLOPPY.TRUNCATEFILE)
WRITEPAGES ← (QUOTE \CFLOPPY.WRITEPAGES)
DEVICEINFO ← \CFLOPPYINFO
RENAMEFILE ← (QUOTE \CFLOPPY.RENAMEFILE)))
(\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) (* edited: "23-Jul-84 15:31")
(OR (\SFLOPPY.HACK FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM)
(PROG (STREAM WAIT CALLOC FULLFILENAME)
(SETQ OTHERINFO (\FLOPPY.OTHERINFO OTHERINFO))
RETRY (* 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) (* edited: "23-Jul-84 15:31")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM FULLFILENAME)
(SETQ STREAM (\CFLOPPY.ASSURESTREAM FILE))
(\CLEARMAP STREAM)
(SETQ FULLFILENAME (\CFLOPPY.CLOSEFILE1 STREAM))
(RETURN FULLFILENAME)))))
(\CFLOPPY.CLOSEFILE1
(LAMBDA (STREAM) (* edited: "23-Jul-84 15:31")
(* 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)
(COND
((fetch (CALLOC DELETEFLG) of CALLOC)
(\CFLOPPY.DELETEFILE STREAM)))
(RETURN FULLFILENAME))))
(\CFLOPPY.DELETEFILE
(LAMBDA (FILE FDEV RECOG) (* kbr: "17-Jul-85 18:52")
(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
((NULL CALLOC) (* File not found. *)
(* Returning NIL means unsuccessful.
*)
(RETURN NIL)))
(SETQ FULLFILENAME (\FLOPPY.ADDDEVICENAME (fetch (CALLOC FILENAME)
of CALLOC)))
(COND
((\CFLOPPY.STREAMS.USING CALLOC)
(* Make deletion pending. *)
(replace (CALLOC DELETEFLG) of CALLOC with T))
(T (* Carry out deletion. *)
(replace (CALLOC DELETEFLG) of CALLOC with NIL)
(\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 (OLDFILE NEWFILE FDEV OLDRECOG NEWRECOG) (* edited: "23-Jul-84 15:31")
(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))
(SETQ CALLOC (\CFLOPPY.DIR.GET OLDFILENAME OLDRECOG))
(COND
((NULL CALLOC) (* File 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) (* edited: "23-Jul-84 15:31")
(* Return other open floppy streams with same CALLOC.
*)
(FOR F IN \OPENFILES WHEN (AND (EQ (fetch (STREAM DEVICE) of F)
\FLOPPYFDEV)
(EQ (fetch (FLOPPYSTREAM CALLOC) of F)
(fetch (FLOPPYSTREAM CALLOC) of STREAM))
(NOT (EQ F STREAM)))
COLLECT F)))
(\CFLOPPY.STREAMS.USING
(LAMBDA (CALLOC) (* edited: "23-Jul-84 15:31")
(* Return open floppy streams with this CALLOC.
*)
(FOR F IN \OPENFILES WHEN (AND (EQ (fetch (STREAM DEVICE) of F)
\FLOPPYFDEV)
(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: "19-Jul-85 16:29")
(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)
(for FCB in FCBS do (replace (FCB ET) of FCB with CPMDELETEMARK))
(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: "19-Jul-85 16:31")
(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
((AND (EQ (fetch (FCB ET) of FCB)
CPMDELETEMARK)
(NOT (FMEMB FCB FREEFCBS)))
(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 (* kbr: "19-Jul-85 16:37")
(* 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 \OPENFILES when (AND (EQ (fetch (STREAM DEVICE) of F)
\FLOPPYFDEV)
(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: "18-Jul-85 13:46")
(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)
77 T)
(OR (NOT (fetch (FLOPPYRESULT TWOSIDED)
of \FLOPPYRESULT))
(AND (\FLOPPY.RECALIBRATE T)
(\FLOPPY.FORMATTRACKS
\FLOPPY.IBMS128.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 1
SECTOR ← 1)
77 T)))))
(\FLOPPY.MESSAGE "RETRYING FORMAT")
(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 76
thereis (NULL (\FLOPPY.READSECTOR
\FLOPPY.IBMS128.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← I
HEAD ← 0
SECTOR ← 1)
\FLOPPY.SCRATCH.BUFFER T)
))
(\FLOPPY.MESSAGE "RETRYING FORMAT")
(GO RETRY))))))
(for I from 0 to 15 do (COND
((NULL (\CFLOPPY.WRITERECORDNO I \CFLOPPYBLANKSECTOR
T))
(* Unsuccessful write. *)
(\FLOPPY.MESSAGE "RETRYING FORMAT")
(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))
(DECLARE: DONTCOPY
(FILEMAP (NIL (75448 78516 (\FLOPPY.TRANSLATEFLOPPYRESULT 75458 . 76252) (\FLOPPY.SEVERE.ERROR 76254
. 76598) (\FLOPPY.TRANSLATEPMPAGEETYPE 76600 . 76956) (\FLOPPY.TRANSLATEFILETYPE 76958 . 77522) (
\FLOPPY.MTL.FIXP 77524 . 77756) (\FLOPPY.LTM.FIXP 77758 . 77990) (\FLOPPY.MTL.IDATE 77992 . 78252) (
\FLOPPY.LTM.IDATE 78254 . 78514)) (78994 98501 (\FLOPPY.TRANSLATESETUP 79004 . 79447) (\FLOPPY.SETUP
79449 . 81009) (\FLOPPY.CHECK.FLOPPYIOCB 81011 . 84766) (\FLOPPY.DENSITY 84768 . 85030) (
\FLOPPY.SECTORLENGTH 85032 . 85332) (\FLOPPY.ENCODEDSECTORLENGTH 85334 . 85645) (\FLOPPY.GAP3 85647 .
85943) (\FLOPPY.SECTORSPERTRACK 85945 . 86248) (\FLOPPY.RUN 86250 . 89805) (\FLOPPY.ERROR 89807 .
91034) (\FLOPPY.LOCK.BUFFER 91036 . 92054) (\FLOPPY.UNLOCK.BUFFER 92056 . 92625) (
\FLOPPY.PREPAREFORCRASH 92627 . 93186) (\FLOPPY.COMMAND 93188 . 93957) (\FLOPPY.INITIALIZE 93959 .
94485) (\FLOPPY.NOP 94487 . 94724) (\FLOPPY.RECALIBRATE 94726 . 94979) (\FLOPPY.RECOVER 94981 . 95237)
(\FLOPPY.TRANSFER 95239 . 95935) (\FLOPPY.READSECTOR 95937 . 96130) (\FLOPPY.WRITESECTOR 96132 .
96327) (\FLOPPY.FORMATTRACKS 96329 . 96960) (\FLOPPY.DISKCHANGECLEAR 96962 . 97226) (\FLOPPY.DUMP
97228 . 97906) (\FLOPPY.DEBUG 97908 . 98499)) (100500 117717 (FLOPPY.RESTART 100510 . 102208) (
FLOPPY.MODE 102210 . 104089) (\FLOPPY.EVENTFN 104091 . 104564) (\FLOPPY.HOSTNAMEP 104566 . 104868) (
\FLOPPY.ADDDEVICENAME 104870 . 105231) (\FLOPPY.ASSUREFILENAME 105233 . 106463) (\FLOPPY.OTHERINFO
106465 . 106974) (\FLOPPY.LEXASSOC 106976 . 107343) (\FLOPPY.LEXPUTASSOC 107345 . 108453) (
\FLOPPY.LEXREMOVEASSOC 108455 . 109259) (\FLOPPY.CACHED.READ 109261 . 109960) (\FLOPPY.CACHED.WRITE
109962 . 110918) (\FLOPPY.OPEN 110920 . 111208) (\FLOPPY.CLOSE 111210 . 111973) (\FLOPPY.FLUSH 111975
. 112895) (\FLOPPY.UNCACHED.READ 112897 . 113701) (\FLOPPY.UNCACHED.WRITE 113703 . 114539) (
\FLOPPY.EXISTSP 114541 . 115009) (\FLOPPY.MOUNTEDP 115011 . 115926) (\FLOPPY.WRITEABLEP 115928 .
116599) (\FLOPPY.CAN.READP 116601 . 116797) (\FLOPPY.CAN.WRITEP 116799 . 117031) (\FLOPPY.BREAK 117033
. 117283) (\FLOPPY.MESSAGE 117285 . 117604) (\FLOPPY.BUFFER 117606 . 117715)) (120944 179251 (
\PFLOPPY.INIT 120954 . 122139) (\PFLOPPY.OPEN 122141 . 123092) (\PFLOPPY.OPEN.PSECTOR9 123094 . 123516
) (\PFLOPPY.GET.PSECTOR9 123518 . 124356) (\PFLOPPY.OPEN.PFILELIST 124358 . 127000) (\PFLOPPY.DAMAGED
127002 . 127357) (\PFLOPPY.OPENFILE 127359 . 129625) (\PFLOPPY.OPENFILE1 129627 . 130953) (
\PFLOPPY.OPENOLDFILE 130955 . 131889) (\PFLOPPY.OPENNEWFILE 131891 . 133510) (\PFLOPPY.ASSURESTREAM
133512 . 133979) (\PFLOPPY.GETFILEINFO 133981 . 134495) (\PFLOPPY.GETFILEINFO1 134497 . 135818) (
\PFLOPPY.SETFILEINFO 135820 . 138135) (\PFLOPPY.CLOSEFILE 138137 . 138510) (\PFLOPPY.CLOSEFILE1 138512
. 140718) (\PFLOPPY.DELETEFILE 140720 . 142242) (\PFLOPPY.GENERATEFILES 142244 . 144818) (
\PFLOPPY.NEXTFILEFN 144820 . 145916) (\PFLOPPY.FILEINFOFN 145918 . 146282) (\PFLOPPY.RENAMEFILE 146284
. 148196) (\PFLOPPY.STREAMS.AGAINST 148198 . 148761) (\PFLOPPY.STREAMS.USING 148763 . 149242) (
\PFLOPPY.READPAGES 149244 . 149552) (\PFLOPPY.READPAGE 149554 . 150663) (\PFLOPPY.READPAGENO 150665 .
151377) (\PFLOPPY.WRITEPAGENO 151379 . 152090) (\PFLOPPY.PAGENOTODISKADDRESS 152092 . 152810) (
\PFLOPPY.DISKADDRESSTOPAGENO 152812 . 153371) (\PFLOPPY.DIR.GET 153373 . 154775) (\PFLOPPY.DIR.PUT
154777 . 156329) (\PFLOPPY.DIR.REMOVE 156331 . 157923) (\PFLOPPY.DIR.VERSION 157925 . 159223) (
\PFLOPPY.GETFILENAME 159225 . 161521) (\PFLOPPY.CREATE.PFILELIST 161523 . 162251) (
\PFLOPPY.ADD.TO.PFILELIST 162253 . 166290) (\PFLOPPY.DELETE.FROM.PFILELIST 166292 . 167727) (
\PFLOPPY.SAVE.PFILELIST 167729 . 168304) (\PFLOPPY.SAVE.PSECTOR9 168306 . 168756) (\PFLOPPY.WRITEPAGES
168758 . 169070) (\PFLOPPY.WRITEPAGE 169072 . 169871) (\PFLOPPY.TRUNCATEFILE 169873 . 171378) (
\PFLOPPY.FORMAT 171380 . 177178) (\PFLOPPY.CONFIRM 177180 . 178408) (\PFLOPPY.GET.NAME 178410 . 178734
) (\PFLOPPY.SET.NAME 178736 . 179249)) (179515 201457 (\PFLOPPY.ALLOCATE 179525 . 181859) (
\PFLOPPY.ALLOCATE.LARGEST 181861 . 182611) (\PFLOPPY.TRUNCATE 182613 . 185613) (\PFLOPPY.DEALLOCATE
185615 . 186715) (\PFLOPPY.EXTEND 186717 . 191639) (\PFLOPPY.GAINSPACE 191641 . 192679) (
\PFLOPPY.GAINSPACE.MERGE 192681 . 194875) (\PFLOPPY.ALLOCATE.WATCHDOG 194877 . 195524) (
\PFLOPPY.FREE.PAGES 195526 . 196683) (\PFLOPPY.LENGTHS 196685 . 196940) (\PFLOPPY.STARTS 196942 .
197195) (\PFLOPPY.ICHECK 197197 . 200512) (\PFLOPPY.ALLOCATIONS 200514 . 201455)) (201483 204375 (
FLOPPY.FREE.PAGES 201493 . 201828) (FLOPPY.FORMAT 201830 . 202192) (FLOPPY.NAME 202194 . 202391) (
FLOPPY.GET.NAME 202393 . 202664) (FLOPPY.SET.NAME 202666 . 202942) (FLOPPY.CAN.READP 202944 . 203220)
(FLOPPY.CAN.WRITEP 203222 . 203500) (FLOPPY.WAIT.FOR.FLOPPY 203502 . 204373)) (204982 220028 (
\SFLOPPY.INIT 204992 . 206105) (\SFLOPPY.GETFILEINFO 206107 . 207723) (\SFLOPPY.OPENHUGEFILE 207725 .
210002) (\SFLOPPY.WRITEPAGES 210004 . 210313) (\SFLOPPY.WRITEPAGE 210315 . 211537) (\SFLOPPY.READPAGES
211539 . 211932) (\SFLOPPY.READPAGE 211934 . 212611) (\SFLOPPY.CLOSEHUGEFILE 212613 . 213924) (
\SFLOPPY.INPUTFLOPPY 213926 . 215673) (\SFLOPPY.OUTPUTFLOPPY 215675 . 217789) (\SFLOPPY.CLOSEFLOPPY
217791 . 219345) (\SFLOPPY.HACK 219347 . 220026)) (220500 234367 (\HFLOPPY.INIT 220510 . 221641) (
\HFLOPPY.GETFILEINFO 221643 . 223259) (\HFLOPPY.OPENHUGEFILE 223261 . 225778) (\HFLOPPY.WRITEPAGES
225780 . 226092) (\HFLOPPY.WRITEPAGE 226094 . 227316) (\HFLOPPY.READPAGES 227318 . 227714) (
\HFLOPPY.READPAGE 227716 . 228393) (\HFLOPPY.CLOSEHUGEFILE 228395 . 229221) (\HFLOPPY.INPUTFLOPPY
229223 . 230970) (\HFLOPPY.OUTPUTFLOPPY 230972 . 232732) (\HFLOPPY.CLOSEFLOPPY 232734 . 234365)) (
234433 248191 (FLOPPY.SCAVENGE 234443 . 234635) (\PFLOPPY.SCAVENGE 234637 . 235189) (
\PFLOPPY.SCAVENGE.PMPAGES 235191 . 236007) (\PFLOPPY.SCAVENGE.PMPAGE31 236009 . 238281) (
\PFLOPPY.SCAVENGE.PMPAGE.AFTER 238283 . 239655) (\PFLOPPY.SCAVENGE.PMPAGE.AFTER1 239657 . 242473) (
\PFLOPPY.SCAVENGE.PLPAGES 242475 . 245610) (\PFLOPPY.SCAVENGE.PSECTOR9 245612 . 247738) (
\PFLOPPY.SCAVENGE.PFILELIST 247740 . 248189)) (248213 251408 (FLOPPY.TO.FILE 248223 . 249753) (
FLOPPY.FROM.FILE 249755 . 251406)) (251433 260028 (FLOPPY.COMPACT 251443 . 251780) (\PFLOPPY.COMPACT
251782 . 253333) (\PFLOPPY.COMPACT.PFALLOCS 253335 . 256355) (\PFLOPPY.COMPACT.PFALLOC 256357 . 258703
) (\PFLOPPY.COMPACT.PSECTOR9 258705 . 259356) (\PFLOPPY.COMPACT.PFILELIST 259358 . 260026)) (260053
262057 (FLOPPY.ARCHIVE 260063 . 261154) (FLOPPY.UNARCHIVE 261156 . 262055)) (272307 329580 (
\CFLOPPY.GET.FCB.FILENAME 272317 . 273026) (\CFLOPPY.SET.FCB.FILENAME 273028 . 273473) (\CFLOPPY.INIT
273475 . 275370) (\CFLOPPY.OPEN 275372 . 276124) (\CFLOPPY.OPEN.DIRECTORY 276126 . 279402) (
\CFLOPPY.OPENFILE 279404 . 281666) (\CFLOPPY.OPENFILE1 281668 . 283194) (\CFLOPPY.OPENOLDFILE 283196
. 285349) (\CFLOPPY.OPENNEWFILE 285351 . 286546) (\CFLOPPY.ASSURESTREAM 286548 . 287017) (
\CFLOPPY.GETFILEINFO 287019 . 287650) (\CFLOPPY.GETFILEINFO1 287652 . 288383) (\CFLOPPY.SETFILEINFO
288385 . 289068) (\CFLOPPY.CLOSEFILE 289070 . 289443) (\CFLOPPY.CLOSEFILE1 289445 . 290464) (
\CFLOPPY.DELETEFILE 290466 . 291730) (\CFLOPPY.GETFILENAME 291732 . 292552) (\CFLOPPY.GENERATEFILES
292554 . 294168) (\CFLOPPY.NEXTFILEFN 294170 . 295265) (\CFLOPPY.FILEINFOFN 295267 . 295631) (
\CFLOPPY.RENAMEFILE 295633 . 297420) (\CFLOPPY.STREAMS.AGAINST 297422 . 297982) (
\CFLOPPY.STREAMS.USING 297984 . 298460) (\CFLOPPY.READPAGES 298462 . 298773) (\CFLOPPY.READPAGE 298775
. 300024) (\CFLOPPY.PHYSICAL.RECORDNO 300026 . 300890) (\CFLOPPY.READRECORDNO 300892 . 301613) (
\CFLOPPY.WRITERECORDNO 301615 . 302335) (\CFLOPPY.RECORDNOTODISKADDRESS 302337 . 303162) (
\CFLOPPY.DIR.GET 303164 . 304276) (\CFLOPPY.DIR.PUT 304278 . 305675) (\CFLOPPY.DIR.REMOVE 305677 .
306881) (\CFLOPPY.WRITEPAGES 306883 . 307198) (\CFLOPPY.WRITEPAGE 307200 . 308127) (
\CFLOPPY.TRUNCATEFILE 308129 . 310013) (\CFLOPPY.ALLOCATE.FCB 310015 . 310962) (
\CFLOPPY.ALLOCATE.GROUP 310964 . 311516) (\CFLOPPY.ALLOCATE 311518 . 313890) (\CFLOPPY.TRUNCATE 313892
. 316490) (\CFLOPPY.DEALLOCATE 316492 . 317518) (\CFLOPPY.EXTEND 317520 . 319728) (
\CFLOPPY.SAVE.CHANGES 319730 . 321837) (\CFLOPPY.ICHECK 321839 . 323956) (\CFLOPPY.ICHECK.CALLOC
323958 . 324724) (\CFLOPPY.FREE.PAGES 324726 . 325079) (\CFLOPPY.FORMAT 325081 . 327237) (
CPM.DIRECTORY 327239 . 329578)))))
STOP