IMPLEMENTATION MODULE NdxFiles; (* * REPERTOIRE * Release 1.6 * By Charles Bradford and Cole Brecheen * (c) Copyright 1985-1992 PMI * Green Bay, Wisconsin * All rights reserved * (414) 468-6040 * * $Header: D:/logfiles/mods/ndxfiles.mov 1.8 10 Mar 1991 15:30:18 coleb $ * *) IMPORT FAPI; (*EntryDiag: IMPORT Diagnostics; :EntryDiag*) IMPORT Drectory; IMPORT ErrorManager; IMPORT ErrorNames; IMPORT HandleIO; IMPORT GenLists; IMPORT ListUtils; IMPORT LowLevel; IMPORT M2Strings; IMPORT NdxBones; IMPORT NdxTypes; FROM NdxTypes IMPORT NdxRecord; IMPORT Numbers; IMPORT NumTypes; IMPORT PosUtils; IMPORT StrEdit; IMPORT StringIO; IMPORT SYSTEM; IMPORT VStorage; VAR Initialized : BOOLEAN; VAR NulHandle: VStorage.MemHandle; PROCEDURE NoMemMessage( message: ARRAY OF CHAR ); VAR tmpstr: ARRAY [0..79] OF CHAR; BEGIN StrEdit.AssignStr( 'Ran out of memory in ', tmpstr ); StrEdit.Append( tmpstr, message ); ErrorManager.WARN( tmpstr ); END NoMemMessage; PROCEDURE CreateNdxFile( VAR NdxFile: NdxTypes.NdxFileType; fname, Structure: ARRAY OF CHAR ); (*Structure should look something like this: "Name, Password, AcctBal, Address {Street, City, State}' Names listed here can be used to access specific fields within records, using the Get and Put procedures below. All procedures that use field names are case sensitive. *) VAR TmpName: ARRAY [0..255] OF CHAR; StruSize: CARDINAL; BytesWritten: LONGINT; SavedMessage: CARDINAL; PROCEDURE MakeStructure( VAR StruList: GenLists.GenList; Structure: ARRAY OF CHAR ); VAR NextSpot, BraceSpot, CommaSpot: CARDINAL; SubList: GenLists.GenList; NameStr: ARRAY [0..255] OF CHAR; PROCEDURE PosCloseBrace( Start: CARDINAL; Structure: ARRAY OF CHAR): CARDINAL; (* find the closing brace that matches this open brace *) VAR OpenSpot, CloseSpot: CARDINAL; BEGIN CloseSpot := PosUtils.Positn( '}', Structure, Start); OpenSpot := PosUtils.Positn( '{', Structure, Start); IF (CloseSpot < OpenSpot) OR (CloseSpot > HIGH( Structure)) THEN RETURN CloseSpot; ELSE RETURN PosCloseBrace( 1+PosCloseBrace( OpenSpot + 1, Structure), Structure); END; END PosCloseBrace; BEGIN (*MakeStructure*) IF M2Strings.Length(Structure) = 0 THEN RETURN; END; IF Structure[ M2Strings.Length(Structure) - 1 ] # ',' THEN StrEdit.Append(Structure, ","); (*Makes all names end the same way for the convenience of the loop below; nothing will be appended, however, if a constant structure string was passed because it completely fills its array.*) END; WHILE M2Strings.Length(Structure) > 0 DO CommaSpot := PosUtils.Pos(',', Structure); (*OK if no comma*) BraceSpot := PosUtils.Pos('{', Structure); IF CommaSpot < BraceSpot THEN NextSpot := CommaSpot; ELSE NextSpot := BraceSpot; END; IF NextSpot = 0 THEN ErrorNames.WarningName( 'NoNam' ); RETURN; END; M2Strings.Copy( Structure, 0, NextSpot, NameStr ); (*Copy everything up to the next separator, but not the separator itself.*) M2Strings.Delete( Structure, 0, NextSpot ); (*Delete everything up to but not including the separator.*) IF M2Strings.Length( Structure ) > 0 THEN M2Strings.Delete( Structure, 0, 1 ); (*Delete the separator, if present.*) END; GenLists.ListInsert( NameStr, GenLists.StrCode, StruList, 65535); (* insert this name into the list *) IF (NextSpot = BraceSpot) AND (BraceSpot <= HIGH(Structure)) THEN (* the preceeding name has a sublist *) GenLists.NewList( SubList); GenLists.ListInsert( SubList, GenLists.ListCode, StruList, 65535); (* insert a sublist into the list *) BraceSpot := PosCloseBrace( 0, Structure); IF BraceSpot > HIGH( Structure) THEN ErrorNames.WarningName( 'NdxBrac' ); RETURN; END; M2Strings.Copy( Structure, 0, BraceSpot, NameStr ); (*Copy everything up to the next brace, but not the brace itself.*) M2Strings.Delete( Structure, 0, BraceSpot + 1 ); (*Delete everything up to and including the brace.*) IF M2Strings.Length( Structure) > 0 THEN (* now delete comma after closing brace *) IF Structure[0] # ',' THEN ErrorNames.WarningName( 'NdxCmm' ); RETURN; ELSE M2Strings.Delete( Structure, 0, 1); END; END; MakeStructure( SubList, NameStr); END; END; END MakeStructure; BEGIN (*CreateNdxFile*) NdxTypes.InitNdxFile( NdxFile ); StrEdit.AssignStr( fname, NdxFile^.name ); WITH NdxFile^ DO StringIO.PrintMessage( HandleIO.CreateFile( handle, name ) ); UpdateNeeded := TRUE; GenLists.NewList( Ndx); GenLists.NilList( AltKeys ); GenLists.NewList( ListBuf); GenLists.NewList( StructLst); END; StrEdit.DeleteChar( ' ', Structure ); StrEdit.CAPstr(Structure); StringIO.WriteStr( NdxFile^.handle, '00' ); (* space at start of file for size of structure to be put *) MakeStructure( NdxFile^.StructLst, Structure); M2Strings.Concat( NdxBones.IsGarbageByte, NdxBones.StructName, TmpName); GenLists.ListInsert( TmpName, GenLists.StrCode, NdxFile^.StructLst, 1); (* add structure name to structure list *) SavedMessage := ListUtils.ListToFileHandle( NdxFile^.StructLst, NdxFile^.handle, NdxBones.StartSep, NdxBones.EndSep, 0, BytesWritten ); StruSize := Numbers.C( BytesWritten ); IF (SavedMessage # StringIO.NoError) THEN ErrorNames.WarningName( 'StructCreate' ); END; GenLists.ListDelete( NdxFile^.StructLst, 1, 1); (* deletes the StructName from the Structure *) NdxFile^.NdxFilePtr := Numbers.Lc( 2 + StruSize); (* Point to NdxMarker *) StringIO.WriteStr( NdxFile^.handle, NdxBones.NdxMarker ); StringIO.PrintMessage( HandleIO.BlockWrite( NdxFile^.handle, SYSTEM.ADR(NdxFile^.NdxFilePtr), 4)); (* write ndxmarker & position out to end of file *) HandleIO.SetFilePtr( NdxFile^.handle, HandleIO.FromStart, Numbers.Lc( 0)); StringIO.PrintMessage( HandleIO.BlockWrite( NdxFile^.handle, SYSTEM.ADR( StruSize), 2)); (* write size of structure out to start of file *) NdxBones.MakeEmptyBuf( NdxFile^.StructLst, NdxFile^.ListBuf ); END CreateNdxFile; PROCEDURE WriteNdx( NdxFile: NdxTypes.NdxFileType ); VAR BytesWritten: LONGINT; BEGIN HandleIO.SetFilePtr( NdxFile^.handle, HandleIO.FromStart, NdxFile^.NdxFilePtr ); (*Go to end of data area.*) StringIO.WriteStr( NdxFile^.handle, NdxBones.NdxMarker); (*Write NdxMarker.*) IF StringIO.NoError # ListUtils.ListToFileHandle( NdxFile^.Ndx, NdxFile^.handle, '', '', 0, BytesWritten ) THEN (*The nulls mean "don't write delimiters."*) ErrorNames.WarningName( 'NdxWrt' ); END; StringIO.PrintMessage( HandleIO.BlockWrite( NdxFile^.handle, SYSTEM.ADR(NdxFile^.NdxFilePtr), 4) ); (* write starting position of index *) StringIO.PrintMessage(Drectory.SetFileLength(NdxFile^.handle, HandleIO.GetFilePtr(NdxFile^.handle))); HandleIO.UpdateDisk(NdxFile^.handle); SetFileUpdate( NdxFile^.handle, NdxBones.NotGarbageByte); NdxFile^.UpdateNeeded := FALSE; END WriteNdx; PROCEDURE SetFileUpdate( handle: CARDINAL; GbgByte: CHAR); BEGIN (* Puts the passed character in the file's UpdateNeeded Byte (use IsGarbageByte when file index needs update, and NotGarbageByte when update no longer needed). *) HandleIO.SetFilePtr( handle, HandleIO.FromStart, Numbers.Lc( 10)); StringIO.WriteStr( handle, GbgByte); END SetFileUpdate; PROCEDURE CloseNdxFile( VAR NdxFile: NdxTypes.NdxFileType ); BEGIN NdxTypes.CheckInit( NdxFile ); IF NdxFile^.UpdateNeeded THEN WriteNdx( NdxFile); (* Write Ndx if it has been changed *) END; WITH NdxFile^ DO GenLists.DisposeList( ListBuf); GenLists.DisposeList( StructLst); GenLists.DisposeList( Ndx ); GenLists.DisposeList( AltKeys ); (*Note that we don't dispose of the FileBufPtr because it should always have been absorbed into the ListBuf.*) IF handle # 0 THEN (*handle may be 0 if the NdxFile record was initialized but never passed to OpenNdxFile.*) StringIO.PrintMessage( HandleIO.CloseHandle( handle) ); END; END; VStorage.DosDealloc( NdxFile, SYSTEM.TSIZE(NdxRecord) ); END CloseNdxFile; PROCEDURE ChangedIndex(NdxFile: NdxTypes.NdxFileType); BEGIN (* need to account for small changes to index or just big?? *) IF NdxFile^.SafetyOn THEN WriteNdx( NdxFile); HandleIO.UpdateDisk( NdxFile^.handle ); (* writes entire index at end of file *) ELSE IF NOT NdxFile^.UpdateNeeded THEN SetFileUpdate( NdxFile^.handle, NdxBones.IsGarbageByte); NdxFile^.UpdateNeeded := TRUE; END; END; END ChangedIndex; PROCEDURE DeleteRecord( VAR NdxFile: NdxTypes.NdxFileType; RecName: ARRAY OF CHAR ): BOOLEAN; (*Marks RecName as garbage in the linked list so that CrunchNdxFile can delete it from the file, sets garbage byte in file record, and erases in current buffer (if there). If SafetyOn is set for this NdxFile, also writes the linked list out to the file.*) VAR FilePos: LONGINT; UsedSize, AllocSize : CARDINAL; BEGIN NdxTypes.CheckInit( NdxFile ); StrEdit.CrunchBlanks( RecName ); IF (M2Strings.Length(RecName) = 0) OR (NOT NdxBones.FindRecord( NdxFile, RecName, FilePos, UsedSize, AllocSize)) THEN (* If don't find record in index, return FALSE *) RETURN FALSE; END; IF NOT ChangeNdxEntry( RecName, '', FilePos, AllocSize, NdxFile) THEN RETURN FALSE; END; (* change index entry to garbage *) INC( FilePos, 8 ); HandleIO.SetFilePtr( NdxFile^.handle, HandleIO.FromStart, FilePos); StringIO.WriteStr( NdxFile^.handle, NdxBones.IsGarbageByte); (* write garbage byte in old record *) IF PosUtils.Equal(RecName, NdxFile^.BufRecName) THEN (* if record is now in buffer, erase it *) StrEdit.SetLength( NdxFile^.BufRecName, 0); END; ChangedIndex( NdxFile); RETURN TRUE; END DeleteRecord; PROCEDURE EncodeList( VAR TheList: GenLists.GenList); PROCEDURE EnCodeField( OldAddr: SYSTEM.ADDRESS; OldSize, NumberFound: CARDINAL; VAR NewAddr: SYSTEM.ADDRESS; VAR NewSize: CARDINAL); (* Change all occurences of CodeChar to CodedStr *) VAR tmpsize, toskip : CARDINAL; Source, Dest: SYSTEM.ADDRESS; BEGIN NewSize := NumberFound + OldSize; VStorage.DosAlloc( NewAddr, NewSize); (* max size needed *) tmpsize := OldSize; Source := OldAddr; (* starting address *) Dest := NewAddr; LOOP toskip := LowLevel.ScanEQ( tmpsize, NdxBones.CodeChar, Source); (* look for next CodeChar *) LowLevel.Move( Source, Dest, toskip); IF toskip >= tmpsize THEN EXIT; END; Dest := LowLevel.AddAddr( Dest, toskip ); LowLevel.Move( SYSTEM.ADR( NdxBones.CodedStr), Dest, 2); Dest := LowLevel.AddAddr( Dest, 2 ); INC( OldSize); Source := LowLevel.AddAddr( Source, toskip + 1 ); DEC( tmpsize, toskip + 1); END; END EnCodeField; VAR NumberFound, OldSize, NewSize, ElmntType, cnt, leng: CARDINAL; SubList: GenLists.GenList; OldAddr, NewAddr: SYSTEM.ADDRESS; BEGIN leng := GenLists.ListLength( TheList ); FOR cnt := 1 TO leng DO GenLists.GetElmtAdr( TheList, cnt, OldAddr, OldSize, ElmntType); IF ElmntType # GenLists.ListCode THEN NumberFound := PosUtils.ByteCount( OldSize, NdxBones.CodeChar, OldAddr ); IF NumberFound > 0 THEN (* do not replace unless code chars found *) EnCodeField( OldAddr, OldSize, NumberFound, NewAddr, NewSize ); GenLists.ListReplaceAdr( NewAddr, NewSize, ElmntType, TheList, cnt); VStorage.DosDealloc( NewAddr,NewSize ); (* 9/14/91 per report from J March *) END; ELSE (* this element is a list *) GenLists.GetChildList( TheList, cnt, SubList); IF GenLists.Initialized( SubList ) THEN (*Make sure it's not a nil list.*) EncodeList( SubList ); (* encode this sublist *) END; END; END; END EncodeList; PROCEDURE WriteRecord( VAR NdxFile: NdxTypes.NdxFileType; RecName: ARRAY OF CHAR ): BOOLEAN; (*First checks to see whether RecName is in the List buffer created by the Put routines below. Returns FALSE if it isn't. If it is, then checks to see whether RecName is in the list of existing record names. If so, and if the record will still fit in its old spot in the file, WriteRecord overwrites the old spot in the file with the data in the list buffer. Otherwise, it adds the record to the end of the NdxFile, overwriting the ndx, and if the record is not new, marks the spot it formerly occupied as garbage. If the NdxFile's SafetyOn feature has been turned on, a new ndx will be written each time a record is added to the end of the NdxFile. Otherwise, the new ndx will be written only when CloseNdxFile is called.*) VAR OldTotalBytes, OldUsedBytes, NewTotData, NumLsts: CARDINAL; BytesWritten, NumElmts, NewFilePtr, offset, TotMem: LONGINT; OldEntry, RecordExists: BOOLEAN; TmpStr: ARRAY [0..79] OF CHAR; SavedMessage: CARDINAL; BEGIN (* WriteRecord *) NdxTypes.CheckInit( NdxFile ); StrEdit.CrunchBlanks( RecName ); IF NOT PosUtils.Equal(RecName, NdxFile^.BufRecName) THEN (* if record not in buffer, return FALSE *) RETURN( FALSE ); END; StrEdit.AssignStr( RecName, TmpStr ); M2Strings.Insert( NdxBones.NotGarbageByte, TmpStr, 0 ); GenLists.ListInsert( TmpStr, GenLists.StrCode, NdxFile^.ListBuf, 1 ); (*Put the record name into the ListBuf.*) StrEdit.SetLength( NdxFile^.BufRecName, 0); (*We set BufRecName to null to guarantee that this record gets read from the file next time it is needed, because we are about to encode it.*) OldTotalBytes := 0; RecordExists := NdxBones.FindRecord( NdxFile, RecName, offset, OldUsedBytes, OldTotalBytes); EncodeList( NdxFile^.ListBuf ); NewTotData := Numbers.C( GenLists.ListSize( NdxFile^.ListBuf, NumElmts, NumLsts, TotMem)); (* find out maximum size of data in record to be written *) INC( NewTotData, 6 + 6 * Numbers.C( NumElmts)); (* add room for: 2 char start & end seps for record, 2 char start & end seps for every element, and 2 char TypeCode for every element & for record *) OldEntry := RecordExists AND (NewTotData <= OldTotalBytes); (* whether record exists and old file spot is big enough *) IF OldEntry THEN (* rewrite in old spot if not too big *) IF NOT ChangeNdxEntry( RecName, RecName, offset, NewTotData, NdxFile) THEN RETURN FALSE; END; HandleIO.SetFilePtr( NdxFile^.handle, HandleIO.FromStart, offset ); NewFilePtr := offset; (*I'm not sure this assignment is necessary, but it prevents confusion.*) ELSE (* new entry is too big; so delete old index entry and write at end *) IF RecordExists THEN (* change old entry to garbage *) IF NOT ChangeNdxEntry( RecName, '', offset, OldTotalBytes, NdxFile) THEN RETURN FALSE; END; INC( offset, 8 ); (*We skip past the record's first NdxBones.StartSep and its ListCode, plus the NdxBones.StartSep for the RecordName and its StrCode. Using a numeric literal here is dangerous.*) HandleIO.SetFilePtr( NdxFile^.handle, HandleIO.FromStart, offset); StringIO.WriteStr( NdxFile^.handle, NdxBones.IsGarbageByte); (* write garbage byte in old record *) END; NewFilePtr := NdxFile^.NdxFilePtr; (*NdxFile^.NdxFilePtr always points at the end of the NdxFile's data area--at the NdxMarker, in other words.*) OldTotalBytes := NewTotData; (* initialize two variables that InsertNdxEntry will update if it finds old garbage space to re-use *) IF NOT InsertNdxEntry( RecName, NewFilePtr, NewTotData, OldTotalBytes, NdxFile) THEN (* make new entry for this record, or re-use garbage space *) RETURN FALSE; END; (* make new index entry *) HandleIO.SetFilePtr( NdxFile^.handle, HandleIO.FromStart, NewFilePtr); (* put file pointer at start of this new record *) END; SavedMessage := ListUtils.ListToFileHandle( NdxFile^.ListBuf, NdxFile^.handle, NdxBones.StartSep, NdxBones.EndSep, 0, BytesWritten ); IF BytesWritten # Numbers.Lc(NewTotData) THEN (*we've miscalculated NewTotData*) (* Diagnostics.diagL( "Unexpected value for BytesWritten", BytesWritten ); Diagnostics.diagC( "Should be", NewTotData ); *) END; IF NewTotData < OldTotalBytes THEN (* garbage space at end of record to fill *) DEC( OldTotalBytes, NewTotData); IF HandleIO.FillFile( NdxFile^.handle, OldTotalBytes, 0C ) # StringIO.NoError THEN (* fill end of record with nulls *) RETURN FALSE; END; END; IF (NOT OldEntry) OR (NewTotData # OldUsedBytes) THEN (* if not using old index entry *) IF NewFilePtr = NdxFile^.NdxFilePtr THEN NdxFile^.NdxFilePtr := NdxFile^.NdxFilePtr + Numbers.Lc( NewTotData ); StringIO.WriteStr( NdxFile^.handle, NdxBones.NdxMarker); (* correct ndxfileptr and write ndxmarker if adding to end of file *) END; ChangedIndex( NdxFile); (* write changed index to file, or set UpdateNeeded *) END; GenLists.DisposeList( NdxFile^.ListBuf ); (*Might as well dispose of the list buffer since it's no good once we've encoded it.*) StrEdit.SetLength( NdxFile^.BufRecName, 0); (*Set BufRecName to null again because ChangeNdxEntry may have put the name back in.*) RETURN TRUE; END WriteRecord; PROCEDURE ResetBuf( VAR TheBuf: GenLists.GenList ); VAR ElmntBytes, ElmntType, theleng, cnt: CARDINAL; TmpAddr: SYSTEM.ADDRESS; sublst: GenLists.GenList; BEGIN theleng := GenLists.ListLength( TheBuf); IF theleng # 0 THEN FOR cnt := 1 TO theleng DO GenLists.GetElmtAdr( TheBuf, cnt, TmpAddr, ElmntBytes, ElmntType); IF ElmntType = GenLists.ListCode THEN GenLists.GetChildList( TheBuf, cnt, sublst); ResetBuf( sublst); ELSIF ElmntType = GenLists.StrCode THEN LowLevel.Fill( TmpAddr, 1, 0C); ELSE LowLevel.Fill( TmpAddr, ElmntBytes, 0C); END; END; END; END ResetBuf; PROCEDURE FindField( StruList: GenLists.GenList; FieldName: ARRAY OF CHAR; VAR DataList: GenLists.GenList; VAR spot: CARDINAL): BOOLEAN; (* flip thru structure to find field & return the sublist it is in & its position in that list; if can't find, return FALSE. Start counting with spot.*) VAR NameSize, NameType, PeriodSpot, indx, cnt, FieldLeng, ElmntBytes, ElmntType: CARDINAL; TmpPtr, NamePtr: LowLevel.Address8086; SubName: ARRAY [0..255] OF CHAR; NotFound, StillMatches: BOOLEAN; SubStruList, SubDataList: GenLists.GenList; TmpAddr: SYSTEM.ADDRESS; BEGIN (*FindField*) StrEdit.CAPstr(FieldName); IF PosUtils.Equal( FieldName, 'RECORD') THEN spot := 0; RETURN TRUE; END; cnt := 1; NotFound := TRUE; PeriodSpot := PosUtils.Pos( '.', FieldName); StrEdit.SetLength( SubName, 0); IF PeriodSpot <= HIGH( FieldName) THEN (* period found -> subfields specified *) IF PeriodSpot = M2Strings.Length(FieldName) - 1 THEN StrEdit.SetLength( FieldName, M2Strings.Length( FieldName) - 1); (* delete period if alone at end of field name *) ELSE M2Strings.Copy( FieldName, PeriodSpot + 1, M2Strings.Length(FieldName) -PeriodSpot - 1, SubName); (* SubName is the name of the subfields *) StrEdit.SetLength( FieldName, PeriodSpot); (* make field name the name at the first level *) END; END; FieldLeng := M2Strings.Length( FieldName); (* length of name sought *) WHILE (cnt <= GenLists.ListLength( StruList)) AND NotFound DO (* flip thru structure to find field *) GenLists.GetElmtAdr( StruList, cnt, NamePtr.a, NameSize, NameType); (* read next field *) INC( cnt); IF (NameType # GenLists.ListCode) THEN (* if not a list, see if it is the sought name *) INC( spot); (* inc the field counter *) IF NameSize = (1 + FieldLeng) THEN (* compare this field name to name sought *) indx := 0; TmpPtr := NamePtr; StillMatches := TRUE; WHILE StillMatches AND (indx < FieldLeng) DO StillMatches := FieldName[ indx] = TmpPtr.b^; IF StillMatches THEN INC( indx); LowLevel.IncAddr( TmpPtr.a, 1 ); END; END; NotFound := NOT StillMatches; END; END; END; IF NotFound THEN RETURN FALSE ; END; IF M2Strings.Length( SubName) # 0 THEN GenLists.GetElmtAdr( StruList, cnt, TmpAddr, ElmntBytes, ElmntType); IF ElmntType = GenLists.ListCode THEN (* if this field has a sub list *) GenLists.GetChildList( StruList, cnt, SubStruList); GenLists.GetChildList( DataList, spot, SubDataList); DataList := SubDataList; spot := 0; IF NOT FindField( SubStruList, SubName, DataList, spot) THEN RETURN FALSE; END; ELSE RETURN FALSE; END; END; RETURN TRUE; END FindField; PROCEDURE AddRecord( NdxFile: NdxTypes.NdxFileType; RecName: ARRAY OF CHAR); (* Adds new record to file by: putting record name in BufRecName (don't add to index; WriteRec will do it) and creating empty list buffer *) BEGIN StrEdit.AssignStr(RecName, NdxFile^.BufRecName); ResetBuf( NdxFile^.ListBuf ); (* initialize empty ListBuf *) END AddRecord; PROCEDURE PutField( VAR NdxFile: NdxTypes.NdxFileType; RecName, FieldName: ARRAY OF CHAR; TheType: CARDINAL; TheField: ARRAY OF SYSTEM.BYTE ): BOOLEAN; BEGIN RETURN PutFieldAdr( NdxFile, RecName, FieldName, TheType, SYSTEM.ADR(TheField), HIGH(TheField) + 1 ); END PutField; PROCEDURE GetField( VAR NdxFile: NdxTypes.NdxFileType; RecName, FieldName: ARRAY OF CHAR; VAR TheType: CARDINAL; VAR TheField: ARRAY OF SYSTEM.BYTE ): BOOLEAN; VAR TmpAdr: SYSTEM.ADDRESS; TmpSize: CARDINAL; found: BOOLEAN; BEGIN found := GetFieldAdr( NdxFile, RecName, FieldName, TheType, TmpAdr, TmpSize ); IF found THEN LowLevel.Move( TmpAdr, SYSTEM.ADR(TheField), Numbers.Min(TmpSize, HIGH(TheField) + 1) ); IF TheType = GenLists.StrCode THEN IF (HIGH(TheField) + 2) < TmpSize THEN (*Ignore the fact that we couldn't store the null terminator.*) found := FALSE; END; ELSIF (HIGH(TheField) + 1) < TmpSize THEN (*We do this to warn user that there's been an overflow.*) found := FALSE; END; END; RETURN found; END GetField; PROCEDURE PutFieldAdr( VAR NdxFile: NdxTypes.NdxFileType; RecName, FieldName: ARRAY OF CHAR; TheType: CARDINAL; TheFieldAdr: SYSTEM.ADDRESS; TheFieldSize: CARDINAL ): BOOLEAN; (*Returns FALSE if FieldName is not in the structure list associated with NdxFile, or if not of TheType. It calls InitBuffer to: do a Retrieve if current contents of RecName are not in the read buffer, and then it transfers from the read buffer into the list buffer (actually it allocates a list element for every field in the read buffer). If the RecName does not exist, it is created. Then it looks for FieldName in that list (the list buffer), encodes the incoming string and puts it over the current value. Doesn't actually write anything to the file; you have to use WriteRecord before doing a Put with any different record, else the stuff you've stored in the list buffer will be lost.*) VAR len1, len2, spot: CARDINAL; TmpList, DataList: GenLists.GenList; BEGIN spot := 0; StrEdit.CrunchBlanks( RecName ); len1 := M2Strings.Length(RecName); IF len1 > NdxTypes.RecNameLength THEN StrEdit.SetLength( RecName, NdxTypes.RecNameLength ); END; IF len1 = 0 THEN RETURN FALSE; ELSIF NOT NdxBones.InitBuffer( NdxFile, RecName) THEN (*Loads file data if exists, or else creates new record.*) AddRecord( NdxFile, RecName); END; DataList := NdxFile^.ListBuf; IF NOT FindField( NdxFile^.StructLst, FieldName, DataList, spot) THEN (* locates field; returns list and position *) RETURN FALSE; END; IF (spot = 0) THEN (* replacing the entire record *) IF (TheType # GenLists.ListCode) THEN (*This used to be illegal. Now we anticipate what they're trying to do.*) GenLists.NewList( TmpList ); GenLists.ListInsertAdr( TheFieldAdr, TheFieldSize, TheType, TmpList, 1 ); ELSIF NOT GenLists.AdrToList( TheFieldAdr, TheFieldSize, TmpList ) THEN HALT(); END; len1 := GenLists.ListLength(TmpList); len2 := GenLists.ListLength(DataList); IF ( 1 + len1 ) >= len2 THEN (* only allow if list as big as structure *) IF SYSTEM.ADDRESS(NdxFile^.ListBuf) # SYSTEM.ADDRESS(TmpList) THEN (*We do this test because it's likely that ListBuf and TmpList will be the same--GetField gives you the real ListBuf, not a copy of it, so people may be modifying the ListBuf directly and then passing it back to PutField. The PutField in that case isn't necessary, since PutField's only purpose is to modify the ListBuf.*) GenLists.DisposeList( NdxFile^.ListBuf); NdxFile^.ListBuf := TmpList; (* dispose of old buffer and use new data as buffer *) END; ELSE RETURN FALSE; END; ELSE GenLists.ListReplaceAdr( TheFieldAdr, TheFieldSize, TheType, DataList, spot ); (* puts new data in list buffer in proper spot *) END; RETURN TRUE; END PutFieldAdr; PROCEDURE GetFieldAdr( VAR NdxFile: NdxTypes.NdxFileType; RecName, FieldName: ARRAY OF CHAR; VAR TheType: CARDINAL; VAR TheFieldAdr: SYSTEM.ADDRESS; VAR TheFieldSize: CARDINAL ): BOOLEAN; (*GetFieldAdr first calls InitBuffer to do retrieve if needed & finds field in index list if it is there. If problem with either, return FALSE. Then get the element out of the ListBuffer *) VAR spot: CARDINAL; DataList: GenLists.GenList; offset: LONGINT; (*Not used.*) RecSize, ListSpot: CARDINAL; (*Not used.*) BEGIN spot := 0; StrEdit.CrunchBlanks( RecName ); IF (M2Strings.Length(RecName)=0) OR (NOT NdxBones.FindRecord( NdxFile, RecName, offset, RecSize, ListSpot )) THEN RETURN FALSE; END; IF NOT NdxBones.InitBuffer( NdxFile, RecName) THEN RETURN FALSE; END; DataList := NdxFile^.ListBuf; IF NOT FindField( NdxFile^.StructLst, FieldName, DataList, spot) THEN RETURN FALSE; END; IF spot = 0 THEN (* entire record requested *) TheFieldSize := (*SYSTEM.TSIZE(GenLists.GenList)*) 4; TheFieldAdr := GenLists.AdrOfList( NdxFile^.ListBuf ); TheType := GenLists.ListCode; RETURN TRUE; ELSE GenLists.GetElmtAdr( DataList, spot, TheFieldAdr, TheFieldSize, TheType); (* try to retrieve the requested element *) END; RETURN TRUE; END GetFieldAdr; PROCEDURE FileStructure( NdxFile: NdxTypes.NdxFileType; VAR Structure: ARRAY OF CHAR ); (*Returns a string containing the names of all fields defined for the NdxFile, in the form used by the Structure parameter of the CreateNdxFile procedure.*) PROCEDURE AddTheList( TheList: GenLists.GenList); VAR leng, cnt, TheType, TmpSize: CARDINAL; tmpbuf: ARRAY [0..NdxTypes.RecNameLength] OF CHAR; TmpAddr: SYSTEM.ADDRESS; SubList: GenLists.GenList; BEGIN leng := GenLists.ListLength( TheList); FOR cnt := 1 TO leng DO GenLists.GetElmtAdr( TheList, cnt, TmpAddr, TmpSize, TheType); IF TheType # GenLists.ListCode THEN IF cnt # 1 THEN StrEdit.Append( Structure, ','); END; IF TmpSize <= (NdxTypes.RecNameLength + 1) THEN LowLevel.Move( TmpAddr, SYSTEM.ADR(tmpbuf), TmpSize); ELSE LowLevel.Move( TmpAddr, SYSTEM.ADR(tmpbuf), (NdxTypes.RecNameLength + 1)); END; StrEdit.Append( Structure, tmpbuf); ELSE StrEdit.Append( Structure, '{'); GenLists.GetChildList( TheList, cnt, SubList); AddTheList( SubList); StrEdit.Append( Structure, '}'); END; END; END AddTheList; BEGIN NdxTypes.CheckInit( NdxFile ); StrEdit.SetLength( Structure, 0); AddTheList( NdxFile^.StructLst); END FileStructure; PROCEDURE RecordExists( NdxFile: NdxTypes.NdxFileType; VAR RecName: ARRAY OF CHAR ): BOOLEAN; VAR offset: LONGINT; (*Not used.*) RecSize, ListSpot: CARDINAL; (*Not used.*) BEGIN NdxTypes.CheckInit( NdxFile ); StrEdit.CrunchBlanks( RecName ); RETURN (M2Strings.Length(RecName) # 0) AND (NdxBones.FindRecord( NdxFile, RecName, offset, RecSize, ListSpot )); END RecordExists; PROCEDURE SafetyOn( VAR NdxFile: NdxTypes.NdxFileType ); (*After SafetyOn is called, every time WriteRecord adds a record to the end of an NdxFile and thereby overwrites the ndx, it writes out a new copy of the ndx at the end of the file. NdxFiles are initialized with Safety off.*) BEGIN NdxTypes.CheckInit( NdxFile ); NdxFile^.SafetyOn := TRUE; END SafetyOn; PROCEDURE SafetyOff( VAR NdxFile: NdxTypes.NdxFileType ); (*After SafetyOff is called, the ndx at the end of an NdxFile can be overwritten, and will be restored only when CloseNdxFile is called.*) BEGIN NdxTypes.CheckInit( NdxFile ); NdxFile^.SafetyOn := FALSE; END SafetyOff; PROCEDURE FindBlankSpace( VAR Ndx: GenLists.GenList; VAR NewElmt: NdxTypes.NdxElement; VAR OldElmt: CARDINAL): BOOLEAN; (* if can find space for NewElmt in deleted records at end of index, change NewElmt to point to the empty spot, return the cardinal position of the re-used garbage element of the index, and return TRUE *) VAR TheType: CARDINAL; TmpElmt: NdxTypes.NdxElement; BEGIN IF (M2Strings.Length( NewElmt.RecName) = 0) OR (NewElmt.UsedChars = 0) OR (GenLists.ListLength(Ndx) = 0) THEN (* don't try this for garbage entries or empty index *) RETURN FALSE; ELSE GenLists.GetElmt( Ndx, GenLists.ListLength(Ndx), TmpElmt, TheType); END; WHILE M2Strings.Length(TmpElmt.RecName) = 0 DO (* search through all entries in index with no name (garbage entries) *) IF TmpElmt.Allocated >= NewElmt.Allocated THEN (* found an entry to re-use *) NewElmt.Allocated := TmpElmt.Allocated; NewElmt.FilePos := TmpElmt.FilePos; OldElmt := GenLists.ElmtNow( Ndx); RETURN TRUE; END; IF GenLists.ElmtNow( Ndx ) = 1 THEN (* if can't back up any more, return FALSE *) RETURN FALSE; END; GenLists.NextElmt( Ndx, -1, TmpElmt, TheType); END; RETURN FALSE; END FindBlankSpace; (*$O-*) (*We turn off optimization in this procedure to avoid a bug in the beta copy of Logitech's v3.0 compiler.*) PROCEDURE InsertNdxEntry( RecName: ARRAY OF CHAR; VAR FilePos: LONGINT; UsedChars: CARDINAL; VAR AllocatedChars: CARDINAL; VAR NdxFile: NdxTypes.NdxFileType ): BOOLEAN; VAR dummylong: LONGINT; TheElmt, dummycard, OldElmt, NameLength: CARDINAL; TmpElmt: NdxTypes.NdxElement; BEGIN NameLength := M2Strings.Length(RecName); IF NameLength < (HIGH(RecName) + 1) THEN LowLevel.Fill( LowLevel.AddAddr(SYSTEM.ADR(RecName), NameLength ), 1 + HIGH(RecName) - NameLength, 0C ); (*We do this to initialize end space in the Ndx; makes it easier to read when debugging.*) END; LowLevel.Fill( SYSTEM.ADR(TmpElmt.RecName), M2Strings.Length(TmpElmt.RecName), 0C ); StrEdit.AssignStr( RecName, TmpElmt.RecName ); TmpElmt.FilePos := FilePos; TmpElmt.UsedChars := UsedChars; TmpElmt.Allocated := AllocatedChars; IF NOT NdxBones.FindRecord(NdxFile, RecName, dummylong, dummycard, TheElmt) THEN (*The FindRecord returns the alphabetically correct insertion point, TheElmt.*) IF FindBlankSpace( NdxFile^.Ndx, TmpElmt, OldElmt) THEN (* if can find space for record in existing garbage, use it and delete the garbage index entry *) FilePos := TmpElmt.FilePos; AllocatedChars := TmpElmt.Allocated; GenLists.ListDelete( NdxFile^.Ndx, OldElmt, 1); END; GenLists.ListInsert( TmpElmt, NdxTypes.NdxTypeCode, NdxFile^.Ndx, TheElmt); RETURN TRUE; ELSE RETURN FALSE; END; END InsertNdxEntry; (*$O=*) PROCEDURE ChangeNdxEntry( OldRecName, NewRecName: ARRAY OF CHAR; FilePos: LONGINT; NumUsed: CARDINAL; VAR NdxFile: NdxTypes.NdxFileType): BOOLEAN; VAR TmpElmt: NdxTypes.NdxElement; dummylong: LONGINT; dummycard, NewElmt, OldElmt: CARDINAL; ToGarbage: BOOLEAN; BEGIN LowLevel.Fill( SYSTEM.ADR(TmpElmt.RecName), M2Strings.Length(TmpElmt.RecName), 0C ); StrEdit.AssignStr( NewRecName, TmpElmt.RecName ); ToGarbage := M2Strings.Length( NewRecName)=0; IF ToGarbage THEN TmpElmt.UsedChars := 0; (* Marks the entry as garbage if you change name to '' *) ELSE TmpElmt.UsedChars := NumUsed; END; TmpElmt.FilePos := FilePos; TmpElmt.Allocated := NumUsed; IF NdxBones.FindRecord(NdxFile, OldRecName, dummylong, dummycard, dummycard) THEN IF NdxBones.CompareProc( OldRecName, NewRecName) # 0 THEN (* to change record names, find and save old position, if new name does not exist then delete old and insert new *) OldElmt := GenLists.ElmtNow(NdxFile^.Ndx); IF ToGarbage OR (NOT NdxBones.FindRecord(NdxFile, NewRecName, dummylong, dummycard, dummycard)) THEN GenLists.ListDelete( NdxFile^.Ndx, OldElmt, 1); (*If new name does not exist (or represents garbage) and old entry can be deleted, return success of trying to insert new name *) ToGarbage := NdxBones.FindRecord(NdxFile, NewRecName, dummylong, dummycard, NewElmt); (*We do not need this result. We need NewElmt. *) IF ToGarbage THEN (* if found new value in file already, it is a garbage entry; insert at that point *) NewElmt := GenLists.ElmtNow( NdxFile^.Ndx); END; GenLists.ListInsert( TmpElmt, NdxTypes.NdxTypeCode, NdxFile^.Ndx, NewElmt); RETURN TRUE; ELSE RETURN FALSE; END; (* if changed name, delete old and add new *) END; GenLists.ListReplace( TmpElmt, NdxTypes.NdxTypeCode, NdxFile^.Ndx, GenLists.ElmtNow(NdxFile^.Ndx)); RETURN TRUE; ELSE RETURN FALSE; END; END ChangeNdxEntry; PROCEDURE Init(); BEGIN IF Initialized THEN RETURN; ELSE Initialized := TRUE; END; (*EntryDiag: Diagnostics.Init(); :EntryDiag*) Drectory.Init(); ErrorManager.Init(); ErrorNames.Init(); HandleIO.Init(); GenLists.Init(); ListUtils.Init(); LowLevel.Init(); M2Strings.Init(); NdxBones.Init(); NdxTypes.Init(); Numbers.Init(); NumTypes.Init(); PosUtils.Init(); StrEdit.Init(); StringIO.Init(); VStorage.Init(); (*EntryDiag: Diagnostics.diagS( 'Entering NdxFiles', '' ); :EntryDiag*) VStorage.NilHandle( NulHandle ); (*EntryDiag: Diagnostics.diagS( 'Exiting NdxFiles', '' ); :EntryDiag*) END Init; BEGIN Initialized := FALSE; Init(); END NdxFiles.