(FILECREATED "16-Oct-85 19:27:22" {QV}<NOTECARDS>1.3K>FGHCHKPT.;7 18025
changes to: (VARS FGHCHKPTCOMS)
(FNS NC.CheckpointDatabase NC.BuildIndexArray NC.FetchIndexArray
NC.IncreaseIndexArray NC.GetStatusFromIndex NC.GetPtrsFromIndex
NC.GetIndexOffset NC.PutStatusToIndex NC.PutPtrToIndex)
previous date: "16-Oct-85 15:53:18" {QV}<NOTECARDS>1.3K>FGHCHKPT.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FGHCHKPTCOMS)
(RPAQQ FGHCHKPTCOMS ((* * New FNS)
(FNS NC.FetchIndexArray)
(* * Redefined from NCCARDS and NCDATABASE)
(FNS NC.GetPtrFromIndex NC.SetIndexOffset NC.CheckpointDatabase
NC.BuildIndexArray NC.IncreaseIndexArray NC.GetStatusFromIndex
NC.GetPtrsFromIndex NC.GetIndexOffset NC.PutStatusToIndex NC.PutPtrToIndex
NC.IndexFromID NC.SortIndexEntries NC.CleanupIndexEntries NC.AbortSession)))
(* * New FNS)
(DEFINEQ
(NC.FetchIndexArray
(LAMBDA (DatabaseStream IndexArray) (* fgh: "16-Oct-85 15:51")
(* * Get the IndexArray from a database stream unless IndexArray is already that IndexArray)
(COND
((AND (ARRAYP IndexArray)
(NOT (EQUAL (ELT IndexArray 0)
-1)))
(* * IndexArray is a pointer to a still valid cache array -- i.e., one with Active in its zeroth position.)
IndexArray)
((AND (STREAMP DatabaseStream)
(ARRAYP (STREAMPROP DatabaseStream (QUOTE NCINDEXARRAY)))))
((AND (STREAMP PSA.Database)
(ARRAYP (STREAMPROP PSA.Database (QUOTE NCINDEXARRAY)))))
(T (NC.ReportError NIL "No cache array could be found.")))))
)
(* * Redefined from NCCARDS and NCDATABASE)
(DEFINEQ
(NC.GetPtrFromIndex
(LAMBDA (DatabaseStream IndexArray) (* fgh: "16-Oct-85 15:22")
(* * Read a value from the current spot in index array and increment counter. The array and its offset are found on
stream's props.)
(LET (Offset)
(SETQ IndexArray (OR (ARRAYP IndexArray)
(STREAMPROP DatabaseStream (QUOTE NCINDEXARRAY))))
(SETQ Offset (ELT IndexArray 0))
(PROG1 (ELT IndexArray Offset)
(SETA IndexArray 0 (ADD1 Offset))))))
(NC.SetIndexOffset
(LAMBDA (DatabaseStream Num IndexArray) (* fgh: "16-Oct-85 15:23")
(* * Sets the current offset into the index array.)
(SETA (OR (ARRAYP IndexArray)
(NC.FetchIndexArray DatabaseStream IndexArray))
0 Num)))
(NC.CheckpointDatabase
(LAMBDA (DatabaseStream QuietFlg) (* fgh: "16-Oct-85 17:58")
(* * First save to the database any cards currently dirty. Copy the index array back into the file and set the
LastChkptPtr to the end of the file.)
(PROG (Ptr OperationMsg CardTotal IndexArray)
(OR DatabaseStream (SETQ DatabaseStream PSA.Database))
(SETQ OperationMsg (CONCAT "Checkpointing notefile " (FILENAMEFIELD (FULLNAME
DatabaseStream)
(QUOTE NAME))
(CHARACTER 13)))
(COND
((OR (NULL DatabaseStream)
(NOT (OPENP DatabaseStream)))
(NC.PrintMsg NIL T "There is no open NoteFile!!!" (CHARACTER 13)))
(T (OR QuietFlg (NC.PrintMsg NIL T "Checkpointing current notefile " (FULLNAME
DatabaseStream)
" ..."))
(NC.SaveDirtyCards DatabaseStream)
(SETFILEPTR DatabaseStream 16)
(SETQ IndexArray (NC.FetchIndexArray DatabaseStream))
(NC.SetIndexOffset DatabaseStream 1 IndexArray)
(OR QuietFlg (NC.PrintMsg NIL T OperationMsg "Processing item number " 1 " out of "
(SETQ CardTotal (SUB1 (SUBATOM (NC.GetNewID DatabaseStream T)
3)))
"."
(CHARACTER 13)))
(for Num from 1 to CardTotal bind Ptr eachtime (BLOCK)
do (OR QuietFlg (AND (ZEROP (IREMAINDER Num 100))
(NC.PrintMsg NIL T OperationMsg "Processing item number " Num
" out of "
CardTotal "." (CHARACTER 13))))
(* Put out the 1 byte status and 4 pointers.)
(SETQ Ptr (NC.GetPtrFromIndex DatabaseStream IndexArray))
(NC.PutPtr DatabaseStream Ptr 1)
(SETQ Ptr (NC.GetPtrFromIndex DatabaseStream IndexArray))
(NC.PutPtr DatabaseStream Ptr)
(SETQ Ptr (NC.GetPtrFromIndex DatabaseStream IndexArray))
(NC.PutPtr DatabaseStream Ptr)
(SETQ Ptr (NC.GetPtrFromIndex DatabaseStream IndexArray))
(NC.PutPtr DatabaseStream Ptr)
(SETQ Ptr (NC.GetPtrFromIndex DatabaseStream IndexArray))
(NC.PutPtr DatabaseStream Ptr)
(NC.GetPtr DatabaseStream)) (* Put out the new ChkptPtr to the file.)
(SETFILEPTR DatabaseStream 8)
(SETQ Ptr (GETEOFPTR DatabaseStream))
(NC.PutPtr DatabaseStream Ptr) (* Put out the new highest ID number to the file.)
(SETFILEPTR DatabaseStream 0)
(SETQ Ptr (STREAMPROP DatabaseStream (QUOTE NCNEXTIDNUM)))
(NC.PutPtr DatabaseStream Ptr 2) (* Put out the new next link id to notefile.)
(SETFILEPTR DatabaseStream 4)
(SETQ Ptr (STREAMPROP DatabaseStream (QUOTE NCNEXTLINKID)))
(NC.PutPtr DatabaseStream Ptr)
(OR QuietFlg (NC.PrintMsg NIL NIL "Done." (CHARACTER 13))))))))
(NC.BuildIndexArray
(LAMBDA (DatabaseStream) (* fgh: "16-Oct-85 18:04")
(* * Build the index array by copying from the index on the file.)
(PROG ((NextIDNum (STREAMPROP DatabaseStream (QUOTE NCNEXTIDNUM)))
BadGuysList
(EofPtr (GETEOFPTR DatabaseStream))
(IndexPtr (TIMES (ADD1 NC.IndexSizeInEntries)
16))
IndexArray)
(STREAMPROP DatabaseStream (QUOTE NCINDEXARRAY)
(SETQ IndexArray (ARRAY (ITIMES 5 (IMAX NC.DefaultIndexSizeInEntries
(FIX (TIMES 1.5 NextIDNum))))
(QUOTE FIXP)
NIL 0))) (* Copy entries from index on file to index array.)
(SETFILEPTR DatabaseStream 16)
(NC.SetIndexOffset DatabaseStream 1 IndexArray)
(COND
((GREATERP NextIDNum 1)
(for Index from 1 to (SUB1 NextIDNum) bind ReasonsList ActiveCardFlg
do (BLOCK)
(SETQ ReasonsList NIL)
(COND
((NULL (NC.PutStatusToIndex DatabaseStream (NC.GetStatus DatabaseStream)
IndexArray))
(push ReasonsList (QUOTE BADSTATUS))))
(NC.SetIndexOffset DatabaseStream (SUB1 (NC.GetIndexOffset DatabaseStream
IndexArray))
IndexArray)
(SETQ ActiveCardFlg (EQ (NC.GetStatusFromIndex DatabaseStream IndexArray)
(QUOTE ACTIVE)))
(COND
((NC.OutOfBoundsIndexPtr DatabaseStream (NC.PutPtrToIndex DatabaseStream
(NC.GetPtr
DatabaseStream)
IndexArray)
EofPtr IndexPtr)
(AND ActiveCardFlg (push ReasonsList (QUOTE BADITEMPTR)))))
(COND
((NC.OutOfBoundsIndexPtr DatabaseStream (NC.PutPtrToIndex DatabaseStream
(NC.GetPtr
DatabaseStream)
IndexArray)
EofPtr IndexPtr)
(AND ActiveCardFlg (push ReasonsList (QUOTE BADLINKSPTR)))))
(COND
((NC.OutOfBoundsIndexPtr DatabaseStream (NC.PutPtrToIndex DatabaseStream
(NC.GetPtr
DatabaseStream)
IndexArray)
EofPtr IndexPtr)
(AND ActiveCardFlg (push ReasonsList (QUOTE BADTITLEPTR)))))
(COND
((NC.OutOfBoundsIndexPtr DatabaseStream (NC.PutPtrToIndex DatabaseStream
(NC.GetPtr
DatabaseStream)
IndexArray)
EofPtr IndexPtr)
(AND ActiveCardFlg (push ReasonsList (QUOTE BADPROPLISTPTR)))))
(AND ReasonsList (push BadGuysList (CONS (NC.IDFromNumber Index)
(DREVERSE ReasonsList))))
(NC.GetPtr DatabaseStream))
(STREAMPROP DatabaseStream (QUOTE NCBADCARDS)
BadGuysList))))))
(NC.IncreaseIndexArray
(LAMBDA (DatabaseStream) (* fgh: "16-Oct-85 15:51")
(* * Make a new array half again as big and copy the contents from the old one. But don't make the new array any
bigger than the current index size.)
(LET ((Array (STREAMPROP DatabaseStream (QUOTE NCINDEXARRAY)))
OldSize NewArray)
(SETQ OldSize (ARRAYSIZE Array))
(SETQ NewArray (ARRAY (IMIN NC.IndexSizeInEntries (FIX (TIMES 1.5 OldSize)))
(QUOTE FIXP)
NIL 0))
(for i from 0 to OldSize do (SETA NewArray i (ELT Array i)))
(STREAMPROP DatabaseStream (QUOTE NCINDEXARRAY)
NewArray)
(SETA Array 0 -1)
NewArray)))
(NC.GetStatusFromIndex
(LAMBDA (DatabaseStream IndexArray) (* fgh: "16-Oct-85 15:39")
(* * Read status from the current spot in the index array.)
(SELCHARQ (NC.GetPtrFromIndex DatabaseStream IndexArray)
(A (QUOTE ACTIVE))
(F (QUOTE FREE))
(D (QUOTE DELETED))
(S (QUOTE SPECIAL))
NIL)))
(NC.GetPtrsFromIndex
(LAMBDA (DatabaseStream ID IndexArray) (* fgh: "16-Oct-85 15:42")
(* * A version of NC.GetPtrs that gets the pointers from the index array instead of the file.)
(PROG (Index Ptr LinksPtr TitlePtr PropsPtr Status PtrList EofPtr)
(SETQ IndexArray (OR (ARRAYP IndexArray)
(NC.FetchIndexArray DatabaseStream)))
(SETQ Index (NC.IndexFromID ID "NC.GetPtrs"))
(NC.SetIndexOffset DatabaseStream Index IndexArray)
(SETQ Status (NC.GetStatusFromIndex DatabaseStream IndexArray))
(SETQ Ptr (NC.GetPtrFromIndex DatabaseStream IndexArray))
(SETQ LinksPtr (NC.GetPtrFromIndex DatabaseStream IndexArray))
(SETQ TitlePtr (NC.GetPtrFromIndex DatabaseStream IndexArray))
(SETQ PropsPtr (NC.GetPtrFromIndex DatabaseStream IndexArray))
(SETQ PtrList
(create POINTERLIST
STATUS ← Status
MAINPTR ← Ptr
LINKSPTR ← LinksPtr
TITLEPTR ← TitlePtr
PROPSPTR ← PropsPtr
INDEXPTR ← Index))
(SETQ EofPtr (GETEOFPTR DatabaseStream))
(AND (EQ Status (QUOTE ACTIVE))
(for Ptr in (CDR PtrList) when (OR (IGREATERP Ptr EofPtr)
(MINUSP Ptr))
do (replace (POINTERLIST STATUS) of PtrList with (QUOTE BADPOINTER))))
(RETURN PtrList))))
(NC.GetIndexOffset
(LAMBDA (DatabaseStream IndexArray) (* fgh: "16-Oct-85 15:43")
(* * Return the current index array offset for the given stream.)
(ELT (OR (ARRAYP IndexArray)
(NC.FetchIndexArray DatabaseStream IndexArray))
0)))
(NC.PutStatusToIndex
(LAMBDA (DatabaseStream Status IndexArray) (* fgh: "16-Oct-85 15:44")
(* * Write the status at the current spot in the index array.)
(NC.PutPtrToIndex DatabaseStream (SELECTQ Status
((A ACTIVE)
(CONSTANT (CHARCODE A)))
((D DELETED)
(CONSTANT (CHARCODE D)))
((F FREE)
(CONSTANT (CHARCODE F)))
((S SPECIAL)
(CONSTANT (CHARCODE S)))
(NILL))
IndexArray)))
(NC.PutPtrToIndex
(LAMBDA (DatabaseStream Ptr IndexArray) (* fgh: "16-Oct-85 15:47")
(* * Write this pointer value at the current spot in the index array.)
(LET (Offset)
(SETQ IndexArray (NC.FetchIndexArray DatabaseStream IndexArray))
(SETQ Offset (ELT IndexArray 0))
(SETA IndexArray Offset (OR Ptr 0))
(SETA IndexArray 0 (ADD1 Offset))
Ptr)))
(NC.IndexFromID
(LAMBDA (ID FromFunction) (* fgh: "16-Oct-85 17:57")
(* * rht 1/30/85: Now returns offset into the index array.)
(COND
((NC.IDP ID)
(ADD1 (ITIMES (SUB1 (SUBATOM ID 3))
5)))
(T (NC.ReportError FromFunction (CONCAT ID ": Invalid ID"))))))
(NC.SortIndexEntries
(LAMBDA (Stream) (* fgh: "16-Oct-85 18:06")
(* * Using the IndexArray for Stream, return the sorted list of index entries as triples of fileptr, ID, and
EntryType.)
(PROG ((NextIDNum (STREAMPROP Stream (QUOTE NCNEXTIDNUM)))
(IndexArray (STREAMPROP Stream (QUOTE NCINDEXARRAY))))
(NC.SetIndexOffset Stream 1)
(RETURN (SORT (for Index from 1 to (SUB1 NextIDNum)
join (SELECTQ (NC.GetStatusFromIndex Stream)
(ACTIVE (PROG1 (BQUOTE ((, (NC.GetPtrFromIndex Stream)
, Index 0)
(, (NC.GetPtrFromIndex Stream)
, Index 1)
(, (NC.GetPtrFromIndex Stream)
, Index 2)
(, (NC.GetPtrFromIndex Stream)
, Index 3)))))
(SPECIAL (PROG1 (BQUOTE ((, (NC.GetPtrFromIndex Stream)
, Index 4)))
(NC.SetIndexOffset Stream
(IPLUS 3 (
NC.GetIndexOffset
Stream)))))
(PROGN (NC.SetIndexOffset Stream (IPLUS 4 (NC.GetIndexOffset
Stream)))
NIL)))
T)))))
(NC.CleanupIndexEntries
(LAMBDA (Stream) (* fgh: "16-Oct-85 18:08")
(* * Take a pass through index, replacing any entries not ACTIVE, SPECIAL, or FREE, by FREE entries.
This uses the array to save time, so it better be up to date with the file.)
(PROG ((NextIDNum (STREAMPROP Stream (QUOTE NCNEXTIDNUM)))
(IndexArray (STREAMPROP Stream (QUOTE NCINDEXARRAY))))
(NC.SetIndexOffset Stream 1)
(for Index from 1 to (SUB1 NextIDNum)
do (BLOCK)
(COND
((NOT (FMEMB (NC.GetStatusFromIndex Stream)
(QUOTE (ACTIVE SPECIAL FREE))))
(NC.MarkIndexEntryFreeInFile (NC.IDFromNumber Index)
Stream)))
(NC.SetIndexOffset Stream (IPLUS 4 (NC.GetIndexOffset Stream)))))))
(NC.AbortSession
(LAMBDA (DatabaseStream CacheArray IndexArray) (* fgh: "16-Oct-85 18:37")
(* * Kill the current notecards session. Work lost since last checkpoint.)
(* * rht 7/14/85: Replaced the call to reset the main menu with call to NC.ResetMainMenu. Also took out redundant
reset of PSA.Database, since NC.ForceDatabaseClose is doing that.)
(* * fgh & rht 10/16/85 Update with new cacheing mechanism.)
(LET (FullFileName LastChkptPtr EndPtr CardTotal NewBytes)
(SETQ DatabaseStream (OR (STREAMP DatabaseStream)
PSA.Database))
(SETQ CacheArray (NC.FetchCacheArray DatabaseStream CacheArray))
(SETQ IndexArray (NC.FetchIndexArray DatabaseStream IndexArray))
(SETQ FullFileName (FULLNAME DatabaseStream))
(SETFILEPTR DatabaseStream 8)
(SETQ LastChkptPtr (NC.GetPtr DatabaseStream))
(SETQ EndPtr (GETEOFPTR DatabaseStream))
(SETQ NewBytes (IDIFFERENCE EndPtr LastChkptPtr))
(COND
((OR (ZEROP NewBytes)
(PROGN (NC.PrintMsg NIL T
"Aborting will lose work since the last checkpoint i.e., the last "
NewBytes " bytes of " FullFileName (CHARACTER 13))
(NC.YesP (NC.AskUser "Want to abort anyway? " "--" "Yes" NIL NIL NIL T T))))
(for CardNumber from 1 to (SETQ CardTotal (SUB1 (SUBATOM (NC.GetNewID DatabaseStream T)
3)))
bind ID Win
do (BLOCK)
(COND
((ZEROP (IREMAINDER CardNumber 100))
(NC.PrintMsg NIL T "Quitting from active cards ... " (CHARACTER 13)
"Processing item number " CardNumber " out of " CardTotal "."
(CHARACTER 13))))
(COND
((NC.ActiveCardP CardNumber DatabaseStream CacheArray)
(SETQ ID (NC.IDFromNumber CardNumber))
(SETQ Win (NC.FetchWindow ID))
(NC.AbortCard ID)
(COND
(Win (bind (Process ←(WINDOWPROP Win (QUOTE PROCESS)))
until (OR (NULL Process)
(PROCESS.FINISHEDP Process))
do (BLOCK))
(CLOSEW Win))))))
(NC.ForceDatabaseClose DatabaseStream)
(COND
((LESSP LastChkptPtr EndPtr)
(NC.PrintMsg NIL T "Truncating file " FullFileName " ...")
(COND
((NOT (SETFILEINFO FullFileName (QUOTE LENGTH)
LastChkptPtr))
(NC.PrintMsg NIL NIL "Couldn't truncate " FullFileName "." (CHARACTER 13))))))
(NC.ResetMainMenu)
(NC.PrintMsg NIL T FullFileName " closed."))
(T (NC.ClearMsg NIL)))
NIL)))
)
(PUTPROPS FGHCHKPT COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (940 1737 (NC.FetchIndexArray 950 . 1735)) (1788 17946 (NC.GetPtrFromIndex 1798 . 2357)
(NC.SetIndexOffset 2359 . 2659) (NC.CheckpointDatabase 2661 . 5798) (NC.BuildIndexArray 5800 . 8683) (
NC.IncreaseIndexArray 8685 . 9480) (NC.GetStatusFromIndex 9482 . 9880) (NC.GetPtrsFromIndex 9882 .
11391) (NC.GetIndexOffset 11393 . 11700) (NC.PutStatusToIndex 11702 . 12252) (NC.PutPtrToIndex 12254
. 12710) (NC.IndexFromID 12712 . 13081) (NC.SortIndexEntries 13083 . 14338) (NC.CleanupIndexEntries
14340 . 15219) (NC.AbortSession 15221 . 17944)))))
STOP