(FILECREATED "18-Mar-85 16:16:11" {ERIS}<LISP>INTERMEZZO>PATCHES>FLOPPYSYSOUTPATCH.;2
 4727   

      changes to:  (VARS FLOPPYSYSOUTPATCHCOMS)

      previous date: "18-Mar-85 16:11:28" {ERIS}<LISP>INTERMEZZO>PATCHES>FLOPPYSYSOUTPATCH.;1)


(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT FLOPPYSYSOUTPATCHCOMS)

(RPAQQ FLOPPYSYSOUTPATCHCOMS
 ((FNS \PFLOPPY.ICHECK \FLOPPY.FLUSH)))
(DEFINEQ

(\PFLOPPY.ICHECK

  [LAMBDA NIL                                                (* kbr: "18-Mar-85 13:22")

                                                             (* Integrity check. *)

    (
PROG
 (STARTS LENGTHS PFALLOCS PMPAGE1 PMPAGE2)
          (
SETQ
 STARTS (
\PFLOPPY.STARTS
))
          (
SETQ
 LENGTHS (
\PFLOPPY.LENGTHS
))
          (
COND

	    ([
NOT
 (
EQUAL
 STARTS (
SORT
 (
COPY
 STARTS]
	      (
\FLOPPY.SEVERE.ERROR
 "Starts Allocation Error")))
          (
COND

	    ((for
 L in
 LENGTHS thereis
 (
ILESSP
 L 0))
	      (
\FLOPPY.SEVERE.ERROR
 "Lengths1 Allocation Error")))
          (
COND

	    ((
NOT
 (
IEQP
 (
IPLUS
 (for
 L in
 LENGTHS sum
 L)
			       (
LENGTH
 LENGTHS))
			2280))
	      (
\FLOPPY.SEVERE.ERROR
 "Lengths2 Allocation Error")))
          (
SETQ
 PFALLOCS (fetch
 (PFLOPPYFDEV PFALLOCS) of
 \FLOPPYFDEV))
          (for
 P1 in
 PFALLOCS when
 [
OR
 (
AND
 (fetch
 (PFALLOC PREV) of
 P1)
					    (
NOT
 (
MEMB
 (fetch
 (PFALLOC PREV) of
 P1)
						       PFALLOCS)))
				       (
AND
 (fetch
 (PFALLOC NEXT) of
 P1)
					    (
NOT
 (
MEMB
 (fetch
 (PFALLOC NEXT) of
 P1)
						       PFALLOCS]
	     do
 (
\FLOPPY.SEVERE.ERROR
 "Links Allocation Error"))
          (for
 P1 in
 PFALLOCS as
 P2 in
 (
CDR
 PFALLOCS)
	     when
 (
OR
 (
NOT
 (
EQ
 (fetch
 (PFALLOC NEXT) of
 P1)
			       P2))
		      (
NOT
 (
EQ
 (fetch
 (PFALLOC PREV) of
 P2)
			       P1)))
	     do
 (
\FLOPPY.SEVERE.ERROR
 "Links2 Allocation Error"))
          (for
 P1 in
 PFALLOCS as
 P2 in
 (
CDR
 PFALLOCS)
	     when
 (
NOT
 (
IEQP
 (
IPLUS
 (fetch
 (PFALLOC END) of
 P1)
				    2)
			     (fetch
 (PFALLOC START) of
 P2)))
	     do
 (
\FLOPPY.SEVERE.ERROR
 "Lengths3 Allocation Error"))
                                                             (* Patch around FUGUE disaster *)

          [
OR
 (
QUOTE
 POSSIBLY.FUGUE.FLOPPY)
	      (for
 P1 in
 PFALLOCS as
 P2 in
 (
CDR
 PFALLOCS)
		 do
 (
SETQ
 PMPAGE1 (fetch
 (PFALLOC PMPAGE) of
 P1))
		    (
SETQ
 PMPAGE2 (fetch
 (PFALLOC PMPAGE) of
 P2))
		    (
COND

		      ([
OR
 (
NOT
 (
IEQP
 (fetch
 (PMPAGE NLENGTH) of
 PMPAGE1)
				      (fetch
 (PMPAGE PLENGTH) of
 PMPAGE2)))
			   (
NOT
 (
IEQP
 (fetch
 (PMPAGE NTYPE) of
 PMPAGE1)
				      (fetch
 (PMPAGE PTYPE) of
 PMPAGE2)))
			   (
NOT
 (
IEQP
 (fetch
 (PMPAGE NFILEID) of
 PMPAGE1)
				      (fetch
 (PMPAGE PFILEID) of
 PMPAGE2)))
			   (
NOT
 (
IEQP
 (fetch
 (PMPAGE NFILETYPE) of
 PMPAGE1)
				      (fetch
 (PMPAGE PFILETYPE) of
 PMPAGE2]
			(
\FLOPPY.SEVERE.ERROR
 "PMPAGEs Allocation Error"]
          (
COND

	    ([
NOT
 (
FMEMB
 (
FLOPPY.MODE
)
			 (
QUOTE
 (
SYSOUT
 HUGEPILOT]
	      (for
 F in
 \OPENFILES when
 [
AND
 (
EQ
 (fetch
 (STREAM DEVICE) of
 F)
						 \FLOPPYFDEV)
					     (
NOT
 (
MEMB
 (fetch
 (FLOPPYSTREAM PFALLOC) of
 F)
							(fetch
 (PFLOPPYFDEV PFALLOCS) of
 \FLOPPYFDEV]
		 do
 (
\FLOPPY.SEVERE.ERROR
 "Streams Allocation Error"])

(\FLOPPY.FLUSH

  [LAMBDA NIL                                                (* kbr: "16-Mar-85 11:27")

                                                             (* Forcibly flush streams. *)

    (
PROG
 NIL                                                (* TBW: This function will go away when a wrong floppy 

							     FDEV is implemented. *)

          (
COND

	    ((
FMEMB
 (
FLOPPY.MODE
)
		    (
QUOTE
 (
SYSOUT
 HUGEPILOT)))
	      (
RETURN
)))
          (for
 STREAM in
 \OPENFILES when
 (
EQ
 (fetch
 (STREAM DEVICE) of
 STREAM)
					     \FLOPPYFDEV)
	     do
 (
SETQ
 \OPENFILES (
DREMOVE
 STREAM \OPENFILES))
		(replace
 (STREAM STRMBINFN) of
 STREAM with
 (
QUOTE
 \STREAM.NOT.OPEN))
		(replace
 (STREAM STRMBOUTFN) of
 STREAM with
 (
QUOTE
 \STREAM.NOT.OPEN))
		(replace
 (STREAM ACCESS) of
 STREAM with
 NIL])
)
(PUTPROPS FLOPPYSYSOUTPATCH COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (426 4639 (\PFLOPPY.ICHECK 436 . 3718) (\FLOPPY.FLUSH 3720 . 4637)))))
STOP