(FILECREATED "18-Jun-86 16:54:50" {ERIS}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}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