$title ('SDIR - Search For Files')
search:
do;
                /* search module for extended dir */

$include (comlit.lit)
$include (mon.plm)

dcl debug boolean external;

dcl first$pass boolean external;
dcl get$all$dir$entries boolean external;
dcl usr$vector address external;
dcl active$usr$vector address external;
dcl used$de address public;                /* used directory entries        */
dcl filesfound address public;             /* num files collected in memory */

$include(fcb.lit)
$include(xfcb.lit)

declare
    deleted$type lit '0E5H';

$include (search.lit)
dcl find find$structure external;      /* what kind of files to look for */
dcl num$search$files byte external;
dcl search (max$search$files) search$structure external;
                                       /* file specs to match on         */

        /* other globals        */

dcl cur$usr byte external,
    cur$drv byte external,        /* current drive   "     "           */
    dir$label byte public;      /* directory label for BDOS 3.0      */


/* -------- BDOS calls -------- */

read$char: procedure byte;
    return mon2 (1,0);
end read$char;


/* -------- in sort.plm -------- */

mult23: procedure(f$info$index) address external;
    dcl f$info$index word;
end mult23;


/* -------- in util.plm -------- */

print: procedure(string$adr) external;
    dcl string$adr address;
end print;

print$char: procedure(char) external;
    dcl char byte;
end print$char;

pdecimal:procedure(val,prec,zsup) external;
    dcl (val, prec) address;
    dcl zsup boolean;
end pdecimal;

printfn: procedure(fnameadr) external;
    dcl fnameadr address;
end printfn;

crlf: procedure external;   /* print carriage return, linefeed */
end crlf;

add3byte: procedure(byte3adr,num) external;
      dcl (byte3adr,num) address;
end add3byte;

        /* add three byte number to 3 byte accumulater */ 
add3byte3: procedure(totalb,numb) external;
      dcl (totalb,numb) address;
end add3byte3;

        /* divide 3 byte value by 8 */
shr3byte: procedure(byte3adr) external;
      dcl byte3adr address;
end shr3byte;

/* -------- In dpb86.plm -------- */

$include(dpb.lit)

dcl k$per$block byte external;        /* set in dpb module */

base$dpb: procedure external;
end base$dpb;

dpb$byte: procedure(param) byte external;
    dcl param byte;
end dpb$byte;

dpb$word: procedure(param) address external;
    dcl param byte;
end dpb$word;


/* -------- Some Utility Routines -------- */

check$console$status: procedure byte;
    return mon2 (11,0);
end check$console$status;

search$first: procedure (fcb$address) byte public;
    declare fcb$address address;             /* shared with disp.plm */
    return mon2 (17,fcb$address);            /* for short display    */
end search$first;

search$next: procedure byte public;          /* shared with disp.plm */
    return mon2 (18,0);
end search$next;

terminate: procedure external;               /* in main.plm */
end terminate;

set$vec: procedure(vector,value) external;   /* in main.plm */
dcl vector address,
    value byte;
end set$vec;

break: procedure public;                     /* shared with disp.plm */
    dcl x byte;
    if check$console$status then
    do;
        x = read$char;
        call terminate;
    end;
end break;


/* -------- file information record declaration -------- */

$include(finfo.lit)

declare
        buf$fcb$adr address public,     /* index into directory buffer */
        buf$fcb based buf$fcb$adr (32) byte,
                                        /* fcb template for dir        */
        (first$f$i$adr, f$i$adr, last$f$i$adr) address public,
                                   /* indices into file$info array    */
        file$info based f$i$adr f$info$structure,
        x$i$adr address public,
        xfcb$info based x$i$adr x$info$structure;

compare: procedure(length, str1$adr, str2$adr) boolean;
    dcl (length,i) byte,
        (str1$adr, str2$adr) address,
        str1 based str1$adr (1) byte,
        str2 based str2$adr (1) byte;
            /* str2 is the possibly wildcarded filename we are looking for */

    do i = 0 to length - 1;
        if ((str1(i) and 7fh) <> (str2(i) and 7fh)) and str2(i) <> '?' then
            return(false);
    end;
    return(true);
end compare;

