Listing: 1 2 IMPLEMENTATION MODULE ChkInd; 3 (* 4 * ModBase 5 * Release 3.0 6 * By Don Fletcher & John McMonagle 7 * (c) Copyright 1986 - 1991 PMI 8 * P.O. Box 8402 9 * Green Bay Wi 53308 10 * All Rights Reserved 11 * 12 *) 13 14 FROM DBIndxes IMPORT 15 FindPositionCh, OpenIndex, BuildIndex, DBIndex, NextRecord, PrevRecord, 16 CurrentRec,CurrentKeyCh,GoTop; 17 18 FROM StrConv IMPORT 19 CardinalToStr; 20 21 22 FROM StringIO IMPORT 23 ReadStr, WriteStr, WriteEol; 24 25 FROM M2Strings IMPORT 26 Assign, CompareStr,Concat; 27 28 FROM BigSets IMPORT InitSet,InSet,InclSet; 29 30 FROM Storage IMPORT ALLOCATE, DEALLOCATE; 31 32 CONST 33 inp = 0; 34 outp = 1; 35 prn = 4; 36 stderror = 2; 37 38 PROCEDURE NDXChk(VAR ndx:DBIndex); 39 VAR 40 LastKey,KeyStr : ARRAY[ 0 .. 127 ] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 41 str,string :ARRAY[0..79] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 42 cardrec, Keys :CARDINAL; 43 CurRec : LONGINT; 44 ok, 45 error, 46 dumbool : BOOLEAN; 47 set : POINTER TO ARRAY[0..4095] OF BITSET; ***** ^ not supported yet ***** ^ undeclared identifier 48 49 BEGIN 50 NEW( set); ***** ^ undeclared identifier ***** ^ not supported yet 51 error:=FALSE; 52 Keys:=1; 53 InitSet(set^); ***** ^ not supported yet ***** ^ not supported yet 54 GoTop( ndx ); ***** ^ not supported yet ***** ^ not supported yet 55 InclSet(set^,VAL(CARDINAL,CurrentRec(ndx))); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 56 CurrentKeyCh( ndx, LastKey ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 57 58 WHILE NextRecord( ndx, CurRec ) DO ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 59 cardrec:=VAL(CARDINAL,CurRec); ***** ^ undeclared identifier ***** ^ not supported yet 60 CurrentKeyCh(ndx,KeyStr); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 61 IF InSet(set^,cardrec) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 62 THEN 63 error:=TRUE; 64 Concat('duplicate entry for ',KeyStr,str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 65 Concat(str,' record number ',str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 66 CardinalToStr(cardrec,1,string); ***** ^ not supported yet ***** ^ not supported yet 67 Concat(str,string,str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 68 WriteEol(prn,str); ***** ^ not supported yet ***** ^ not supported yet 69 HALT; ***** ^ undeclared identifier 70 ELSE 71 InclSet(set^,cardrec); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 72 END; 73 INC(Keys); ***** ^ undeclared identifier ***** ^ not supported yet 74 IF CompareStr( LastKey, KeyStr ) > 0 ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 75 THEN 76 WriteEol(prn,'sort error in index'); ***** ^ not supported yet ***** ^ not supported yet 77 error:=TRUE; 78 HALT; ***** ^ undeclared identifier 79 END (* if *); 80 Assign( KeyStr, LastKey ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 81 END (* while *); 82 FOR cardrec:=1 TO Keys DO 83 IF NOT InSet(set^,cardrec) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 84 THEN 85 CardinalToStr(cardrec,1,string); ***** ^ not supported yet ***** ^ not supported yet 86 Concat('record number not in index ',string,str); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 87 WriteEol(prn,str); ***** ^ not supported yet ***** ^ not supported yet 88 HALT; ***** ^ undeclared identifier 89 END; 90 END (* for *); 91 92 93 IF error 94 THEN 95 CardinalToStr(Keys,8,LastKey); ***** ^ not supported yet ***** ^ not supported yet 96 WriteStr( prn, LastKey ); ***** ^ not supported yet ***** ^ not supported yet 97 WriteEol( prn ,' keys found.'); ***** ^ not supported yet ***** ^ not supported yet 98 WriteEol( prn, 'SORTING ERRORS FOUND'); ***** ^ not supported yet ***** ^ not supported yet 99 END; 100 DISPOSE(set); ***** ^ undeclared identifier ***** ^ not supported yet 101 END NDXChk; ***** ^ not supported yet 102 END ChkInd. ***** ^ not supported yet 86 errors