| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918 |
- 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) AND (AtNo<TheNum) DO
- 103 INC(AtNo);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 104 AtPos := PosUtils.Positn(TheSep,TheStr,AtPos)+1;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 105 END;
- 106 IF (AtNo<TheNum) OR (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 Postpos<len THEN
- 116 M2Strings.Copy(TheStr, AtPos, Postpos-AtPos, ThePar);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 117 ELSE
- 118 (* Postpos may be greater than len, so to be on the safe side: *)
- 119 M2Strings.Copy(TheStr, AtPos, len-AtPos, ThePar);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 120 END;
- 121 END;
- 122 RETURN TRUE;
- 123 END;
- 124 (* shouldn't get here *)
- 125 HALT();
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 126 END Get1Parameter;
- ***** ^ not supported yet
- 127
- 128
- 129 PROCEDURE CompareCriteria(e1 : SYSTEM.ADDRESS; l1 : CARDINAL; e2 : SYSTEM.ADDRESS;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 130 l2 : CARDINAL) : INTEGER;
- 131 (* Compare routine for SortList. It is assumed here that
- 132 (1) the elements to be sorted are themselves lists of equal length, and
- 133 (2) there is at least one spot in the sublists with unequal elements of
- 134 same type.
- 135 These conditions are guaranteed by InitCriteriaList(...) below.
- 136 *)
- 137 VAR
- 138 count, spot : CARDINAL;
- 139 maxcount : CARDINAL;
- 140 RdAd1, RdAd2 : SYSTEM.ADDRESS;
- ***** ^ not supported yet
- 141 GL1, GL2 : GenLists.GenList;
- ***** ^ not supported yet
- 142 GLP1, GLP2 : POINTER TO GenLists.GenList;
- ***** ^ not supported yet
- 143 Typ1, Typ2 : CARDINAL;
- 144 Siz1, Siz2 : CARDINAL;
- 145 Reslt : INTEGER;
- 146 Str1, Str2 : String;
- ***** ^ not supported yet
- 147 BEGIN
- 148 (* Note that it is not necessary to EXIT from the outer LOOP,
- 149 the inner LOOP shall always RETURN (see conditions above).
- 150 *)
- 151 spot := 0;
- 152 LOOP
- 153 INC(spot);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 154 (* would have been nice to dereference directly through a construct
- 155 like GLPType(e1)^, but Logitech won't take that one. Even more
- 156 elegant of course would have been to declare e1 and e2 NOT as
- 157 ADDRESS, but as POINTER TO GenList directly. Why couldn't a variable
- 158 of type ADDRESS be compatible with any pointer type?
- 159 Well, programming probably never was meant to be easy. Sigh ..
- 160 *)
- 161 GLP1 := e1;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 162 GL1 := GLP1^;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 163 Typ1 := TypeOf(GL1,spot);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 164 GLP2 := e2;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 165 GL2 := GLP2^;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 166 Typ2 := TypeOf(GL2,spot);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 167 IF Typ1=Typ2 THEN
- 168 (* should I compare apples and oranges ? *)
- 169 IF Typ1=GenLists.StrCode THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- 170 GenLists.GetElmt(GL1, spot, Str1, Typ1);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 171 GenLists.GetElmt(GL2, spot, Str2, Typ2);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 172 Reslt := M2Strings.CompareStr(Str1,Str2);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 173 IF Reslt#0 THEN
- 174 RETURN Reslt;
- 175 END;
- 176 ELSE
- 177 (* PMI! I never sort on anything else than strings,
- 178 so this part of the code has probably never been
- 179 executed.
- 180 *)
- 181 GenLists.GetElmtAdr(GL1, spot, RdAd1, Siz1, Typ1);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 182 GenLists.GetElmtAdr(GL2, spot, RdAd2, Siz2, Typ2);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 183 (* block compare could come in handy here, but the one found in
- 184 Logitech's block ops only returns true/false. Silly *)
- 185 count := 0;
- 186 maxcount := Siz1;
- 187 IF Siz2>Siz1 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 Siz1<Siz2 THEN
- 209 RETURN 1;
- 210 END;
- 211 END;
- 212 (* IF types equal *)
- 213 (* proceed to next element in the two lists *)
- 214 END;
- 215 (* LOOP *)
- 216 (* impossible to get here *)
- 217 HALT();
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 218 END CompareCriteria;
- ***** ^ not supported yet
- 219
- 220
- 221 (* routine to decode the string with sort fields and optionally lengths *)
- 222 PROCEDURE DecodeFieldStr(TheFile : NdxTypes.NdxFileType; FieldStr : ARRAY OF
- ***** ^ not supported yet
- 223 CHAR; VAR FieldList : GenLists.GenList);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 224 (* Give this routine an NdxFile and a string containing names of
- 225 fields in this file, the routine will exit with FieldList containing
- 226 a list of the position of each field in the genlist that holds the
- 227 file's data record. Fields that are not in the file are ignored.
- 228 The names in the FieldStr are separated by blank(s). Each name may
- 229 optionally be followed by parameters, separated from the name and from
- 230 each other by comma. The first parameter signifies the maximum
- 231 number of bytes used for keeping the copy of that field in the criteria
- 232 list, default is DefMaxSize. Subsequent parameters are (currently)
- 233 ignored, but could easily be stored in the FieldStr to be used
- 234 while building the criteria list.
- 235 Execution speed has not been a concern for the implementation.
- 236 *)
- 237 CONST
- 238 FieldSep = ' ';
- 239 ParSep = ',';
- 240 VAR
- 241 AFieldName, AString : String;
- ***** ^ not supported yet
- 242 FieldPart, NumbrPart : String;
- ***** ^ not supported yet
- 243 MaxPos, p, dummy, AType : CARDINAL;
- 244 found : BOOLEAN;
- 245 BEGIN
- 246 StrEdit.CrunchBlanks(FieldStr);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 247 StrEdit.CAPstr(FieldStr);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 248 p := 0;
- 249 LOOP
- 250 (* on all fields in the input string *)
- 251 INC(p);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 252 IF NOT Get1Parameter(FieldStr,FieldSep,p,AString) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 253 EXIT;
- 254 END;
- 255 (* look into the substructure of this parameter *)
- 256 IF Get1Parameter(AString,ParSep,1,FieldPart) AND (M2Strings.Length(
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 257 FieldPart)>0) 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
|