| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057 |
- 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.
|