CHK.LST 5.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163
  1. Listing:
  2. 1
  3. 2 MODULE Chk;
  4. 3 (*
  5. 4 * ModBase
  6. 5 * Release 3.0
  7. 6 * By Don Fletcher & John McMonagle
  8. 7 * (c) Copyright 1986 - 1991 PMI
  9. 8 * BOX 8402
  10. 9 * Green Bay WI 54308-8402
  11. 10 * All Rights Reserved
  12. 11 *
  13. 12 *)
  14. 13
  15. 14 FROM ModBase3 IMPORT DBFile,InitDBF,OpenDBF,DefaultFixUp;
  16. 15
  17. 16 FROM DBIndxes IMPORT
  18. 17 GoTop, OpenIndex, BuildIndex, DBIndex, NextRecord, PrevRecord,
  19. 18 DisposeIndex,InitIndex,CurrentRec,CurrentKeyCh,CurrentKeyN,NumKeyType;
  20. 19
  21. 20 FROM StrConv IMPORT
  22. 21 CardinalToStr;
  23. 22
  24. 23 FROM EnvironUtils IMPORT ParsedParam;
  25. 24
  26. 25 FROM StringIO IMPORT
  27. 26 ReadStr, WriteStr, WriteEol;
  28. 27
  29. 28 FROM M2Strings IMPORT
  30. 29 Assign, CompareStr,Concat;
  31. 30
  32. 31 FROM BigSets IMPORT InitSet,InSet,InclSet;
  33. 32
  34. 33 FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  35. 34
  36. 35 FROM NumTypes IMPORT Real8;
  37. 36
  38. 37 FROM StrConv IMPORT RealToStr;
  39. ***** ^ duplicate identifier
  40. 38
  41. 39 IMPORT
  42. 40 InitCompilerMods;
  43. 41
  44. 42
  45. 43 CONST
  46. 44 inp = 0;
  47. 45 outp = 1;
  48. 46 prn = 4;
  49. 47 stderror = 2;
  50. 48
  51. 49 VAR
  52. 50 dbf : DBFile;
  53. 51 ndx : DBIndex;
  54. 52 Name: ARRAY[0..70] OF CHAR;
  55. ***** ^ not supported yet
  56. ***** ^ not supported yet
  57. 53 PROCEDURE NDXChk(VAR ndx:DBIndex);
  58. 54 VAR
  59. 55 KeyStr,LastKey : ARRAY[ 0 .. 127 ] OF CHAR;
  60. ***** ^ not supported yet
  61. ***** ^ not supported yet
  62. 56 str,string :ARRAY[0..127] OF CHAR;
  63. ***** ^ not supported yet
  64. ***** ^ not supported yet
  65. 57 cardrec, Keys :CARDINAL;
  66. 58 CurRec : LONGINT;
  67. 59 ok,
  68. 60 error,
  69. 61 dumbool : BOOLEAN;
  70. 62 set : POINTER TO ARRAY[0..4095] OF BITSET;
  71. ***** ^ not supported yet
  72. ***** ^ undeclared identifier
  73. 63
  74. 64 BEGIN
  75. 65 NEW( set);
  76. ***** ^ undeclared identifier
  77. ***** ^ not supported yet
  78. 66 error:=FALSE;
  79. 67 Keys:=1;
  80. 68 InitSet(set^);
  81. ***** ^ not supported yet
  82. ***** ^ not supported yet
  83. 69 GoTop( ndx );
  84. ***** ^ not supported yet
  85. ***** ^ not supported yet
  86. 70 InclSet(set^,VAL(CARDINAL,CurrentRec(ndx)));
  87. ***** ^ not supported yet
  88. ***** ^ not supported yet
  89. ***** ^ undeclared identifier
  90. ***** ^ not supported yet
  91. ***** ^ not supported yet
  92. 71 CurrentKeyCh( ndx, LastKey );
  93. ***** ^ not supported yet
  94. ***** ^ not supported yet
  95. ***** ^ not supported yet
  96. 72
  97. 73 WHILE NextRecord( ndx, CurRec ) DO
  98. ***** ^ not supported yet
  99. ***** ^ not supported yet
  100. ***** ^ not supported yet
  101. 74 cardrec:=VAL(CARDINAL,CurRec);
  102. ***** ^ undeclared identifier
  103. ***** ^ not supported yet
  104. 75 CurrentKeyCh(ndx,KeyStr);
  105. ***** ^ not supported yet
  106. ***** ^ not supported yet
  107. ***** ^ not supported yet
  108. 76 IF InSet(set^,cardrec)
  109. ***** ^ not supported yet
  110. ***** ^ not supported yet
  111. ***** ^ not supported yet
  112. 77 THEN
  113. 78 error:=TRUE;
  114. 79 Concat('duplicate entry for ',KeyStr,str);
  115. ***** ^ not supported yet
  116. ***** ^ not supported yet
  117. ***** ^ not supported yet
  118. ***** ^ not supported yet
  119. 80 Concat(str,' record number ',str);
  120. ***** ^ not supported yet
  121. ***** ^ not supported yet
  122. ***** ^ not supported yet
  123. ***** ^ not supported yet
  124. 81 CardinalToStr(cardrec,1,string);
  125. ***** ^ not supported yet
  126. ***** ^ not supported yet
  127. 82 Concat(str,string,str);
  128. ***** ^ not supported yet
  129. ***** ^ not supported yet
  130. ***** ^ not supported yet
  131. ***** ^ not supported yet
  132. 83 WriteEol(outp,str);
  133. ***** ^ not supported yet
  134. ***** ^ not supported yet
  135. 84 ELSE
  136. 85 InclSet(set^,cardrec);
  137. ***** ^ not supported yet
  138. ***** ^ not supported yet
  139. ***** ^ not supported yet
  140. 86 END;
  141. 87 INC(Keys);
  142. ***** ^ undeclared identifier
  143. ***** ^ not supported yet
  144. 88 IF CompareStr( LastKey, KeyStr ) > 0
  145. ***** ^ not supported yet
  146. ***** ^ not supported yet
  147. ***** ^ not supported yet
  148. 89 THEN
  149. 90 WriteEol(outp,'sort error in index');
  150. ***** ^ not supported yet
  151. ***** ^ not supported yet
  152. 91 error:=TRUE;
  153. 92 (* HALT; *)
  154. 93 END (*QMLB
  155. ***** ^ 'END' expected
  156. 94 l
  157. 95 ÛB
  158. 96 Û“
  159. 61 errors