Listing: 1 IMPLEMENTATION MODULE NdxSort; 2 (* 3 * REPERTOIRE 4 * Release 1.6 5 * By Charles Bradford and Cole Brecheen 6 * (c) Copyright 1985-1992 PMI 7 * Green Bay, Wisconsin 8 * All rights reserved 9 * (414) 468-6040 10 * 11 * $Header: D:/logfiles/mods/ndxsort.mov 1.8 10 Mar 1991 15:30:36 coleb $ 12 * 13 * 14 * Written and contributed by Torbjorn Sund of 15 * Tromsoe, Norway. 16 * 17 *) 18 19 20 (*EntryDiag: 21 IMPORT Diagnostics; 22 :EntryDiag*) 23 IMPORT ErrorManager; 24 IMPORT GenLists; 25 IMPORT LowLevel; 26 IMPORT M2Strings; 27 IMPORT NdxFiles; 28 IMPORT NdxTypes; 29 IMPORT PosUtils; 30 IMPORT StrConv; 31 IMPORT StrEdit; 32 IMPORT SYSTEM; 33 34 VAR 35 Initialized : BOOLEAN; 36 37 PROCEDURE Init(); 38 BEGIN 39 IF Initialized THEN 40 RETURN; 41 ELSE 42 Initialized := TRUE; 43 END; 44 (*EntryDiag: 45 Diagnostics.Init(); 46 :EntryDiag*) 47 ErrorManager.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 48 LowLevel.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 49 StrEdit.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 50 NdxTypes.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 51 NdxFiles.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 52 GenLists.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 53 M2Strings.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 54 PosUtils.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 55 StrConv.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 56 57 (*EntryDiag: 58 Diagnostics.diagS( 'Entering NdxSort', '' ); 59 :EntryDiag*) 60 61 DefMaxPos := InitDefMaxPos; ***** ^ undeclared identifier ***** ^ undeclared identifier 62 63 (*EntryDiag: 64 Diagnostics.diagS( 'Exiting NdxSort', '' ); 65 :EntryDiag*) 66 END Init; ***** ^ not supported yet 67 68 69 CONST 70 AFTERLAST = 65535; 71 (* clarifies list-append operation *) 72 73 TYPE 74 String = ARRAY [0..127] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 75 76 (* below taken from Repertoire book *) 77 PROCEDURE TypeOf(TheList : GenLists.GenList; TheElmt : CARDINAL) : CARDINAL; ***** ^ not supported yet 78 VAR 79 TypeCode, DummySize : CARDINAL; 80 DummyAddr : POINTER TO CARDINAL; ***** ^ not supported yet 81 BEGIN 82 GenLists.GetElmtAdr(TheList, TheElmt, DummyAddr, DummySize, TypeCode); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 83 RETURN TypeCode; 84 END TypeOf; ***** ^ not supported yet 85 86 87 (* PMI. Get1Parameter below is something I seem to end up implementing 88 variations upon again and again. You might use your procedure to 89 parse the structure string - or at closer look it seems to be convoluted 90 enough already! You might consider implementing a general, useful, 91 small, fast etc parsing routine ? 92 *) 93 PROCEDURE Get1Parameter(TheStr : ARRAY OF CHAR; TheSep : CHAR; ***** ^ not supported yet 94 TheNum : CARDINAL; VAR ThePar : ARRAY OF CHAR) : BOOLEAN; ***** ^ not supported yet 95 VAR 96 AtPos, Postpos, AtNo, len : CARDINAL; 97 BEGIN 98 len := M2Strings.Length(TheStr); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 99 (* search for separator number TheNum-1 *) 100 AtNo := 1; 101 AtPos := 0; 102 WHILE (AtPos=len) THEN 107 (* didn't find it *) 108 RETURN FALSE; 109 ELSE 110 (* found it, so get the parameter *) 111 IF AtPos>=len THEN 112 StrEdit.SetLength(ThePar, 0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 113 ELSE 114 Postpos := PosUtils.Positn(TheSep,TheStr,AtPos); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 115 IF PostposSiz1 THEN 188 maxcount := Siz2; 189 END; 190 (* this is probably a good place to turn off run-time checks *) 191 LOOP 192 INC(count); ***** ^ undeclared identifier ***** ^ not supported yet 193 IF count>maxcount THEN 194 EXIT; 195 END; 196 IF CARDINAL(RdAd1^) > CARDINAL(RdAd2^) THEN ***** ^ not supported yet ***** ^ not supported yet 197 RETURN -1; 198 ELSIF CARDINAL(RdAd1^) < CARDINAL(RdAd2^) THEN ***** ^ not supported yet ***** ^ not supported yet 199 RETURN 1; 200 END; 201 LowLevel.IncAddr( RdAd1, 1 ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 202 LowLevel.IncAddr( RdAd2, 1 ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 203 END; 204 END; 205 (* EXITed, elements equal so far. test lengths. *) 206 IF Siz1>Siz2 THEN 207 RETURN -1; 208 ELSIF Siz10) THEN ***** ^ not supported yet 258 IF Get1Parameter(AString,ParSep,2,NumbrPart) AND ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 259 StrConv.StrToCardinal(NumbrPart,0,MaxPos) AND (MaxPos>0) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 260 IF MaxPos>255 THEN 261 MaxPos := 255; 262 END; 263 ELSE 264 MaxPos := DefMaxPos; ***** ^ undeclared identifier 265 END; 266 (* is this a field of the file ? Could use Get1Parameter on the 267 structure string instead of relying on internal details of the 268 NdxFile-record. 269 *) 270 GenLists.GetElmt(TheFile^.StructLst, 1, AFieldName, AType); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 271 LOOP 272 IF M2Strings.CompareStr(FieldPart,AFieldName)=0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 273 found := TRUE; 274 EXIT; 275 ELSIF GenLists.ElmtNow(TheFile^.StructLst)>=GenLists.ListLength(TheFile^. ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 276 StructLst) THEN ***** ^ not supported yet 277 found := FALSE; 278 EXIT; 279 END; 280 GenLists.NextElmt(TheFile^.StructLst, 1, AFieldName, AType); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 281 END; 282 (* LOOP on structure list *) 283 IF found THEN 284 (* append the position and the max size *) 285 dummy := GenLists.ElmtNow(TheFile^.StructLst); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 286 GenLists.ListInsert(dummy, 0, FieldList, AFTERLAST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 287 GenLists.ListInsert(MaxPos, 0, FieldList, AFTERLAST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 288 END; 289 END; 290 (* IF FieldPart not empty *) 291 END; 292 (* LOOP on the input string *) 293 END DecodeFieldStr; ***** ^ not supported yet 294 295 296 PROCEDURE InitCriteriaList(TheNdxFile : NdxTypes.NdxFileType; TheIndexes : ***** ^ not supported yet 297 GenLists.GenList; FldNums : GenLists.GenList; VAR into : GenLists.GenList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 298 (* Initialize the "into" criteria list for those records in TheNdxFile 299 that are selected by TheIndexes. For each record, use the fields 300 that are indicated by the FldNums list. 301 NB. To keep NewList and DisposeList on the same program level (easier to 302 verify correctness), it is left to the calling program to do a 303 NewList(into) before calling InitCriteriaList. 304 The "into" GenList is structured as a list of lists, where each sublist 305 corresponds to a record in TheNdxFile. The elements of each sublist contain 306 values fetched from fields in each data record, and FldNums specifies which 307 data fields shall enter as criterion. 308 In addition, the next-to-last element of each sublist contains the original 309 sequence number, this guarantees that the sort is stable, and makes the 310 compare routine easier (will always find two elements that are unequal). 311 The last element of the sublist contains a copy of the original record 312 key. It is not used during the sort but is copied back into the output 313 (sorted) list after the sort is finished.. 314 *) 315 VAR 316 AType : CARDINAL; 317 SubList : GenLists.GenList; ***** ^ not supported yet 318 AListPtr : POINTER TO GenLists.GenList; ***** ^ not supported yet 319 TheRec : GenLists.GenList; ***** ^ not supported yet 320 ReadAddr : SYSTEM.ADDRESS; ***** ^ not supported yet 321 TheSize, MaxSiz : CARDINAL; 322 TheNum : CARDINAL; 323 IndexNo : CARDINAL; 324 AnIndex : NdxTypes.RecNameStr; ***** ^ not supported yet 325 AnNdxElmt : NdxTypes.NdxElement; ***** ^ not supported yet 326 TypeOK : BOOLEAN; 327 BEGIN 328 IF GenLists.ListLength(FldNums)=0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 329 RETURN; 330 END; 331 IndexNo := 0; 332 (* Loop on the selected records in TheNdxFile *) 333 WHILE IndexNo < GenLists.ListLength(TheIndexes) DO ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 334 INC(IndexNo); ***** ^ undeclared identifier ***** ^ not supported yet 335 TypeOK := TRUE; 336 CASE TypeOf(TheIndexes,IndexNo) OF ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 337 NdxTypes.NdxTypeCode : ***** ^ not supported yet ***** ^ not supported yet 338 GenLists.GetElmt(TheIndexes, IndexNo, AnNdxElmt, AType); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 339 StrEdit.AssignStr(AnNdxElmt.RecName, AnIndex); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 340 | GenLists.StrCode : ***** ^ not supported yet ***** ^ not supported yet 341 GenLists.GetElmt(TheIndexes, IndexNo, AnIndex, AType); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 342 ELSE 343 TypeOK := FALSE; 344 END; 345 IF NOT TypeOK THEN 346 ErrorManager.WARN('Improper type in TheIndexes in NdxSort.InitCriteriaList'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 347 ELSIF NOT NdxFiles.RecordExists(TheNdxFile,AnIndex) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 348 (* that's ok, no such record, not much to be done then *) 349 ELSIF NOT NdxFiles.GetField(TheNdxFile,AnIndex,'RECORD',AType,TheRec) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 350 (* ? *) 351 ErrorManager.WARN('Corrupted RECORD in NdxSort.InitCriteriaList'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 352 ELSIF AType#GenLists.ListCode THEN ***** ^ not supported yet ***** ^ not supported yet 353 ErrorManager.WARN('Corrupted GetField in NdxSort.InitCriteriaList'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 354 ELSE 355 (* Move each sort field into the sublist. *) 356 GenLists.NewList(SubList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 357 (* note structure of FldNums: REPEAT(fieldno maxfieldsize) *) 358 GenLists.GetElmt(FldNums, 1, TheNum, AType); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 359 GenLists.NextElmt(FldNums, 1, MaxSiz, AType); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 360 (* could put this into loop *) 361 LOOP 362 (* on each selected field *) 363 GenLists.GetElmtAdr(TheRec, TheNum, ReadAddr, TheSize, AType); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 364 (* It doesn't make much sense to compare lists as addresses. 365 So if the field is a list, use instead the first element of the 366 list, and if that element is a list, use the first element, etc, 367 etc, ... ad nauseatum 368 *) 369 LOOP 370 IF AType#GenLists.ListCode THEN ***** ^ not supported yet ***** ^ not supported yet 371 EXIT; 372 END; 373 AListPtr := ReadAddr; ***** ^ not supported yet ***** ^ not supported yet 374 IF GenLists.ListLength(AListPtr^)=0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 375 EXIT; 376 END; 377 (* retry with the first elmt of the list *) 378 GenLists.GetElmtAdr(AListPtr^, 1, ReadAddr, TheSize, AType); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 379 END; 380 GenLists.ListInsertAdr(ReadAddr, TheSize, AType, SubList, AFTERLAST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 381 IF GenLists.ElmtNow(FldNums)>=GenLists.ListLength(FldNums) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 382 EXIT; 383 END; 384 GenLists.NextElmt(FldNums, 1, TheNum, AType); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 385 GenLists.NextElmt(FldNums, 1, MaxSiz, AType); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 386 END; 387 (* append to SubList the original position number in the main list *) 388 GenLists.ListInsert(IndexNo, 0, SubList, AFTERLAST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 389 (* append the record index to the sublist *) 390 GenLists.ListInsert(AnIndex, GenLists.StrCode, SubList, AFTERLAST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 391 (* finally append the sublist to the main list *) 392 (* note that in 1.4c, the sublist is absorbed into the main list, 393 so the sublist should not be disposed afterwards 394 *) 395 GenLists.ListInsert(SubList, GenLists.ListCode, into, AFTERLAST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 396 END; 397 (* IF index is proper type AND record found AND has proper type *) 398 END; 399 (* LOOP on all selected records *) 400 END InitCriteriaList; ***** ^ not supported yet 401 402 403 PROCEDURE RefillSortedList(frm : GenLists.GenList; VAR into : GenLists.GenList); ***** ^ not supported yet ***** ^ not supported yet 404 VAR 405 AType : CARDINAL; 406 AList : GenLists.GenList; ***** ^ not supported yet 407 AString : String; ***** ^ not supported yet 408 BEGIN 409 (* dispose of the original key sequence found in SortedList *) 410 GenLists.DisposeList(into); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 411 GenLists.NewList(into); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 412 (* initialize loop with first element of list *) 413 IF GenLists.ListLength(frm)=0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 414 RETURN; 415 END; 416 GenLists.GetElmt(frm, 1, AList, AType); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 417 LOOP 418 IF AType#GenLists.ListCode THEN ***** ^ not supported yet ***** ^ not supported yet 419 ErrorManager.WARN('Corrupted frm in NdxSort.RefillSortedList'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 420 ELSE 421 (* index is in the last element of each (list) element of the frm list*) 422 GenLists.GetElmt(AList, GenLists.ListLength(AList), AString, AType); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 423 IF AType#GenLists.StrCode THEN ***** ^ not supported yet ***** ^ not supported yet 424 ErrorManager.WARN('Corrupted frm.sublist in NdxSort.RefillSortedList'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 425 ELSE 426 GenLists.ListInsert(AString, AType, into, AFTERLAST); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 427 END; 428 END; 429 IF GenLists.ElmtNow(frm)>=GenLists.ListLength(frm) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 430 EXIT; 431 END; 432 GenLists.NextElmt(frm, 1, AList, AType); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 433 END; 434 (* LOOP *) 435 END RefillSortedList; ***** ^ not supported yet 436 437 438 PROCEDURE AltNdxSort(TheFile : NdxTypes.NdxFileType; TheFields : ARRAY OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 439 VAR TheRecordList : GenLists.GenList); ***** ^ not supported yet 440 (* Finally, the main driver routine. *) 441 VAR 442 FieldNumbers, CriteriaList : GenLists.GenList; ***** ^ not supported yet 443 BEGIN 444 (* NdxSort *) 445 IF NOT GenLists.Initialized(TheRecordList) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 446 ErrorManager.WARN(' Unitialized "TheRecordList" in call to NdxSort'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 447 GenLists.NewList(TheRecordList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 448 END; 449 (* Decode the string with the list of fields to sort on *) 450 GenLists.NewList(FieldNumbers); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 451 DecodeFieldStr(TheFile, TheFields, FieldNumbers); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 452 (* Initialize the list of sort criteria *) 453 GenLists.NewList(CriteriaList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 454 IF GenLists.ListLength(TheRecordList)>0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 455 (* TheRecordList contains the list of ptrs to selected records *) 456 InitCriteriaList(TheFile, TheRecordList, FieldNumbers, ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 457 CriteriaList); ***** ^ not supported yet 458 ELSE 459 (* otherwise, sort the whole file *) 460 InitCriteriaList(TheFile, TheFile^.Ndx, FieldNumbers, ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 461 CriteriaList); ***** ^ not supported yet 462 END; 463 (* Sort the criteria list *) 464 GenLists.SortList(CriteriaList, CompareCriteria); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 465 (* dispose and refill the original list of record keys *) 466 RefillSortedList(CriteriaList, TheRecordList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 467 (* finally do away with all temporary lists *) 468 GenLists.DisposeList(CriteriaList); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 469 GenLists.DisposeList(FieldNumbers); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 470 END AltNdxSort; ***** ^ not supported yet 471 472 473 BEGIN 474 Initialized := FALSE; 475 Init(); ***** ^ not supported yet ***** ^ not supported yet 476 END NdxSort. ***** ^ not supported yet 436 errors