(FILECREATED " 4-Nov-86 19:33:02" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH134.;7 19739
changes to: (FNS NCLocalDevice.PutFromLinks NCLocalDevice.CompactNoteFile)
(VARS RHTPATCH134COMS)
previous date: " 3-Nov-86 21:51:53" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH134.;5)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH134COMS)
(RPAQQ RHTPATCH134COMS ((* * Fixes for compactor)
(FILES (FROM NOTECARDS)
NCCOMPACT)
(* * Changes to NCCOMPACT)
(FNS NC.CopyCardPart NC.UpdateCardLoc NC.CompactNoteFileToTarget
NC.CompactNoteFileInPlace NC.CopySortedCardParts NC.ExpandIndexInPlace)
(* * Changes to NCLOCALDEVICE)
(FNS NCLocalDevice.CompactNoteFile NCLocalDevice.PutFromLinks)))
(* * Fixes for compactor)
(FILESLOAD (FROM NOTECARDS)
NCCOMPACT)
(* * Changes to NCCOMPACT)
(DEFINEQ
(NC.CopyCardPart
(LAMBDA (CardPartTypeNum Card FromStream ToStream FromPtr ToPtr)
(* rht: " 3-Nov-86 19:33")
(* * 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.)
(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 PROMPTWINDOW)
(NC.PrintMsg NIL T "Bad NoteFile. Please Inspect and Repair." (CHARACTER 13))
NIL))))
(NC.UpdateCardLoc
(LAMBDA (Card CardPartTypeNum ToPtr) (* rht: " 3-Nov-86 19:36")
(SELECTQ CardPartTypeNum
(0 (replace (Card MainLoc) of Card with ToPtr))
(1 (replace (Card LinksLoc) of Card with ToPtr))
(2 (replace (Card TitleLoc) of Card with ToPtr))
(3 (replace (Card PropListLoc) of Card with ToPtr))
(PROGN (FLASHW PROMPTWINDOW)
(NC.PrintMsg NIL T "Bad NoteFile. Please Inspect and Repair." (CHARACTER
13))))))
(NC.CompactNoteFileToTarget
(LAMBDA (FromNoteFile ToFileName InterestedWindow) (* rht: " 3-Nov-86 21:43")
(* * 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.)
(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 (
NC.ComputeNewDatabaseIndexSize
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: " 3-Nov-86 21:42")
(* * 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.)
(RESETLST (RESETSAVE NIL (BQUOTE (NC.ForceDatabaseClose , NoteFile)))
(AND NoteFile (SETQ NoteFile (NC.OpenDatabaseFile NoteFile (QUOTE BOTH)
T NIL T NIL NIL T T
InterestedWindow))
(LET ((SourceStream (fetch (NoteFile Stream) of NoteFile))
(BufferStream (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)
NIL
(QUOTE ((TYPE BINARY)))))
(FullFileName (fetch (NoteFile FullFileName) of NoteFile))
ToPtr SortedSortingRecords OriginalLengthOfFile TotalUseableCardParts
OperationMsg)
(* * Expand index if needed.)
(SETQ OperationMsg (CONCAT "Compacting " FullFileName " in place."
(CHARACTER 13)))
(LET ((NewIndexSize (NC.ComputeNewDatabaseIndexSize NoteFile)))
(if (GREATERP NewIndexSize (fetch (NoteFile HashArraySize)
of NoteFile))
then (* Expand index if needed.)
(NC.ExpandIndexInPlace NoteFile NewIndexSize
BufferStream InterestedWindow
OperationMsg)))
(* * In sorted order, copy entries to lower locations in the file.)
(SETQ ToPtr (NC.TotalIndexSize (fetch (NoteFile HashArraySize)
of NoteFile)))
(SETQ SortedSortingRecords (NC.SortIndexEntries NoteFile))
(SETQ OriginalLengthOfFile (GETEOFPTR SourceStream))
(if (SETQ ToPtr (NC.CopySortedCardParts SortedSortingRecords NIL
ToPtr BufferStream
OriginalLengthOfFile
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))
)
(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.CopySortedCardParts
(LAMBDA (SortedSortingRecords NewNoteFile ToPtr BufferStream OriginalLengthOfFile InterestedWindow
OperationMsg) (* rht: " 3-Nov-86 21:23")
(* * 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.)
(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)
else (NC.CopySortedCardPartInPlace SortedRecord
BufferStream
ToPtr
OriginalLengthOfFile))))
then (RETURN NIL))
finally (RETURN ToPtr)))))
(NC.ExpandIndexInPlace
(LAMBDA (NoteFile NewIndexSize TempStream InterestedWindow OperationMsg)
(* rht: " 3-Nov-86 21:47")
(* * 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.)
(OR OperationMsg (SETQ OperationMsg ""))
(LET ((Stream (fetch (NoteFile Stream) of NoteFile))
(BufferStream (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)
NIL
(QUOTE ((TYPE BINARY)))))
(SortedSortingRecords (NC.SortIndexEntries NoteFile))
TotalUseableCardParts)
(SETQ TotalUseableCardParts (LENGTH SortedSortingRecords))
(NC.PrintMsg InterestedWindow T OperationMsg "Making room for expanded index."
(CHARACTER 13)
"Moving card part " 1 " of " TotalUseableCardParts "." (CHARACTER 13))
(for SortedRecord in SortedSortingRecords as CTR from 1
bind (ToPtr ←(GETEOFPTR Stream))
(TotalIndexSize ←(NC.TotalIndexSize NewIndexSize))
until (IGREATERP (fetch (SortingRecord FileLoc) of SortedRecord)
TotalIndexSize)
eachtime (BLOCK)
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)))
(SETQ ToPtr (NC.CopySortedCardPartInPlace SortedRecord BufferStream ToPtr))
(* Put out the new ChkptPtr to the file just in case
we crash inside this loop.)
(NC.PutCheckptPtr NoteFile ToPtr)) (* Record new index size in file.)
(replace (NoteFile NextIndexNum) of NoteFile with (ADD1 (QUOTIENT (LENGTH
SortedSortingRecords)
4)))
(NCLocalDevice.PutHashArray NoteFile NIL "Compacting Index" T)
(replace (NoteFile HashArray) of NoteFile with (HASHARRAY NewIndexSize))
(replace (NoteFile HashArraySize) of NoteFile with NewIndexSize)
(NCLocalDevice.BuildHashArray NoteFile))))
)
(* * Changes to NCLOCALDEVICE)
(DEFINEQ
(NCLocalDevice.CompactNoteFile
(LAMBDA (FromNoteFile ToFileName InPlaceFlg PromptWindow)
(* rht: " 4-Nov-86 19:11")
(* * Compact a NoteFile. If InPlaceFlg is T calls NC.CompactNoteFileInPlace. Otherwise if ToFileName is NIL, asks
for a new file name.)
(* * fkr 11/8/85 Updated to handle new CardID scheme and NoteFile object.)
(* * kirk 19Nov85: Created from NC.CompactDatabaseInPlace to handle new NoteFile format)
(* * fgh 5/186 Totally rewritten to get rid of numerous bugs. Added new PromptWindow parameter.)
(* * rht 7/2/86: Fixed bug in call to NC.CompactToTarget and NC.CompactInPlace. They were being called with
FromNoteFile instead of (OR FromNoteFile FromFileName).)
(* * kirk 3Jul86 Added SETQ NC.DatabaseFileNameSuggestion)
(* * rht 10/16/86: Now autoloads NCREPAIR.)
(* * rht 11/3/86: No longer reopens if was originally open. Also now passes PromptWindow along to called
functions.)
(DECLARE (GLOBALVARS NC.DatabaseFileNameSuggestion))
(LET (FromFileName ToNoteFile success)
(* * Get the name of the file to be compacted)
(SETQ FromFileName (COND
((NULL FromNoteFile)
(PROG1 (NC.DatabaseFileName "Name of NoteFile to be compacted:" " -- " T NIL NIL
PromptWindow)
(NC.ClearMsg PromptWindow)))
((type? NoteFile FromNoteFile)
(fetch (NoteFile FullFileName) of FromNoteFile))
(T FromNoteFile)))
(* * If compact to target, get the name of the target file)
(if (NULL InPlaceFlg)
then (SETQ NC.DatabaseFileNameSuggestion (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
(FULLNAME FromFileName)))
(SETQ ToFileName (OR ToFileName (PROG1 (NC.DatabaseFileName
"Name of target of compaction:"
" -- " T NIL
NIL
PromptWindow)
(NC.ClearMsg PromptWindow)))))
(* * As long as you have file names, go ahead!)
(if (AND FromFileName (OR InPlaceFlg ToFileName))
then
(* * Make full names)
(SETQ FromFileName (FULLNAME FromFileName (QUOTE OLD)))
(SETQ ToFileName (FULLNAME ToFileName (QUOTE NEW)))
(* * Close the file if its open)
(if (AND (SETQ FromNoteFile (NC.NoteFileFromFileName FromFileName))
(OPENP FromFileName))
then (NC.CloseDatabaseFile FromNoteFile))
(* * Compact the file and reopen if successfull and was previously open)
(NC.PrintMsg PromptWindow T "Compacting " FromFileName " ...")
(if (SETQ ToNoteFile (if InPlaceFlg
then (NC.AutoloadApply* (FUNCTION
NC.CompactNoteFileInPlace)
(OR FromNoteFile
FromFileName)
PromptWindow)
else (* compact to target)
(NC.AutoloadApply* (FUNCTION
NC.CompactNoteFileToTarget)
(OR FromNoteFile
FromFileName)
ToFileName PromptWindow)))
then (NC.ClearMsg PromptWindow T)
else (NC.PrintMsg NIL T "Compact of " FromFileName " cancelled."))))))
(NCLocalDevice.PutFromLinks
(LAMBDA (Card StreamLoc) (* rht: " 4-Nov-86 19:32")
(* * Assuming that Card has on it UserProps the old TOLINKS and GLOBALLINKS, this function rewrites over the end of
the NoteFile stream starting at StreamLoc the Links Info merged with the new FromLinks, which are already on the
Stream.)
(* * rht&rg 11/4/86: Now sets length field properly after writing down the links.)
(DECLARE (GLOBALVARS NC.LinksIdentifier))
(LET ((STREAM (fetch (NoteFile Stream) of (fetch (Card NoteFile) of Card)))
FromLinks EndLoc DataLoc)
(SETFILEPTR STREAM StreamLoc)
(NC.ReadCardPartHeader Card NC.LinksIdentifier STREAM)
(SETQ DataLoc (GETFILEPTR STREAM))
(SETQ FromLinks (NC.ReadListOfLinks STREAM))
(SETFILEPTR STREAM DataLoc)
(NC.WriteListOfLinks STREAM (CAR (NC.GetProp Card (QUOTE OldLinks))))
(NC.WriteListOfLinks STREAM FromLinks)
(NC.WriteListOfLinks STREAM (CDR (NC.GetProp Card (QUOTE OldLinks))))
(SETQ EndLoc (GETFILEPTR STREAM))
(SETFILEPTR STREAM StreamLoc)
(NC.WritePtr STREAM (DIFFERENCE EndLoc StreamLoc)
3)
(SETFILEPTR STREAM EndLoc)
(NC.SetLinksLoc Card StreamLoc))))
)
(PUTPROPS RHTPATCH134 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (884 14651 (NC.CopyCardPart 894 . 2699) (NC.UpdateCardLoc 2701 . 3269) (
NC.CompactNoteFileToTarget 3271 . 6698) (NC.CompactNoteFileInPlace 6700 . 10544) (
NC.CopySortedCardParts 10546 . 12057) (NC.ExpandIndexInPlace 12059 . 14649)) (14689 19657 (
NCLocalDevice.CompactNoteFile 14699 . 18217) (NCLocalDevice.PutFromLinks 18219 . 19655)))))
STOP