match: procedure boolean public;
dcl i byte,
    temp address;
    if (i := (buf$fcb(f$drvusr) and 0fh)) <> cur$usr then
        if not get$all$dir$entries then       /* Not looking for this user  */
            return(false);                    /* and not buffering all other*/
        else                                  /* specified user files on    */
        do; temp = 0;                         /* this drive.                */
            call set$vec(.temp,i);
            if (temp and usr$vector) = 0 then /* Getting all dir entries,   */
                return(false);                /* with user number corresp'g */
        end;                                  /* to a bit on in usr$vector  */

    if usr$vector <> 0 and i <> 0 and first$pass <> 0 then
        call set$vec(.active$usr$vector,i);   /* skip cur$usr files         */
                                  /* build active usr vector for this drive */

    do i = 0 to num$search$files - 1;
        if search(i).drv = 0ffh or search(i).drv = cur$drv then
                      /* match on any drive if 0ffh */
            if search(i).anyfile = true then
                 return(not find.exclude);    /* file found */
            else if compare(11,.buf$fcb(f$name),.search(i).name(0)) then
                 return(not find.exclude);    /* file found */
    end;
    return(find.exclude);     /* file not found */
end match;                    /* find.exclude = the exclude option value   */

dcl hash$table$size lit '128',               /* must be power of 2         */
    hash$table (hash$table$size) address at (.memory),
                                             /* must be initialized on each*/
    hash$entry$adr address,                  /* disk scan                  */
    hash$entry based hash$entry$adr address; /* where to put a new entry's */
                                             /* address                    */

hash$look$up: procedure boolean;
    dcl (i,found,hash$index) byte;
    hash$index = 0;
    do i = f$name to f$namelen + f$typelen;
        hash$index = hash$index + (buf$fcb(i) and 7fh); /* attributes may   */
    end;                                     /* only be set w/ 1st extent   */
    hash$index = hash$index + cur$usr;
    hash$index = hash$index and (hash$table$size - 1);
    hash$entry$adr = .hash$table(hash$index); /* put new entry in table if  */
    f$i$adr = hash$table(hash$index);         /* unused ( = 0)              */
    
    found = false;
    do while f$i$adr <> 0 and not found;
        if file$info.usr = (buf$fcb(f$drvusr) and 0fh) and
            compare(f$namelen + f$typelen,.file$info.name(0),.buf$fcb(f$name))
            then
            found = true;
        else                                  /* table entry used - collison */
            do; hash$entry$adr = .file$info.hash$link; /* resolve by linked  */
            f$i$adr = file$info.hash$link;             /* list               */
            end;
    end;
    if f$i$adr = 0 then
        return(false);   /* didn't find it, used hash$entry to keep new info */
    else return(true);   /* found it, file$info at matched entry             */
end hash$look$up;

