(FILECREATED "23-Jan-87 14:31:54" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH185.;5 21582
changes to: (FNS NC.CompactNoteFileInPlace)
(VARS RHTPATCH185COMS)
previous date: "23-Jan-87 00:03:46" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH185.;4)
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH185COMS)
(RPAQQ RHTPATCH185COMS ((FILES (FROM {QV}<NOTECARDS>1.3K>NEXT)
NCCOMPACT)
(* * Fixes bug #406 reported by Peggy whereby CompactInPlace broke when
expanding index. Had to revise much code in the process.)
(* * New function for NCCOMPACT)
(FNS NC.CopySortedCardPartInPlaceToEOF)
(* * Changes to NCCOMPACT)
(FNS NC.CopySortedCardPartInPlace NC.CopySortedCardPart
NC.CopySortedCardParts NC.ComputeNewDatabaseIndexSize
NC.CompactNoteFileToTarget NC.CompactNoteFileInPlace
NC.ExpandIndexInPlace NC.CopyCardPart)))
(FILESLOAD (FROM {QV}<NOTECARDS>1.3K>NEXT)
NCCOMPACT)
(* * Fixes bug #406 reported by Peggy whereby CompactInPlace broke when expanding index. Had
to revise much code in the process.)
(* * New function for NCCOMPACT)
(DEFINEQ
(NC.CopySortedCardPartInPlaceToEOF
(LAMBDA (SortingRecord TempStream InterestedWindow) (* rht: "22-Jan-87 23:16")
(* * This just copies given card to the end of the notefile.)
(LET ((FromPtr (fetch (SortingRecord FileLoc) of SortingRecord))
(Card (fetch (SortingRecord Card) of SortingRecord))
(CardPartTypeNum (fetch (SortingRecord CardPartTypeNum) of SortingRecord))
NoteFile)
(WITH.MONITOR (NC.FetchMonitor (SETQ NoteFile (fetch (Card NoteFile) of Card)))
(LET ((Stream (fetch (NoteFile Stream) of NoteFile))
EOFPtr Length)
(SETQ EOFPtr (GETEOFPTR Stream))
(* * Copy the substance out to the {NODIRCORE} stream.)
(SETQ Length (NC.CopyCardPart Stream TempStream FromPtr 0
InterestedWindow))
(* * Now copy to its proper home.)
(if (NC.CopyCardPart TempStream Stream 0 EOFPtr InterestedWindow)
then (NC.UpdateCardLoc Card CardPartTypeNum EOFPtr)
(PLUS EOFPtr Length)))))))
)
(* * Changes to NCCOMPACT)
(DEFINEQ
(NC.CopySortedCardPartInPlace
(LAMBDA (SortingRecord BufferStream ToPtr EOFBufferLoc InterestedWindow)
(* rht: "22-Jan-87 23:20")
(* * Copy some portion of a card; title, links, substance, proplist, to ptr in Stream and update index
accordingly.)
(* * fkr 11/8/85: No longer worries about link labels part. Also updated to hadle new CradID and NoteFileobject.)
(* * kirk 23Nov85: added ToNoteFile parameter and restructured to reduce redundant code and to blindly COPYBYTES)
(* * rht 1/22/87: Now properly handles case when NC.CopyCardPart returns NIL. This function no longer called under
NC.ExpandIndexInPlace. Added InterestedWindow arg.)
(LET ((FromPtr (fetch (SortingRecord FileLoc) of SortingRecord))
(Card (fetch (SortingRecord Card) of SortingRecord))
(CardPartTypeNum (fetch (SortingRecord CardPartTypeNum) of SortingRecord))
NoteFile)
(if (EQUAL ToPtr FromPtr)
then (PLUS ToPtr (NC.GetCardPartLength Card FromPtr))
else (WITH.MONITOR (NC.FetchMonitor (SETQ NoteFile (fetch (Card NoteFile)
of Card)))
(LET ((Stream (fetch (NoteFile Stream) of NoteFile))
EndPtr Length)
(* * Copy the substance out to the {NODIRCORE} stream.)
(SETQ Length (NC.CopyCardPart Stream BufferStream FromPtr 0
InterestedWindow))
(* * Copy to end of file if needed for safety. That way, if we crash during second copy, all nearby card parts are
still okay.)
(SETQ EndPtr (PLUS ToPtr Length))
(if (OR (GEQ FromPtr EndPtr)
(AND (NC.CopyCardPart BufferStream Stream 0
EOFBufferLoc
InterestedWindow)
(NC.UpdateCardLoc Card CardPartTypeNum
EOFBufferLoc)))
then
(* * Now copy to its proper home.)
(if (NC.CopyCardPart BufferStream Stream 0 ToPtr
InterestedWindow)
then (NC.UpdateCardLoc Card CardPartTypeNum
ToPtr)
EndPtr))))))))
(NC.CopySortedCardPart
(LAMBDA (SortingRecord ToNoteFile InterestedWindow) (* rht: "22-Jan-87 23:19")
(* * Copy some portion of a card; title, links, substance, proplist, to ptr in Stream and update index
accordingly.)
(* * fkr 11/8/85: No longer worries about link labels part. Also updated to hadle new CradID and NoteFileobject.)
(* * kirk 23Nov85: restructured to reduce redundant code)
(* * rht 1/22/87: Added InterestedWindow arg.)
(WITH.MONITOR (NC.FetchMonitor FromNoteFile)
(LET ((FromPtr (fetch (SortingRecord FileLoc) of SortingRecord))
(Card (fetch (SortingRecord Card) of SortingRecord))
(CardPartTypeNum (fetch (SortingRecord CardPartTypeNum) of SortingRecord))
(ToStream (fetch (NoteFile Stream) of ToNoteFile))
ToPtr)
(SETQ ToPtr (GETFILEPTR ToStream))
(if (NC.CopyCardPart (fetch (NoteFile Stream)
of (fetch (Card NoteFile) of Card))
ToStream FromPtr ToPtr InterestedWindow)
then (NC.UpdateCardLoc Card CardPartTypeNum ToPtr))))))
(NC.CopySortedCardParts
(LAMBDA (SortedSortingRecords NewNoteFile ToPtr BufferStream OriginalLengthOfFile InterestedWindow
OperationMsg) (* rht: "22-Jan-87 23:22")
(* * Copies card parts to a note file. Assumes FILEPTR is set to the right location in the destination file.
If NewNoteFile is NIL, then ToPtr BuferStream and OriginalLengthOfFile are used to CopySortedCardPartInPlace.)
(* * rht 11/3/86: Added InterestedWindow and OperationMsg arg.)
(* * rht 1/22/87: Now passes InterestedWindow to NC.CopySortedCardPartInPlace and NC.CopySortedCardPart.)
(OR OperationMsg (SETQ OperationMsg (CONCAT "Compacting NoteFile" (CHARACTER 13))))
(LET ((TotalUseableCardParts (LENGTH SortedSortingRecords)))
(NC.PrintMsg InterestedWindow T OperationMsg "Copying piece " 1 " of "
TotalUseableCardParts "." (CHARACTER 13))
(for SortedRecord in SortedSortingRecords as CTR from 1 eachtime (BLOCK)
do (if (ZEROP (IREMAINDER CTR 20))
then (NC.PrintMsg InterestedWindow T OperationMsg "Copying piece " CTR
" of "
TotalUseableCardParts "." (CHARACTER 13)))
(if (NOT (SETQ ToPtr (if NewNoteFile
then (NC.CopySortedCardPart SortedRecord
NewNoteFile
InterestedWindow)
else (NC.CopySortedCardPartInPlace SortedRecord
BufferStream
ToPtr
OriginalLengthOfFile
InterestedWindow))))
then (RETURN NIL))
finally (RETURN ToPtr)))))
(NC.ComputeNewDatabaseIndexSize
(LAMBDA (NoteFile) (* rht: "22-Jan-87 21:45")
(* If the number of notecards we have is more than 3/4 the size of the index, double the index size;
otherwise just keep the same size)
(* * rht 1/22/87: Now returns NIL if index doesn't need expanding.)
(LET ((HashArraySize (fetch (NoteFile HashArraySize) of NoteFile)))
(if (GREATERP (fetch (NoteFile NextIndexNum) of NoteFile)
(FIX (TIMES .75 HashArraySize)))
then (TIMES 2 HashArraySize)))))
(NC.CompactNoteFileToTarget
(LAMBDA (FromNoteFile ToFileName InterestedWindow) (* rht: "22-Jan-87 21:57")
(* * In sorted order, copy card parts to lower addresses in the file.)
(* * fgh 5/1/86 Now returns the ToNoteFile in order to be compatible with compact in place.)
(* * rht 11/3/86: Now opens FromNoteFile read-only. Also now takes InterestedWindow arg.)
(* * rht 1/22/87: Slight change to computation of new index size.)
(LET (FromFileLength ToNoteFile TargetStream TargetFileLength OriginalStream BytesRecovered
OperationMsg)
(SETQ FromNoteFile (NC.OpenDatabaseFile FromNoteFile (QUOTE INPUT)
T NIL T T NIL T T T InterestedWindow))
(SETQ OperationMsg (CONCAT "Compacting " (fetch (NoteFile FullFileName) of
FromNoteFile)
(CHARACTER 13)))
(SETQ ToNoteFile (NC.OpenDatabaseFile (NC.CreateDatabaseFile
ToFileName
(OR (NC.ComputeNewDatabaseIndexSize
FromNoteFile)
(fetch (NoteFile HashArraySize)
of FromNoteFile))
OperationMsg T NIL T InterestedWindow)
NIL T NIL T T T T T T InterestedWindow))
(SETQ TargetStream (fetch (NoteFile Stream) of ToNoteFile))
(SETQ OriginalStream (fetch (NoteFile Stream) of FromNoteFile))
(replace (NoteFile NextIndexNum) of ToNoteFile with (fetch (NoteFile NextIndexNum)
of FromNoteFile))
(SETFILEPTR TargetStream (NC.TotalIndexSize (fetch (NoteFile HashArraySize)
of ToNoteFile)))
(* truncate ToNoteFile after the index)
(if (NC.CopySortedCardParts (NC.SortIndexEntries FromNoteFile)
ToNoteFile NIL NIL NIL InterestedWindow OperationMsg)
then (* all useable card parts got copied)
(SETQ FromFileLength (GETEOFPTR OriginalStream))
(* * fool NC.PutHashArray into writing out the index for the new NoteFile)
(replace (NoteFile Stream) of FromNoteFile with TargetStream)
(NCLocalDevice.PutHashArray FromNoteFile InterestedWindow T OperationMsg)
(replace (NoteFile Stream) of FromNoteFile with OriginalStream)
(* * Put out the new ChkptPtr to the file.)
(replace (NoteFile CheckptPtr) of ToNoteFile with (SETQ TargetFileLength
(GETEOFPTR
TargetStream)))
(* * Steal the UID from the original file so links will work. Write out the header.)
(replace (NoteFile UID) of ToNoteFile with (fetch (NoteFile UID)
of FromNoteFile))
(NC.PutNoteFileHeader ToNoteFile)
(SETQ BytesRecovered (DIFFERENCE FromFileLength TargetFileLength))
(NC.PrintMsg NIL T (fetch (NoteFile FullFileName) of FromNoteFile)
" compacted to "
(fetch (NoteFile FullFileName) of ToNoteFile)
(CHARACTER 13)
"Recovered " BytesRecovered " bytes ("
(FIX (TIMES 100 (FQUOTIENT BytesRecovered FromFileLength)))
"%%)"
(CHARACTER 13))
(NC.ClearMsg InterestedWindow T))
(NC.ForceDatabaseClose FromNoteFile T)
(SETQ ToNoteFile (NC.ForceDatabaseClose ToNoteFile T))
ToNoteFile)))
(NC.CompactNoteFileInPlace
(LAMBDA (NoteFile InterestedWindow) (* rht: "23-Jan-87 14:16")
(* * Compact the notefile in place. If index needs to be increased, then first make room for bigger index by
copying. Compaction is done by sorting index pointers and moving each entry in the file to lower addresses.)
(* * fkr 11/8/85 Updated to handle new CardID scheme and NoteFile object.)
(* * kirk 19Nov85: Created from NC.CompactDatabaseInPlace)
(* * rht 11/3/86: Added InterestedWindow arg.)
(* * rht&pmi 12/9/86: Moved RESETLST to be after call to NC.OpenDatabaseFile.)
(* * rht 1/22/87: Now bails out if NC.ExpandIndexInPlace was called but returned NIL. Also fixed message when size
of notefile actually increases.)
(if (AND NoteFile (SETQ NoteFile (NC.OpenDatabaseFile NoteFile (QUOTE BOTH)
T NIL T NIL NIL T T
InterestedWindow)))
then (RESETLST (RESETSAVE NIL (BQUOTE (NC.ForceDatabaseClose , NoteFile)))
(LET ((SourceStream (fetch (NoteFile Stream) of NoteFile))
(BufferStream (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)
NIL
(QUOTE ((TYPE BINARY)))))
(FullFileName (fetch (NoteFile FullFileName) of NoteFile))
(NewIndexSize (NC.ComputeNewDatabaseIndexSize NoteFile))
ToPtr OriginalLengthOfFile OperationMsg)
(* * Expand index if needed.)
(SETQ OperationMsg (CONCAT "Compacting " FullFileName
" in place."
(CHARACTER 13)))
(SETQ OriginalLengthOfFile (GETEOFPTR SourceStream))
(* * In sorted order, copy entries to lower locations in the file. Expand index first if necessary.)
(if (AND (OR (NULL NewIndexSize)
(NC.ExpandIndexInPlace NoteFile NewIndexSize
BufferStream
InterestedWindow
OperationMsg))
(SETQ ToPtr (NC.CopySortedCardParts
(NC.SortIndexEntries NoteFile)
NIL
(NC.TotalIndexSize (fetch (NoteFile
HashArraySize)
of NoteFile))
BufferStream
(GETEOFPTR SourceStream)
InterestedWindow OperationMsg)))
then (* all useable card parts got copied)
(NC.PutCheckptPtr NoteFile ToPtr)
(* Put out the new ChkptPtr to the file.)
(* * Truncate file at that point.)
(NC.PrintMsg InterestedWindow T "Truncating file "
FullFileName " ...")
(NCLocalDevice.PutHashArray NoteFile InterestedWindow T
OperationMsg)
(if (NOT (SETFILEINFO FullFileName (QUOTE LENGTH)
ToPtr))
then (NC.PrintMsg InterestedWindow NIL
"Couldn't truncate "
FullFileName "." (CHARACTER
13))
else (NC.PrintMsg InterestedWindow T "Done."
(CHARACTER 13))
(NC.ClearMsg InterestedWindow T))
(LET ((NumBytesSaved (DIFFERENCE OriginalLengthOfFile
ToPtr)))
(if (MINUSP NumBytesSaved)
then (NC.PrintMsg
NIL T FullFileName
" compacted in place."
(CHARACTER 13)
"Increased by "
(MINUS NumBytesSaved)
" bytes ("
(FIX (TIMES 100 (FQUOTIENT
(MINUS NumBytesSaved)
OriginalLengthOfFile)))
"%%)"
(CHARACTER 13))
else (NC.PrintMsg NIL T FullFileName
" compacted in place."
(CHARACTER 13)
"Recovered " NumBytesSaved
" bytes ("
(FIX (TIMES 100
(FQUOTIENT
NumBytesSaved
OriginalLengthOfFile)))
"%%)"
(CHARACTER 13))))
(SETQ NC.DatabaseFileNameSuggestion (PACKFILENAME
(QUOTE VERSION)
NIL
(QUOTE BODY)
FullFileName))
else (FLASHW PROMPTWINDOW)
(NC.PrintMsg NIL T "Compact of " FullFileName
" cancelled.")))))))
(NC.ExpandIndexInPlace
(LAMBDA (NoteFile NewIndexSize TempStream InterestedWindow OperationMsg)
(* rht: "23-Jan-87 00:02")
(* * Make room for a bigger index by copying a few card parts out to the end of the file. Assumes a checkpoint has
been done to write all information onto the file.)
(* * kirk 9/22/86 Changed to use NCLocalDevice fns)
(* * rht 11/3/86: Added InterestedWindow and OperationMsg arg and fixed typos.)
(* * rht 1/22/87: Was ignoring its TempStream argument. Now calls NC.CopySortedCardPartInPlaceToEOF instead of
NC.CopySortedCardPartInPlace and now checks that it succeeded before continuing.)
(OR OperationMsg (SETQ OperationMsg ""))
(OR TempStream (SETQ TempStream (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)
NIL
(QUOTE ((TYPE BINARY))))))
(LET ((Stream (fetch (NoteFile Stream) of NoteFile))
(SortedSortingRecords (NC.SortIndexEntries NoteFile))
(TotalIndexSize (NC.TotalIndexSize NewIndexSize))
TotalUseableCardParts ToPtr)
(NC.PrintMsg InterestedWindow T OperationMsg "Making room for expanded index."
(CHARACTER 13)
"Moving card part " 1 " of " (SETQ TotalUseableCardParts (LENGTH
SortedSortingRecords))
"."
(CHARACTER 13))
(if (GREATERP TotalIndexSize (GETEOFPTR Stream))
then (* Need to lengthen the file so that copies of cards
will be out of way of expanding index.)
(SETFILEPTR Stream TotalIndexSize))
(if (for SortedRecord in SortedSortingRecords as CTR from 1 eachtime (BLOCK)
until (GREATERP (fetch (SortingRecord FileLoc) of SortedRecord)
TotalIndexSize)
do (if (ZEROP (IREMAINDER CTR 100))
then (NC.PrintMsg InterestedWindow T OperationMsg
"Making room for expanded index."
(CHARACTER 13)
"Moving card part " CTR " of " TotalUseableCardParts
"."
(CHARACTER 13)))
(if (SETQ ToPtr (NC.CopySortedCardPartInPlaceToEOF SortedRecord
TempStream
InterestedWindow))
then (* Put out the new ChkptPtr to the file just in case
we crash inside this loop.)
(NC.PutCheckptPtr NoteFile ToPtr)
else (RETURN NIL))
finally (RETURN T))
then (* Record new index size in file.)
(replace (NoteFile NextIndexNum) of NoteFile
with (ADD1 (QUOTIENT (LENGTH SortedSortingRecords)
4)))
(NCLocalDevice.PutHashArray NoteFile InterestedWindow T "Compacting Index")
(replace (NoteFile HashArray) of NoteFile with (HASHARRAY NewIndexSize))
(replace (NoteFile HashArraySize) of NoteFile with NewIndexSize)
(NCLocalDevice.BuildHashArray NoteFile NIL InterestedWindow OperationMsg)
(* * Make sure new hash array size gets written down.)
(NC.PutNoteFileHeader NoteFile)
T))))
(NC.CopyCardPart
(LAMBDA (FromStream ToStream FromPtr ToPtr InterestedWindow)
(* rht: "22-Jan-87 23:42")
(* * Copy a card part from one stream to another)
(* * This function is used by both Compact to new file and CompactInPlace. Returns Length The Length result is used
by Compact to new file as a success flag. Length is used by CompactInPlace to compute the next place to write.)
(* * rht 11/3/86: Added flashw before error message.)
(* * rht 1/22/87: Removed unused CardPartTypeNum and Card args. Added InterestedWindow arg.)
(LET (Length EndPtr)
(SETFILEPTR FromStream FromPtr)
(SETFILEPTR ToStream ToPtr)
(if (SETQ Length (FIXP (NC.ReadPtr FromStream 3)))
then (SETQ EndPtr (PLUS FromPtr Length))
(until (if (CAR (ERSETQ (OR (COPYBYTES FromStream ToStream FromPtr
EndPtr)
0)))
then (RETURN Length)
else (if (EQ (ERRORN)
22)
then (* file system resources exceeded)
(ERROR "Trouble copying card."
(CONCAT "Try freeing at least "
(MAX 1 (IQUOTIENT
(IDIFFERENCE EndPtr
FromPtr)
512))
" pages in "
(FILENAMEFIELD ToStream
(QUOTE HOST))
(FILENAMEFIELD ToStream
(QUOTE
DIRECTORY))
"."
(CHARACTER 13)
"Then click here, type OK, and hit RETURN"))
NIL
else (RETURN NIL))))
else (FLASHW InterestedWindow)
(NC.PrintMsg InterestedWindow T "Bad NoteFile. Please Inspect and Repair."
(CHARACTER 13))
NIL))))
)
(PUTPROPS RHTPATCH185 COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1173 2298 (NC.CopySortedCardPartInPlaceToEOF 1183 . 2296)) (2332 21500 (
NC.CopySortedCardPartInPlace 2342 . 4613) (NC.CopySortedCardPart 4615 . 5790) (NC.CopySortedCardParts
5792 . 7483) (NC.ComputeNewDatabaseIndexSize 7485 . 8114) (NC.CompactNoteFileToTarget 8116 . 11707) (
NC.CompactNoteFileInPlace 11709 . 16191) (NC.ExpandIndexInPlace 16193 . 19563) (NC.CopyCardPart 19565
. 21498)))))
STOP