Listing: 1 (* ==================================================== *) 2 (* Copyright (C) 1990-1992 Clarion Software Corporation *) 3 (* ==================================================== *) 4 5 IMPLEMENTATION MODULE Table; 6 7 IMPORT Lib; 8 FROM Storage IMPORT ALLOCATE, DEALLOCATE; 9 10 11 CLASS IMPLEMENTATION Element; ***** ^ undeclared identifier 12 13 VIRTUAL PROCEDURE Compare( p : ElementPtr ) : INTEGER; ***** ^ undeclared identifier 14 (* It is an error not to supply an implementation of this 15 method. The client MUST supply a method to compare 16 'THIS' with 'p'. 17 *) 18 BEGIN 19 Lib.FatalError(' implemeted by client '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 20 RETURN 0; 21 END Compare; ***** ^ not supported yet 22 23 BEGIN 24 END Element ; ***** ^ not supported yet 25 26 CLASS GenElem (Element) ; ***** ^ undeclared identifier 27 GenericData : CHAR; 28 END GenElem; ***** ^ not supported yet 29 30 CLASS IMPLEMENTATION GenElem; 31 BEGIN 32 END GenElem; ***** ^ not supported yet 33 34 TYPE 35 GenElemPtr = POINTER TO GenElem; ***** ^ not supported yet 36 (* The above definitions are a skeleton for all the 37 implementation of the 'Element' CLASS. This enables 38 the 'TABLE' class to successfully copy any client 39 implementation of 'Element' 40 *) 41 42 43 CLASS IMPLEMENTATION TABLE; ***** ^ undeclared identifier 44 45 PROCEDURE Insert( VAR x : Element ); ***** ^ undeclared identifier 46 (* Insert a new element 'x' in 'THIS' table *) 47 48 PROCEDURE Search( VAR p : ElementPtr; VAR h : BOOLEAN); ***** ^ undeclared identifier 49 (* Searches a tree 'p' for the element 'x'. If it is found 50 then the new value replaces the old. If 'x' is not 51 in the tree, then 'x' becomes a new leaf of the tree. 52 *) 53 VAR 54 p1 : ElementPtr; ***** ^ undeclared identifier 55 p2 : ElementPtr; ***** ^ undeclared identifier 56 57 BEGIN 58 IF (p = NIL) THEN (* Create new leaf *) ***** ^ not supported yet 59 ALLOCATE(p,SIZE(x)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 60 Lib.Move(ADR(x),p,SIZE(x)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 61 p^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 62 p^.Left := NIL; ***** ^ not supported yet ***** ^ not supported yet 63 p^.Right := NIL; ***** ^ not supported yet ***** ^ not supported yet 64 h := TRUE; (* Tree requires balancing *) 65 ELSE 66 IF (x.Compare(p) < 0) THEN (* 'THIS' is < 'p' *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 67 (* Search the 'Left' branch of 'p' recursively 68 until 'x' is either found or created. 69 *) 70 Search(p^.Left,h); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 71 IF h THEN (* i.e. requires balancing *) 72 CASE p^.Bal OF ***** ^ not supported yet ***** ^ not supported yet 73 | 1 : 74 p^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 75 h := FALSE; 76 | 0 : 77 p^.Bal := -1; ***** ^ not supported yet ***** ^ not supported yet 78 | -1 : 79 p1 := p^.Left; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 80 IF (p1^.Bal = -1) THEN ***** ^ not supported yet ***** ^ not supported yet 81 p^.Left := p1^.Right; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 82 p1^.Right := p; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 83 p^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 84 p := p1; ***** ^ not supported yet ***** ^ not supported yet 85 ELSE 86 p2 := p1^.Right; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 87 p1^.Right := p2^.Left; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 88 p2^.Left := p1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 89 p^.Left := p2^.Right; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 90 p2^.Right := p; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 91 IF (p2^.Bal = -1) THEN ***** ^ not supported yet ***** ^ not supported yet 92 p^.Bal := 1; ***** ^ not supported yet ***** ^ not supported yet 93 ELSE 94 p^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 95 END; 96 IF (p2^.Bal = 1) THEN ***** ^ not supported yet ***** ^ not supported yet 97 p1^.Bal := -1; ***** ^ not supported yet ***** ^ not supported yet 98 ELSE 99 p1^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 100 END; 101 p := p2; ***** ^ not supported yet ***** ^ not supported yet 102 END; 103 p^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 104 h := FALSE; (* Balancing done *) 105 END (* CASE *); 106 END (* of balancing 'Left' sub-tree *); 107 ELSIF (x.Compare(p) > 0) THEN (* 'THIS' > 'p' *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 108 (* Search the 'Right' branch of 'p' recursively 109 until 'x' is either found or created. 110 *) 111 Search( p^.Right,h); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 112 IF h THEN (* i.e. tree needs balancing *) 113 CASE p^.Bal OF ***** ^ not supported yet ***** ^ not supported yet 114 | -1 : 115 p^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 116 h := FALSE; 117 | 0 : 118 p^.Bal := 1; ***** ^ not supported yet ***** ^ not supported yet 119 | 1 : 120 p1 := p^.Right; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 121 IF (p1^.Bal = 1) THEN ***** ^ not supported yet ***** ^ not supported yet 122 p^.Right := p1^.Left; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 123 p1^.Left := p; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 124 p^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 125 p := p1; ***** ^ not supported yet ***** ^ not supported yet 126 ELSE 127 p2 := p1^.Left; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 128 p1^.Left := p2^.Right; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 129 p2^.Right := p1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 130 p^.Right := p2^.Left; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 131 p2^.Left := p; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 132 IF (p2^.Bal = 1) THEN ***** ^ not supported yet ***** ^ not supported yet 133 p^.Bal := -1; ***** ^ not supported yet ***** ^ not supported yet 134 ELSE 135 p^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 136 END; 137 IF (p2^.Bal = -1) THEN ***** ^ not supported yet ***** ^ not supported yet 138 p1^.Bal := 1; ***** ^ not supported yet ***** ^ not supported yet 139 ELSE 140 p1^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 141 END; 142 p := p2; ***** ^ not supported yet ***** ^ not supported yet 143 END; 144 p^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 145 h := FALSE; (* Tree balanced *) 146 END (* CASE *); 147 END (* Balancing 'Right' sub-tree *); 148 ELSE (* 'THIS' and 'p' are the same *) 149 h := FALSE; 150 Lib.Move(ADR(GenElemPtr(ADR(x))^.GenericData), ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 151 ADR(GenElemPtr(p)^.GenericData), ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 152 SIZE(x)-VSIZE(Element.Bal)); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 153 END (* Possible comaprison results *); 154 END; 155 END Search; ***** ^ not supported yet 156 157 VAR 158 h : BOOLEAN; 159 160 BEGIN 161 IF (Root # NIL) AND (ADR(Root^.Compare) # ADR(x.Compare)) THEN ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 162 (* All table elements must be homogeneous; i.e. they must be of 163 the same CLASS 164 *) 165 Lib.FatalError('object not compatible with table'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 166 END; 167 Search(Root,h); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 168 END Insert; ***** ^ not supported yet 169 170 PROCEDURE Find( VAR x : Element ) : BOOLEAN; ***** ^ undeclared identifier 171 (* Search for 'x' in 'THIS' tree; if 'x' is found in 172 'THIS' tree then the function returns 'TRUE' and 'x' 173 is set to the mathing element. Otherwise the 174 method returns 'FALSE'. 175 *) 176 177 PROCEDURE _Find( r : ElementPtr ) : ElementPtr; ***** ^ undeclared identifier ***** ^ undeclared identifier 178 (* Implements the search algorithm *) 179 BEGIN 180 LOOP 181 IF (r = NIL) THEN (* No match *) ***** ^ not supported yet 182 RETURN r; ***** ^ not supported yet 183 ELSIF (x.Compare(r) < 0) THEN (* 'THIS' < r *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 184 r := r^.Left; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 185 ELSIF (x.Compare(r) > 0) THEN (* 'THIS' > r *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 186 r := r^.Right; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 187 ELSE (* FOUND IT! *) 188 RETURN r; ***** ^ not supported yet 189 END; 190 END (* LOOP *); 191 END _Find; ***** ^ not supported yet 192 193 VAR 194 p : ElementPtr; ***** ^ undeclared identifier 195 196 BEGIN 197 p := _Find(Root); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 198 IF (p # NIL) THEN (* Element Located *) ***** ^ not supported yet 199 Lib.Move(p,ADR(x),SIZE(x)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 200 RETURN TRUE; 201 ELSE 202 RETURN FALSE; 203 END; 204 END Find; ***** ^ not supported yet 205 206 PROCEDURE Delete( VAR x : Element ); ***** ^ undeclared identifier 207 (* Locate the element 'x' in 'THIS' tree and delete it *) 208 VAR 209 q : ElementPtr; ***** ^ undeclared identifier 210 211 PROCEDURE r_Balance( VAR p : ElementPtr; VAR h : BOOLEAN); ***** ^ undeclared identifier 212 (* Blance a right sub-tree *) 213 VAR 214 p1 : ElementPtr; ***** ^ undeclared identifier 215 p2 : ElementPtr; ***** ^ undeclared identifier 216 b1 : BalanceFlag; ***** ^ undeclared identifier 217 b2 : BalanceFlag; ***** ^ undeclared identifier 218 BEGIN 219 CASE p^.Bal OF ***** ^ not supported yet ***** ^ not supported yet 220 | -1 : 221 p^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 222 | 0 : 223 p^.Bal := 1; ***** ^ not supported yet ***** ^ not supported yet 224 h := FALSE; 225 | 1 : 226 p1 := p^.Right; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 227 b1 := p1^.Bal; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 228 IF (b1 >= 0) THEN ***** ^ not supported yet 229 p^.Right := p1^.Left; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 230 p1^.Left := p; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 231 IF (b1 = 0) THEN ***** ^ not supported yet 232 p^.Bal := 1; ***** ^ not supported yet ***** ^ not supported yet 233 p1^.Bal := -1; ***** ^ not supported yet ***** ^ not supported yet 234 h := FALSE 235 ELSE 236 p^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 237 p1^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 238 END; 239 p := p1; ***** ^ not supported yet ***** ^ not supported yet 240 ELSE 241 p2 := p1^.Left; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 242 b2 := p2^.Bal; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 243 p1^.Left := p2^.Right; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 244 p2^.Right := p1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 245 p^.Right := p2^.Left; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 246 p2^.Left := p; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 247 IF (b2 = 1) THEN ***** ^ not supported yet 248 p^.Bal := -1; ***** ^ not supported yet ***** ^ not supported yet 249 ELSE 250 p^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 251 END; 252 IF (b2 = -1) THEN ***** ^ not supported yet 253 p1^.Bal := 1; ***** ^ not supported yet ***** ^ not supported yet 254 ELSE 255 p1^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 256 END; 257 p := p2; ***** ^ not supported yet ***** ^ not supported yet 258 p2^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 259 END; 260 END (* CASE *); 261 END r_Balance; ***** ^ not supported yet 262 263 PROCEDURE l_Balance( VAR p : ElementPtr; VAR h : BOOLEAN); ***** ^ undeclared identifier 264 (* Balance a left sub-tree *) 265 VAR 266 p1 : ElementPtr; ***** ^ undeclared identifier 267 p2 : ElementPtr; ***** ^ undeclared identifier 268 b1 : BalanceFlag; ***** ^ undeclared identifier 269 b2 : BalanceFlag; ***** ^ undeclared identifier 270 BEGIN 271 CASE p^.Bal OF ***** ^ not supported yet ***** ^ not supported yet 272 | 1 : 273 p^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 274 | 0 : 275 p^.Bal := -1; ***** ^ not supported yet ***** ^ not supported yet 276 h := FALSE; 277 | -1 : 278 p1 := p^.Left; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 279 b1 := p1^.Bal; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 280 IF (b1 <= 0) THEN ***** ^ not supported yet 281 p^.Left := p1^.Right; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 282 p1^.Right := p; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 283 IF (b1 = 0) THEN ***** ^ not supported yet 284 p^.Bal := -1; ***** ^ not supported yet ***** ^ not supported yet 285 p1^.Bal := 1; ***** ^ not supported yet ***** ^ not supported yet 286 h := FALSE 287 ELSE 288 p^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 289 p1^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 290 END; 291 p := p1; ***** ^ not supported yet ***** ^ not supported yet 292 ELSE 293 p2 := p1^.Right; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 294 b2 := p2^.Bal; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 295 p1^.Right := p2^.Left; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 296 p2^.Left := p1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 297 p^.Left := p2^.Right; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 298 p2^.Right := p; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 299 IF (b2 = -1) THEN ***** ^ not supported yet 300 p^.Bal := 1; ***** ^ not supported yet ***** ^ not supported yet 301 ELSE 302 p^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 303 END; 304 IF (b2 = 1) THEN ***** ^ not supported yet 305 p1^.Bal := -1; ***** ^ not supported yet ***** ^ not supported yet 306 ELSE 307 p1^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 308 END; 309 p := p2; ***** ^ not supported yet ***** ^ not supported yet 310 p2^.Bal := 0; ***** ^ not supported yet ***** ^ not supported yet 311 END; 312 END (* CASE *); 313 END l_Balance; ***** ^ not supported yet 314 315 PROCEDURE DeleteLeaf( VAR r : ElementPtr; VAR h : BOOLEAN ); ***** ^ undeclared identifier 316 (* Recursively search for extreme right-hand node of 317 the sub-tree 'r' and move data into 'q' 318 *) 319 BEGIN 320 IF (r^.Right # NIL) THEN ***** ^ not supported yet ***** ^ not supported yet 321 DeleteLeaf(r^.Right,h); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 322 IF h THEN 323 l_Balance(r,h); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 324 END; 325 ELSE 326 Lib.Move(ADR(GenElemPtr(r)^.GenericData), ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 327 ADR(GenElemPtr(q)^.GenericData), ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 328 SIZE(x)-VSIZE(Element.Bal)); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 329 q := r; ***** ^ not supported yet ***** ^ not supported yet 330 r := r^.Left; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 331 h := TRUE; 332 END; 333 END DeleteLeaf; ***** ^ not supported yet 334 335 PROCEDURE _Delete( VAR p : ElementPtr; VAR h : BOOLEAN ); ***** ^ undeclared identifier 336 (* Main recursive deletion procedure *) 337 BEGIN 338 IF (p = NIL) THEN (* Not found *) ***** ^ not supported yet 339 h := FALSE; 340 ELSIF (x.Compare(p) < 0) THEN (* 'THIS' < 'p' *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 341 _Delete(p^.Left,h); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 342 IF h THEN 343 r_Balance(p,h); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 344 END; 345 ELSIF (x.Compare(p) > 0) THEN (* 'THIS' > 'p' *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 346 _Delete(p^.Right,h); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 347 IF h THEN 348 l_Balance(p,h); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 349 END; 350 ELSE (* Found it! *) 351 q := p; ***** ^ not supported yet ***** ^ not supported yet 352 IF (q^.Right = NIL) THEN ***** ^ not supported yet ***** ^ not supported yet 353 p := q^.Left; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 354 h := TRUE; 355 ELSIF (q^.Left = NIL) THEN ***** ^ not supported yet ***** ^ not supported yet 356 p := q^.Right; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 357 h := TRUE; 358 ELSE 359 DeleteLeaf(q^.Left,h); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 360 IF h THEN 361 r_Balance(p,h); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 362 END; 363 END; 364 DISPOSE(q); ***** ^ undeclared identifier ***** ^ not supported yet 365 END; 366 END _Delete; ***** ^ not supported yet 367 368 VAR 369 h : BOOLEAN; 370 371 BEGIN 372 IF (Root = NIL) THEN ***** ^ undeclared identifier 373 RETURN; 374 END; 375 IF (Root # NIL) AND (ADR(x.Compare) # ADR(Root^.Compare)) THEN ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 376 (* 'x' is not the same type as tree members *) 377 Lib.FatalError('object not compatible with table'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 378 END; 379 _Delete(Root,h); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 380 END Delete; ***** ^ not supported yet 381 382 PROCEDURE Apply( p : Action ); ***** ^ undeclared identifier 383 (* Apply a procedure to all table elements in order *) 384 385 PROCEDURE ApplyToElement( s : ElementPtr ); ***** ^ undeclared identifier 386 (* Apply 'p' to left sub-tree of s, then s, then the 387 right sub-tree of s. 388 *) 389 BEGIN 390 IF (s = NIL) THEN ***** ^ not supported yet 391 RETURN; 392 ELSE 393 ApplyToElement(s^.Left); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 394 p(s); ***** ^ not supported yet ***** ^ not supported yet 395 ApplyToElement(s^.Right); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 396 END; 397 END ApplyToElement; ***** ^ not supported yet 398 399 BEGIN 400 ApplyToElement(Root); ***** ^ not supported yet ***** ^ undeclared identifier 401 END Apply; ***** ^ not supported yet 402 403 PROCEDURE Init; 404 (* Initialise a tree *) 405 BEGIN 406 Root := NIL; ***** ^ undeclared identifier 407 END Init; ***** ^ not supported yet 408 409 410 PROCEDURE Eq( t2 : TABLE ) : INTEGER; ***** ^ undeclared identifier 411 (* Compare 'THIS' to 't2'. Return values: 412 413 <0 'THIS' is less than 't2' 414 0 'THIS' is equal to 't2' 415 >0 'THIS' is greater than 't2' 416 417 The trees are searched from the bottom up (i.e. in 418 order) and the elements compared. The procedure 419 returns immediately a difference is detected or 420 when both trees are exhausted (and, therefore, they 421 must be equal). This process is implemented iteratively 422 rather than recursively. 423 *) 424 425 VAR 426 S1, 427 S2 : ARRAY [1..32] OF ElementPtr; ***** ^ not supported yet ***** ^ undeclared identifier 428 r1, 429 r2 : ElementPtr; ***** ^ undeclared identifier 430 sp1, 431 sp2 : CARDINAL; 432 res : INTEGER; 433 434 BEGIN 435 r1 := Root; ***** ^ not supported yet ***** ^ undeclared identifier 436 r2 := t2.Root; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 437 IF (r1 # NIL) AND (r1 # r2) AND (ADR(r1^.Compare) # ADR(r2^.Compare)) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 438 (* Both trees must contain the same sort of element *) 439 Lib.FatalError(' not compareable '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 440 END; 441 sp1 := 0; 442 sp2 := 0; 443 LOOP 444 WHILE (r1 # NIL) DO (* Build left edge array for 'THIS' *) ***** ^ not supported yet 445 INC(sp1); ***** ^ undeclared identifier ***** ^ not supported yet 446 S1[sp1] := r1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 447 r1 := r1^.Left; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 448 END; 449 WHILE (r2 # NIL) DO (* Build left edge array for 't2' *) ***** ^ not supported yet 450 INC(sp2); ***** ^ undeclared identifier ***** ^ not supported yet 451 S2[sp2] := r2; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 452 r2 := r2^.Left; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 453 END; 454 IF (sp1 = 0) THEN (* No left sub-tree for 'THIS' *) 455 IF (sp2 = 0) THEN (* No left sub-tree for 't2' *) 456 RETURN 0; (* Implies they are equal *) 457 ELSE 458 RETURN -1; (* 'THIS' < 't2' *) 459 END; 460 ELSIF (sp2 = 0) THEN (* No left sub-tree for 't2' *) 461 RETURN 1; (* 'THIS' > 't2' *) 462 ELSE 463 r1 := S1[sp1]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 464 DEC(sp1); ***** ^ undeclared identifier ***** ^ not supported yet 465 r2 := S2[sp2]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 466 DEC(sp2); ***** ^ undeclared identifier ***** ^ not supported yet 467 END; 468 res := r1^.Compare(r2); (* Compare extreme left of both *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 469 IF (res # 0) THEN (* These are different! *) 470 RETURN res; (* Return how they are different *) 471 END; 472 r1 := r1^.Right; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 473 r2 := r2^.Right; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 474 END (* LOOP *); 475 END Eq; ***** ^ not supported yet 476 477 PROCEDURE SubSet( t2 : TABLE ) : BOOLEAN; ***** ^ undeclared identifier 478 (* Are the elements of 'THIS' table a sub set of the elements 479 of the table 't2'? 480 The procedure scans scans the trees in order looking for 481 an initial point of equality. Then 'THIS' is compared to 482 this sub-tree of 't2' until either an element greater than 483 the current 'THIS' element is found, or 'THIS' is exhuasted. 484 The process is implemented iteratively rather than 485 recursively. 486 *) 487 VAR 488 S1, 489 S2 : ARRAY [1..32] OF ElementPtr; ***** ^ not supported yet ***** ^ undeclared identifier 490 r1, 491 r2, 492 cr : ElementPtr; ***** ^ undeclared identifier 493 sp1, 494 sp2 : CARDINAL; 495 res : INTEGER; 496 BEGIN 497 IF (Root # NIL) AND (t2.Root # Root) AND (ADR(Root^.Compare) # ADR(t2.Root^.Compare)) THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 498 (* Both trees must contain the same type of element *) 499 Lib.FatalError('different types'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 500 END; 501 r1 := Root; ***** ^ not supported yet ***** ^ undeclared identifier 502 r2 := t2.Root; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 503 sp1 := 0; 504 sp2 := 0; 505 LOOP 506 WHILE (r1 # NIL) DO ***** ^ not supported yet 507 INC(sp1); ***** ^ undeclared identifier ***** ^ not supported yet 508 S1[sp1] := r1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 509 r1 := r1^.Left; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 510 END; 511 IF (sp1 = 0) THEN (* End of 'THIS' => is a sub-tree *) 512 RETURN TRUE; 513 END; 514 r1 := S1[sp1]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 515 DEC(sp1); ***** ^ undeclared identifier ***** ^ not supported yet 516 cr := r1; ***** ^ not supported yet ***** ^ not supported yet 517 r1 := r1^.Right; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 518 LOOP 519 WHILE (r2 # NIL) DO ***** ^ not supported yet 520 INC(sp2); ***** ^ undeclared identifier ***** ^ not supported yet 521 S2[sp2] := r2; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 522 r2 := r2^.Left; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 523 END; 524 IF (sp2 = 0) THEN (* End of 't2' => not a sub-tree *) 525 RETURN FALSE; 526 ELSE 527 r2 := S2[sp2]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 528 DEC(sp2); ***** ^ undeclared identifier ***** ^ not supported yet 529 END; 530 res := cr^.Compare(r2); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 531 r2 := r2^.Right; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 532 IF (res < 0) THEN 533 RETURN FALSE; 534 ELSIF (res = 0) THEN 535 EXIT; 536 END; 537 END (* LOOP *); 538 END (* LOOP *); 539 END SubSet; ***** ^ not supported yet 540 541 PROCEDURE Copy() : TABLE; ***** ^ undeclared identifier 542 (* Make a copy of 'THIS' *) 543 544 PROCEDURE _Copy( r : ElementPtr ) : ElementPtr; ***** ^ undeclared identifier ***** ^ undeclared identifier 545 (* Recursively generate a copy of 'r' *) 546 VAR 547 x : ElementPtr; ***** ^ undeclared identifier 548 BEGIN 549 IF (r # NIL) THEN ***** ^ not supported yet 550 ALLOCATE(x,SIZE(r^)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 551 Lib.Move(r,x,SIZE(r^)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 552 x^.Left := _Copy(r^.Left); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 553 x^.Right := _Copy(r^.Right); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 554 RETURN x; ***** ^ not supported yet 555 ELSE 556 RETURN r; ***** ^ not supported yet 557 END; 558 END _Copy; ***** ^ not supported yet 559 560 VAR 561 NewTree : TABLE; ***** ^ undeclared identifier 562 BEGIN 563 NewTree.Root := _Copy(Root); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 564 RETURN NewTree; ***** ^ not supported yet 565 END Copy; ***** ^ not supported yet 566 567 PROCEDURE Incl( t2 : TABLE); ***** ^ undeclared identifier 568 (* Include 't2' in 'THIS' tree *) 569 570 PROCEDURE _Incl( r : ElementPtr ); ***** ^ undeclared identifier 571 (* Recursively insert 'r' into 'THIS' *) 572 BEGIN 573 IF (r # NIL) THEN ***** ^ not supported yet 574 _Incl(r^.Left); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 575 _Incl(r^.Right); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 576 Insert(r^); ***** ^ not supported yet ***** ^ not supported yet 577 END; 578 END _Incl; ***** ^ not supported yet 579 580 BEGIN 581 IF (Root # NIL) AND (t2.Root # Root) AND (ADR(Root^.Compare) # ADR(t2.Root^.Compare)) THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 582 Lib.FatalError('different types'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 583 END; 584 _Incl(t2.Root); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 585 END Incl; ***** ^ not supported yet 586 587 588 PROCEDURE Excl( t2 : TABLE); ***** ^ undeclared identifier 589 (* Exclude elements of 't2' from 'THIS' *) 590 591 PROCEDURE _Excl( r: ElementPtr ); ***** ^ undeclared identifier 592 (* Recursively exclude 'r' from 'THIS' *) 593 BEGIN 594 IF (r # NIL) THEN ***** ^ not supported yet 595 _Excl(r^.Left); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 596 _Excl(r^.Right); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 597 Delete(r^); ***** ^ not supported yet ***** ^ not supported yet 598 END; 599 END _Excl; ***** ^ not supported yet 600 601 BEGIN 602 IF (Root # NIL) AND (t2.Root # Root) AND (ADR(Root^.Compare) # ADR(t2.Root^.Compare)) THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 603 Lib.FatalError('different types'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 604 END; 605 _Excl(t2.Root); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 606 END Excl; ***** ^ not supported yet 607 608 PROCEDURE Empty() : BOOLEAN; 609 (* Is 'THIS' empty? *) 610 BEGIN 611 RETURN (Root = NIL); ***** ^ undeclared identifier 612 END Empty; ***** ^ not supported yet 613 614 PROCEDURE Dispose; 615 (* Dispose of entire tree *) 616 617 PROCEDURE _Dispose( r : ElementPtr ); ***** ^ undeclared identifier 618 (* Recursively dispose of each element of 'r' *) 619 BEGIN 620 IF (r # NIL) THEN ***** ^ not supported yet 621 _Dispose(r^.Left); (* Delete left sub-tree *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 622 _Dispose(r^.Right); (* Delete right sub-tree *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 623 DISPOSE(r); ***** ^ undeclared identifier ***** ^ not supported yet 624 END; 625 END _Dispose; ***** ^ not supported yet 626 627 BEGIN 628 _Dispose(Root); ***** ^ not supported yet ***** ^ undeclared identifier 629 END Dispose; ***** ^ not supported yet 630 631 BEGIN 632 633 END TABLE ; ***** ^ not supported yet 634 635 636 END Table. ***** ^ not supported yet 703 errors