  (* 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 *)

=>