(FILECREATED "18-Jun-86 16:54:50" {ERIS}<LISPCORE>SOURCES>DOVEFLOPPYPATCH.;15 45584
changes to: (VARS DOVEFLOPPYPATCHCOMS)
(FNS \DOVEFLOPPY.XFERDISK \DOVEFLOPPY.INITDCB \PFLOPPY.FORMAT
\PFLOPPY.GENERATEFILES \FLOPPY.MOUNTEDP \PFLOPPY.SCAVENGE.PMPAGE.AFTER1
\PFLOPPY.OPEN.PFILELIST \FLOPPY.TRANSFER)
previous date: "18-Jun-86 10:15:41" {ERIS}<LISPCORE>SOURCES>DOVEFLOPPYPATCH.;14)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DOVEFLOPPYPATCHCOMS)
(RPAQQ DOVEFLOPPYPATCHCOMS ((INITVARS (\DOVEFLOPPY.TRACEFLG NIL))
(FNS \DOVEFLOPPY.XFERDISK \DOVEFLOPPY.INITDCB \PFLOPPY.FORMAT
\PFLOPPY.GENERATEFILES \FLOPPY.MOUNTEDP
\PFLOPPY.SCAVENGE.PMPAGE.AFTER1 \PFLOPPY.OPEN.PFILELIST
\FLOPPY.TRANSFER)
(GLOBALRESOURCES \FLOPPY.SCRATCH.BUFFER2)
(P (SETQ \FLOPPY.SCRATCH.BUFFER2 (NCREATE 'VMEMPAGEP))
(COND ((EQ (MACHINETYPE)
'DOVE)
(\DOVEFLOPPY.INIT))))))
(RPAQ? \DOVEFLOPPY.TRACEFLG NIL)
(DEFINEQ
(\DOVEFLOPPY.XFERDISK
(LAMBDA (CYL HD SEC BUFF MODE RECAL? RESET?) (* edited: "23-Mar-86 14:40")
(PROG (STATUS)
(SETQ STATUS (\DOVEFLOPPY.TRANSFER CYL HD SEC BUFF MODE RESET? RECAL?))
(for I from 1 to 50
do
(* * kbr: " 8-Nov-85 12:19" Repeat a few times because of spurious OVERRUN errors. I've also seen a few spurious
DATAERRORs. 3 retries is not enough, so I've made it 10.0 *)
(* * kbr: "19-Mar-86 17:18" Had problems copying an Intellicorp sysout floppy to {DSK}, but if we change the number
of retries from 10 to 20, the problem (DATAERRORs) goes away. So I've set the number of retries to 40! *)
(* * kbr: "19-Mar-86 17:18" MESA code uses ActualNumberOfRetriesWhenDMAHit = 50 when handlingError inside
UpdateOperation on FLOPPYHEADDOVE.MESA. So I've set the number of retries to 50! *)
(COND
((OR (EQ STATUS 'OK)
(EQ STATUS 'TIMEOUT))
(COND
(\DOVEFLOPPY.TRACEFLG (COND
((EQ I 1)
(PRIN1 "." TRACEWINDOW))
(T (PRIN1 "R" TRACEWINDOW)
(PRIN1 I TRACEWINDOW)))))
(RETURN))
(\DOVEFLOPPY.TRACEFLG (PRIN1 STATUS TRACEWINDOW)
(PRIN1 "-" TRACEWINDOW)))
(* kbr: "19-Mar-86 17:18" Try recalibrating and
resetting every fourth time though loop instead of
every time through loop. *)
(COND
((EQ (IMOD I 4)
1)
(COND
(\DOVEFLOPPY.TRACEFLG (PRIN1 "RECALIBRATE-" TRACEWINDOW)))
(SETQ STATUS (\DOVEFLOPPY.TRANSFER CYL HD SEC BUFF MODE T T))
(DISMISS 50))
(T (SETQ STATUS (\DOVEFLOPPY.TRANSFER CYL HD SEC BUFF MODE NIL NIL)))))
(RETURN STATUS))))
(\DOVEFLOPPY.INITDCB
(LAMBDA NIL (* kbr: "20-Apr-86 13:16")
(replace (DOVEFLOPPYDCB DOOROPEN) of (fetch (DOVEFLOPPYFCB FLOPPYDCB0BASE) of
\DoveFloppy.FCBPointer)
with 0)
(replace (DOVEFLOPPYDCB PILOTDISKCHANGED) of (fetch (DOVEFLOPPYFCB FLOPPYDCB0BASE)
of \DoveFloppy.FCBPointer)
with 0)
(replace (DOVEFLOPPYDCB DIAGNOSTICDISKCHANGED) of (fetch (DOVEFLOPPYFCB FLOPPYDCB0BASE)
of \DoveFloppy.FCBPointer)
with 0) (* Magic constant 6712 is byteswap of Mesa's 14362
magic constant. *)
(replace (DOVEFLOPPYDCB Port80ControlWord) of (fetch (DOVEFLOPPYFCB FLOPPYDCB0BASE)
of \DoveFloppy.FCBPointer)
with 6712)
(* kbr: "20-Apr-86 13:15" Added the following two replaces. From an INSPECT window I can tell that the value of
these fields were 177 and 2, but I have no idea where they originally got set from, and I have looked to try to
find out how. According to OSBUNORTH people, HeadLoadTimePlusNotInDMAmode must be 20 to allow 40ms time for head
settling before write operations. Without this change, what will happen is that occasionally the DAYBREAK floppy
heads will still be vibrating around at the time of the write operation. Later, reads will not be able to read the
malformed data and will cause DATAERRORs. *)
(replace (DOVEFLOPPYDCB StepRateTimePlusHeadUnloadTime) of (fetch (DOVEFLOPPYFCB
FLOPPYDCB0BASE)
of \DoveFloppy.FCBPointer)
with 177)
(replace (DOVEFLOPPYDCB HeadLoadTimePlusNotInDMAmode) of (fetch (DOVEFLOPPYFCB
FLOPPYDCB0BASE)
of \DoveFloppy.FCBPointer)
with 20)))
(\PFLOPPY.FORMAT
(LAMBDA (NAME AUTOCONFIRMFLG SLOWFLG) (* kbr: "18-Jun-86 16:53")
(* Return T if formatted, NIL if user abort.
*)
(PROG (CONFIRM PSECTOR9 PMPAGEA PMPAGEB PMPAGEC PFILELIST PFLE NATTEMPTS NTIMES)
(SETQ NTIMES 1)
(\FLOPPY.UNCACHED.WRITE) (* Confirmation. *)
(SETQ CONFIRM (\PFLOPPY.CONFIRM "Destroy contents of floppy" AUTOCONFIRMFLG T))
(COND
((NOT CONFIRM)
(RETURN NIL))) (* Forcibly close floppy. *)
(\FLOPPY.CLOSE) (* Create critical records.
*)
(SETQ PFILELIST (\FLOPPY.BUFFER 2))
(replace (PFILELIST SEAL) of PFILELIST with SEAL.PFILELIST)
(replace (PFILELIST VERSION) of PFILELIST with VERSION.PFILELIST)
(replace (PFILELIST NENTRIES) of PFILELIST with 1)
(replace (PFILELIST MAXENTRIES) of PFILELIST with (IQUOTIENT (IDIFFERENCE
512 4)
5))
(SETQ PFLE (create PFLE
FILEID ← 1
TYPE ← FILETYPE.PFILELIST
START ← (ADD1 \PFLOPPYFIRSTDATAPAGE)
LENGTH ← 2))
(\MOVEWORDS PFLE 0 PFILELIST 4 5)
(SETQ PMPAGEA
(create PMPAGE
PTYPE ← PMPAGEETYPE.FREE
PFILEID ← 0
PFILETYPE ← FILETYPE.FREE
PLENGTH ← 0
NTYPE ← PMPAGEETYPE.PFILELIST
NFILETYPE ← FILETYPE.PFILELIST
NFILEID ← 1
NLENGTH ← 2))
(SETQ PMPAGEB
(create PMPAGE
PTYPE ← PMPAGEETYPE.PFILELIST
PFILETYPE ← FILETYPE.PFILELIST
PFILEID ← 1
PLENGTH ← 2
NTYPE ← PMPAGEETYPE.FREE
NFILETYPE ← FILETYPE.FREE
NFILEID ← 0
NLENGTH ← (IDIFFERENCE \PFLOPPYLASTDATAPAGE (IPLUS \PFLOPPYFIRSTDATAPAGE
4))))
(SETQ PMPAGEC (create PMPAGE
PTYPE ← PMPAGEETYPE.FREE
PFILEID ← 0
PFILETYPE ← FILETYPE.FREE
PLENGTH ← (IDIFFERENCE \PFLOPPYLASTDATAPAGE (IPLUS
\PFLOPPYFIRSTDATAPAGE 4))
NTYPE ← PMPAGEETYPE.FREE
NFILEID ← 0
NFILETYPE ← FILETYPE.FREE
NLENGTH ← 0))
(SETQ PSECTOR9 (create PSECTOR9
PFILELISTSTART ← (ADD1 \PFLOPPYFIRSTDATAPAGE)
PFILELISTFILEID ← 1
PFILELISTLENGTH ← 2
ROOTFILEID ← 0
NEXTUNUSEDFILEID ← 2))
(replace (PSECTOR9 $LABEL) of PSECTOR9 with NAME)
(* Check floppy can write. *)
(SETQ NATTEMPTS 0)
RETRY
(SETQ NATTEMPTS (ADD1 NATTEMPTS))
(COND
((IGREATERP NATTEMPTS 5)
(\FLOPPY.MESSAGE "Couldn't format floppy")
(RETURN NIL)))
(COND
((NOT (AND (\FLOPPY.INITIALIZE T)
(\FLOPPY.WRITEABLEP)))
(GO ERROR))) (* Configure floppy. *)
(COND
((OR SLOWFLG (NULL PSECTOR9)) (* Format tracks. *)
(COND
((NOT (AND (\FLOPPY.INITIALIZE T)
(\FLOPPY.RECALIBRATE T)
(GLOBALRESOURCE \FLOPPY.IBMS128.FLOPPYIOCB
(\FLOPPY.FORMATTRACKS \FLOPPY.IBMS128.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 0
SECTOR ← 1)
1 T))
(GLOBALRESOURCE \FLOPPY.IBMD256.FLOPPYIOCB
(\FLOPPY.FORMATTRACKS \FLOPPY.IBMD256.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 1
SECTOR ← 1)
1 T))
(\FLOPPY.RECALIBRATE T)
(GLOBALRESOURCE \FLOPPY.IBMD512.FLOPPYIOCB
(\FLOPPY.FORMATTRACKS \FLOPPY.IBMD512.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← 1
HEAD ← 0
SECTOR ← 1)
(SUB1 \FLOPPY.CYLINDERS)
T)
(\FLOPPY.FORMATTRACKS \FLOPPY.IBMD512.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← 1
HEAD ← 1
SECTOR ← 1)
(SUB1 \FLOPPY.CYLINDERS)
T))))
(GO ERROR)))
(* Check that we can read from each page. We need to do this because FORMATTRACKS (espescially DOVE) is unreliable.
If we find a bad page, it usually works to try again a few times. We know from experience that the tendency is for
an unformatted floppy to become better the more times you format it. *)
(COND
((GLOBALRESOURCE \FLOPPY.IBMD512.FLOPPYIOCB
(for I from \PFLOPPYFIRSTDATAPAGE to \PFLOPPYLASTDATAPAGE
by (SELECTQ (MACHINETYPE)
(DOVE 1)
(DANDELION (COND
((type? PSECTOR9 CONFIRM)
(* Formatted before. Spot check output of formatting.
*)
19)
(T
(* Never formatted before. Be more careful.
*)
1)))
NIL)
thereis (NULL (\PFLOPPY.READPAGENO I
\FLOPPY.SCRATCH.BUFFER T)))
)
(\FLOPPY.MESSAGE "Retrying format." PROMPTWINDOW)
(GO ERROR))))) (* Write PMPAGEs, PFILELIST, and PSECTOR9.
Write PSECTOR9 last. We check for it first when we
open floppy. *)
(COND
((NOT (AND (\PFLOPPY.WRITEPAGENO \PFLOPPYFIRSTDATAPAGE PMPAGEA T)
(\PFLOPPY.WRITEPAGENO (ADD1 \PFLOPPYFIRSTDATAPAGE)
PFILELIST T)
(\PFLOPPY.WRITEPAGENO (IPLUS \PFLOPPYFIRSTDATAPAGE 2)
(\ADDBASE PFILELIST 256)
T)
(\PFLOPPY.WRITEPAGENO (IPLUS \PFLOPPYFIRSTDATAPAGE 3)
PMPAGEB T)
(\PFLOPPY.WRITEPAGENO \PFLOPPYLASTDATAPAGE PMPAGEC T)
(GLOBALRESOURCE \FLOPPY.IBMS128.FLOPPYIOCB
(\FLOPPY.WRITESECTOR \FLOPPY.IBMS128.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← 0
HEAD ← 0
SECTOR ← 9)
PSECTOR9 T))))
(GO ERROR)))
(SETQ NTIMES (SUB1 NTIMES))
(COND
((EQ NTIMES 0) (* Successful Return. *)
(RETURN T))
(T (GO RETRY)))
ERROR
(SETQ SLOWFLG T)
(COND
((EQ (MACHINETYPE)
'DOVE)
(* DOVEFLOPPY formatting is so flakey that if we find any indication of problems in formatting that we then insist
that we keep formatting until we can successfully format twice in a row. *)
(SETQ NTIMES 2)))
(GO RETRY))))
(\PFLOPPY.GENERATEFILES
(LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS) (* kbr: "22-Mar-86 17:53")
(WITH.MONITOR \FLOPPYLOCK (PROG (ALLOCS FILTER DESIREDVERSION GENFILESTATE PFALLOC VALIST
VERSION FILEGENOBJ)
(* No floppy gives empty directory so that {FLOPPY}
can safely be on DIRECTORIES search path.
*)
(COND
((EQ (MACHINETYPE)
'DOVE) (* Patch around DOVE IOP assembly language coded
dooropen & diskchangeclear status flags not working.
*)
(COND
((NOT (for STREAM in \OPENFILES
thereis (EQ (fetch (STREAM DEVICE)
of STREAM)
\FLOPPYFDEV)))
(* Don't have any open streams to DOVE floppy, so
assume that user may have switched floppies.
*)
(\FLOPPY.CLOSE)))))
(COND
((AND (\FLOPPY.EXISTSP T)
(\FLOPPY.CACHED.READ T))
(SETQ FILTER (DIRECTORY.MATCH.SETUP PATTERN))
(SETQ DESIREDVERSION (FILENAMEFIELD PATTERN
'VERSION))
(SETQ ALLOCS
(for NBUCKET in (fetch (PFLOPPYFDEV DIR)
of \FLOPPYFDEV)
join
(for EBUCKET in (CDR NBUCKET)
join (COND
((FIXP DESIREDVERSION)
(SETQ PFALLOC
(CDR (ASSOC DESIREDVERSION
(CDR EBUCKET))))
(COND
((AND PFALLOC
(DIRECTORY.MATCH
FILTER
(fetch (PFALLOC FILENAME)
of PFALLOC)))
(LIST PFALLOC))))
((DIRECTORY.MATCH FILTER
(CONCAT
(CAR NBUCKET)
"."
(CAR EBUCKET)))
(COND
((NULL DESIREDVERSION)
(* Highest version only *)
(SETQ VALIST (CDR EBUCKET))
(SETQ VERSION
(\PFLOPPY.DIR.VERSION
NIL
'OLD VALIST))
(SETQ PFALLOC
(CDR (ASSOC VERSION VALIST)))
(COND
(PFALLOC (LIST PFALLOC))))
(T (for VBUCKET
in (CDR EBUCKET)
collect (CDR VBUCKET))))))))
)))
(COND
((MEMB '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)))))
(\FLOPPY.MOUNTEDP
(LAMBDA (NOERROR) (* edited: "23-Mar-86 15:08")
(* Floppy drive contains floppy, door is shut, door
stable since last \FLOPPY.INITIALIZE? *)
(PROG (ANSWER)
(* There is apparently no way to test these facts independently. Also, if DOOROPENED bit was set in the past &
floppy is now mounted, this routine treats this as unmounted. Some recovery routine must do a \FLOPPY.INITIALIZE as
one of its actions to clear this bit. *)
(SETQ ANSWER (SELECTQ (MACHINETYPE)
(DANDELION (UNINTERRUPTABLY
(\FLOPPY.NOP T)
(NOT (fetch (FLOPPYRESULT DOOROPENED)
of \FLOPPYRESULT))))
(DOVE (* MORE UGLY CRUFT TO GET AROUND DOVE DOOROPEN BITS
NOT WORKING. *)
(COND
((for F in \OPENFILES
thereis (EQ (fetch (STREAM DEVICE)
of F)
\FLOPPYFDEV))
(* If the user has streams open on {FLOPPY} then the
user probably hasn't switched floppies.
*)
T)
((AND (NOT (STKPOS 'FLOPPY.FORMAT))
(EQ (WITH.MONITOR \FLOPPYLOCK
(\DOVEFLOPPY.TRANSFER
20 0 1
\FLOPPY.SCRATCH.BUFFER
'READDATA))
'TIMEOUT))
(* Notice that we obtain \FLOPPYLOCK before doing timeing. Since TIMEOUT can happen if floppy is not formatted
properly, just say T if we're underneath FLOPPY.FORMAT. *)
NIL)
(T T)))
NIL))
(COND
((OR NOERROR ANSWER)
(RETURN ANSWER)))
(\FLOPPY.BREAK "Door open(ed) or disk missing"))))
(\PFLOPPY.SCAVENGE.PMPAGE.AFTER1
(LAMBDA (PLOCATION PPMPAGE LOCATION PMPAGE) (* edited: "23-Mar-86 20:05")
(PROG (TRIEDWRITING TRIEDFORMATTING OLDPAGES LENGTH TYPE FILETYPE FILEID)
RETRY
(COND
((NOT (\PFLOPPY.READPAGENO LOCATION PMPAGE T))
(* Couldn't read this LOCATION.
Assume misformatted track. *)
(COND
((NOT TRIEDWRITING)
(for I from 0 to 511 do (\PUTBASEBYTE PMPAGE I (CHARCODE " ")))
(\PFLOPPY.WRITEPAGENO LOCATION PMPAGE T)
(SETQ TRIEDWRITING T)
(GO RETRY))
((NOT TRIEDFORMATTING)
(GLOBALRESOURCE \FLOPPY.IBMD512.FLOPPYIOCB (SETQ DISKADDRESS (
\PFLOPPY.PAGENOTODISKADDRESS LOCATION))
(SETQ OLDPAGES (for SECTOR from 1 to
\FLOPPY.SECTORSPERTRACK
collect
(PROG (OLDPAGE)
(SETQ OLDPAGE (NCREATE
'VMEMPAGEP))
(\FLOPPY.READSECTOR
\FLOPPY.IBMD512.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ←
(fetch (DISKADDRESS
CYLINDER)
of DISKADDRESS)
HEAD ←
(fetch (DISKADDRESS
HEAD)
of DISKADDRESS)
SECTOR ← SECTOR)
OLDPAGE T)
(RETURN OLDPAGE))))
(* Since formatting is unreliable, repeat format twice
in a row. *)
(\FLOPPY.FORMATTRACKS \FLOPPY.IBMD512.FLOPPYIOCB DISKADDRESS 1
T)
(\FLOPPY.FORMATTRACKS \FLOPPY.IBMD512.FLOPPYIOCB DISKADDRESS 1
T)
(* Restore what we could salvage before reformatting.
*)
(for SECTOR from 1 to \FLOPPY.SECTORSPERTRACK as OLDPAGE
in OLDPAGES do (\FLOPPY.WRITESECTOR
\FLOPPY.IBMD512.FLOPPYIOCB
(create DISKADDRESS
CYLINDER ← (fetch
(DISKADDRESS CYLINDER)
of DISKADDRESS)
HEAD ← (fetch (DISKADDRESS
HEAD)
of DISKADDRESS)
SECTOR ← SECTOR)
OLDPAGE T)))
(SETQ TRIEDFORMATTING T)
(GO RETRY))
(T (\FLOPPY.MESSAGE (CONCAT "Couldn't read or reformat page " LOCATION))
(\FLOPPY.MESSAGE "User should not trust this floppy.")
(* At this point PMPAGE is blank.
*)
(RETURN PMPAGE)))))
(COND
((NOT (OR (fetch (PMPAGE INTACT) of PMPAGE)
(IEQP LOCATION \PFLOPPYLASTDATAPAGE)))
(RETURN))) (* Force PMPAGE to be a legal marker page.
*)
(replace (PMPAGE SEAL) of PMPAGE with SEAL.PMPAGE)
(replace (PMPAGE VERSION) of PMPAGE with VERSION.PMPAGE)
(SETQ LENGTH (IPLUS LOCATION (IMINUS PLOCATION)
-1))
(COND
((ZEROP LENGTH)
(SETQ TYPE PMPAGEETYPE.FREE)
(SETQ FILETYPE FILETYPE.FREE)
(SETQ FILEID 0))
(T (SETQ TYPE (fetch (PMPAGE NTYPE) of PPMPAGE))
(SETQ FILETYPE (fetch (PMPAGE NFILETYPE) of PPMPAGE))
(SETQ FILEID (COND
((EQ TYPE PMPAGEETYPE.PFILELIST)
1)
(T 0)))))
(replace (PMPAGE PLENGTH) of PMPAGE with LENGTH)
(replace (PMPAGE PTYPE) of PMPAGE with TYPE)
(replace (PMPAGE PFILETYPE) of PMPAGE with FILETYPE)
(replace (PMPAGE PFILEID) of PMPAGE with FILEID)
(* Fix PPMPAGE wrt PMPAGE now *)
(replace (PMPAGE NLENGTH) of PPMPAGE with LENGTH)
(replace (PMPAGE NTYPE) of PPMPAGE with TYPE)
(replace (PMPAGE NFILETYPE) of PPMPAGE with FILETYPE)
(replace (PMPAGE NFILEID) of PPMPAGE with FILEID)
(\PFLOPPY.WRITEPAGENO PLOCATION PPMPAGE))))
(\PFLOPPY.OPEN.PFILELIST
(LAMBDA NIL (* kbr: " 7-Aug-85 18:09")
(PROG (PSECTOR9 PFILELIST FILENAME PMPAGE PLPAGE PFALLOC PFALLOCS)
RETRY
(SETQ PSECTOR9 (fetch (PFLOPPYFDEV PSECTOR9) of \FLOPPYFDEV))
(SETQ PFILELIST (\PFLOPPY.CREATE.PFILELIST (fetch (PSECTOR9 PFILELISTLENGTH)
of PSECTOR9)))
(replace (PFLOPPYFDEV PFILELIST) of \FLOPPYFDEV with PFILELIST)
(replace (PSECTOR9 NEXTUNUSEDFILEID) of PSECTOR9 with 1)
(for (START ← (ADD1 \PFLOPPYFIRSTDATAPAGE)) by (IPLUS START (fetch
(PMPAGE NLENGTH)
of PMPAGE)
1)
do (SETQ PMPAGE (NCREATE '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 'PLPAGE))
(\PFLOPPY.READPAGENO START PLPAGE)
(COND
((NOT (fetch (PLPAGE INTACT) of PLPAGE))
(\PFLOPPY.DAMAGED)
(SETQ PFALLOCS NIL)
(GO RETRY)))
(SETQ FILENAME (fetch (PLPAGE $NAME) of PLPAGE)))
(T (SETQ PLPAGE NIL)
(SETQ FILENAME (LIST (fetch (PMPAGE $NFILETYPE) of PMPAGE)))))
(SETQ PFALLOC
(create PFALLOC
FILENAME ← FILENAME
START ← START
PMPAGE ← PMPAGE
PLPAGE ← PLPAGE))
(COND
((NOT (EQ (fetch (PMPAGE NFILETYPE) of PMPAGE)
FILETYPE.FREE))
(\PFLOPPY.ADD.TO.PFILELIST PFALLOC)))
(push PFALLOCS PFALLOC)
(COND
((IEQP START (ADD1 \PFLOPPYLASTDATAPAGE))
(RETURN))))
(SETQ PFALLOCS (DREVERSE PFALLOCS))
(for PREV in PFALLOCS as NEXT in (CDR PFALLOCS) while NEXT
do (replace (PFALLOC NEXT) of PREV with NEXT)
(replace (PFALLOC PREV) of NEXT with PREV))
(replace (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV with PFALLOCS)
(* We create the directory last because PACKFILENAME is brittle and it is nice to have the other info already
filled in if you have to debug. *)
(for PFALLOC in PFALLOCS when (EQ (fetch (PFALLOC FILETYPE) of PFALLOC)
FILETYPE.FILE)
do (\PFLOPPY.DIR.PUT (fetch (PFALLOC FILENAME) of PFALLOC)
'OLD PFALLOC)))))
(\FLOPPY.TRANSFER
(LAMBDA (FLOPPYIOCB COMMAND DISKADDRESS PAGE NOERROR) (* kbr: "17-Apr-86 18:41")
(PROG (MESSAGE ANSWER)
(SETQ ANSWER (SELECTQ (MACHINETYPE)
(DANDELION (SETQ COMMAND (SELECTQ COMMAND
(READ C.READSECTOR)
(WRITE C.WRITESECTOR)
(SHOULDNT)))
(UNINTERRUPTABLY
(replace (FLOPPYIOCB COMMAND) of FLOPPYIOCB
with COMMAND)
(replace (FLOPPYIOCB SUBCOMMAND) of
FLOPPYIOCB
with SC.NOP)
(replace (FLOPPYIOCB DISKADDRESS)
of FLOPPYIOCB with DISKADDRESS)
(replace (FLOPPYIOCB BUFFER) of FLOPPYIOCB
with PAGE)
(replace (FLOPPYIOCB SECTORCOUNT)
of FLOPPYIOCB with 1))
(COND
((\FLOPPY.RUN FLOPPYIOCB NOERROR)
(* Successful coMPletion. *)
PAGE)))
(DOVE (SETQ COMMAND (SELECTQ COMMAND
(READ 'READDATA)
(WRITE 'WRITEDATA)
(SHOULDNT)))
(\DOVEFLOPPY.SETCONTEXT (fetch (FLOPPYIOCB $DENSITY)
of FLOPPYIOCB)
(fetch (FLOPPYIOCB
$ENCODEDSECTORLENGTH)
of FLOPPYIOCB))
(COND
((EQ COMMAND 'WRITEDATA)
(* kbr: "24-Mar-86 01:36" We're going to write a sector on DOVE floppy, but it turns out that DOVE floppy drive
heads vibrate when they move and 1 in 5000 times you smash your floppy if you try to move and write with the same
operation. We get around this problem by first doing our move during a read operation, which is safe since we are
not modifying floppy during a read. After completing the read we do a DISMISS to pass a little time between the
read/move and the coming write. I tried running without the DISMISS and do still find occasional long sequences of
MISSINGADDRESSMARKs or DATAERRORs in the error log in TRACEWINDOW I get with \DOVEFLOPPY.TRACEFLG = T.
After 10 hours of filebanging operations, one of the long sequences finally got long enough to break FLOPPY.
I have not tested yet whether the DISMISS does any good, but I don't think it can hurt. (WHAT A MESS!) *)
(* kbr: "17-Apr-86 18:38" Message from PURVES.OSBUNORTH AND MCQUILKIN.OSBUNORTH recomends 40 ms settling time for
DOVE floppy drive head before writing. Therefore (DISMISS 20) changed to (DISMISS 40) Pray this works.
*)
(GLOBALRESOURCE \FLOPPY.SCRATCH.BUFFER2
(\DOVEFLOPPY.XFERDISK
(fetch (DISKADDRESS CYLINDER)
of DISKADDRESS)
(fetch (DISKADDRESS HEAD)
of DISKADDRESS)
(fetch (DISKADDRESS SECTOR)
of DISKADDRESS)
\FLOPPY.SCRATCH.BUFFER2
'READDATA))
(DISMISS 40)))
(SETQ MESSAGE (\DOVEFLOPPY.XFERDISK
(fetch (DISKADDRESS CYLINDER) of DISKADDRESS)
(fetch (DISKADDRESS HEAD) of DISKADDRESS)
(fetch (DISKADDRESS SECTOR) of DISKADDRESS)
PAGE COMMAND))
(COND
((EQ MESSAGE 'OK)
PAGE)
((NOT NOERROR)
(\FLOPPY.BREAK MESSAGE))))
NIL))
(RETURN ANSWER))))
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTDEF '\FLOPPY.SCRATCH.BUFFER2 'RESOURCES '(NEW (\FLOPPY.BUFFER 4)))
)
)
(/SETTOPVAL '\\FLOPPY.SCRATCH.BUFFER2.GLOBALRESOURCE)
(SETQ \FLOPPY.SCRATCH.BUFFER2 (NCREATE 'VMEMPAGEP))
(COND ((EQ (MACHINETYPE)
'DOVE)
(\DOVEFLOPPY.INIT)))
(PUTPROPS DOVEFLOPPYPATCH COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1331 45202 (\DOVEFLOPPY.XFERDISK 1341 . 3876) (\DOVEFLOPPY.INITDCB 3878 . 6362) (
\PFLOPPY.FORMAT 6364 . 18048) (\PFLOPPY.GENERATEFILES 18050 . 25222) (\FLOPPY.MOUNTEDP 25224 . 28357)
(\PFLOPPY.SCAVENGE.PMPAGE.AFTER1 28359 . 35401) (\PFLOPPY.OPEN.PFILELIST 35403 . 39198) (
\FLOPPY.TRANSFER 39200 . 45200)))))
STOP