mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-25 01:14:21 +00:00
571 lines
19 KiB
Plaintext
571 lines
19 KiB
Plaintext
$title ('SDIR - Show')
|
||
|
||
/*
|
||
Copyright (C) 1981
|
||
Digital Research
|
||
P.O. Box 579
|
||
Pacific Grove, CA 93950
|
||
|
||
Revised:
|
||
14 Sept 81 by Danny Horovitz
|
||
*/
|
||
|
||
dshow:
|
||
do;
|
||
/* display module for extended directory */
|
||
|
||
/* commonly used macros */
|
||
|
||
declare dcl literally 'declare',
|
||
lit literally 'literally',
|
||
true literally '1',
|
||
false literally '0',
|
||
boolean literally 'byte',
|
||
cr literally '13',
|
||
lf literally '10',
|
||
ff literally '12';
|
||
|
||
dcl buff(128) byte external,
|
||
fcb (35) byte external;
|
||
|
||
dcl (cur$drv, cur$usr) byte external;
|
||
|
||
dcl (os,bdos) byte external,
|
||
bdos20 lit '20H',
|
||
bdos30 lit '30H',
|
||
mpm lit '10H';
|
||
|
||
dcl used$de address external; /* number of used directory entries */
|
||
|
||
dcl sorted boolean external;
|
||
dcl filesfound address external;
|
||
|
||
dcl search$ops address external, /* search options */
|
||
s$dir lit '1',
|
||
s$sys lit '2',
|
||
s$ro lit '4',
|
||
s$rw lit '8',
|
||
s$xfcb lit '32', /* show files with xfcbs */
|
||
s$nonxfcb lit '64', /* " " without xfcbs */
|
||
s$exclude lit '128';
|
||
|
||
dcl format byte external, /* format is one of the following */
|
||
page$len address external, /* page size before printing new headers */
|
||
message boolean external, /* print titles and msg when no file found */
|
||
formfeeds boolean external, /* use form feeds to separate headers */
|
||
form$short lit '0',
|
||
form$size lit '1',
|
||
form$full lit '2';
|
||
|
||
dcl file$displayed boolean public initial (false);
|
||
|
||
declare /* directory label: special case of XFCB */
|
||
dirlabel byte external,
|
||
dirlabeltype lit '20', /* identifier on disk */
|
||
dl$databyte lit '12', /* data byte */
|
||
dl$password lit '128', /* masks on data byte */
|
||
dl$access lit '64',
|
||
dl$update lit '32',
|
||
dl$makexfcb lit '16',
|
||
dl$exists lit '1';
|
||
|
||
dcl
|
||
buf$fcb$adr address external, /* index into directory buffer */
|
||
buf$fcb based buf$fcb$adr (32) byte,
|
||
/* fcb template for dir */
|
||
|
||
(f$i$adr,last$f$i$adr,end$adr) address external,
|
||
cur$file address, /* number of file currently */
|
||
/* being displayed */
|
||
|
||
/* structure of file info */
|
||
file$info based f$i$adr structure(
|
||
usr byte,
|
||
name (8) byte,
|
||
type (3) byte,
|
||
bytes address, /* byte count (mod kilobyte) */
|
||
kbytes address, /* kilobyte count */
|
||
recs$lword address, /* record count is 3 byte value */
|
||
recs$hbyte byte, /* low word, high byte */
|
||
hash$link address,
|
||
x$i$adr address), /* index into time stamp array for */
|
||
/* this file */
|
||
|
||
x$i$adr address external,
|
||
xfcb$info based x$i$adr structure (
|
||
create (4) byte,
|
||
update (4) byte,
|
||
passmode byte);
|
||
|
||
dcl f$i$indices$base address external, /* if sorted then f$i$indices */
|
||
f$i$indices based f$i$indices$base (1) address; /* are here */
|
||
|
||
dcl dpb$adr address external, /* disk parameter block address */
|
||
dpb based dpb$adr structure
|
||
(spt address, blkshf byte, blkmsk byte, extmsk byte, blkmax address,
|
||
dirmax address, dirblk address, chksiz address, offset address);
|
||
|
||
printchar: procedure (char) external;
|
||
dcl char byte;
|
||
end printchar;
|
||
|
||
print: procedure (string$adr) external; /* BDOS call # 9 */
|
||
dcl string$adr address;
|
||
end print;
|
||
|
||
search$first: procedure(fcb$adr) byte external;
|
||
dcl fcb$adr address;
|
||
end search$first;
|
||
|
||
search$next: procedure byte external;
|
||
end search$next;
|
||
|
||
break: procedure external;
|
||
end break;
|
||
|
||
display$time$stamp: procedure (ts$adr) external; /* in dts.plm */
|
||
dcl ts$adr address;
|
||
end display$time$stamp;
|
||
|
||
printb: procedure external;
|
||
end printb;
|
||
|
||
crlf: procedure external;
|
||
end crlf;
|
||
|
||
printfn: procedure(fname$adr) external;
|
||
dcl fname$adr address;
|
||
end printfn;
|
||
|
||
pdecimal: procedure(v,prec,zerosup) external;
|
||
/* print value val, field size = (log10 prec) + 1 */
|
||
/* with leading zero suppression if zerosup = true */
|
||
declare v address, /* value to print */
|
||
prec address, /* precision */
|
||
zerosup boolean; /* zero suppression flag */
|
||
end pdecimal;
|
||
|
||
p3byte: procedure(byte3adr,prec)external;
|
||
/* print 3 byte value with 0 suppression */
|
||
dcl (byte3adr,prec) address; /* assume high order bit is < 10 */
|
||
end p3byte;
|
||
|
||
terminate: procedure external;
|
||
end terminate;
|
||
|
||
match: procedure boolean external;
|
||
dcl fcb$adr address;
|
||
end match;
|
||
|
||
add3byte: procedure (byte3$adr,word$amt) external;
|
||
dcl (byte3$adr, word$amt) address;
|
||
end add3byte; /* add word to 3 byte structure */
|
||
|
||
add3byte3: procedure (byte3$adr,byte3) external;
|
||
dcl (byte3$adr, byte3) address;
|
||
end add3byte3; /* add 3 byte quantity to 3 byte total */
|
||
|
||
shr3byte: procedure (byte3$adr) external;
|
||
dcl byte3$adr address;
|
||
end shr3byte;
|
||
|
||
set$drive: procedure external;
|
||
end set$drive;
|
||
|
||
/* routines local to this module */
|
||
|
||
dcl total$kbytes structure ( /* grand total k bytes of files matched */
|
||
lword address,
|
||
hbyte byte),
|
||
total$recs structure ( /* grand total records of files matched */
|
||
lword address,
|
||
hbyte byte),
|
||
total$1k$blocks structure( /* how many 1k blocks are allocated */
|
||
lword address,
|
||
hbyte byte);
|
||
|
||
add$totals: procedure;
|
||
dcl temp structure (lword address, hbyte byte);
|
||
|
||
call add3byte(.total$kbytes,file$info.kbytes);
|
||
if file$info.bytes > 0 then /* round up to nearest k */
|
||
call add3byte(.total$kbytes,1); /* actual disk space allocated */
|
||
|
||
call add3byte3(.total$recs,.file$info.recs$lword); /* records in file */
|
||
temp.lword = file$info.recs$lword;
|
||
temp.hbyte = file$info.recs$hbyte;
|
||
call shr3byte(.temp); /* disk space if 1k blksiz */
|
||
call add3byte3(.total$1k$blocks,.temp);
|
||
if (file$info.recs$lword and 07h) <> 0 then
|
||
call add3byte(.total$1k$blocks,1); /* round up */
|
||
|
||
end add$totals;
|
||
|
||
mult23: procedure(index) address external;
|
||
dcl index address;
|
||
end mult23;
|
||
|
||
/* fcb and dma buffer constants */
|
||
declare
|
||
f$drvusr lit '0', /* drive and user field */
|
||
f$name lit '1', /* file name */
|
||
f$rw lit '9', /* high bit is R/W attribute */
|
||
f$dirsys lit '10', /* high bit is dir/sys attribute */
|
||
f$arc lit '11', /* high bit is archive attribute */
|
||
f$ex lit '12';
|
||
|
||
declare /* XFCB */
|
||
xfcb$type lit '10', /* identifier on disk */
|
||
xf$passmode lit '12', /* pass word protection mode */
|
||
xf$pass lit '16', /* XFCB password */
|
||
passlen lit '8', /* password length */
|
||
xf$create lit '25', /* creation/access time stamp */
|
||
xf$update lit '29'; /* update time stamp */
|
||
|
||
declare /* password mode of xfcb */
|
||
pm$read lit '80h',
|
||
pm$write lit '40h',
|
||
pm$delete lit '20h';
|
||
|
||
dcl files$per$line byte;
|
||
dcl cur$line address;
|
||
|
||
dcl hdr (*) byte data (' Name Bytes Recs Attributes $');
|
||
dcl hdr$bars (*) byte data ('------------ ------ ------ ------------$');
|
||
dcl hdr$pu (*) byte data (' Prot Update $');
|
||
dcl hdr$xfcb$bars (*) byte data (' ------ -------------- --------------$');
|
||
dcl hdr$access (*) byte data (' Access $');
|
||
dcl hdr$create (*) byte data (' Create $');
|
||
/* example date 04/02/55 00:34 */
|
||
|
||
display$file$info: procedure;
|
||
/* print filename.typ */
|
||
call printfn(.file$info.name(0));
|
||
call printb;
|
||
call pdecimal(file$info.kbytes,10000,true);
|
||
cal<61> printchar('k')<29> /<2F> u<> t<> 3<> Me<4D> - Byte<74> */
|
||
/* or 32,000k */
|
||
call printb;
|
||
call p3byte(.file$info.recs$lword,1); /* records */
|
||
call printb;
|
||
if rol(file$info.name(f$dirsys-1),1) then /* Type */
|
||
call print(.('Sys$'));
|
||
else call print(.('Dir$'));
|
||
call printb;
|
||
if rol(file$info.name(f$rw-1),1) then
|
||
call print(.('RO$'));
|
||
else call print(.('RW$'));
|
||
call printb;
|
||
if rol(file$info.name(f$arc-1),1) then /* arc bit was on in all */
|
||
call print$char('A'); /* dir entries */
|
||
else call printb;
|
||
if rol(file$info.name(0),1) then
|
||
call print$char('1');
|
||
else call printb;
|
||
if rol(file$info.name(1),1) then
|
||
call print$char('2');
|
||
else call printb;
|
||
if rol(file$info.name(2),1) then
|
||
call print$char('3');
|
||
else call printb;
|
||
if rol(file$info.name(3),1) then
|
||
call print$char('4');
|
||
else call printb;
|
||
end display$file$info;
|
||
|
||
display$xfcb$info: procedure;
|
||
if file$info.x$i$adr <> 0 then
|
||
do;
|
||
call printb;
|
||
x$i$adr = file$info.x$i$adr;
|
||
if (xfcb$info.passmode and pm$read) <> 0 then
|
||
call print(.('Read $'));
|
||
else if (xfcb$info.passmode and pm$write) <> 0 then
|
||
call print(.('Write $'));
|
||
else if (xfcb$info.passmode and pm$delete) <> 0 then
|
||
call print(.('Delete$'));
|
||
else
|
||
call print(.('None $'));
|
||
call printb;
|
||
if (xfcb$info.update(0) <> 0 or xfcb$info.update(1) <> 0) then
|
||
call display$timestamp(.xfcb$info.update);
|
||
else call print(.(' $'));
|
||
call printb; call printb;
|
||
if (xfcb$info.create(0) <> 0 or xfcb$info.create(1) <> 0) then
|
||
call display$timestamp(.xfcb$info.create(0));
|
||
/* Create/Access */
|
||
end;
|
||
end display$xfcb$info;
|
||
|
||
dcl first$title boolean initial (true);
|
||
|
||
display$title: procedure;
|
||
|
||
if formfeeds then
|
||
call print$char(ff);
|
||
else if not first$title then
|
||
call crlf;
|
||
call print(.('Directory For Drive $'));
|
||
call printchar('A'+ cur$drv); call printchar(':');
|
||
if bdos >= bdos20 then
|
||
do;
|
||
call print(.(' User $'));
|
||
call pdecimal(cur$usr,10,true);
|
||
end;
|
||
call crlf;
|
||
cur$line = 2;
|
||
first$title = false;
|
||
end display$title;
|
||
|
||
short$display: procedure (fname$adr);
|
||
dcl fname$adr address;
|
||
if cur$file mod files$per$line = 0 then
|
||
do;
|
||
if cur$line mod page$len = 0 then
|
||
do; call crlf;
|
||
call display$title;
|
||
call crlf;
|
||
end;
|
||
else
|
||
call crlf;
|
||
cur$line = cur$line + 1;
|
||
call printchar(cur$drv + 'A');
|
||
end;
|
||
else call printb;
|
||
call print(.(': $'));
|
||
call printfn(fname$adr);
|
||
call break;
|
||
cur$file = cur$file + 1;
|
||
end short$display;
|
||
|
||
test$att: procedure(char,off,on) boolean;
|
||
dcl (char,off,on) byte;
|
||
if (80h and char) <> 80h and (off and search$ops) <> 0 then
|
||
return(true);
|
||
if (80h and char) = 80h and (on and search$ops) <> 0 then
|
||
return(true);
|
||
return(false);
|
||
end test$att;
|
||
|
||
right$attributes: procedure(name$adr) boolean;
|
||
dcl name$adr address,
|
||
name based name$adr (1) byte;
|
||
return
|
||
test$att(name(f$rw-1),s$rw,s$ro) and
|
||
test$att(name(f$dirsys-1),s$dir,s$sys);
|
||
end right$attributes;
|
||
|
||
short$dir: procedure;
|
||
dcl dcnt byte;
|
||
fcb(f$drvusr) = '?';
|
||
files$per$line = 4;
|
||
dcnt = search$first(.fcb);
|
||
call set$drive;
|
||
do while dcnt <> 0ffh;
|
||
buf$fcb$adr = shl(dcnt and 11b,5)+.buff; /* dcnt mod 4 * 32 */
|
||
if (buf$fcb(f$drvusr) and 0f0h) = 0 and buf$fcb(f$ex)<= dpb.extmsk
|
||
then /* no dir labels, xfcbs */
|
||
if match then
|
||
if right$attributes(.buf$fcb(f$name)) then
|
||
call short$display(.buf$fcb(f$name));
|
||
dcnt = search$next;
|
||
end;
|
||
end short$dir;
|
||
|
||
dcl index address;
|
||
|
||
getnxt$file$info: procedure;
|
||
dcl right$usr boolean;
|
||
right$usr = false;
|
||
if sorted then
|
||
do while not right$usr;
|
||
if index < filesfound then
|
||
do; f$i$adr = mult23(f$i$indices(index));
|
||
index = index + 1;
|
||
right$usr = file$info.usr = cur$usr;
|
||
end;
|
||
else
|
||
do; f$i$adr = end$adr; /* no more file$info recs */
|
||
right$usr = true;
|
||
end;
|
||
end;
|
||
else
|
||
do while not right$usr and f$i$adr <> end$adr;
|
||
f$i$adr = f$i$adr - size(file$info);
|
||
right$usr = file$info.usr = cur$usr;
|
||
end;
|
||
end getnxt$file$info;
|
||
|
||
size$display: procedure;
|
||
if (format and form$size) <> 0 then
|
||
files$per$line = 3;
|
||
else files$per$line = 4;
|
||
do while f$i$adr <> end$adr;
|
||
if ((file$info.x$i$adr <> 0 and (search$ops and s$xfcb) <> 0) or
|
||
(file$info.x$i$adr = 0 and (search$ops and s$nonxfcb) <> 0)) and
|
||
right$attributes(.file$info.name(0)) then
|
||
do;
|
||
cal<61> add$totals;
|
||
call short$display(.file$info.name(0));
|
||
call pdecimal(file$info.kbytes,10000,true);
|
||
call print(.('k$'));
|
||
end;
|
||
call getnxt$file$info;
|
||
end;
|
||
end size$display;
|
||
|
||
display$no$dirlabel: procedure;
|
||
files$per$line = 2;
|
||
do while f$i$adr <> end$adr;
|
||
if right$attributes(.file$info.name(0)) then
|
||
do;
|
||
if cur$file mod files$per$line = 0 then /* need new line */
|
||
do;
|
||
if cur$line mod page$len = 0 then
|
||
do; call crlf;
|
||
call display$title;
|
||
call crlf;
|
||
call print(.hdr);
|
||
if (not sorted and f$i$adr <> end$adr + size(file$info)) or
|
||
(sorted and index < filesfound) then
|
||
do; call printb; /* then two sets of hdrs */
|
||
call print(.hdr); /* more than 1 file left */
|
||
end;
|
||
call crlf;
|
||
call print(.hdr$bars);
|
||
if (not sorted and f$i$adr <> end$adr + size(file$info)) or
|
||
(sorted and index < filesfound) then
|
||
do; call printb;
|
||
call print(.hdr$bars);
|
||
end;
|
||
call crlf;
|
||
cur$line = cur$line + 3;
|
||
end;
|
||
else
|
||
do; call crlf;
|
||
cur$line = cur$line + 1;
|
||
end;
|
||
end;
|
||
else
|
||
call printb; /* separate the files */
|
||
|
||
call display$file$info;
|
||
cur$file = cur$file + 1;
|
||
call add$totals;
|
||
call break;
|
||
end;
|
||
call getnxt$file$info;
|
||
end;
|
||
end display$no$dirlabel;
|
||
|
||
display$with$dirlabel: procedure;
|
||
files$per$line = 1;
|
||
do while f$i$adr <> end$adr;
|
||
if ((file$info.x$i$adr <> 0 and (search$ops and s$xfcb) <> 0) or
|
||
(file$info.x$i$adr = 0 and (search$ops and s$nonxfcb) <> 0)) and
|
||
right$attributes(.file$info.name(0)) then
|
||
do;
|
||
cur$file = cur$file + 1;
|
||
if cur$line mod page$len = 0 then
|
||
do; call crlf;
|
||
call display$title;
|
||
call crlf;
|
||
call print(.hdr);
|
||
call print(.hdr$pu);
|
||
if (dirlabel and dl$access) <> 0 then
|
||
call print(.hdr$access);
|
||
else
|
||
call print(.hdr$create);
|
||
call crlf;
|
||
call print(.hdr$bars);
|
||
call print(.hdr$xfcb$bars);
|
||
cur$line = cur$line + 2;
|
||
end;
|
||
call crlf;
|
||
call display$file$info; /* display non bdos 3.0 file info */
|
||
call display$xfcb$info;
|
||
call break;
|
||
cur$line = cur$line + 1;
|
||
call add$totals;
|
||
end;
|
||
call getnxt$file$info;
|
||
end;
|
||
end display$with$dirlabel;
|
||
|
||
show$files: procedure public; /* MODULE ENTRY POINT */
|
||
/* display the collected data */
|
||
cur$line, cur$file = 0; /* force titles and new line */
|
||
totalkbytes.lword, totalkbytes.hbyte, totalrecs.lword, totalrecs.hbyte =0;
|
||
total$1k$blocks.lword, total$1k$blocks.hbyte = 0;
|
||
f$i$adr = last$f$i$adr + size(file$info); /* initial if no sort */
|
||
index = 0; /* initial if sorted */
|
||
call getnxt$file$info; /* base file info record */
|
||
|
||
if format > 2 then
|
||
do;
|
||
call print(.('Illegal Format Value$'));
|
||
call terminate;
|
||
end;
|
||
do case format; /* format = */
|
||
call short$dir; /* form$short */
|
||
call size$display; /* form$size */
|
||
/* form = full */
|
||
if (dir$label and dl$exists) = 0 or ((search$ops and s$xfcb) = 0 and
|
||
(search$ops and s$nonxfcb) <> 0) then
|
||
call display$no$dirlabel;
|
||
else
|
||
call display$with$dirlabel;
|
||
end;
|
||
|
||
if cur$file > 1 and format <> form$short then /* print totals */
|
||
do;
|
||
if (page$len <> 0) and (cur$line + 4 > page$len) and formfeeds then
|
||
do;
|
||
call printchar(cr);
|
||
call printchar(ff); /* need a new page ? */
|
||
end;
|
||
else
|
||
do;
|
||
call crlf;
|
||
call crlf;
|
||
end;
|
||
call print(.( 'Total Bytes = $'));
|
||
call p3byte(.total$kbytes,1); /* 6 digit max */
|
||
call printchar('k');
|
||
call print(.(' Total Records = $'));
|
||
call p3byte(.total$recs,10); /* 7 digit max */
|
||
call print(.(' Files Found = $'));
|
||
call pdecimal(cur$file,1000,true); /* 4 digit max */
|
||
call print(.(cr,lf,'Total 1k Blocks = $'));
|
||
call p3byte(.total$1k$blocks,1); /* 6 digit max */
|
||
call print(.(' Used/Max Dir Entries For Drive $'));
|
||
call print$char('A' + cur$drv);
|
||
call print$char(':'); call printb;
|
||
call pdecimal(used$de,1000,true);
|
||
call print$char('/');
|
||
call pdecimal(dpb.dirmax + 1,1000,true);
|
||
end;
|
||
|
||
if cur$file = 0 then
|
||
do;
|
||
if message then
|
||
do; call crlf;
|
||
call display$title;
|
||
call print(.('File Not Found.',cr,lf,'$'));
|
||
end;
|
||
call break;
|
||
end;
|
||
else
|
||
do; file$displayed = true;
|
||
if not formfeeds then
|
||
call print(.(cr,lf,'$'));
|
||
end;
|
||
|
||
end show$files;
|
||
|
||
end dshow;
|
||
|
||
|
||
|
||
|
||
|