(* For library utilities - specialized sub area *)

  (* typical global declarations required, commented out here *)
{ CONST
    binrcdmax   = 63;

  TYPE
    byte        = char;
    binfptr     = 0..binrcdmax;
    binfile     = FILE OF ARRAY[binfptr] OF byte;

    direntry    = RECORD
      status      : byte;
      name        : ARRAY[1..8] OF byte;
      ext         : ARRAY[1..3] OF byte;
      location,
      size,
      crcval,
      modified    : integer;
      spare       : ARRAY[1..12] OF byte;
      END;

    dirptr      = ^dirchunk;
    dirchunk    = RECORD
      next,
      left,
      right       : dirptr;
      dir         : direntry;
      END;
}

  FUNCTION loaddir(VAR l : binfile; VAR root : dirptr;
                   VAR dircrc, crcwd : integer) : boolean;
  (* libfile l is open and rewound.       *)
  (* Returns true if apparently a library *)

    CONST
      dirpcmax     = 31; (* 0 based *)
      dirpcsize    = 32; (* dirpcmax + 1 *)

    TYPE
      dirpiece     = ARRAY[0..dirpcmax] OF byte;

    VAR
      p            : dirptr;
      dirsize, i   : integer;

    (* 2---------------2 *)

    PROCEDURE savechunk(VAR r : dirptr);

      VAR
        ix       : integer;

      (* 3---------------3 *)

      PROCEDURE insert(VAR dp : dirpiece);
      (* this operation preserves compatability *)
      (* across various 16 and 8 bit machines.  *)

        BEGIN (* insert *)
        new(r); r^.next := NIL;
        WITH r^.dir DO BEGIN
          status := dp[0];
(*$s-*)   name := dp[1 FOR 8]; ext := dp[9 FOR 3];
(*$s+*)   location := mergebytes(ord(dp[13]), ord(dp[12]));
          size := mergebytes(ord(dp[15]), ord(dp[14]));
          crcval := mergebytes(ord(dp[17]), ord(dp[16]));
          modified := mergebytes(ord(dp[19]), ord(dp[18])); END;
        END; (* insert *)

      (* 3---------------3 *)

      BEGIN (* savechunk *)
      IF odd(i) THEN ix := 0
      ELSE ix := 32; (* unpack direntry from l^ *)
(*$s-*)
      insert(l^[ix FOR dirpcsize]);
(*$s+*)
      IF NOT odd(i) THEN BEGIN (* need more from l *)
        FOR ix := 0 TO binrcdmax DO crc(l^[ix], crcwd);
        get(l); END;
      END; (* savechunk *)

    (* 2---------------2 *)

    BEGIN (* loaddir *)
    dirsize := mergebytes(ord(l^[15]), ord(l^[14]));
    dircrc := mergebytes(ord(l^[17]), ord(l^[16]));
    loaddir := false; (* default *) root := NIL;
(*$s-*)
    IF (l^[1] <= ' ') AND (* reduced test for MSDOS compatiblity *)
(*$s+*) (mergebytes(ord(l^[13]), ord(l^[12])) = 0) AND
        (dirsize < 8192) AND (dirsize > 0) AND
        (l^[0] = chr(0)) THEN BEGIN
      (* looks like a valid directory header *)
      l^[17] := chr(0); l^[16] := chr(0);
      i := 1; savechunk(root); (* the directory header *)
      p := root;
      FOR i := 2 TO 4*dirsize DO BEGIN
        savechunk(p^.next); p := p^.next; END;
      loaddir := true; END;
    END; (* loaddir *)

  (* 1---------------1 *)