(* For library utilities - specialized sub area *) PROCEDURE sortdir(p : dirptr; how : sortkind; VAR pp : dirptr); (* follow the chain from and including p via *) (* the "next" fields, and set up the "left" *) (* and "right" fields so that pp becomes a *) (* pointer to the root of a binary tree. *) (* Modified 85/10/16, sort speed up, pp param *) (* The code now caters to presorted data, at *) (* the expense of random data. *) VAR p1 : dirptr; (* 2---------------2 *) FUNCTION greaterorequal(p1, p2 : dirptr) : boolean; BEGIN (* greaterorequal *) WITH p1^, p2^.dir DO IF how = bygroup THEN IF dir.ext < ext THEN greaterorequal := false ELSE IF dir.ext > ext THEN greaterorequal := true ELSE IF dir.name < name THEN greaterorequal := false ELSE greaterorequal := true ELSE (* how = byname *) IF dir.name < name THEN greaterorequal := false ELSE IF dir.name > name THEN greaterorequal := true ELSE IF dir.ext < ext THEN greaterorequal := false ELSE greaterorequal := true; END; (* greaterorequal *) (* 2---------------2 *) PROCEDURE install(p1, (* in root *) p : dirptr); (* 3---------------3 *) PROCEDURE insert(p1 : dirptr; VAR p : dirptr); BEGIN (* insert *) IF p = NIL THEN p := p1 ELSE IF greaterorequal(p1, p) THEN insert(p1, p^.right) ELSE insert(p1, p^.left); END; (* insert *) (* 3---------------3 *) BEGIN (* install *) WHILE greaterorequal(p1, p) DO p := p^.next; insert(p1, p^.left); END; (* install *) (* 2---------------2 *) BEGIN (* sortdir *) pp := p; (* default *) IF p <> NIL THEN BEGIN p1 := p; IF how = unsorted THEN REPEAT (* make links reflect original order *) p1^.left := nil; p1^.right := p1^.next; p1 := p1^.next; UNTIL p1 = NIL ELSE BEGIN REPEAT (* clear the pointers *) p1^.left := nil; p1^.right := NIL; p1 := p1^.next; UNTIL p1 = NIL; p1 := p^.next; WHILE p1 <> NIL DO BEGIN IF greaterorequal(p1, p) THEN BEGIN p^.right := p1; p := p1; p1 := p^.next; END ELSE BEGIN (* must go in a left field somewhere *) install(p1, pp); p1 := p1^.next; END; END; END; END; END; (* sortdir *) (* 1---------------1 *)