(FILECREATED "29-Nov-84 16:09:16" {ERIS}<SANNELLA>LISP>FLOPPY.;3 281619
changes to: (FNS \PFLOPPY.ADD.TO.PFILELIST \PFLOPPY.OPEN.PFILELIST)
previous date: "29-Nov-84 09:51:20" {ERIS}<SANNELLA>LISP>FLOPPY.;1)
(* Copyright (c) 1984 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.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)))
(/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)))
(/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)))
(/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)))
(/DECLAREDATATYPE (QUOTE PFLE)
(QUOTE (SWAPPEDFIXP WORD WORD WORD)))
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(ACCESSFNS DISKADDRESS ((CYLINDER (LRSH DATUM 16))
(HEAD (LRSH (LOGAND DATUM 65535)
8))
(SECTOR (LOGAND DATUM 255)))
[CREATE (IPLUS (COND
((OR (ILESSP CYLINDER 0)
(IGREATERP CYLINDER 76))
(\FLOPPY.SEVERE.ERROR "Illegal Diskaddress"))
(T (LLSH CYLINDER 16)))
(COND
((OR (ILESSP HEAD 0)
(IGREATERP HEAD 1))
(\FLOPPY.SEVERE.ERROR "Illegal Diskaddress"))
(T (LLSH HEAD 8)))
(COND
((OR (ILESSP SECTOR 1)
(IGREATERP SECTOR 36))
(\FLOPPY.SEVERE.ERROR "Illegal Diskaddress"))
(T SECTOR])
(DATATYPE 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))
(BINARY (replace (PLPAGE \TYPE) of DATUM with 2))
(replace (PLPAGE \TYPE) of DATUM with 1)))
(\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)))
(/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)))
(/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)))
(/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)))
(/DECLAREDATATYPE (QUOTE PFLE)
(QUOTE (SWAPPEDFIXP WORD WORD WORD)))
)
(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) (* lmm "13-Aug-84 16:18")
(* 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))
(\FLOPPY.CHECK.FLOPPYIOCB FLOPPYIOCB)
(COND
(\FLOPPY.DEBUG (* For floppy wizards. *)
(COND
(\FLOPPY.INSPECTW (CLOSEW \FLOPPY.INSPECTW)))
(SETQ \FLOPPY.INSPECTW
(INSPECT FLOPPYIOCB (QUOTE FLOPPYIOCB)
(create POSITION
XCOORD ← 0
YCOORD ← 0)))
(printout T (fetch (FLOPPYIOCB $COMMAND) of FLOPPYIOCB)
" (C"
(fetch (FLOPPYIOCB CYLINDER) of FLOPPYIOCB)
" H"
(fetch (FLOPPYIOCB HEAD) of FLOPPYIOCB)
" S"
(fetch (FLOPPYIOCB SECTOR) of FLOPPYIOCB)
") " T)))
(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
(\FLOPPY.DEBUG (PRIN1 (fetch (FLOPPYRESULT MPMESSAGE) of \FLOPPYRESULT)
T)
(BREAK1 NIL T)))
(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
(\FLOPPY.DEBUG (PRIN1 (QUOTE CRCERROR)
T)
(BREAK1 NIL T)))
(COND
((AND RETRYFLG NOERROR) (* Abandon command. *)
(RETURN NIL)))
(COND
((OR RETRYFLG \FLOPPY.DEBUG)
(\FLOPPY.MESSAGE (QUOTE CRCERROR)))))
((AND (OR (fetch (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. *)
(COND
(\FLOPPY.DEBUG (PRIN1 (\FLOPPY.TRANSLATEFLOPPYRESULT (fetch (FLOPPYRESULT WORD)
of \FLOPPYRESULT))
T)
(\FLOPPY.MESSAGE (\FLOPPY.TRANSLATEFLOPPYRESULT (fetch (FLOPPYRESULT
WORD)
of \FLOPPYRESULT)))
(BREAK1 NIL T)))
(\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: "22-Jul-84 22:34")
(PROG ($FLOPPYRESULT)
(SETQ $FLOPPYRESULT (\FLOPPY.TRANSLATEFLOPPYRESULT (fetch (FLOPPYRESULT WORD) of
\FLOPPYRESULT)))
(COND
(\FLOPPY.DEBUG (PRIN1 $FLOPPYRESULT \FLOPPY.HISTORYW)
(BREAK1 NIL T)))
(COND
((EQ $FLOPPYRESULT (QUOTE DOOROPENED))
(\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. INITIALIZE 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: "22-Jul-84 22:34")
(GLOBALRESOURCE \FLOPPY.SCRATCH.FLOPPYIOCB (\FLOPPY.COMMAND \FLOPPY.SCRATCH.FLOPPYIOCB
C.INITIALIZE SC.NOP 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.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 (* lmm "13-Aug-84 15:45")
(* 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) (* edited: "23-Jul-84 15:33")
(WITH.MONITOR \FLOPPYLOCK (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) (* edited: "23-Jul-84 15:33")
(* NAME equals name of floppy FDEV? *)
(WITH.MONITOR \FLOPPYLOCK (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) (* edited: "23-Jul-84 15:33")
(* 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)))
(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 ""]
(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 (* edited: "23-Jul-84 15:33")
(* Forcibly flush streams. *)
(PROG NIL (* TBW: This function will go away when a wrong floppy
FDEV is implemented. *)
(for STREAM in \OPENFILES when (EQ (fetch (STREAM DEVICE) of STREAM)
\FLOPPYFDEV)
do (SETQ \OPENFILES (DREMOVE STREAM \OPENFILES])
(\FLOPPY.UNCACHED.READ
(LAMBDA (NOERROR) (* edited: "23-Jul-84 15:33")
(* 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) (* edited: "23-Jul-84 15:33")
(* 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)))
(/DECLAREDATATYPE (QUOTE PFINFO)
(QUOTE (POINTER POINTER POINTER POINTER POINTER)))
(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)))
(/DECLAREDATATYPE (QUOTE PFINFO)
(QUOTE (POINTER POINTER POINTER POINTER POINTER)))
)
(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: "25-Nov-84 13:01")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM PLPAGE)
(\FLOPPY.CACHED.WRITE)
(SETQ STREAM (\PFLOPPY.ASSURESTREAM FILE))
(COND
(STREAM (SETQ PLPAGE (fetch (FLOPPYSTREAM PLPAGE) of STREAM))
(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))
(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))
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)))))))))
(\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) (* edited: "23-Jul-84 15:35")
(WITH.MONITOR \FLOPPYLOCK (PROG (FILENAME PFALLOC PMPAGE NEXT NPMPAGE FULLFILENAME)
(\PFLOPPY.OPEN)
(SETQ FILENAME (\FLOPPY.ASSUREFILENAME FILE))
(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: "25-Nov-84 12:11")
(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 T)
(\FLOPPY.CACHED.READ T))
(SETQ FILTER (DIRECTORY.MATCH.SETUP PATTERN))
(SETQ ALLOCS (for PFALLOC in (fetch (PFLOPPYFDEV PFALLOCS)
of \FLOPPYFDEV)
when (AND (LITATOM (fetch (PFALLOC FILENAME)
of PFALLOC))
(DIRECTORY.MATCH
FILTER
(fetch (PFALLOC FILENAME)
of PFALLOC)))
collect PFALLOC))))
(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) (* edited: "23-Jul-84 15:35")
(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# (fetch (STREAM EPAGE) of STREAM))
(* 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: "13-Oct-84 15:23")
(PROG (UNAME NALIST EALIST VALIST NAME EXTENSION VERSION PFALLOC)
(COND
((EQ RECOG (QUOTE NEW))
(RETURN NIL)))
(SETQ FILENAME (\FLOPPY.ASSUREFILENAME FILENAME))
(COND
((NOT (EQ RECOG (QUOTE EXACT)))
(SETQ UNAME (UNPACKFILENAME FILENAME))
(SETQ VERSION (U-CASE (LISTGET UNAME (QUOTE VERSION))))
(SETQ NAME (PACKFILENAME (LIST (QUOTE DIRECTORY)
(LISTGET UNAME (QUOTE DIRECTORY))
(QUOTE NAME)
(U-CASE (LISTGET UNAME (QUOTE NAME))))))
(SETQ EXTENSION (U-CASE (LISTGET UNAME (QUOTE EXTENSION))))
(SETQ NALIST (fetch (PFLOPPYFDEV DIR) of \FLOPPYFDEV))
(SETQ EALIST (CDR (ASSOC NAME NALIST)))
(SETQ VALIST (CDR (ASSOC EXTENSION EALIST)))
(SETQ VERSION (\PFLOPPY.DIR.VERSION VERSION RECOG VALIST))
(SETQ 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: "13-Oct-84 15:24")
(PROG (UNAME NALIST EALIST VALIST NAME EXTENSION VERSION)
(SETQ FILENAME (\FLOPPY.ASSUREFILENAME FILENAME))
(SETQ UNAME (UNPACKFILENAME FILENAME))
(SETQ VERSION (U-CASE (LISTGET UNAME (QUOTE VERSION))))
(SETQ NAME (PACKFILENAME (LIST (QUOTE DIRECTORY)
(LISTGET UNAME (QUOTE DIRECTORY))
(QUOTE NAME)
(U-CASE (LISTGET UNAME (QUOTE NAME))))))
(SETQ EXTENSION (U-CASE (LISTGET UNAME (QUOTE EXTENSION))))
(SETQ NALIST (fetch (PFLOPPYFDEV DIR) of \FLOPPYFDEV))
(SETQ EALIST (CDR (ASSOC NAME NALIST)))
(SETQ VALIST (CDR (ASSOC EXTENSION EALIST)))
(SETQ VERSION (\PFLOPPY.DIR.VERSION VERSION RECOG VALIST))
(LISTPUT UNAME (QUOTE VERSION)
VERSION)
(LISTPUT UNAME (QUOTE HOST)
NIL)
(SETQ FILENAME (PACKFILENAME UNAME))
(replace (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: "13-Oct-84 15:24")
(PROG (FILENAME UNAME NALIST EALIST VALIST NAME EXTENSION VERSION)
(SETQ FILENAME (fetch (PFALLOC FILENAME) of PFALLOC))
(SETQ UNAME (UNPACKFILENAME FILENAME))
(SETQ VERSION (U-CASE (LISTGET UNAME (QUOTE VERSION))))
(SETQ NAME (PACKFILENAME (LIST (QUOTE DIRECTORY)
(LISTGET UNAME (QUOTE DIRECTORY))
(QUOTE NAME)
(U-CASE (LISTGET UNAME (QUOTE NAME))))))
(SETQ EXTENSION (U-CASE (LISTGET UNAME (QUOTE EXTENSION))))
(SETQ NALIST (fetch (PFLOPPYFDEV DIR) of \FLOPPYFDEV))
(SETQ EALIST (CDR (ASSOC NAME NALIST)))
(SETQ VALIST (CDR (ASSOC EXTENSION EALIST)))
(SETQ VERSION (\PFLOPPY.DIR.VERSION VERSION (QUOTE OLD)
VALIST))
(SETQ VALIST (\FLOPPY.LEXREMOVEASSOC VERSION VALIST))
(COND
(VALIST (SETQ EALIST (\FLOPPY.LEXPUTASSOC EXTENSION VALIST EALIST))
(SETQ NALIST (\FLOPPY.LEXPUTASSOC NAME EALIST NALIST)))
(T (SETQ EALIST (\FLOPPY.LEXREMOVEASSOC EXTENSION EALIST))
(COND
(EALIST (SETQ NALIST (\FLOPPY.LEXPUTASSOC NAME EALIST NALIST)))
(T (SETQ NALIST (\FLOPPY.LEXREMOVEASSOC NAME NALIST))))))
(replace (PFLOPPYFDEV DIR) of \FLOPPYFDEV with NALIST)
(RETURN PFALLOC))))
(\PFLOPPY.DIR.VERSION
[LAMBDA (VERSION RECOG VALIST) (* edited: "23-Jul-84 15:35")
(PROG NIL
(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]
(RETURN VERSION])
(\PFLOPPY.GETFILENAME
(LAMBDA (FILE RECOG FDEV) (* kbr: "13-Oct-84 15:34")
(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 (PACKFILENAME (LIST (QUOTE DIRECTORY)
(LISTGET UNAME (QUOTE
DIRECTORY))
(QUOTE NAME)
(U-CASE (LISTGET UNAME
(QUOTE NAME)))
)))
(SETQ EXTENSION (LISTGET UNAME (QUOTE EXTENSION)))
(SETQ VERSION (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
((AND (NOT (EQ RECOG (QUOTE NEW)))
(NULL (SETQ PFALLOC (CDR (ASSOC VERSION VALIST)))))
(* INFILEP returns NIL if filename not found *)
(RETURN NIL)))
(LISTPUT UNAME (QUOTE VERSION)
VERSION)
(SETQ FILENAME (PACKFILENAME UNAME))))
(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) (* lmm "13-Aug-84 15:42")
(* Return T if formatted, NIL if user abort.
*)
(PROG (PSECTOR9 PMPAGE31 PMPAGE34 PMPAGE2310 PFILELIST PFLE)
(\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. *)
RETRY
(COND
((NOT (\FLOPPY.CAN.WRITEP))
(GO RETRY))) (* Configure floppy. *)
(COND
((OR SLOWFLG (NULL PSECTOR9))
(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.INITIALIZE 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))))) (* 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 (* edited: "23-Jul-84 15:35")
(PROG NIL
(\FLOPPY.UNCACHED.READ)
(\PFLOPPY.OPEN.PSECTOR9)
(RETURN (fetch (PSECTOR9 $LABEL) of (fetch (PFLOPPYFDEV PSECTOR9) of \FLOPPYFDEV))))))
(\PFLOPPY.SET.NAME
(LAMBDA (NAME) (* edited: "23-Jul-84 15:35")
(PROG NIL
(\FLOPPY.UNCACHED.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: "22-Jul-84 22:34")
(* 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")))))
(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: "22-Jul-84 22:40")
(WITH.MONITOR \FLOPPYLOCK (PROG (ANSWER)
(\FLOPPY.INITIALIZE)
(SETQ ANSWER (\FLOPPY.CAN.READP T))
(RETURN ANSWER)))))
(FLOPPY.CAN.WRITEP
(LAMBDA NIL (* kbr: "22-Jul-84 22:40")
(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-Nov-84 11:31")
(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.
*)
(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))
(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) (* kbr: "26-Aug-84 11:20")
(* 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))) (* At this point \SFLOPPY.PAGENO is the next page we
would write. *)
(\PFLOPPY.TRUNCATEFILE STREAM \SFLOPPY.PAGENO (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) (* mjs "10-Oct-84 14:40")
(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-Nov-84 11:31")
(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))
(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) (* kbr: "26-Aug-84 11:20")
(* 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 \HFLOPPY.PAGENO (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: "26-Aug-84 11:20")
(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 T)
(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)))
(/DECLAREDATATYPE (QUOTE CALLOC)
(QUOTE (POINTER POINTER POINTER POINTER FLAG FLAG)))
(/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)))
(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 DATUM 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)))
(/DECLAREDATATYPE (QUOTE CALLOC)
(QUOTE (POINTER POINTER POINTER POINTER FLAG FLAG)))
(/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)))
)
(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) (* edited: "23-Jul-84 15:31")
(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))))
(NEW (COND
((NULL CALLOC)
(\CFLOPPY.OPENNEWFILE FILENAME
OTHERINFO))))
((OLD OLDEST)
(\CFLOPPY.OPENOLDFILE CALLOC))
(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) (* edited: "23-Jul-84 15:31")
(PROG (FCBS STREAM)
(COND
((NULL CALLOC) (* Error in calling function.
*)
(RETURN NIL)))
(SETQ FCBS (fetch (CALLOC FCBS) of CALLOC))
(SETQ STREAM (CREATE STREAM
DEVICE ← \FLOPPYFDEV
FULLFILENAME ← (\FLOPPY.ADDDEVICENAME (fetch (CALLOC FILENAME)
of CALLOC))
EPAGE ← (IQUOTIENT (fetch (CALLOC LENGTH) of CALLOC)
512)
EOFFSET ← (IREMAINDER (fetch (CALLOC LENGTH) of CALLOC)
512)))
(replace (FLOPPYSTREAM CALLOC) of STREAM with CALLOC)
(replace (FLOPPYSTREAM FCBS) of STREAM with FCBS)
(RETURN STREAM))))
(\CFLOPPY.OPENNEWFILE
(LAMBDA (FILENAME OTHERINFO) (* edited: "23-Jul-84 15:31")
(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))
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) (* edited: "23-Jul-84 15:31")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM LP ANSWER)
(\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) (* edited: "23-Jul-84 15:31")
(* Used by \CFLOPPY.GETFILEINFO & \CFLOPPY.FILEINFOFN
*)
(PROG (ANSWER)
(SETQ ANSWER (SELECTQ ATTRIBUTE
(LENGTH (fetch (CALLOC LENGTH) of CALLOC))
(SIZE (fetch (CALLOC PAGELENGTH) of CALLOC))
NIL))
(RETURN ANSWER))))
(\CFLOPPY.SETFILEINFO
(LAMBDA NIL (* edited: "23-Jul-84 15:31")
NIL))
(\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) (* edited: "23-Jul-84 15:31")
(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) (* edited: "23-Jul-84 15:31")
(WITH.MONITOR \FLOPPYLOCK (PROG (STREAM CALLOC RECORDNO)
(SETQ STREAM (\CFLOPPY.ASSURESTREAM FILE))
(SETQ CALLOC (fetch (FLOPPYSTREAM CALLOC) of STREAM))
(COND
((IGREATERP FIRSTPAGE# (fetch (STREAM EPAGE) of STREAM))
(* Don't bother to do actual read.
*)
(COND
((IGREATERP 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) (* edited: "23-Jul-84 15: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)))
(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) (* edited: "23-Jul-84 15:32")
(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 blanks *)
(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 SP)))
(\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) (* edited: "23-Jul-84 15:32")
(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.
*)
(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)))
(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) (* edited: "23-Jul-84 15:32")
(PROG (OLDNGROUPS NGROUPS NFCBS FREEFCBS FREEGROUPS CHANGEDFCBS CHANGEDGROUPS)
(COND
((ILEQ (fetch (CALLOC RECORDCOUNT) of CALLOC)
NRECORDS) (* Nothing to do. *)
(RETURN)))
(SETQ OLDNGROUPS (IQUOTIENT (IPLUS (fetch (CALLOC RECORDCOUNT) of CALLOC)
7)
8))
(SETQ NGROUPS (IQUOTIENT (IPLUS NRECORDS 7)
8))
(SETQ NFCBS (IQUOTIENT (IPLUS NGROUPS 15)
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. *)
(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. *)
(UNINTERRUPTABLY
(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) (* edited: "23-Jul-84 15:32")
(PROG (FCBS)
(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))
(FOR FCB IN FCBS DO (replace (FCB ET) of FCB with CPMDELETEMARK))
(replace (CALLOC FCBS) of CALLOC with NIL))
(\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) (* edited: "23-Jul-84 15:32")
(PROG (FREEFCBS FREEGROUPS RECORDNO RECORDNOS) (* Determine new FREEFCBS & FREEGROUPS for
\CFLOPPYINFO. Calc which directory records need to be
rewritten. *)
(SETQ FREEFCBS (fetch (CINFO FREEFCBS) of \CFLOPPYINFO))
(SETQ FREEGROUPS (fetch (CINFO FREEGROUPS) of \CFLOPPYINFO))
(FOR FCB IN (fetch (CALLOC CHANGEDFCBS) of CALLOC)
DO (\BLT (\ADDBASE \CFLOPPYDIRECTORY (ITIMES 16 (fetch (FCB NUMBER) of FCB)))
FCB 16)
(SETQ RECORDNO (IQUOTIENT (fetch (FCB NUMBER) of FCB)
4))
(COND
((NOT (MEMB RECORDNO RECORDNOS))
(PUSH RECORDNOS RECORDNO)))
(COND
((IEQP (fetch (FCB ET) of FCB)
CPMDELETEMARK)
(PUSH FREEFCBS FCB))))
(SETQ FREEGROUPS (APPEND (fetch (CALLOC CHANGEDGROUPS) of CALLOC)
FREEGROUPS)) (* Write out changed directory records *)
(FOR RECORDNO IN RECORDNOS DO (\CFLOPPY.WRITERECORDNO RECORDNO (\ADDBASE \CFLOPPYDIRECTORY
(ITIMES 64
RECORDNO))))
(* Update CALLOC & \CFLOPPYINFO *)
(UNINTERRUPTABLY
(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 (* edited: "23-Jul-84 15:32")
(* 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 (UNION (fetch (CALLOC FCBS) of CALLOC)
(fetch (CALLOC CHANGEDFCBS) of CALLOC))
USEDFCBS))
(SETQ USEDGROUPS (APPEND (UNION (fetch (CALLOC GROUPS) of CALLOC)
(fetch (CALLOC CHANGEDGROUPS) 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 (IEQP (LENGTH FCBS)
64))
(\FLOPPY.SEVERE.ERROR "Wrong number of FCBS")))
(COND
((NOT (IEQP (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) (* edited: "23-Jul-84 15:32")
(* 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")))))
(\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) (* csk: "29-Jul-84 18:15")
(WITH.MONITOR \FLOPPYLOCK
(PROG NIL
(\FLOPPY.CLOSE)
RETRY
(COND
((NOT (\FLOPPY.UNCACHED.WRITE))
(GO RETRY))) (* Configure floppy. *)
(COND
(SLOWFLG (GLOBALRESOURCE \FLOPPY.IBMS128.FLOPPYIOCB
(COND
((NOT (AND (\FLOPPY.INITIALIZE T)
(\FLOPPY.RECALIBRATE T)
(\FLOPPY.FORMATTRACKS
\FLOPPY.IBMS128.FLOPPYIOCB
(create
DISKADDRESS
CYLINDER ← 0
HEAD ←
0
SECTOR
← 1)
77 T)
(\FLOPPY.INITIALIZE T)
(\FLOPPY.RECALIBRATE T)
(\FLOPPY.FORMATTRACKS
\FLOPPY.IBMS128.FLOPPYIOCB
(create
DISKADDRESS
CYLINDER ← 0
HEAD ←
1
SECTOR
← 1)
77 T)))
(\FLOPPY.MESSAGE "RETRYING FORMAT")
(GO RETRY))))))
(for I from 0 to 15 do (COND
((NULL (\CFLOPPY.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))
(DECLARE: DONTCOPY
(FILEMAP (NIL (36639 39707 (\FLOPPY.TRANSLATEFLOPPYRESULT 36649 . 37443) (\FLOPPY.SEVERE.ERROR 37445
. 37789) (\FLOPPY.TRANSLATEPMPAGEETYPE 37791 . 38147) (\FLOPPY.TRANSLATEFILETYPE 38149 . 38713) (
\FLOPPY.MTL.FIXP 38715 . 38947) (\FLOPPY.LTM.FIXP 38949 . 39181) (\FLOPPY.MTL.IDATE 39183 . 39443) (
\FLOPPY.LTM.IDATE 39445 . 39705)) (40185 60548 (\FLOPPY.TRANSLATESETUP 40195 . 40638) (\FLOPPY.SETUP
40640 . 42200) (\FLOPPY.CHECK.FLOPPYIOCB 42202 . 45944) (\FLOPPY.DENSITY 45946 . 46208) (
\FLOPPY.SECTORLENGTH 46210 . 46510) (\FLOPPY.ENCODEDSECTORLENGTH 46512 . 46823) (\FLOPPY.GAP3 46825 .
47121) (\FLOPPY.SECTORSPERTRACK 47123 . 47426) (\FLOPPY.RUN 47428 . 52304) (\FLOPPY.ERROR 52306 .
53625) (\FLOPPY.LOCK.BUFFER 53627 . 54645) (\FLOPPY.UNLOCK.BUFFER 54647 . 55216) (
\FLOPPY.PREPAREFORCRASH 55218 . 55777) (\FLOPPY.COMMAND 55779 . 56545) (\FLOPPY.INITIALIZE 56547 .
56798) (\FLOPPY.NOP 56800 . 57037) (\FLOPPY.RECALIBRATE 57039 . 57292) (\FLOPPY.RECOVER 57294 . 57550)
(\FLOPPY.TRANSFER 57552 . 58248) (\FLOPPY.READSECTOR 58250 . 58443) (\FLOPPY.WRITESECTOR 58445 .
58640) (\FLOPPY.FORMATTRACKS 58642 . 59273) (\FLOPPY.DUMP 59275 . 59953) (\FLOPPY.DEBUG 59955 . 60546)
) (62532 79455 (FLOPPY.RESTART 62542 . 64257) (FLOPPY.MODE 64259 . 66138) (\FLOPPY.EVENTFN 66140 .
66649) (\FLOPPY.HOSTNAMEP 66651 . 67000) (\FLOPPY.ADDDEVICENAME 67002 . 67363) (\FLOPPY.ASSUREFILENAME
67365 . 68501) (\FLOPPY.OTHERINFO 68503 . 69012) (\FLOPPY.LEXASSOC 69014 . 69381) (
\FLOPPY.LEXPUTASSOC 69383 . 70491) (\FLOPPY.LEXREMOVEASSOC 70493 . 71297) (\FLOPPY.CACHED.READ 71299
. 71998) (\FLOPPY.CACHED.WRITE 72000 . 72956) (\FLOPPY.OPEN 72958 . 73246) (\FLOPPY.CLOSE 73248 .
74011) (\FLOPPY.FLUSH 74013 . 74579) (\FLOPPY.UNCACHED.READ 74581 . 75412) (\FLOPPY.UNCACHED.WRITE
75414 . 76277) (\FLOPPY.EXISTSP 76279 . 76747) (\FLOPPY.MOUNTEDP 76749 . 77664) (\FLOPPY.WRITEABLEP
77666 . 78337) (\FLOPPY.CAN.READP 78339 . 78535) (\FLOPPY.CAN.WRITEP 78537 . 78769) (\FLOPPY.BREAK
78771 . 79021) (\FLOPPY.MESSAGE 79023 . 79342) (\FLOPPY.BUFFER 79344 . 79453)) (81837 136994 (
\PFLOPPY.INIT 81847 . 83032) (\PFLOPPY.OPEN 83034 . 83985) (\PFLOPPY.OPEN.PSECTOR9 83987 . 84409) (
\PFLOPPY.GET.PSECTOR9 84411 . 85249) (\PFLOPPY.OPEN.PFILELIST 85251 . 87893) (\PFLOPPY.DAMAGED 87895
. 88250) (\PFLOPPY.OPENFILE 88252 . 90518) (\PFLOPPY.OPENFILE1 90520 . 91846) (\PFLOPPY.OPENOLDFILE
91848 . 92782) (\PFLOPPY.OPENNEWFILE 92784 . 94403) (\PFLOPPY.ASSURESTREAM 94405 . 94872) (
\PFLOPPY.GETFILEINFO 94874 . 95388) (\PFLOPPY.GETFILEINFO1 95390 . 96711) (\PFLOPPY.SETFILEINFO 96713
. 98688) (\PFLOPPY.CLOSEFILE 98690 . 99063) (\PFLOPPY.CLOSEFILE1 99065 . 101271) (\PFLOPPY.DELETEFILE
101273 . 102572) (\PFLOPPY.GENERATEFILES 102574 . 104192) (\PFLOPPY.NEXTFILEFN 104194 . 105290) (
\PFLOPPY.FILEINFOFN 105292 . 105656) (\PFLOPPY.RENAMEFILE 105658 . 107570) (\PFLOPPY.STREAMS.AGAINST
107572 . 108135) (\PFLOPPY.STREAMS.USING 108137 . 108616) (\PFLOPPY.READPAGES 108618 . 108926) (
\PFLOPPY.READPAGE 108928 . 110020) (\PFLOPPY.READPAGENO 110022 . 110734) (\PFLOPPY.WRITEPAGENO 110736
. 111447) (\PFLOPPY.PAGENOTODISKADDRESS 111449 . 112165) (\PFLOPPY.DISKADDRESSTOPAGENO 112167 .
112726) (\PFLOPPY.DIR.GET 112728 . 114131) (\PFLOPPY.DIR.PUT 114133 . 115682) (\PFLOPPY.DIR.REMOVE
115684 . 117273) (\PFLOPPY.DIR.VERSION 117275 . 118231) (\PFLOPPY.GETFILENAME 118233 . 120362) (
\PFLOPPY.CREATE.PFILELIST 120364 . 121092) (\PFLOPPY.ADD.TO.PFILELIST 121094 . 125131) (
\PFLOPPY.DELETE.FROM.PFILELIST 125133 . 126568) (\PFLOPPY.SAVE.PFILELIST 126570 . 127145) (
\PFLOPPY.SAVE.PSECTOR9 127147 . 127594) (\PFLOPPY.WRITEPAGES 127596 . 127908) (\PFLOPPY.WRITEPAGE
127910 . 128709) (\PFLOPPY.TRUNCATEFILE 128711 . 130216) (\PFLOPPY.FORMAT 130218 . 134911) (
\PFLOPPY.CONFIRM 134913 . 136141) (\PFLOPPY.GET.NAME 136143 . 136472) (\PFLOPPY.SET.NAME 136474 .
136992)) (137258 159092 (\PFLOPPY.ALLOCATE 137268 . 139602) (\PFLOPPY.ALLOCATE.LARGEST 139604 . 140354
) (\PFLOPPY.TRUNCATE 140356 . 143356) (\PFLOPPY.DEALLOCATE 143358 . 144458) (\PFLOPPY.EXTEND 144460 .
149382) (\PFLOPPY.GAINSPACE 149384 . 150422) (\PFLOPPY.GAINSPACE.MERGE 150424 . 152618) (
\PFLOPPY.ALLOCATE.WATCHDOG 152620 . 153267) (\PFLOPPY.FREE.PAGES 153269 . 154426) (\PFLOPPY.LENGTHS
154428 . 154683) (\PFLOPPY.STARTS 154685 . 154938) (\PFLOPPY.ICHECK 154940 . 158147) (
\PFLOPPY.ALLOCATIONS 158149 . 159090)) (159118 162016 (FLOPPY.FREE.PAGES 159128 . 159463) (
FLOPPY.FORMAT 159465 . 159827) (FLOPPY.NAME 159829 . 160026) (FLOPPY.GET.NAME 160028 . 160299) (
FLOPPY.SET.NAME 160301 . 160577) (FLOPPY.CAN.READP 160579 . 160858) (FLOPPY.CAN.WRITEP 160860 . 161141
) (FLOPPY.WAIT.FOR.FLOPPY 161143 . 162014)) (162623 177480 (\SFLOPPY.INIT 162633 . 163746) (
\SFLOPPY.GETFILEINFO 163748 . 165364) (\SFLOPPY.OPENHUGEFILE 165366 . 167643) (\SFLOPPY.WRITEPAGES
167645 . 167954) (\SFLOPPY.WRITEPAGE 167956 . 169178) (\SFLOPPY.READPAGES 169180 . 169573) (
\SFLOPPY.READPAGE 169575 . 170252) (\SFLOPPY.CLOSEHUGEFILE 170254 . 171411) (\SFLOPPY.INPUTFLOPPY
171413 . 173160) (\SFLOPPY.OUTPUTFLOPPY 173162 . 175276) (\SFLOPPY.CLOSEFLOPPY 175278 . 176798) (
\SFLOPPY.HACK 176800 . 177478)) (177952 191801 (\HFLOPPY.INIT 177962 . 179093) (\HFLOPPY.GETFILEINFO
179095 . 180711) (\HFLOPPY.OPENHUGEFILE 180713 . 183230) (\HFLOPPY.WRITEPAGES 183232 . 183544) (
\HFLOPPY.WRITEPAGE 183546 . 184768) (\HFLOPPY.READPAGES 184770 . 185166) (\HFLOPPY.READPAGE 185168 .
185845) (\HFLOPPY.CLOSEHUGEFILE 185847 . 186764) (\HFLOPPY.INPUTFLOPPY 186766 . 188513) (
\HFLOPPY.OUTPUTFLOPPY 188515 . 190275) (\HFLOPPY.CLOSEFLOPPY 190277 . 191799)) (191867 205625 (
FLOPPY.SCAVENGE 191877 . 192069) (\PFLOPPY.SCAVENGE 192071 . 192623) (\PFLOPPY.SCAVENGE.PMPAGES 192625
. 193441) (\PFLOPPY.SCAVENGE.PMPAGE31 193443 . 195715) (\PFLOPPY.SCAVENGE.PMPAGE.AFTER 195717 .
197089) (\PFLOPPY.SCAVENGE.PMPAGE.AFTER1 197091 . 199907) (\PFLOPPY.SCAVENGE.PLPAGES 199909 . 203044)
(\PFLOPPY.SCAVENGE.PSECTOR9 203046 . 205172) (\PFLOPPY.SCAVENGE.PFILELIST 205174 . 205623)) (205647
208842 (FLOPPY.TO.FILE 205657 . 207187) (FLOPPY.FROM.FILE 207189 . 208840)) (208867 217462 (
FLOPPY.COMPACT 208877 . 209214) (\PFLOPPY.COMPACT 209216 . 210767) (\PFLOPPY.COMPACT.PFALLOCS 210769
. 213789) (\PFLOPPY.COMPACT.PFALLOC 213791 . 216137) (\PFLOPPY.COMPACT.PSECTOR9 216139 . 216790) (
\PFLOPPY.COMPACT.PFILELIST 216792 . 217460)) (217487 219493 (FLOPPY.ARCHIVE 217497 . 218588) (
FLOPPY.UNARCHIVE 218590 . 219491)) (227313 280602 (\CFLOPPY.GET.FCB.FILENAME 227323 . 228032) (
\CFLOPPY.SET.FCB.FILENAME 228034 . 228479) (\CFLOPPY.INIT 228481 . 230376) (\CFLOPPY.OPEN 230378 .
231130) (\CFLOPPY.OPEN.DIRECTORY 231132 . 234408) (\CFLOPPY.OPENFILE 234410 . 236672) (
\CFLOPPY.OPENFILE1 236674 . 237991) (\CFLOPPY.OPENOLDFILE 237993 . 238912) (\CFLOPPY.OPENNEWFILE
238914 . 240076) (\CFLOPPY.ASSURESTREAM 240078 . 240547) (\CFLOPPY.GETFILEINFO 240549 . 241031) (
\CFLOPPY.GETFILEINFO1 241033 . 241525) (\CFLOPPY.SETFILEINFO 241527 . 241657) (\CFLOPPY.CLOSEFILE
241659 . 242032) (\CFLOPPY.CLOSEFILE1 242034 . 243053) (\CFLOPPY.DELETEFILE 243055 . 244340) (
\CFLOPPY.GETFILENAME 244342 . 245162) (\CFLOPPY.GENERATEFILES 245164 . 246778) (\CFLOPPY.NEXTFILEFN
246780 . 247875) (\CFLOPPY.FILEINFOFN 247877 . 248241) (\CFLOPPY.RENAMEFILE 248243 . 250030) (
\CFLOPPY.STREAMS.AGAINST 250032 . 250592) (\CFLOPPY.STREAMS.USING 250594 . 251070) (\CFLOPPY.READPAGES
251072 . 251383) (\CFLOPPY.READPAGE 251385 . 252634) (\CFLOPPY.PHYSICAL.RECORDNO 252636 . 253376) (
\CFLOPPY.READRECORDNO 253378 . 254108) (\CFLOPPY.WRITERECORDNO 254110 . 254839) (
\CFLOPPY.RECORDNOTODISKADDRESS 254841 . 255666) (\CFLOPPY.DIR.GET 255668 . 256780) (\CFLOPPY.DIR.PUT
256782 . 258179) (\CFLOPPY.DIR.REMOVE 258181 . 259385) (\CFLOPPY.WRITEPAGES 259387 . 259702) (
\CFLOPPY.WRITEPAGE 259704 . 260631) (\CFLOPPY.TRUNCATEFILE 260633 . 262491) (\CFLOPPY.ALLOCATE.FCB
262493 . 263440) (\CFLOPPY.ALLOCATE.GROUP 263442 . 263994) (\CFLOPPY.ALLOCATE 263996 . 266200) (
\CFLOPPY.TRUNCATE 266202 . 268877) (\CFLOPPY.DEALLOCATE 268879 . 269493) (\CFLOPPY.EXTEND 269495 .
271703) (\CFLOPPY.SAVE.CHANGES 271705 . 273504) (\CFLOPPY.ICHECK 273506 . 275800) (
\CFLOPPY.ICHECK.CALLOC 275802 . 276292) (\CFLOPPY.FREE.PAGES 276294 . 276647) (\CFLOPPY.FORMAT 276649
. 278259) (CPM.DIRECTORY 278261 . 280600)))))
STOP