$eject
store$file$info: procedure boolean;
        /* Look for file name of last found fcb or xfcb in fileinfo       */
        /* array, if not found put name in fileinfo array.   Copy other   */
        /* info to fileinfo or xfcbinfo.   The lookup is hash coded with  */
        /* collisions handled by linking up file$info records through     */
        /* the hash$link field of the previous file$info record.          */
        /* The file$info array grows upward in memory and the xfcbinfo    */
        /* grows downward.                                                */
        /*
                          
                        -------------------------<---.memory
       __               |      HASH TABLE       |
hash = \ of filename -->| root of file$info list|------------>-----------| 
func   /__ letters      |          .            |                        |
                        |          .            |                        |
        lower memory    ------------------------- <-- first$f$i$adr      |
                        |    file$info entry    |                        |
      (hash)    -----<--|          .            | <----------------------|
    (collision) |       |          .            |
                ------->|          .            |
                        |          .            |-------------------->|
                        | last file$info entry  | <- last$f$i$adr     |
                        |-----------------------|                     |
                        |                       |                     |
                        |                       |                     |
                        |   unused by dsearch,  |                     |
                        |     used by dsort     |                     |
                        |      for indices      |                     |
                        |                       |                     |
                        |                       |                     | 
                        |-----------------------|                     |
                        |    last$xfcb entry    | <- x$i$adr          |
                        |           .           |                     |
                        |           .           |                     |
                        |           .           | <-------------------|
                        |   first xfcb entry    |
                        |-----------------------|
                        |   un-usuable memory   | <- maxb
  higher memory         -------------------------                        */


    dcl (i, j, d$map$cnt) byte,
        temp address;

    if not hash$look$up then           /* not in table already            */ 
                           /* hash$entry is where to put adr of new entry */ 
    do;                    /* copy to new position in file info array     */
        if (temp := mult23(files$found + 1)) > x$i$adr then
            return(false);                     /* out of memory           */
        if (temp < first$f$i$adr) then
            return(false);                 /* wrap around - out of memory */
        f$i$adr = (last$f$i$adr := last$f$i$adr + size(file$info));
        filesfound = filesfound + 1;
        call move(f$namelen + f$typelen, .buf$fcb(f$name),.file$info.name);
        file$info.usr = buf$fcb(f$drvusr) and 0fh;
        file$info.onekblocks,file$info.kbytes,file$info.recs$lword,
            file$info.recs$hbyte, file$info.x$i$adr,file$info.hash$link = 0;
        hash$entry = f$i$adr;           /* save the address of file$info    */
    end;                                /* zero totals for the new file     */

    /* else hash$lookup has set f$i$adr to the file entry already in the    */
    /* hash table                       */  

                                        /* save xfcb or fcb type info       */
    if (buf$fcb(f$drvusr) and xfcb$type) <> 0 then
    do;                                        /* XFCB                      */
        if last$f$i$adr + size(file$info) > x$i$adr - size(xfcb$info) then
            return(false);                /* out of memory                  */
        x$i$adr = x$i$adr - size(xfcb$info);
        call move(8,.buf$fcb(xf$create),.xfcb$info.create);
        xfcb$info.passmode = buf$fcb(xf$passmode);
        file$info.x$i$adr = x$i$adr;
    end;
    else            /* regular fcb, file$info  is already positioned        */
    do;                                  /* add to number of records        */
        call move(f$namelen + f$typelen, .buf$fcb(f$name),.file$info.name);
                    /* attributes are not in XFCBs to copy again in case    */
                    /* XFCB came first in directory                         */
        
        file$info.name(f$arc-1) = file$info.name(f$arc-1) and buf$fcb(f$arc);
                               /* 0 archive bit if it is 0 in any dir entry */
        d$map$cnt = 0;         /* count kilobytes for current dir entry     */
        i = 1;                            /* 1 or 2 byte block numbers ?    */
        if dpb$word(blk$max$w) > 255 then
            i = 2;
        do j = f$diskmap to f$diskmap + diskmaplen - 1 by i;
            temp = buf$fcb(j);
            if i = 2 then                      /* word block numbers        */
                temp = temp or buf$fcb(j+1);
            if temp <> 0 then                  /* allocated                 */
                d$map$cnt = d$map$cnt + 1;
        end;
        if d$map$cnt > 0 then
        do;
          call add3byte
            (.file$info.recs$lword,
              d$map$cnt * (dpb$byte(blkmsk$b) + 1) -
              (  (128 - buf$fcb(f$rc)) and dpb$byte(blkmsk$b)  )
            );
          file$info.onekblocks = file$info.onekblocks +
            d$map$cnt * k$per$block -
            shr( (128 - buf$fcb(f$rc)) and dpb$byte(blkmsk$b), 3 );
             /* treat each directory entry separately for sparse files */
             /* if copied to single density diskette, the number of 1kblocks */
          file$info.kbytes = file$info.kbytes + d$map$cnt * k$per$block;
        end;
    end;
    return(true);                             /* success                    */
end store$file$info;

                   /* Module Entry Point */

get$files: procedure public;       /* with one scan through directory get   */
    dcl dcnt byte;                 /* files from currently selected drive   */

    last$f$i$adr = first$f$i$adr - size(file$info);
                                   /* after hash table                */
    /* last$f$i$adr is the address of the highest file info record    */
    /* in memory                                                      */

    do dcnt = 0 to hash$table$size - 1;   /* init hash table                */
        hash$table(dcnt) = 0;
    end;

    x$i$adr = maxb;               /* top of mem, put xfcb info here         */
    call base$dpb;
    dir$label,filesfound, used$de = 0;
    
    fcb(f$drvusr) = '?';          /* match all dir entries                  */
    dcnt = search$first(.fcb);
    do while dcnt <> 255;
        buf$fcb$adr = shl(dcnt and 11b,5)+.buff;  /* dcnt mod 4 * 32        */
        if buf$fcb(f$drvusr) <> deleted$type then
        do;
          used$de = used$de + 1;
          if buf$fcb(f$drvusr) = dirlabel$type then   /* dir label ?        */
              dir$label = buf$fcb(f$ex);           /* save label info       */
          else if match then
          do;
              if not store$file$info then         /* store fcb or xfcb info */
              do;                                 /* out of space           */
                  call print (.('Out of Memory',cr,lf,'$'));
                  return; 
              end;
          end;
        end;
        call break;
        dcnt = search$next;                   /* to next entry in directory */
    end; /* of do while dcnt <> 255 */

end get$files;

search$init: procedure public;                /* called once from main.plm  */
    if (first$f$i$adr := (.hash$table + size(hash$table))) + size(file$info)
        > maxb then
    do;
        call print(.('Not Enough Memory',cr,lf,'$'));
        call terminate;
    end;
end search$init;

end search;