mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-26 09:54:20 +00:00
Upload
Digital Research
This commit is contained in:
@@ -0,0 +1,17 @@
|
||||
|
||||
SDIR status: working 1/28/83
|
||||
SDIR BUG: 'sdir sdir.ccm' gives bogus header (NEW PROBLEM) *****
|
||||
SDIR BUG: should say how much room is left on disk
|
||||
SDIR BUG: 'number of 1k blocks' may be misleading when block size=2k...
|
||||
SDIR BUG: paging... *****
|
||||
SDIR notes
|
||||
2/16/83 Changed version check to ignore OS version and select BDOS version
|
||||
of 2.2 or greater.FMB.
|
||||
2/15/83 Fixed the bogus header problem. See above.FMB.
|
||||
1/31/83 Took out the 'break' subroutine to allow type-ahead. Took out paging
|
||||
stuff, and the repeating titles. Displays everything you asked for with
|
||||
out a break, unless you hit ^S. Changes made to subroutine structure of
|
||||
Disp.plm. Type-ahead works. FMB.
|
||||
10/21/82 This needs lots of work: I need to convert DPB headers back, etc.,
|
||||
as soon as I get the new BDOS to play with...
|
||||
|
||||
@@ -0,0 +1,16 @@
|
||||
|
||||
declare
|
||||
lit literally 'literally',
|
||||
dcl lit 'declare',
|
||||
true lit '0ffh',
|
||||
false lit '0',
|
||||
boolean lit 'byte',
|
||||
forever lit 'while true',
|
||||
cr lit '13',
|
||||
lf lit '10',
|
||||
tab lit '9',
|
||||
ctrlc lit '3',
|
||||
ff lit '12',
|
||||
page$len$offset lit '1ch',
|
||||
nopage$mode$offset lit '2Ch',
|
||||
sectorlen lit '128';
|
||||
@@ -0,0 +1,8 @@
|
||||
|
||||
/*
|
||||
Copyright (C) 1983
|
||||
Digital Research
|
||||
P.O. Box 579
|
||||
Pacific Grove, CA 93950
|
||||
*/
|
||||
|
||||
@@ -0,0 +1,973 @@
|
||||
PL/M-86 COMPILER SDIR - DISPLAY FILES PAGE 1
|
||||
|
||||
|
||||
ISIS-II PL/M-86 V2.0 COMPILATION OF MODULE DISPLAY
|
||||
OBJECT MODULE PLACED IN DISP
|
||||
COMPILER INVOKED BY: :F0: DISP.PLM DEBUG OBJECT(DISP) OPTIMIZE(3) XREF
|
||||
|
||||
|
||||
|
||||
$title ('SDIR - Display Files')
|
||||
1 display:
|
||||
do;
|
||||
/* Display Module for SDIR */
|
||||
|
||||
$include(comlit.lit)
|
||||
=
|
||||
2 1 = declare
|
||||
= lit literally 'literally',
|
||||
= dcl lit 'declare',
|
||||
= true lit '0ffh',
|
||||
= false lit '0',
|
||||
= boolean lit 'byte',
|
||||
= forever lit 'while true',
|
||||
= cr lit '13',
|
||||
= lf lit '10',
|
||||
= tab lit '9',
|
||||
= ctrlc lit '3',
|
||||
= ff lit '12',
|
||||
= page$len$offset lit '1ch',
|
||||
= nopage$mode$offset lit '2Ch',
|
||||
= sectorlen lit '128';
|
||||
|
||||
$include(mon.plm)
|
||||
=
|
||||
= /* definitions for assembly interface module */
|
||||
3 1 = declare
|
||||
= fcb (33) byte external, /* default file control block */
|
||||
= maxb address external, /* top of memory */
|
||||
= buff(128)byte external; /* default buffer */
|
||||
=
|
||||
4 1 = mon1: procedure(f,a) external;
|
||||
5 2 = declare f byte, a address;
|
||||
6 2 = end mon1;
|
||||
=
|
||||
7 1 = mon2: procedure(f,a) byte external;
|
||||
8 2 = declare f byte, a address;
|
||||
9 2 = end mon2;
|
||||
=
|
||||
10 1 = mon3: procedure(f,a) address external;
|
||||
11 2 = declare f byte, a address;
|
||||
12 2 = end mon3;
|
||||
=
|
||||
|
||||
13 1 dcl (cur$drv, cur$usr) byte external;
|
||||
|
||||
14 1 dcl (os,bdos) byte external;
|
||||
$include(vers.lit)
|
||||
15 1 = declare
|
||||
= bdos20 lit '20h',
|
||||
= bdos22 lit '22h',
|
||||
PL/M-86 COMPILER SDIR - DISPLAY FILES PAGE 2
|
||||
|
||||
|
||||
= bdos30 lit '30h',
|
||||
= mpm lit '01h',
|
||||
= cpm86 lit '10h',
|
||||
= mpm86 lit '11h',
|
||||
= ccpm86 lit '14h';
|
||||
|
||||
16 1 dcl used$de address external; /* number of used directory entries */
|
||||
17 1 dcl date$opt boolean external; /* date option flag */
|
||||
18 1 dcl display$attributes boolean external; /* attributes display flag */
|
||||
19 1 dcl sorted boolean external;
|
||||
20 1 dcl filesfound address external;
|
||||
|
||||
$include (search.lit)
|
||||
=
|
||||
21 1 = declare /* what kind of file user wants to find */
|
||||
= find$structure lit 'structure (
|
||||
= dir byte,
|
||||
= sys byte,
|
||||
= ro byte,
|
||||
= rw byte,
|
||||
= pass byte,
|
||||
= xfcb byte,
|
||||
= nonxfcb byte,
|
||||
= exclude byte)';
|
||||
=
|
||||
22 1 = declare
|
||||
= max$search$files literally '10';
|
||||
=
|
||||
23 1 = declare
|
||||
= search$structure lit 'structure(
|
||||
= drv byte,
|
||||
= name(8) byte,
|
||||
= type(3) byte,
|
||||
= anyfile boolean)'; /* match on any drive if true */
|
||||
=
|
||||
24 1 dcl find find$structure external;
|
||||
|
||||
25 1 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 */
|
||||
|
||||
$include(format.lit)
|
||||
=
|
||||
26 1 = dcl form$short lit '0', /* format values for SDIR */
|
||||
= form$size lit '1',
|
||||
= form$full lit '2';
|
||||
=
|
||||
|
||||
27 1 dcl file$displayed boolean public initial (false);
|
||||
/* true if we ever display a file, from any drive or user */
|
||||
/* used by main.plm for file not found message */
|
||||
|
||||
28 1 dcl dir$label byte external;
|
||||
|
||||
$include(fcb.lit)
|
||||
=
|
||||
PL/M-86 COMPILER SDIR - DISPLAY FILES PAGE 3
|
||||
|
||||
|
||||
29 1 = declare
|
||||
= f$drvusr lit '0', /* drive/user byte */
|
||||
= f$name lit '1', /* file name */
|
||||
= f$namelen lit '8', /* file name length */
|
||||
= f$type lit '9', /* file type field */
|
||||
= f$typelen lit '3', /* type length */
|
||||
= 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', /* extent */
|
||||
= f$s1 lit '13', /* module byte */
|
||||
= f$rc lit '15', /* record count */
|
||||
= f$diskmap lit '16', /* file disk map */
|
||||
= diskmaplen lit '16', /* disk map length */
|
||||
= f$drvusr2 lit '16', /* fcb2 */
|
||||
= f$name2 lit '17',
|
||||
= f$type2 lit '25',
|
||||
= f$cr lit '32', /* current record */
|
||||
= f$rrec lit '33', /* random record */
|
||||
= f$rreco lit '35'; /* " " overflow */
|
||||
=
|
||||
$include(xfcb.lit)
|
||||
=
|
||||
30 1 = declare /* XFCB */
|
||||
= xfcb$type lit '10h', /* 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 '24', /* creation/access time stamp */
|
||||
= xf$update lit '28'; /* update time stamp */
|
||||
=
|
||||
31 1 = declare /* directory label: special case of XFCB */
|
||||
= dirlabeltype lit '20h', /* identifier on disk */
|
||||
= dl$password lit '128', /* masks on data byte */
|
||||
= dl$access lit '64',
|
||||
= dl$update lit '32',
|
||||
= dl$makexfcb lit '16',
|
||||
= dl$exists lit '1';
|
||||
=
|
||||
32 1 = declare /* password mode of xfcb */
|
||||
= pm$read lit '80h',
|
||||
= pm$write lit '40h',
|
||||
= pm$delete lit '20h';
|
||||
=
|
||||
|
||||
33 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,first$f$i$adr) address external,
|
||||
cur$file address; /* number of file currently */
|
||||
/* being displayed */
|
||||
|
||||
$include(finfo.lit)
|
||||
=
|
||||
= /* file info record for SDIR - note if this structure changes in size */
|
||||
PL/M-86 COMPILER SDIR - DISPLAY FILES PAGE 4
|
||||
|
||||
|
||||
= /* the multXX: routine in the sort.plm module must also change */
|
||||
=
|
||||
34 1 = declare
|
||||
= f$info$structure lit 'structure(
|
||||
= usr byte, name (8) byte, type (3) byte, onekblocks address,
|
||||
= kbytes address, recs$lword address, recs$hbyte byte,
|
||||
= hash$link address, x$i$adr address)';
|
||||
35 1 = declare
|
||||
= x$info$structure lit 'structure (
|
||||
= create (4) byte,
|
||||
= update (4) byte,
|
||||
= passmode byte)';
|
||||
=
|
||||
/* structure of file info */
|
||||
36 1 dcl file$info based f$i$adr f$info$structure;
|
||||
|
||||
37 1 dcl x$i$adr address external,
|
||||
xfcb$info based x$i$adr x$info$structure;
|
||||
|
||||
38 1 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 */
|
||||
|
||||
|
||||
/* -------- Routines in util.plm -------- */
|
||||
|
||||
39 1 printchar: procedure (char) external;
|
||||
40 2 dcl char byte;
|
||||
41 2 end printchar;
|
||||
|
||||
42 1 print: procedure (string$adr) external; /* BDOS call # 9 */
|
||||
43 2 dcl string$adr address;
|
||||
44 2 end print;
|
||||
|
||||
45 1 printb: procedure external;
|
||||
46 2 end printb;
|
||||
|
||||
47 1 crlf: procedure external;
|
||||
48 2 end crlf;
|
||||
|
||||
49 1 printfn: procedure(fname$adr) external;
|
||||
50 2 dcl fname$adr address;
|
||||
51 2 end printfn;
|
||||
|
||||
52 1 pdecimal: procedure(v,prec,zerosup) external;
|
||||
/* print value val, field size = (log10 prec) + 1 */
|
||||
/* with leading zero suppression if zerosup = true */
|
||||
53 2 declare v address, /* value to print */
|
||||
prec address, /* precision */
|
||||
zerosup boolean; /* zero suppression flag */
|
||||
54 2 end pdecimal;
|
||||
|
||||
55 1 p3byte: procedure(byte3adr,prec)external;
|
||||
/* print 3 byte value with 0 suppression */
|
||||
56 2 dcl (byte3adr,prec) address; /* assume high order bit is < 10 */
|
||||
57 2 end p3byte;
|
||||
|
||||
58 1 add3byte: procedure (byte3$adr,word$amt) external;
|
||||
PL/M-86 COMPILER SDIR - DISPLAY FILES PAGE 5
|
||||
|
||||
|
||||
59 2 dcl (byte3$adr, word$amt) address;
|
||||
60 2 end add3byte; /* add word to 3 byte structure */
|
||||
|
||||
61 1 add3byte3: procedure (byte3$adr,byte3) external;
|
||||
62 2 dcl (byte3$adr, byte3) address;
|
||||
63 2 end add3byte3; /* add 3 byte quantity to 3 byte total */
|
||||
|
||||
64 1 shr3byte: procedure (byte3$adr) external;
|
||||
65 2 dcl byte3$adr address;
|
||||
66 2 end shr3byte;
|
||||
|
||||
|
||||
/* -------- Routines in search.plm -------- */
|
||||
|
||||
67 1 search$first: procedure(fcb$adr) byte external;
|
||||
68 2 dcl fcb$adr address;
|
||||
69 2 end search$first;
|
||||
|
||||
70 1 search$next: procedure byte external;
|
||||
71 2 end search$next;
|
||||
|
||||
/*break: procedure external;
|
||||
end break;*/
|
||||
|
||||
72 1 match: procedure boolean external;
|
||||
73 2 dcl fcb$adr address;
|
||||
74 2 end match;
|
||||
|
||||
|
||||
/* -------- Other external routines -------- */
|
||||
|
||||
75 1 display$time$stamp: procedure (ts$adr) external; /* in dts.plm */
|
||||
76 2 dcl ts$adr address;
|
||||
77 2 end display$time$stamp;
|
||||
|
||||
78 1 terminate: procedure external; /* in main.plm */
|
||||
79 2 end terminate;
|
||||
|
||||
80 1 mult23: procedure(index) address external; /* in sort.plm */
|
||||
81 2 dcl index address;
|
||||
82 2 end mult23;
|
||||
|
||||
|
||||
/* -------- From dpb86.plm or dpb80.plm -------- */
|
||||
|
||||
$include(dpb.lit)
|
||||
=
|
||||
= /* indices into disk parameter block, used as parameters to dpb procedure */
|
||||
=
|
||||
83 1 = dcl spt$w lit '0',
|
||||
= blkshf$b lit '2',
|
||||
= blkmsk$b lit '3',
|
||||
= extmsk$b lit '4',
|
||||
= blkmax$w lit '5',
|
||||
= dirmax$w lit '7',
|
||||
= dirblk$w lit '9',
|
||||
= chksiz lit '11',
|
||||
PL/M-86 COMPILER SDIR - DISPLAY FILES PAGE 6
|
||||
|
||||
|
||||
= offset$w lit '13';
|
||||
=
|
||||
|
||||
84 1 dpb$byte: procedure (dpb$index) byte external;
|
||||
85 2 dcl dpb$index byte;
|
||||
86 2 end dpb$byte;
|
||||
|
||||
87 1 dpb$word: procedure (dpb$index) address external;
|
||||
88 2 dcl dpb$index byte;
|
||||
89 2 end dpb$word;
|
||||
|
||||
|
||||
/* -------- routines and data structures local to this module -------- */
|
||||
|
||||
90 1 direct$console$io: procedure byte;
|
||||
91 2 return mon2(6,0ffh); /* ff to stay downward compatable */
|
||||
92 2 end direct$console$io;
|
||||
|
||||
93 1 wait$keypress: procedure;
|
||||
94 2 declare char byte;
|
||||
95 2 char = direct$console$io;
|
||||
96 2 do while char = 0;
|
||||
97 3 char = direct$console$io;
|
||||
98 3 end;
|
||||
99 2 if char = ctrlc then
|
||||
100 2 call terminate;
|
||||
101 2 end wait$keypress;
|
||||
|
||||
102 1 declare global$line$count byte initial(1);
|
||||
|
||||
103 1 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);
|
||||
|
||||
104 1 add$totals: procedure;
|
||||
|
||||
105 2 call add3byte(.total$kbytes,file$info.kbytes);
|
||||
106 2 call add3byte3(.total$recs,.file$info.recs$lword); /* records in file */
|
||||
107 2 call add3byte(.total$1k$blocks,file$info.onekblocks);
|
||||
|
||||
108 2 end add$totals;
|
||||
|
||||
109 1 dcl files$per$line byte;
|
||||
110 1 dcl cur$line address;
|
||||
|
||||
111 1 dcl hdr (*) byte data (' Name Bytes Recs Attributes $');
|
||||
112 1 dcl hdr$bars (*) byte data ('------------ ------ ------ ------------$');
|
||||
113 1 dcl hdr$pu (*) byte data (' Prot Update $');
|
||||
114 1 dcl hdr$xfcb$bars (*) byte data (' ------ -------------- --------------$');
|
||||
115 1 dcl hdr$access (*) byte data (' Access $');
|
||||
116 1 dcl hdr$create (*) byte data (' Create $');
|
||||
PL/M-86 COMPILER SDIR - DISPLAY FILES PAGE 7
|
||||
|
||||
|
||||
/* example date 04/02/55 00:34 */
|
||||
|
||||
117 1 display$file$info: procedure;
|
||||
/* print filename.typ */
|
||||
118 2 call printfn(.file$info.name(0));
|
||||
119 2 call printb;
|
||||
120 2 call pdecimal(file$info.kbytes,10000,true);
|
||||
121 2 call printchar('k'); /* up to 32 Meg - Bytes */
|
||||
/* or 32,000k */
|
||||
122 2 call printb;
|
||||
123 2 call p3byte(.file$info.recs$lword,1); /* records */
|
||||
124 2 call printb;
|
||||
125 2 if rol(file$info.name(f$dirsys-1),1) then /* Type */
|
||||
126 2 call print(.('Sys$'));
|
||||
127 2 else call print(.('Dir$'));
|
||||
128 2 call printb;
|
||||
129 2 if rol(file$info.name(f$rw-1),1) then
|
||||
130 2 call print(.('RO$'));
|
||||
131 2 else call print(.('RW$'));
|
||||
132 2 call printb;
|
||||
133 2 if not display$attributes then do;
|
||||
135 3 if rol(file$info.name(f$arc-1),1) then
|
||||
136 3 call print(.('Arcv $'));
|
||||
else
|
||||
137 3 call print(.(' $'));
|
||||
138 3 end;
|
||||
139 2 else do;
|
||||
140 3 if rol(file$info.name(f$arc-1),1) then /* arc bit was on in all */
|
||||
141 3 call print$char('A'); /* dir entries */
|
||||
142 3 else call printb;
|
||||
143 3 if rol(file$info.name(0),1) then
|
||||
144 3 call print$char('1');
|
||||
145 3 else call printb;
|
||||
146 3 if rol(file$info.name(1),1) then
|
||||
147 3 call print$char('2');
|
||||
148 3 else call printb;
|
||||
149 3 if rol(file$info.name(2),1) then
|
||||
150 3 call print$char('3');
|
||||
151 3 else call printb;
|
||||
152 3 if rol(file$info.name(3),1) then
|
||||
153 3 call print$char('4');
|
||||
154 3 else call printb;
|
||||
155 3 end;
|
||||
156 2 end display$file$info;
|
||||
|
||||
157 1 display$xfcb$info: procedure;
|
||||
158 2 if file$info.x$i$adr <> 0 then
|
||||
159 2 do;
|
||||
160 3 call printb;
|
||||
161 3 x$i$adr = file$info.x$i$adr;
|
||||
162 3 if (xfcb$info.passmode and pm$read) <> 0 then
|
||||
163 3 call print(.('Read $'));
|
||||
164 3 else if (xfcb$info.passmode and pm$write) <> 0 then
|
||||
165 3 call print(.('Write $'));
|
||||
166 3 else if (xfcb$info.passmode and pm$delete) <> 0 then
|
||||
167 3 call print(.('Delete$'));
|
||||
else
|
||||
PL/M-86 COMPILER SDIR - DISPLAY FILES PAGE 8
|
||||
|
||||
|
||||
168 3 call print(.('None $'));
|
||||
169 3 call printb;
|
||||
170 3 if (xfcb$info.update(0) <> 0 or xfcb$info.update(1) <> 0) then
|
||||
171 3 call display$timestamp(.xfcb$info.update);
|
||||
172 3 else call print(.(' $'));
|
||||
173 3 call printb; call printb;
|
||||
175 3 if (xfcb$info.create(0) <> 0 or xfcb$info.create(1) <> 0) then
|
||||
176 3 call display$timestamp(.xfcb$info.create(0));
|
||||
/* Create/Access */
|
||||
177 3 end;
|
||||
178 2 end display$xfcb$info;
|
||||
|
||||
179 1 dcl first$title boolean initial (true);
|
||||
|
||||
180 1 display$title: procedure;
|
||||
|
||||
181 2 if formfeeds then
|
||||
182 2 call print$char(ff);
|
||||
183 2 else if not first$title then
|
||||
184 2 call crlf;
|
||||
call print(.('Directory For Drive $'));
|
||||
186 2 call printchar('A'+ cur$drv); call printchar(':');
|
||||
188 2 if bdos >= bdos20 then
|
||||
189 2 do;
|
||||
190 3 call print(.(' User $'));
|
||||
191 3 call pdecimal(cur$usr,10,true);
|
||||
192 3 end;
|
||||
193 2 call crlf;
|
||||
194 2 cur$line = 2;
|
||||
195 2 first$title = false;
|
||||
196 2 end display$title;
|
||||
|
||||
197 1 short$display: procedure (fname$adr);
|
||||
198 2 dcl fname$adr address;
|
||||
199 2 if cur$file mod files$per$line = 0 then
|
||||
200 2 do;
|
||||
201 3 if cur$line mod page$len = 0 then
|
||||
202 3 do;
|
||||
203 4 call crlf;
|
||||
204 4 call display$title;
|
||||
205 4 call crlf;
|
||||
206 4 end;
|
||||
else
|
||||
207 3 call crlf;
|
||||
208 3 cur$line = cur$line + 1;
|
||||
209 3 call printchar(cur$drv + 'A');
|
||||
210 3 end;
|
||||
211 2 else call printb;
|
||||
212 2 call print(.(': $'));
|
||||
213 2 call printfn(fname$adr);
|
||||
214 2 cur$file = cur$file + 1;
|
||||
215 2 end short$display;
|
||||
|
||||
216 1 test$att: procedure(char,off,on) boolean;
|
||||
217 2 dcl (char,off,on) byte;
|
||||
218 2 if (80h and char) <> 80h and off then
|
||||
219 2 return(true);
|
||||
PL/M-86 COMPILER SDIR - DISPLAY FILES PAGE 9
|
||||
|
||||
|
||||
220 2 if (80h and char) = 80h and on then
|
||||
221 2 return(true);
|
||||
222 2 return(false);
|
||||
223 2 end test$att;
|
||||
|
||||
224 1 right$attributes: procedure(name$adr) boolean;
|
||||
225 2 dcl name$adr address,
|
||||
name based name$adr (1) byte;
|
||||
226 2 return
|
||||
test$att(name(f$rw-1),find.rw,find.ro) and
|
||||
test$att(name(f$dirsys-1),find.dir,find.sys);
|
||||
227 2 end right$attributes;
|
||||
|
||||
228 1 short$dir: procedure; /* looks like "DIR" command */
|
||||
229 2 dcl dcnt byte;
|
||||
230 2 fcb(f$drvusr) = '?';
|
||||
231 2 files$per$line = 4;
|
||||
232 2 dcnt = search$first(.fcb);
|
||||
233 2 do while dcnt <> 0ffh;
|
||||
234 3 buf$fcb$adr = shl(dcnt and 11b,5)+.buff; /* dcnt mod 4 * 32 */
|
||||
235 3 if (buf$fcb(f$drvusr) and 0f0h) = 0 and
|
||||
buf$fcb(f$ex) = 0 and
|
||||
buf$fcb(f$ex)<= dpb$byte(extmsk$b) then /* no dir labels, xfcbs */
|
||||
236 3 if match then
|
||||
237 3 if right$attributes(.buf$fcb(f$name)) then
|
||||
238 3 call short$display(.buf$fcb(f$name));
|
||||
239 3 dcnt = search$next;
|
||||
240 3 end;
|
||||
241 2 end short$dir;
|
||||
|
||||
242 1 dcl (last$plus$one,index) address;
|
||||
|
||||
243 1 getnxt$file$info: procedure; /* set f$i$adr to base file$info on file */
|
||||
244 2 dcl right$usr boolean; /* to be displayed, f$i$adr = 0ffffh if end */
|
||||
245 2 right$usr = false;
|
||||
246 2 if sorted then
|
||||
247 2 do; index = index + 1;
|
||||
249 3 f$i$adr = mult23(f$i$indices(index));
|
||||
250 3 do while file$info.usr <> cur$usr and index <> filesfound;
|
||||
251 4 index = index + 1;
|
||||
252 4 f$i$adr = mult23(f$i$indices(index));
|
||||
253 4 end;
|
||||
254 3 if index = files$found then
|
||||
255 3 f$i$adr = last$plus$one; /* no more files */
|
||||
256 3 end;
|
||||
else /* not sorted display in order found in directory */
|
||||
257 2 do; /* use last$plus$one to avoid wrap around problems */
|
||||
258 3 f$i$adr = f$i$adr + size(file$info);
|
||||
259 3 do while file$info.usr <> cur$usr and f$i$adr <> last$plus$one;
|
||||
260 4 f$i$adr = f$i$adr + size(file$info);
|
||||
261 4 end;
|
||||
262 3 end;
|
||||
263 2 end getnxt$file$info;
|
||||
|
||||
264 1 size$display: procedure;
|
||||
265 2 if (format and form$size) <> 0 then
|
||||
266 2 files$per$line = 3;
|
||||
PL/M-86 COMPILER SDIR - DISPLAY FILES PAGE 10
|
||||
|
||||
|
||||
267 2 else files$per$line = 4;
|
||||
268 2 do while f$i$adr <> last$plus$one;
|
||||
269 3 if ((file$info.x$i$adr <> 0 and find.xfcb) or
|
||||
file$info.x$i$adr = 0 and find.nonxfcb) and
|
||||
right$attributes(.file$info.name(0)) then
|
||||
270 3 do;
|
||||
271 4 call add$totals;
|
||||
272 4 call short$display(.file$info.name(0));
|
||||
273 4 call pdecimal(file$info.kbytes,10000,true);
|
||||
274 4 call print(.('k$'));
|
||||
275 4 end;
|
||||
276 3 call getnxt$file$info;
|
||||
277 3 end;
|
||||
278 2 end size$display;
|
||||
|
||||
279 1 display$no$dirlabel: procedure;
|
||||
280 2 files$per$line = 2;
|
||||
281 2 do while f$i$adr <> last$plus$one; /* Do all valid files */
|
||||
282 3 if ((file$info.x$i$adr <> 0 and find.xfcb) or
|
||||
(file$info.x$i$adr = 0 and find.nonxfcb)) and
|
||||
right$attributes(.file$info.name(0)) then
|
||||
283 3 do;
|
||||
284 4 if cur$file mod files$per$line <> 0 then call printb;
|
||||
286 4 else do; /* need a new line */
|
||||
287 5 if cur$line mod page$len <> 0 then do; /* just crlf */
|
||||
289 6 call crlf;
|
||||
290 6 cur$line = cur$line + 1;
|
||||
291 6 end;
|
||||
292 5 else do; /* print header */
|
||||
293 6 call crlf;
|
||||
294 6 call display$title; call crlf;
|
||||
296 6 call print(.hdr); call printb; call print(.hdr);
|
||||
299 6 call crlf;
|
||||
300 6 call print(.hdr$bars); call printb; call print(.hdr$bars);
|
||||
303 6 call crlf;
|
||||
304 6 cur$line = cur$line + 3;
|
||||
305 6 end;
|
||||
306 5 end;
|
||||
307 4 call display$file$info;
|
||||
308 4 cur$file = cur$file + 1;
|
||||
309 4 call add$totals;
|
||||
310 4 end;
|
||||
311 3 call getnxt$file$info;
|
||||
312 3 end;/* do loop */
|
||||
313 2 end display$no$dirlabel;
|
||||
|
||||
314 1 display$with$dirlabel: procedure;
|
||||
315 2 files$per$line = 1;
|
||||
316 2 do while f$i$adr <> last$plus$one; /* Display the file info */
|
||||
317 3 if ((file$info.x$i$adr <> 0 and find.xfcb) or
|
||||
(file$info.x$i$adr = 0 and find.nonxfcb)) and
|
||||
right$attributes(.file$info.name(0)) then
|
||||
318 3 do;
|
||||
319 4 if cur$line mod page$len = 0 then do; /* display the header */
|
||||
321 5 call crlf;
|
||||
322 5 call display$title; call crlf;
|
||||
324 5 call print(.hdr); call print(.hdr$pu);
|
||||
PL/M-86 COMPILER SDIR - DISPLAY FILES PAGE 11
|
||||
|
||||
|
||||
326 5 if (dirlabel and dl$access) <> 0 then
|
||||
327 5 call print(.hdr$access);
|
||||
328 5 else call print(.hdr$create);
|
||||
329 5 call crlf;
|
||||
330 5 call print(.hdr$bars); call print(.hdr$xfcb$bars);
|
||||
332 5 cur$line = cur$line + 2;
|
||||
333 5 end; /* header display */
|
||||
334 4 call crlf;
|
||||
335 4 call display$file$info; /* display non bdos 3.0 file info */
|
||||
336 4 call display$xfcb$info;
|
||||
337 4 cur$file = cur$file+1; cur$line = cur$line+1;
|
||||
339 4 call add$totals;
|
||||
340 4 end;
|
||||
341 3 call getnxt$file$info;
|
||||
342 3 end;
|
||||
343 2 end display$with$dirlabel;
|
||||
|
||||
|
||||
344 1 display$files: procedure public; /* MODULE ENTRY POINT */
|
||||
/* display the collected data */
|
||||
345 2 cur$line, cur$file = 0; /* force titles and new line */
|
||||
346 2 totalkbytes.lword, totalkbytes.hbyte, totalrecs.lword, totalrecs.hbyte =0;
|
||||
347 2 total$1k$blocks.lword, total$1k$blocks.hbyte = 0;
|
||||
348 2 f$i$adr = first$f$i$adr - size(file$info); /* initial if no sort */
|
||||
349 2 last$plus$one = last$f$i$adr + size(file$info);
|
||||
350 2 index = 0ffffh; /* initial if sorted */
|
||||
351 2 call getnxt$file$info; /* base file info record */
|
||||
|
||||
352 2 if format > 2 then
|
||||
353 2 do;
|
||||
354 3 call print(.('Illegal Format Value$'));
|
||||
355 3 call terminate; /* default could be patched - watch it */
|
||||
356 3 end;
|
||||
|
||||
357 2 do case format; /* format = */
|
||||
358 3 call short$dir; /* form$short */
|
||||
359 3 call size$display; /* form$size */
|
||||
/* form = full */
|
||||
360 3 if date$opt then do;
|
||||
362 4 if ((( dir$label and dl$exists) <> 0 ) and
|
||||
((( dir$label and dl$access) <> 0 ) or
|
||||
(( dir$label and dl$update) <> 0 ) or
|
||||
(( dir$label and dl$makexfcb) <> 0 ))) then
|
||||
363 4 call display$with$dirlabel; /* Timestamping is active! */
|
||||
364 4 else do;
|
||||
365 5 call print(.('Date and Time Stamping Inactive$'));
|
||||
366 5 call terminate;
|
||||
367 5 end;
|
||||
368 4 end;
|
||||
369 3 else do; /* No date option; Regular Full display */
|
||||
370 4 if (dir$label and dl$exists) <> 0 then
|
||||
371 4 call display$with$dirlabel;
|
||||
else
|
||||
372 4 call display$no$dirlabel;
|
||||
373 4 end;
|
||||
374 3 end; /* end of case */
|
||||
375 2 if format <> form$short and cur$file > 0 then /* print totals */
|
||||
PL/M-86 COMPILER SDIR - DISPLAY FILES PAGE 12
|
||||
|
||||
|
||||
376 2 do;
|
||||
377 3 if cur$line + 4 > page$len and formfeeds then
|
||||
378 3 do;
|
||||
379 4 call printchar(cr);
|
||||
380 4 call printchar(ff); /* need a new page ? */
|
||||
381 4 end;
|
||||
else
|
||||
382 3 do;
|
||||
383 4 call crlf;
|
||||
384 4 call crlf;
|
||||
385 4 end;
|
||||
386 3 call print(.( 'Total Bytes = $'));
|
||||
387 3 call p3byte(.total$kbytes,1); /* 6 digit max */
|
||||
388 3 call printchar('k');
|
||||
389 3 call print(.(' Total Records = $'));
|
||||
390 3 call p3byte(.total$recs,10); /* 7 digit max */
|
||||
391 3 call print(.(' Files Found = $'));
|
||||
392 3 call pdecimal(cur$file,1000,true); /* 4 digit max */
|
||||
393 3 call print(.(cr,lf,'Total 1k Blocks = $'));
|
||||
394 3 call p3byte(.total$1k$blocks,1); /* 6 digit max */
|
||||
395 3 call print(.(' Used/Max Dir Entries For Drive $'));
|
||||
396 3 call print$char('A' + cur$drv);
|
||||
397 3 call print$char(':'); call printb;
|
||||
399 3 call pdecimal(used$de,1000,true);
|
||||
400 3 call print$char('/');
|
||||
401 3 call pdecimal(dpb$word(dirmax$w) + 1,1000,true);
|
||||
402 3 end;
|
||||
|
||||
403 2 if cur$file = 0 then
|
||||
404 2 do;
|
||||
405 3 if message then
|
||||
406 3 do; call crlf;
|
||||
408 4 call display$title;
|
||||
409 4 call print(.('File Not Found.',cr,lf,'$'));
|
||||
410 4 end;
|
||||
411 3 end;
|
||||
412 2 else do;
|
||||
413 3 file$displayed = true;
|
||||
414 3 if not formfeeds then
|
||||
415 3 call crlf;
|
||||
416 3 end;
|
||||
|
||||
417 2 end display$files;
|
||||
|
||||
418 1 end display;
|
||||
|
||||
PL/M-86 COMPILER SDIR - DISPLAY FILES PAGE 13
|
||||
|
||||
|
||||
CROSS-REFERENCE LISTING
|
||||
-----------------------
|
||||
|
||||
|
||||
DEFN ADDR SIZE NAME, ATTRIBUTES, AND REFERENCES
|
||||
----- ------ ----- --------------------------------
|
||||
|
||||
|
||||
7 0000H 2 A. . . . . . . . . . WORD PARAMETER 8
|
||||
4 0000H 2 A. . . . . . . . . . WORD PARAMETER 5
|
||||
10 0000H 2 A. . . . . . . . . . WORD PARAMETER 11
|
||||
58 0000H ADD3BYTE . . . . . . PROCEDURE EXTERNAL(34) STACK=0000H 105 107
|
||||
61 0000H ADD3BYTE3. . . . . . PROCEDURE EXTERNAL(35) STACK=0000H 106
|
||||
104 002BH 48 ADDTOTALS. . . . . . PROCEDURE STACK=0008H 271 309 339
|
||||
14 0000H 1 BDOS . . . . . . . . BYTE EXTERNAL(9) 188
|
||||
15 BDOS20 . . . . . . . LITERALLY 188
|
||||
15 BDOS22 . . . . . . . LITERALLY
|
||||
15 BDOS30 . . . . . . . LITERALLY
|
||||
83 BLKMAXW. . . . . . . LITERALLY
|
||||
83 BLKMSKB. . . . . . . LITERALLY
|
||||
83 BLKSHFB. . . . . . . LITERALLY
|
||||
2 BOOLEAN. . . . . . . LITERALLY 17 18 19 25 27 53 72 179 216 224 244
|
||||
3 0000H 128 BUFF . . . . . . . . BYTE ARRAY(128) EXTERNAL(2) 234
|
||||
33 0000H 32 BUFFCB . . . . . . . BYTE BASED(BUFFCBADR) ARRAY(32) 235 237 238
|
||||
33 0000H 2 BUFFCBADR. . . . . . WORD EXTERNAL(21) 33 234 235 237 238
|
||||
61 0000H 2 BYTE3. . . . . . . . WORD PARAMETER 62
|
||||
64 0000H 2 BYTE3ADR . . . . . . WORD PARAMETER 65
|
||||
55 0000H 2 BYTE3ADR . . . . . . WORD PARAMETER 56
|
||||
58 0000H 2 BYTE3ADR . . . . . . WORD PARAMETER 59
|
||||
61 0000H 2 BYTE3ADR . . . . . . WORD PARAMETER 62
|
||||
15 CCPM86 . . . . . . . LITERALLY
|
||||
94 000BH 1 CHAR . . . . . . . . BYTE 95 96 97 99
|
||||
39 0000H 1 CHAR . . . . . . . . BYTE PARAMETER 40
|
||||
216 0008H 1 CHAR . . . . . . . . BYTE PARAMETER AUTOMATIC 217 218 220
|
||||
83 CHKSIZ . . . . . . . LITERALLY
|
||||
15 CPM86. . . . . . . . LITERALLY
|
||||
2 CR . . . . . . . . . LITERALLY 379 393 409
|
||||
37 0000H 4 CREATE . . . . . . . BYTE ARRAY(4) MEMBER(XFCBINFO) 175 176
|
||||
47 0000H CRLF . . . . . . . . PROCEDURE EXTERNAL(30) STACK=0000H 184 193 203 205 207 289
|
||||
293 295 299 303 321 323 329 334 383 384 407 415
|
||||
2 CTRLC. . . . . . . . LITERALLY 99
|
||||
13 0000H 1 CURDRV . . . . . . . BYTE EXTERNAL(6) 186 209 396
|
||||
33 0000H 2 CURFILE. . . . . . . WORD 199 214 284 308 337 345 375 392 403
|
||||
110 0004H 2 CURLINE. . . . . . . WORD 194 201 208 287 290 304 319 332 338 345 377
|
||||
13 0000H 1 CURUSR . . . . . . . BYTE EXTERNAL(7) 191 250 259
|
||||
17 0000H 1 DATEOPT. . . . . . . BYTE EXTERNAL(11) 360
|
||||
2 DCL. . . . . . . . . LITERALLY
|
||||
229 0018H 1 DCNT . . . . . . . . BYTE 232 233 234 239
|
||||
24 0000H 1 DIR. . . . . . . . . BYTE MEMBER(FIND) 226
|
||||
83 DIRBLKW. . . . . . . LITERALLY
|
||||
90 0000H 15 DIRECTCONSOLEIO. . . PROCEDURE BYTE STACK=0008H 95 97
|
||||
28 0000H 1 DIRLABEL . . . . . . BYTE EXTERNAL(20) 326 362 370
|
||||
31 DIRLABELTYPE . . . . LITERALLY
|
||||
83 DIRMAXW. . . . . . . LITERALLY 401
|
||||
29 DISKMAPLEN . . . . . LITERALLY
|
||||
1 0000H DISPLAY. . . . . . . PROCEDURE STACK=0000H
|
||||
18 0000H 1 DISPLAYATTRIBUTES. . BYTE EXTERNAL(12) 133
|
||||
PL/M-86 COMPILER SDIR - DISPLAY FILES PAGE 14
|
||||
|
||||
|
||||
117 005BH 287 DISPLAYFILEINFO. . . PROCEDURE STACK=000AH 307 335
|
||||
344 0611H 443 DISPLAYFILES . . . . PROCEDURE PUBLIC STACK=001AH
|
||||
279 04B0H 182 DISPLAYNODIRLABEL. . PROCEDURE STACK=0016H 372
|
||||
75 0000H DISPLAYTIMESTAMP . . PROCEDURE EXTERNAL(40) STACK=0000H 171 176
|
||||
180 020EH 98 DISPLAYTITLE . . . . PROCEDURE STACK=000AH 204 294 322 408
|
||||
314 0566H 171 DISPLAYWITHDIRLABEL. PROCEDURE STACK=0016H 363 371
|
||||
157 017AH 148 DISPLAYXFCBINFO. . . PROCEDURE STACK=0006H 336
|
||||
31 DLACCESS . . . . . . LITERALLY 326 362
|
||||
31 DLEXISTS . . . . . . LITERALLY 362 370
|
||||
31 DLMAKEXFCB . . . . . LITERALLY 362
|
||||
31 DLPASSWORD . . . . . LITERALLY
|
||||
31 DLUPDATE . . . . . . LITERALLY 362
|
||||
84 0000H DPBBYTE. . . . . . . PROCEDURE BYTE EXTERNAL(43) STACK=0000H 235
|
||||
84 0000H 1 DPBINDEX . . . . . . BYTE PARAMETER 85
|
||||
87 0000H 1 DPBINDEX . . . . . . BYTE PARAMETER 88
|
||||
87 0000H DPBWORD. . . . . . . PROCEDURE WORD EXTERNAL(44) STACK=0000H 401
|
||||
24 0007H 1 EXCLUDE. . . . . . . BYTE MEMBER(FIND)
|
||||
83 EXTMSKB. . . . . . . LITERALLY 235
|
||||
10 0000H 1 F. . . . . . . . . . BYTE PARAMETER 11
|
||||
4 0000H 1 F. . . . . . . . . . BYTE PARAMETER 5
|
||||
7 0000H 1 F. . . . . . . . . . BYTE PARAMETER 8
|
||||
2 FALSE. . . . . . . . LITERALLY 27 195 222 245
|
||||
29 FARC . . . . . . . . LITERALLY 135 140
|
||||
3 0000H 33 FCB. . . . . . . . . BYTE ARRAY(33) EXTERNAL(0) 230 232
|
||||
73 0002H 2 FCBADR . . . . . . . WORD
|
||||
67 0000H 2 FCBADR . . . . . . . WORD PARAMETER 68
|
||||
29 FCR. . . . . . . . . LITERALLY
|
||||
29 FDIRSYS. . . . . . . LITERALLY 125 226
|
||||
29 FDISKMAP . . . . . . LITERALLY
|
||||
29 FDRVUSR. . . . . . . LITERALLY 230 235
|
||||
29 FDRVUSR2 . . . . . . LITERALLY
|
||||
29 FEX. . . . . . . . . LITERALLY 235
|
||||
2 FF . . . . . . . . . LITERALLY 182 380
|
||||
33 0000H 2 FIADR. . . . . . . . WORD EXTERNAL(22) 36 105 106 107 118 120 123 125 129
|
||||
135 140 143 146 149 152 158 161 249 250 252 255 258 259
|
||||
260 268 269 272 273 281 282 316 317 348
|
||||
38 0000H 2 FIINDICES. . . . . . WORD BASED(FIINDICESBASE) ARRAY(1) 249 252
|
||||
38 0000H 2 FIINDICESBASE. . . . WORD EXTERNAL(26) 38 249 252
|
||||
27 000AH 1 FILEDISPLAYED. . . . BYTE PUBLIC INITIAL 413
|
||||
36 0000H 23 FILEINFO . . . . . . STRUCTURE BASED(FIADR) 105 106 107 118 120 123 125 129
|
||||
135 140 143 146 149 152 158 161 250 258 259 260 269 272
|
||||
273 282 317 348 349
|
||||
20 0000H 2 FILESFOUND . . . . . WORD EXTERNAL(14) 250 254
|
||||
109 0016H 1 FILESPERLINE . . . . BYTE 199 231 266 267 280 284 315
|
||||
24 0000H 8 FIND . . . . . . . . STRUCTURE EXTERNAL(15) 226 269 282 317
|
||||
21 FINDSTRUCTURE. . . . LITERALLY 24
|
||||
34 FINFOSTRUCTURE . . . LITERALLY 36
|
||||
33 0000H 2 FIRSTFIADR . . . . . WORD EXTERNAL(24) 348
|
||||
179 0017H 1 FIRSTTITLE . . . . . BYTE INITIAL 183 195
|
||||
29 FNAME. . . . . . . . LITERALLY 237 238
|
||||
29 FNAME2 . . . . . . . LITERALLY
|
||||
49 0000H 2 FNAMEADR . . . . . . WORD PARAMETER 50
|
||||
197 0004H 2 FNAMEADR . . . . . . WORD PARAMETER AUTOMATIC 198 213
|
||||
29 FNAMELEN . . . . . . LITERALLY
|
||||
2 FOREVER. . . . . . . LITERALLY
|
||||
25 0000H 1 FORMAT . . . . . . . BYTE EXTERNAL(16) 265 352 357 375
|
||||
25 0000H 1 FORMFEEDS. . . . . . BYTE EXTERNAL(19) 181 377 414
|
||||
PL/M-86 COMPILER SDIR - DISPLAY FILES PAGE 15
|
||||
|
||||
|
||||
26 FORMFULL . . . . . . LITERALLY
|
||||
26 FORMSHORT. . . . . . LITERALLY 375
|
||||
26 FORMSIZE . . . . . . LITERALLY 265
|
||||
29 FRC. . . . . . . . . LITERALLY
|
||||
29 FRREC. . . . . . . . LITERALLY
|
||||
29 FRRECO . . . . . . . LITERALLY
|
||||
29 FRW. . . . . . . . . LITERALLY 129 226
|
||||
29 FS1. . . . . . . . . LITERALLY
|
||||
29 FTYPE. . . . . . . . LITERALLY
|
||||
29 FTYPE2 . . . . . . . LITERALLY
|
||||
29 FTYPELEN . . . . . . LITERALLY
|
||||
243 03A9H 141 GETNXTFILEINFO . . . PROCEDURE STACK=0006H 276 311 341 351
|
||||
102 000CH 1 GLOBALLINECOUNT. . . BYTE INITIAL
|
||||
36 0013H 2 HASHLINK . . . . . . WORD MEMBER(FILEINFO)
|
||||
103 0002H 1 HBYTE. . . . . . . . BYTE MEMBER(TOTAL1KBLOCKS) 347
|
||||
103 0002H 1 HBYTE. . . . . . . . BYTE MEMBER(TOTALKBYTES) 346
|
||||
103 0002H 1 HBYTE. . . . . . . . BYTE MEMBER(TOTALRECS) 346
|
||||
111 0000H 40 HDR. . . . . . . . . BYTE ARRAY(40) DATA 296 298 324
|
||||
115 008EH 17 HDRACCESS. . . . . . BYTE ARRAY(17) DATA 327
|
||||
112 0028H 40 HDRBARS. . . . . . . BYTE ARRAY(40) DATA 300 302 330
|
||||
116 009FH 17 HDRCREATE. . . . . . BYTE ARRAY(17) DATA 328
|
||||
113 0050H 23 HDRPU. . . . . . . . BYTE ARRAY(23) DATA 325
|
||||
114 0067H 39 HDRXFCBBARS. . . . . BYTE ARRAY(39) DATA 331
|
||||
80 0000H 2 INDEX. . . . . . . . WORD PARAMETER 81
|
||||
242 0008H 2 INDEX. . . . . . . . WORD 248 249 250 251 252 254 350
|
||||
36 000EH 2 KBYTES . . . . . . . WORD MEMBER(FILEINFO) 105 120 273
|
||||
33 0000H 2 LASTFIADR. . . . . . WORD EXTERNAL(23) 349
|
||||
242 0006H 2 LASTPLUSONE. . . . . WORD 255 259 268 281 316 349
|
||||
2 LF . . . . . . . . . LITERALLY 393 409
|
||||
2 LIT. . . . . . . . . LITERALLY 2 15 21 23 26 29 30 31 32 34 35
|
||||
83
|
||||
103 0000H 2 LWORD. . . . . . . . WORD MEMBER(TOTAL1KBLOCKS) 347
|
||||
103 0000H 2 LWORD. . . . . . . . WORD MEMBER(TOTALRECS) 346
|
||||
103 0000H 2 LWORD. . . . . . . . WORD MEMBER(TOTALKBYTES) 346
|
||||
72 0000H MATCH. . . . . . . . PROCEDURE BYTE EXTERNAL(39) STACK=0000H 236
|
||||
3 0000H 2 MAXB . . . . . . . . WORD EXTERNAL(1)
|
||||
22 MAXSEARCHFILES . . . LITERALLY
|
||||
25 0000H 1 MESSAGE. . . . . . . BYTE EXTERNAL(18) 405
|
||||
4 0000H MON1 . . . . . . . . PROCEDURE EXTERNAL(3) STACK=0000H
|
||||
7 0000H MON2 . . . . . . . . PROCEDURE BYTE EXTERNAL(4) STACK=0000H 91
|
||||
10 0000H MON3 . . . . . . . . PROCEDURE WORD EXTERNAL(5) STACK=0000H
|
||||
15 MPM. . . . . . . . . LITERALLY
|
||||
15 MPM86. . . . . . . . LITERALLY
|
||||
80 0000H MULT23 . . . . . . . PROCEDURE WORD EXTERNAL(42) STACK=0000H 249 252
|
||||
36 0001H 8 NAME . . . . . . . . BYTE ARRAY(8) MEMBER(FILEINFO) 118 125 129 135 140 143 146
|
||||
149 152 269 272 282 317
|
||||
225 0000H 1 NAME . . . . . . . . BYTE BASED(NAMEADR) ARRAY(1) 226
|
||||
224 0004H 2 NAMEADR. . . . . . . WORD PARAMETER AUTOMATIC 225 226
|
||||
24 0006H 1 NONXFCB. . . . . . . BYTE MEMBER(FIND) 269 282 317
|
||||
2 NOPAGEMODEOFFSET . . LITERALLY
|
||||
216 0006H 1 OFF. . . . . . . . . BYTE PARAMETER AUTOMATIC 217 218
|
||||
83 OFFSETW. . . . . . . LITERALLY
|
||||
216 0004H 1 ON . . . . . . . . . BYTE PARAMETER AUTOMATIC 217 220
|
||||
36 000CH 2 ONEKBLOCKS . . . . . WORD MEMBER(FILEINFO) 107
|
||||
14 0000H 1 OS . . . . . . . . . BYTE EXTERNAL(8)
|
||||
55 0000H P3BYTE . . . . . . . PROCEDURE EXTERNAL(33) STACK=0000H 123 387 390 394
|
||||
25 0000H 2 PAGELEN. . . . . . . WORD EXTERNAL(17) 201 287 319 377
|
||||
PL/M-86 COMPILER SDIR - DISPLAY FILES PAGE 16
|
||||
|
||||
|
||||
2 PAGELENOFFSET. . . . LITERALLY
|
||||
24 0004H 1 PASS . . . . . . . . BYTE MEMBER(FIND)
|
||||
30 PASSLEN. . . . . . . LITERALLY
|
||||
37 0008H 1 PASSMODE . . . . . . BYTE MEMBER(XFCBINFO) 162 164 166
|
||||
52 0000H PDECIMAL . . . . . . PROCEDURE EXTERNAL(32) STACK=0000H 120 191 273 392 399 401
|
||||
32 PMDELETE . . . . . . LITERALLY 166
|
||||
32 PMREAD . . . . . . . LITERALLY 162
|
||||
32 PMWRITE. . . . . . . LITERALLY 164
|
||||
55 0000H 2 PREC . . . . . . . . WORD PARAMETER 56
|
||||
52 0000H 2 PREC . . . . . . . . WORD PARAMETER 53
|
||||
42 0000H PRINT. . . . . . . . PROCEDURE EXTERNAL(28) STACK=0000H 126 127 130 131 136 137
|
||||
163 165 167 168 172 185 190 212 274 296 298 300 302 324
|
||||
325 327 328 330 331 354 365 386 389 391 393 395 409
|
||||
45 0000H PRINTB . . . . . . . PROCEDURE EXTERNAL(29) STACK=0000H 119 122 124 128 132 142
|
||||
145 148 151 154 160 169 173 174 211 285 297 301 398
|
||||
39 0000H PRINTCHAR. . . . . . PROCEDURE EXTERNAL(27) STACK=0000H 121 141 144 147 150 153
|
||||
182 186 187 209 379 380 388 396 397 400
|
||||
49 0000H PRINTFN. . . . . . . PROCEDURE EXTERNAL(31) STACK=0000H 118 213
|
||||
36 0012H 1 RECSHBYTE. . . . . . BYTE MEMBER(FILEINFO)
|
||||
36 0010H 2 RECSLWORD. . . . . . WORD MEMBER(FILEINFO) 106 123
|
||||
224 02EEH 49 RIGHTATTRIBUTES. . . PROCEDURE BYTE STACK=0010H 237 269 282 317
|
||||
244 0019H 1 RIGHTUSR . . . . . . BYTE 245
|
||||
24 0002H 1 RO . . . . . . . . . BYTE MEMBER(FIND) 226
|
||||
ROL. . . . . . . . . BUILTIN 125 129 135 140 143 146 149 152
|
||||
24 0003H 1 RW . . . . . . . . . BYTE MEMBER(FIND) 226
|
||||
67 0000H SEARCHFIRST. . . . . PROCEDURE BYTE EXTERNAL(37) STACK=0000H 232
|
||||
70 0000H SEARCHNEXT . . . . . PROCEDURE BYTE EXTERNAL(38) STACK=0000H 239
|
||||
23 SEARCHSTRUCTURE. . . LITERALLY
|
||||
2 SECTORLEN. . . . . . LITERALLY
|
||||
SHL. . . . . . . . . BUILTIN 234
|
||||
228 031FH 138 SHORTDIR . . . . . . PROCEDURE STACK=0014H 358
|
||||
197 0270H 81 SHORTDISPLAY . . . . PROCEDURE STACK=0010H 238 272
|
||||
64 0000H SHR3BYTE . . . . . . PROCEDURE EXTERNAL(36) STACK=0000H
|
||||
SIZE . . . . . . . . BUILTIN 258 260 348 349
|
||||
264 0436H 122 SIZEDISPLAY. . . . . PROCEDURE STACK=0016H 359
|
||||
19 0000H 1 SORTED . . . . . . . BYTE EXTERNAL(13) 246
|
||||
83 SPTW . . . . . . . . LITERALLY
|
||||
42 0000H 2 STRINGADR. . . . . . WORD PARAMETER 43
|
||||
24 0001H 1 SYS. . . . . . . . . BYTE MEMBER(FIND) 226
|
||||
2 TAB. . . . . . . . . LITERALLY
|
||||
78 0000H TERMINATE. . . . . . PROCEDURE EXTERNAL(41) STACK=0000H 100 355 366
|
||||
216 02C1H 45 TESTATT. . . . . . . PROCEDURE BYTE STACK=0008H 226
|
||||
103 0013H 3 TOTAL1KBLOCKS. . . . STRUCTURE 107 347 394
|
||||
103 000DH 3 TOTALKBYTES. . . . . STRUCTURE 105 346 387
|
||||
103 0010H 3 TOTALRECS. . . . . . STRUCTURE 106 346 390
|
||||
2 TRUE . . . . . . . . LITERALLY 120 179 191 219 221 273 392 399 401 413
|
||||
75 0000H 2 TSADR. . . . . . . . WORD PARAMETER 76
|
||||
36 0009H 3 TYPE . . . . . . . . BYTE ARRAY(3) MEMBER(FILEINFO)
|
||||
37 0004H 4 UPDATE . . . . . . . BYTE ARRAY(4) MEMBER(XFCBINFO) 170 171
|
||||
16 0000H 2 USEDDE . . . . . . . WORD EXTERNAL(10) 399
|
||||
36 0000H 1 USR. . . . . . . . . BYTE MEMBER(FILEINFO) 250 259
|
||||
52 0000H 2 V. . . . . . . . . . WORD PARAMETER 53
|
||||
93 000FH 28 WAITKEYPRESS . . . . PROCEDURE STACK=000CH
|
||||
58 0000H 2 WORDAMT. . . . . . . WORD PARAMETER 59
|
||||
24 0005H 1 XFCB . . . . . . . . BYTE MEMBER(FIND) 269 282 317
|
||||
37 0000H 9 XFCBINFO . . . . . . STRUCTURE BASED(XIADR) 162 164 166 170 171 175 176
|
||||
30 XFCBTYPE . . . . . . LITERALLY
|
||||
PL/M-86 COMPILER SDIR - DISPLAY FILES PAGE 17
|
||||
|
||||
|
||||
30 XFCREATE . . . . . . LITERALLY
|
||||
30 XFPASS . . . . . . . LITERALLY
|
||||
30 XFPASSMODE . . . . . LITERALLY
|
||||
30 XFUPDATE . . . . . . LITERALLY
|
||||
37 0000H 2 XIADR. . . . . . . . WORD EXTERNAL(25) 37 161 162 164 166 170 171 175 176
|
||||
36 0015H 2 XIADR. . . . . . . . WORD MEMBER(FILEINFO) 158 161 269 282 317
|
||||
35 XINFOSTRUCTURE . . . LITERALLY 37
|
||||
52 0000H 1 ZEROSUP. . . . . . . BYTE PARAMETER 53
|
||||
|
||||
|
||||
|
||||
MODULE INFORMATION:
|
||||
|
||||
CODE AREA SIZE = 07CCH 1996D
|
||||
CONSTANT AREA SIZE = 01CDH 461D
|
||||
VARIABLE AREA SIZE = 001AH 26D
|
||||
MAXIMUM STACK SIZE = 001AH 26D
|
||||
667 LINES READ
|
||||
0 PROGRAM ERROR(S)
|
||||
|
||||
END OF PL/M-86 COMPILATION
|
||||
@@ -0,0 +1,525 @@
|
||||
$title ('SDIR - Display Files')
|
||||
display:
|
||||
do;
|
||||
/* Display Module for SDIR */
|
||||
|
||||
$include(comlit.lit)
|
||||
|
||||
$include(mon.plm)
|
||||
|
||||
dcl (cur$drv, cur$usr) byte external;
|
||||
|
||||
dcl (os,bdos) byte external;
|
||||
$include(vers.lit)
|
||||
|
||||
dcl used$de address external; /* number of used directory entries */
|
||||
dcl date$opt boolean external; /* date option flag */
|
||||
dcl display$attributes boolean external; /* attributes display flag */
|
||||
dcl sorted boolean external;
|
||||
dcl filesfound address external;
|
||||
|
||||
$include (search.lit)
|
||||
dcl find find$structure external;
|
||||
|
||||
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 */
|
||||
|
||||
$include(format.lit)
|
||||
|
||||
dcl file$displayed boolean public initial (false);
|
||||
/* true if we ever display a file, from any drive or user */
|
||||
/* used by main.plm for file not found message */
|
||||
|
||||
dcl dir$label byte external;
|
||||
|
||||
$include(fcb.lit)
|
||||
$include(xfcb.lit)
|
||||
|
||||
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,first$f$i$adr) address external,
|
||||
cur$file address; /* number of file currently */
|
||||
/* being displayed */
|
||||
|
||||
$include(finfo.lit)
|
||||
/* structure of file info */
|
||||
dcl file$info based f$i$adr f$info$structure;
|
||||
|
||||
dcl x$i$adr address external,
|
||||
xfcb$info based x$i$adr x$info$structure;
|
||||
|
||||
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 */
|
||||
|
||||
|
||||
/* -------- Routines in util.plm -------- */
|
||||
|
||||
printchar: procedure (char) external;
|
||||
dcl char byte;
|
||||
end printchar;
|
||||
|
||||
print: procedure (string$adr) external; /* BDOS call # 9 */
|
||||
dcl string$adr address;
|
||||
end print;
|
||||
|
||||
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;
|
||||
|
||||
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;
|
||||
|
||||
|
||||
/* -------- Routines in search.plm -------- */
|
||||
|
||||
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;*/
|
||||
|
||||
match: procedure boolean external;
|
||||
dcl fcb$adr address;
|
||||
end match;
|
||||
|
||||
|
||||
/* -------- Other external routines -------- */
|
||||
|
||||
display$time$stamp: procedure (ts$adr) external; /* in dts.plm */
|
||||
dcl ts$adr address;
|
||||
end display$time$stamp;
|
||||
|
||||
terminate: procedure external; /* in main.plm */
|
||||
end terminate;
|
||||
|
||||
mult23: procedure(index) address external; /* in sort.plm */
|
||||
dcl index address;
|
||||
end mult23;
|
||||
|
||||
|
||||
/* -------- From dpb86.plm or dpb80.plm -------- */
|
||||
|
||||
$include(dpb.lit)
|
||||
|
||||
dpb$byte: procedure (dpb$index) byte external;
|
||||
dcl dpb$index byte;
|
||||
end dpb$byte;
|
||||
|
||||
dpb$word: procedure (dpb$index) address external;
|
||||
dcl dpb$index byte;
|
||||
end dpb$word;
|
||||
|
||||
|
||||
/* -------- routines and data structures local to this module -------- */
|
||||
|
||||
direct$console$io: procedure byte;
|
||||
return mon2(6,0ffh); /* ff to stay downward compatable */
|
||||
end direct$console$io;
|
||||
|
||||
wait$keypress: procedure;
|
||||
declare char byte;
|
||||
char = direct$console$io;
|
||||
do while char = 0;
|
||||
char = direct$console$io;
|
||||
end;
|
||||
if char = ctrlc then
|
||||
call terminate;
|
||||
end wait$keypress;
|
||||
|
||||
declare global$line$count byte initial(1);
|
||||
|
||||
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;
|
||||
|
||||
call add3byte(.total$kbytes,file$info.kbytes);
|
||||
call add3byte3(.total$recs,.file$info.recs$lword); /* records in file */
|
||||
call add3byte(.total$1k$blocks,file$info.onekblocks);
|
||||
|
||||
end add$totals;
|
||||
|
||||
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);
|
||||
call printchar('k'); /* up to 32 Meg - Bytes */
|
||||
/* 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 not display$attributes then do;
|
||||
if rol(file$info.name(f$arc-1),1) then
|
||||
call print(.('Arcv $'));
|
||||
else
|
||||
call print(.(' $'));
|
||||
end;
|
||||
else do;
|
||||
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;
|
||||
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);
|
||||
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 then
|
||||
return(true);
|
||||
if (80h and char) = 80h and on 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),find.rw,find.ro) and
|
||||
test$att(name(f$dirsys-1),find.dir,find.sys);
|
||||
end right$attributes;
|
||||
|
||||
short$dir: procedure; /* looks like "DIR" command */
|
||||
dcl dcnt byte;
|
||||
fcb(f$drvusr) = '?';
|
||||
files$per$line = 4;
|
||||
dcnt = search$first(.fcb);
|
||||
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) = 0 and
|
||||
buf$fcb(f$ex)<= dpb$byte(extmsk$b) 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 (last$plus$one,index) address;
|
||||
|
||||
getnxt$file$info: procedure; /* set f$i$adr to base file$info on file */
|
||||
dcl right$usr boolean; /* to be displayed, f$i$adr = 0ffffh if end */
|
||||
right$usr = false;
|
||||
if sorted then
|
||||
do; index = index + 1;
|
||||
f$i$adr = mult23(f$i$indices(index));
|
||||
do while file$info.usr <> cur$usr and index <> filesfound;
|
||||
index = index + 1;
|
||||
f$i$adr = mult23(f$i$indices(index));
|
||||
end;
|
||||
if index = files$found then
|
||||
f$i$adr = last$plus$one; /* no more files */
|
||||
end;
|
||||
else /* not sorted display in order found in directory */
|
||||
do; /* use last$plus$one to avoid wrap around problems */
|
||||
f$i$adr = f$i$adr + size(file$info);
|
||||
do while file$info.usr <> cur$usr and f$i$adr <> last$plus$one;
|
||||
f$i$adr = f$i$adr + size(file$info);
|
||||
end;
|
||||
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 <> last$plus$one;
|
||||
if ((file$info.x$i$adr <> 0 and find.xfcb) or
|
||||
file$info.x$i$adr = 0 and find.nonxfcb) and
|
||||
right$attributes(.file$info.name(0)) then
|
||||
do;
|
||||
call 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 <> last$plus$one; /* Do all valid files */
|
||||
if ((file$info.x$i$adr <> 0 and find.xfcb) or
|
||||
(file$info.x$i$adr = 0 and find.nonxfcb)) and
|
||||
right$attributes(.file$info.name(0)) then
|
||||
do;
|
||||
if cur$file mod files$per$line <> 0 then call printb;
|
||||
else do; /* need a new line */
|
||||
if cur$line mod page$len <> 0 then do; /* just crlf */
|
||||
call crlf;
|
||||
cur$line = cur$line + 1;
|
||||
end;
|
||||
else do; /* print header */
|
||||
call crlf;
|
||||
call display$title; call crlf;
|
||||
call print(.hdr); call printb; call print(.hdr);
|
||||
call crlf;
|
||||
call print(.hdr$bars); call printb; call print(.hdr$bars);
|
||||
call crlf;
|
||||
cur$line = cur$line + 3;
|
||||
end;
|
||||
end;
|
||||
call display$file$info;
|
||||
cur$file = cur$file + 1;
|
||||
call add$totals;
|
||||
end;
|
||||
call getnxt$file$info;
|
||||
end;/* do loop */
|
||||
end display$no$dirlabel;
|
||||
|
||||
display$with$dirlabel: procedure;
|
||||
files$per$line = 1;
|
||||
do while f$i$adr <> last$plus$one; /* Display the file info */
|
||||
if ((file$info.x$i$adr <> 0 and find.xfcb) or
|
||||
(file$info.x$i$adr = 0 and find.nonxfcb)) and
|
||||
right$attributes(.file$info.name(0)) then
|
||||
do;
|
||||
if cur$line mod page$len = 0 then do; /* display the header */
|
||||
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; /* header display */
|
||||
call crlf;
|
||||
call display$file$info; /* display non bdos 3.0 file info */
|
||||
call display$xfcb$info;
|
||||
cur$file = cur$file+1; cur$line = cur$line+1;
|
||||
call add$totals;
|
||||
end;
|
||||
call getnxt$file$info;
|
||||
end;
|
||||
end display$with$dirlabel;
|
||||
|
||||
|
||||
display$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 = first$f$i$adr - size(file$info); /* initial if no sort */
|
||||
last$plus$one = last$f$i$adr + size(file$info);
|
||||
index = 0ffffh; /* initial if sorted */
|
||||
call getnxt$file$info; /* base file info record */
|
||||
|
||||
if format > 2 then
|
||||
do;
|
||||
call print(.('Illegal Format Value$'));
|
||||
call terminate; /* default could be patched - watch it */
|
||||
end;
|
||||
|
||||
do case format; /* format = */
|
||||
call short$dir; /* form$short */
|
||||
call size$display; /* form$size */
|
||||
/* form = full */
|
||||
if date$opt then do;
|
||||
if ((( dir$label and dl$exists) <> 0 ) and
|
||||
((( dir$label and dl$access) <> 0 ) or
|
||||
(( dir$label and dl$update) <> 0 ) or
|
||||
(( dir$label and dl$makexfcb) <> 0 ))) then
|
||||
call display$with$dirlabel; /* Timestamping is active! */
|
||||
else do;
|
||||
call print(.('Date and Time Stamping Inactive$'));
|
||||
call terminate;
|
||||
end;
|
||||
end;
|
||||
else do; /* No date option; Regular Full display */
|
||||
if (dir$label and dl$exists) <> 0 then
|
||||
call display$with$dirlabel;
|
||||
else
|
||||
call display$no$dirlabel;
|
||||
end;
|
||||
end; /* end of case */
|
||||
if format <> form$short and cur$file > 0 then /* print totals */
|
||||
do;
|
||||
if 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$word(dirmax$w) + 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;
|
||||
end;
|
||||
else do;
|
||||
file$displayed = true;
|
||||
if not formfeeds then
|
||||
call crlf;
|
||||
end;
|
||||
|
||||
end display$files;
|
||||
|
||||
end display;
|
||||
|
||||
@@ -0,0 +1,13 @@
|
||||
|
||||
/* indices into disk parameter block, used as parameters to dpb procedure */
|
||||
|
||||
dcl spt$w lit '0',
|
||||
blkshf$b lit '2',
|
||||
blkmsk$b lit '3',
|
||||
extmsk$b lit '4',
|
||||
blkmax$w lit '5',
|
||||
dirmax$w lit '7',
|
||||
dirblk$w lit '9',
|
||||
chksiz lit '11',
|
||||
offset$w lit '13';
|
||||
|
||||
@@ -0,0 +1,157 @@
|
||||
PL/M-86 COMPILER SDIR 8086 - GET DISK PARAMETERS PAGE 1
|
||||
|
||||
|
||||
ISIS-II PL/M-86 V2.0 COMPILATION OF MODULE DPB86
|
||||
OBJECT MODULE PLACED IN DPB86
|
||||
COMPILER INVOKED BY: :F0: DPB86.PLM DEBUG OBJECT(DPB86) OPTIMIZE(3) XREF
|
||||
|
||||
|
||||
|
||||
$compact
|
||||
$title ('SDIR 8086 - Get Disk Parameters')
|
||||
1 dpb86:
|
||||
do;
|
||||
/* the purpose of this module is to allow independence */
|
||||
/* of processor, i.e., 8080 or 8086 */
|
||||
|
||||
$include (comlit.lit)
|
||||
=
|
||||
2 1 = declare
|
||||
= lit literally 'literally',
|
||||
= dcl lit 'declare',
|
||||
= true lit '0ffh',
|
||||
= false lit '0',
|
||||
= boolean lit 'byte',
|
||||
= forever lit 'while true',
|
||||
= cr lit '13',
|
||||
= lf lit '10',
|
||||
= tab lit '9',
|
||||
= ctrlc lit '3',
|
||||
= ff lit '12',
|
||||
= page$len$offset lit '1ch',
|
||||
= nopage$mode$offset lit '2Ch',
|
||||
= sectorlen lit '128';
|
||||
|
||||
/* function call 32 in 2.0 or later BDOS, returns the address of the disk
|
||||
parameter block for the currently selected disk, which consists of:
|
||||
spt (2 bytes) number of sectors per track
|
||||
blkshf (1 byte) block size = shl(double(128),blkshf)
|
||||
blkmsk (1 byte) sector# and blkmsk = block number
|
||||
extmsk (1 byte) logical/physical extents
|
||||
blkmax (2 bytes) max alloc number
|
||||
dirmax (2 bytes) size of directory-1
|
||||
dirblk (2 bytes) reservation bits for directory
|
||||
chksiz (2 bytes) size of checksum vector
|
||||
offset (2 bytes) offset for operating system
|
||||
*/
|
||||
|
||||
$include(dpb.lit)
|
||||
=
|
||||
= /* indices into disk parameter block, used as parameters to dpb procedure */
|
||||
=
|
||||
3 1 = dcl spt$w lit '0',
|
||||
= blkshf$b lit '2',
|
||||
= blkmsk$b lit '3',
|
||||
= extmsk$b lit '4',
|
||||
= blkmax$w lit '5',
|
||||
= dirmax$w lit '7',
|
||||
= dirblk$w lit '9',
|
||||
= chksiz lit '11',
|
||||
= offset$w lit '13';
|
||||
PL/M-86 COMPILER SDIR 8086 - GET DISK PARAMETERS PAGE 2
|
||||
|
||||
|
||||
=
|
||||
|
||||
4 1 declare k$per$block byte public;
|
||||
5 1 declare dpb$base pointer;
|
||||
6 1 declare dpb$array based dpb$base (15) byte;
|
||||
|
||||
7 1 mon4: procedure (f,a) pointer external;
|
||||
8 2 dcl f byte, a address;
|
||||
9 2 end mon4;
|
||||
|
||||
10 1 dcl get$dpb lit '31';
|
||||
|
||||
11 1 dpb$byte: procedure(param) byte public;
|
||||
12 2 dcl param byte;
|
||||
13 2 return(dpb$array(param));
|
||||
14 2 end dpb$byte;
|
||||
|
||||
15 1 dpb$word: procedure(param) address public;
|
||||
16 2 dcl param byte;
|
||||
17 2 return(dpb$array(param) + shl(double(dpb$array(param+1)),8));
|
||||
18 2 end dpb$word;
|
||||
|
||||
19 1 base$dpb: procedure public;
|
||||
20 2 dpb$base = mon4(get$dpb,0);
|
||||
21 2 k$per$block = shr(dpb$byte(blkmsk$b)+1 ,3);
|
||||
22 2 end base$dpb;
|
||||
|
||||
23 1 end dpb86;
|
||||
PL/M-86 COMPILER SDIR 8086 - GET DISK PARAMETERS PAGE 3
|
||||
|
||||
|
||||
CROSS-REFERENCE LISTING
|
||||
-----------------------
|
||||
|
||||
|
||||
DEFN ADDR SIZE NAME, ATTRIBUTES, AND REFERENCES
|
||||
----- ------ ----- --------------------------------
|
||||
|
||||
|
||||
7 0000H 2 A. . . . . . . . . WORD PARAMETER 8
|
||||
19 003AH 38 BASEDPB. . . . . . PROCEDURE PUBLIC STACK=0008H
|
||||
3 BLKMAXW. . . . . . LITERALLY
|
||||
3 BLKMSKB. . . . . . LITERALLY 21
|
||||
3 BLKSHFB. . . . . . LITERALLY
|
||||
2 BOOLEAN. . . . . . LITERALLY
|
||||
3 CHKSIZ . . . . . . LITERALLY
|
||||
2 CR . . . . . . . . LITERALLY
|
||||
2 CTRLC. . . . . . . LITERALLY
|
||||
2 DCL. . . . . . . . LITERALLY
|
||||
3 DIRBLKW. . . . . . LITERALLY
|
||||
3 DIRMAXW. . . . . . LITERALLY
|
||||
DOUBLE . . . . . . BUILTIN 17
|
||||
1 0002H DPB86. . . . . . . PROCEDURE STACK=0000H
|
||||
6 0000H 15 DPBARRAY . . . . . BYTE BASED(DPBBASE) ARRAY(15) 13 17
|
||||
5 0000H 4 DPBBASE. . . . . . POINTER 6 13 17 20
|
||||
11 0002H 21 DPBBYTE. . . . . . PROCEDURE BYTE PUBLIC STACK=0004H 21
|
||||
15 0017H 35 DPBWORD. . . . . . PROCEDURE WORD PUBLIC STACK=0004H
|
||||
3 EXTMSKB. . . . . . LITERALLY
|
||||
7 0000H 1 F. . . . . . . . . BYTE PARAMETER 8
|
||||
2 FALSE. . . . . . . LITERALLY
|
||||
2 FF . . . . . . . . LITERALLY
|
||||
2 FOREVER. . . . . . LITERALLY
|
||||
10 GETDPB . . . . . . LITERALLY 20
|
||||
4 0004H 1 KPERBLOCK. . . . . BYTE PUBLIC 21
|
||||
2 LF . . . . . . . . LITERALLY
|
||||
2 LIT. . . . . . . . LITERALLY 2 3 10
|
||||
7 0000H MON4 . . . . . . . PROCEDURE POINTER EXTERNAL(0) STACK=0000H 20
|
||||
2 NOPAGEMODEOFFSET . LITERALLY
|
||||
3 OFFSETW. . . . . . LITERALLY
|
||||
2 PAGELENOFFSET. . . LITERALLY
|
||||
15 0004H 1 PARAM. . . . . . . BYTE PARAMETER AUTOMATIC 16 17
|
||||
11 0004H 1 PARAM. . . . . . . BYTE PARAMETER AUTOMATIC 12 13
|
||||
2 SECTORLEN. . . . . LITERALLY
|
||||
SHL. . . . . . . . BUILTIN 17
|
||||
SHR. . . . . . . . BUILTIN 21
|
||||
3 SPTW . . . . . . . LITERALLY
|
||||
2 TAB. . . . . . . . LITERALLY
|
||||
2 TRUE . . . . . . . LITERALLY
|
||||
|
||||
|
||||
|
||||
MODULE INFORMATION:
|
||||
|
||||
CODE AREA SIZE = 0060H 96D
|
||||
CONSTANT AREA SIZE = 0000H 0D
|
||||
VARIABLE AREA SIZE = 0005H 5D
|
||||
MAXIMUM STACK SIZE = 0008H 8D
|
||||
79 LINES READ
|
||||
PL/M-86 COMPILER SDIR 8086 - GET DISK PARAMETERS PAGE 4
|
||||
|
||||
|
||||
0 PROGRAM ERROR(S)
|
||||
|
||||
END OF PL/M-86 COMPILATION
|
||||
@@ -0,0 +1,50 @@
|
||||
$compact
|
||||
$title ('SDIR 8086 - Get Disk Parameters')
|
||||
dpb86:
|
||||
do;
|
||||
/* the purpose of this module is to allow independence */
|
||||
/* of processor, i.e., 8080 or 8086 */
|
||||
|
||||
$include (comlit.lit)
|
||||
|
||||
/* function call 32 in 2.0 or later BDOS, returns the address of the disk
|
||||
parameter block for the currently selected disk, which consists of:
|
||||
spt (2 bytes) number of sectors per track
|
||||
blkshf (1 byte) block size = shl(double(128),blkshf)
|
||||
blkmsk (1 byte) sector# and blkmsk = block number
|
||||
extmsk (1 byte) logical/physical extents
|
||||
blkmax (2 bytes) max alloc number
|
||||
dirmax (2 bytes) size of directory-1
|
||||
dirblk (2 bytes) reservation bits for directory
|
||||
chksiz (2 bytes) size of checksum vector
|
||||
offset (2 bytes) offset for operating system
|
||||
*/
|
||||
|
||||
$include(dpb.lit)
|
||||
|
||||
declare k$per$block byte public;
|
||||
declare dpb$base pointer;
|
||||
declare dpb$array based dpb$base (15) byte;
|
||||
|
||||
mon4: procedure (f,a) pointer external;
|
||||
dcl f byte, a address;
|
||||
end mon4;
|
||||
|
||||
dcl get$dpb lit '31';
|
||||
|
||||
dpb$byte: procedure(param) byte public;
|
||||
dcl param byte;
|
||||
return(dpb$array(param));
|
||||
end dpb$byte;
|
||||
|
||||
dpb$word: procedure(param) address public;
|
||||
dcl param byte;
|
||||
return(dpb$array(param) + shl(double(dpb$array(param+1)),8));
|
||||
end dpb$word;
|
||||
|
||||
base$dpb: procedure public;
|
||||
dpb$base = mon4(get$dpb,0);
|
||||
k$per$block = shr(dpb$byte(blkmsk$b)+1 ,3);
|
||||
end base$dpb;
|
||||
|
||||
end dpb86;
|
||||
@@ -0,0 +1,22 @@
|
||||
|
||||
declare
|
||||
f$drvusr lit '0', /* drive/user byte */
|
||||
f$name lit '1', /* file name */
|
||||
f$namelen lit '8', /* file name length */
|
||||
f$type lit '9', /* file type field */
|
||||
f$typelen lit '3', /* type length */
|
||||
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', /* extent */
|
||||
f$s1 lit '13', /* module byte */
|
||||
f$rc lit '15', /* record count */
|
||||
f$diskmap lit '16', /* file disk map */
|
||||
diskmaplen lit '16', /* disk map length */
|
||||
f$drvusr2 lit '16', /* fcb2 */
|
||||
f$name2 lit '17',
|
||||
f$type2 lit '25',
|
||||
f$cr lit '32', /* current record */
|
||||
f$rrec lit '33', /* random record */
|
||||
f$rreco lit '35'; /* " " overflow */
|
||||
|
||||
@@ -0,0 +1,15 @@
|
||||
|
||||
/* file info record for SDIR - note if this structure changes in size */
|
||||
/* the multXX: routine in the sort.plm module must also change */
|
||||
|
||||
declare
|
||||
f$info$structure lit 'structure(
|
||||
usr byte, name (8) byte, type (3) byte, onekblocks address,
|
||||
kbytes address, recs$lword address, recs$hbyte byte,
|
||||
hash$link address, x$i$adr address)';
|
||||
declare
|
||||
x$info$structure lit 'structure (
|
||||
create (4) byte,
|
||||
update (4) byte,
|
||||
passmode byte)';
|
||||
|
||||
@@ -0,0 +1,5 @@
|
||||
|
||||
dcl form$short lit '0', /* format values for SDIR */
|
||||
form$size lit '1',
|
||||
form$full lit '2';
|
||||
|
||||
@@ -0,0 +1,12 @@
|
||||
comlit.lit)
|
||||
copyrt.lit)
|
||||
dpb.lit)
|
||||
fcb.lit)
|
||||
finfo.lit)
|
||||
format.lit)
|
||||
main.plm)
|
||||
mon.plm)
|
||||
scan.lit)
|
||||
search.lit)
|
||||
vers.lit)
|
||||
xfcb.lit)
|
||||
@@ -0,0 +1,601 @@
|
||||
|
||||
/* C P / M - M P / M D I R E C T O R Y C O M M O N (SDIR) */
|
||||
|
||||
/* B E G I N N I N G O F C O M M O N M A I N M O D U L E */
|
||||
|
||||
|
||||
/* This module is included in main80.plm or main86.plm. */
|
||||
/* The differences between 8080 and 8086 versions are */
|
||||
/* contained in the modules main80.plm, main86.plm and */
|
||||
/* dpb80.plm, dpb86.plm and the submit files showing */
|
||||
/* the different link and location addresses. */
|
||||
|
||||
/* REVISION history:
|
||||
/* Nov 82 Bill Fitler: convert from CP/M Plus to Concurrent CP/M-86 */
|
||||
/* Feb 83 F.Borda: Took out paging and breaking to allow type-ahead. */
|
||||
|
||||
$include (comlit.lit)
|
||||
$include (mon.plm)
|
||||
|
||||
|
||||
|
||||
/* Scanner Entry Points in scan.plm */
|
||||
|
||||
scan: procedure(pcb$adr) external;
|
||||
declare pcb$adr address;
|
||||
end scan;
|
||||
|
||||
scan$init: procedure(pcb$adr) external;
|
||||
declare pcb$adr address;
|
||||
end scan$init;
|
||||
|
||||
/* -------- Routines in other modules -------- */
|
||||
|
||||
search$init: procedure external; /* initialization of search.plm */
|
||||
end search$init;
|
||||
|
||||
get$files: procedure external; /* entry to search.plm */
|
||||
end get$files;
|
||||
|
||||
sort: procedure external; /* entry to sort.plm */
|
||||
end sort;
|
||||
|
||||
mult23: procedure (num) address external; /* in sort.plm */
|
||||
dcl num address;
|
||||
end mult23;
|
||||
|
||||
display$files: procedure external; /* entry to disp.plm */
|
||||
end display$files;
|
||||
|
||||
/* -------- Routines in util.plm -------- */
|
||||
|
||||
printb: procedure external;
|
||||
end printb;
|
||||
|
||||
print$char: procedure(c) external;
|
||||
dcl c byte;
|
||||
end print$char;
|
||||
|
||||
print: procedure(string$adr) external;
|
||||
dcl string$adr address;
|
||||
end print;
|
||||
|
||||
crlf: procedure external;
|
||||
end crlf;
|
||||
|
||||
p$decimal: procedure(value,fieldsize,zsup) external;
|
||||
dcl value address,
|
||||
fieldsize address,
|
||||
zsup boolean;
|
||||
end p$decimal;
|
||||
|
||||
|
||||
/* ------------------------------------- */
|
||||
|
||||
dcl debug boolean public initial (false);
|
||||
|
||||
/* -------- version information -------- */
|
||||
|
||||
dcl plmstart label public;
|
||||
|
||||
dcl (os,bdos) byte public;
|
||||
$include (vers.lit)
|
||||
|
||||
$include (fcb.lit)
|
||||
|
||||
$include(search.lit)
|
||||
|
||||
dcl find find$structure public initial
|
||||
(false,false,false,false, false,false,false,false);
|
||||
|
||||
dcl
|
||||
num$search$files byte public initial(0),
|
||||
no$page$mode byte public initial(0),
|
||||
search (max$search$files) search$structure public;
|
||||
|
||||
dcl first$f$i$adr address external;
|
||||
dcl get$all$dir$entries boolean public;
|
||||
dcl first$pass boolean public;
|
||||
|
||||
dcl usr$vector address public initial(0), /* bits for user #s to scan */
|
||||
active$usr$vector address public, /* active users on curdrv */
|
||||
drv$vector address initial (0); /* bits for drives to scan */
|
||||
|
||||
$include (format.lit)
|
||||
|
||||
dcl format byte public initial (form$full),
|
||||
page$len address public initial (0ffffh),
|
||||
/* lines on a page before printing new headers, 0 forces initial hdrs */
|
||||
message boolean public initial(false),/* show titles when no files found*/
|
||||
formfeeds boolean public initial(false),/* use form feeds */
|
||||
date$opt boolean public initial(false), /* dates display */
|
||||
display$attributes boolean public initial(false); /* attributes display */
|
||||
|
||||
dcl file$displayed boolean external;
|
||||
/* true if 1 or more files displayed by dsh.plm */
|
||||
|
||||
dcl sort$op boolean initial (true); /* default is to do sorting */
|
||||
dcl sorted boolean external; /* if successful sort */
|
||||
|
||||
|
||||
dcl cur$usr byte public, /* current user being searched */
|
||||
cur$drv byte public; /* current drive " " */
|
||||
|
||||
/* -------- BDOS calls --------- */
|
||||
|
||||
get$version: procedure address; /* returns current version information */
|
||||
return mon3(12,0);
|
||||
end get$version;
|
||||
|
||||
select$drive: procedure(d);
|
||||
declare d byte;
|
||||
call mon1(14,d);
|
||||
end select$drive;
|
||||
|
||||
search$first: procedure(d) byte external;
|
||||
dcl d address;
|
||||
end search$first;
|
||||
|
||||
search$next: procedure byte external;
|
||||
end search$next;
|
||||
|
||||
get$cur$drv: procedure byte; /* return current drive number */
|
||||
return mon2(25,0);
|
||||
end get$cur$drv;
|
||||
|
||||
getlogin: procedure address; /* get the login vector */
|
||||
return mon3(24,0);
|
||||
end getlogin;
|
||||
|
||||
getusr: procedure byte; /* return current user number */
|
||||
return mon2(32,0ffh);
|
||||
end getusr;
|
||||
|
||||
/**************************************************** commented out whf
|
||||
getscbbyte: procedure (offset) byte;
|
||||
declare offset byte;
|
||||
declare scbpb structure
|
||||
(offset byte,
|
||||
set byte,
|
||||
value address);
|
||||
scbpb.offset = offset;
|
||||
scbpb.set = 0;
|
||||
return mon2(49,.scbpb);
|
||||
end getscbbyte;
|
||||
******************************************************/
|
||||
|
||||
set$console$mode: procedure;
|
||||
/* set console mode to control-c only */
|
||||
/********* call mon1(109,1); ********whf************/
|
||||
;
|
||||
end set$console$mode;
|
||||
|
||||
terminate: procedure public;
|
||||
call mon1 (0,0);
|
||||
end terminate;
|
||||
|
||||
|
||||
/* -------- Utility routines -------- */
|
||||
|
||||
number: procedure (char) boolean;
|
||||
dcl char byte;
|
||||
return(char >= '0' and char <= '9');
|
||||
end number;
|
||||
|
||||
make$numeric: procedure(char$adr,len,val$adr) boolean;
|
||||
dcl (char$adr, val$adr, place) address,
|
||||
chars based char$adr (1) byte,
|
||||
value based val$adr address,
|
||||
(i,len) byte;
|
||||
|
||||
value = 0;
|
||||
place = 1;
|
||||
do i = 1 to len;
|
||||
if not number(chars(len - i)) then
|
||||
return(false);
|
||||
value = value + (chars(len - i) - '0') * place;
|
||||
place = place * 10;
|
||||
end;
|
||||
return(true);
|
||||
end make$numeric;
|
||||
|
||||
set$vec: procedure(v$adr,num) public;
|
||||
dcl v$adr address, /* set bit number given by num */
|
||||
vector based v$adr address, /* 0 <= num <= 15 */
|
||||
num byte;
|
||||
if num = 0 then
|
||||
vector = vector or 1;
|
||||
else
|
||||
vector = vector or shl(double(1),num);
|
||||
end set$vec;
|
||||
|
||||
bit$loc: procedure(vector) byte;
|
||||
/* return location of right most on bit vector */
|
||||
dcl vector address, /* 0 - 15 */
|
||||
i byte;
|
||||
i = 0;
|
||||
do while i < 16 and (vector and double(1)) = 0;
|
||||
vector = shr(vector,1);
|
||||
i = i + 1;
|
||||
end;
|
||||
return(i);
|
||||
end bit$loc;
|
||||
|
||||
get$nxt: procedure(vector$adr) byte;
|
||||
dcl i byte,
|
||||
(vector$adr,mask) address,
|
||||
vector based vector$adr address;
|
||||
/* if debug then
|
||||
do; call print(.(cr,lf,'getnxt: vector = $'));
|
||||
call pdecimal(vector,10000,false);
|
||||
end; */
|
||||
|
||||
if (i := bit$loc(vector)) > 15 then
|
||||
return(0ffh);
|
||||
mask = 1;
|
||||
if i > 0 then
|
||||
mask = shl(mask,i);
|
||||
vector = vector xor mask; /* turn off bit */
|
||||
/* if debug then
|
||||
do; call print(.(cr,lf,'getnxt: vector, i, mask $'));
|
||||
call pdecimal(vector,10000,false);
|
||||
call printb;
|
||||
call pdecimal(i,10000,false);
|
||||
call printb;
|
||||
call pdecimal(mask,10000,false);
|
||||
end; */
|
||||
return(i);
|
||||
end get$nxt; /* too bad plm rotates only work on byte values */
|
||||
|
||||
/* help: procedure; COMMENTED OUT - HELP PROGRAM REPLACE DISPLAY
|
||||
|
||||
call print(.(cr,lf,
|
||||
tab,tab,tab,'DIR EXAMPLES',cr,lf,lf,
|
||||
'dir file.one',tab,tab,tab,
|
||||
'(find a file on current user and default drive)',cr,lf,
|
||||
'dir *.com d:*.pli',tab,tab,'(find matching files on default and d: drive)',
|
||||
cr,lf,
|
||||
'dir [rw]',tab,tab,tab,'(find files that are read/write)',cr,lf,
|
||||
'dir [ro dir sys]',tab,tab,'(same for read/only, directory, system)',cr,lf,
|
||||
'dir [xfcb]',tab,tab,tab,'(find files with XFCB''s)',cr,lf,
|
||||
'dir [nonxfcb]',tab,tab,tab,'(find files without XFCB''s)',cr,lf,
|
||||
'dir [exclude] *.com',tab,tab,'(find files that don''t end in ''com'')',cr,lf,
|
||||
'dir [nosort]',tab,tab,tab,'(don''t sort the files)',cr,lf,
|
||||
'dir [full]',tab,tab,tab,'(show all file information)',cr,lf,
|
||||
'dir [size]',tab,tab,tab,'(show name and size in kilobytes)',cr,lf,
|
||||
'dir [short]',tab,tab,tab,'(show just the file names)',cr,lf,
|
||||
'dir [drive = all]',tab,tab,'(search all logged in drives)',cr,lf,
|
||||
'dir [drive = (a,b,p)]',tab,tab,
|
||||
'(search specified drives, ''disk'' is synonym)',cr,lf,
|
||||
'dir [user = all]',tab,tab,'(find files with any user number)',cr,lf,
|
||||
'dir [user = (0,1,15), G12]',tab,'(find files with specified user number)',
|
||||
cr,lf,
|
||||
'dir [length = n]',tab,tab,'(print headers every n lines)',cr,lf,
|
||||
'dir [ff]',tab,tab,tab,'(print form feeds between headers)',cr,lf,
|
||||
'dir [message user=all]',tab,tab,'(show user/drive areas with no files)',
|
||||
cr,lf,
|
||||
'dir [help]',tab,tab,tab,'(show this message)',cr,lf,
|
||||
'dir [dir sys rw ro sort xfcb nonxfcb full] d:*.*',tab,'(defaults)$'));
|
||||
|
||||
call terminate;
|
||||
end help; */
|
||||
|
||||
|
||||
/* -------- Scanner Info -------- */
|
||||
|
||||
$include (scan.lit)
|
||||
|
||||
dcl pcb pcb$structure
|
||||
initial (0,.buff(0),.fcb,0,0,0,0) ;
|
||||
|
||||
dcl token based pcb.token$adr (12) byte;
|
||||
dcl got$options boolean;
|
||||
|
||||
get$options: procedure;
|
||||
dcl temp byte;
|
||||
|
||||
do while pcb.scan$adr <> 0ffffh and ((pcb.tok$typ and t$op) <> 0);
|
||||
if pcb.nxt$token <> t$mod then
|
||||
do; /* options with no modifiers */
|
||||
if token(1) = 'A' then
|
||||
display$attributes = true;
|
||||
else if token(1) = 'D' and token(2) = 'I' then
|
||||
find.dir = true;
|
||||
else if token(1) = 'D' and token(2) = 'A' then do;
|
||||
format = form$full;
|
||||
date$opt = true;
|
||||
end;
|
||||
/* else if token(1) = 'D' and token(2) = 'E' then
|
||||
debug = true; */
|
||||
else if token(1) = 'E' then
|
||||
find.exclude = true;
|
||||
else if token(1) = 'F'then
|
||||
if token(2) = 'F' then
|
||||
formfeeds = true;
|
||||
else if token(2) = 'U' then
|
||||
format = form$full;
|
||||
else goto op$err;
|
||||
else if token(1) = 'G' then
|
||||
do;
|
||||
if pcb.token$len < 3 then
|
||||
temp = token(2) - '0';
|
||||
else
|
||||
temp = (token(2) - '0') * 10 + (token(3) - '0');
|
||||
if temp >= 0 and temp <= 15 then
|
||||
call set$vec(.usr$vector,temp);
|
||||
else goto op$err;
|
||||
end;
|
||||
/* else if token(1) = 'H' then
|
||||
call help; */
|
||||
else if token(1) = 'M' then
|
||||
message = true;
|
||||
else if token(1) = 'N' then
|
||||
if token(4) = 'X' then
|
||||
find.nonxfcb = true;
|
||||
else if token(3) = 'P' then
|
||||
no$page$mode = 0FFh;
|
||||
else if token(3) = 'S' then
|
||||
sort$op = false;
|
||||
else goto op$err;
|
||||
/* else if token(1) = 'P' then
|
||||
find.pass = true; */
|
||||
else if token(1) = 'R' and token(2) = 'O' then
|
||||
find.ro = true;
|
||||
else if token(1) = 'R' and token(2) = 'W' then
|
||||
find.rw = true;
|
||||
else if token(1) = 'S' then
|
||||
if token(2) = 'Y' then
|
||||
find.sys = true;
|
||||
else if token(2) = 'I' then
|
||||
format = form$size;
|
||||
else if token(2) = 'O' then
|
||||
sort$op = true;
|
||||
else goto op$err;
|
||||
else if token(1) = 'X' then
|
||||
find.xfcb = true;
|
||||
else goto op$err;
|
||||
call scan(.pcb);
|
||||
end;
|
||||
else
|
||||
do; /* options with modifiers */
|
||||
if token(1) = 'L' then
|
||||
do;
|
||||
call scan(.pcb);
|
||||
if (pcb.tok$typ and t$numeric) <> 0 then
|
||||
if make$numeric(.token(1),pcb.token$len,.page$len) then
|
||||
if page$len < 5 then
|
||||
goto op$err;
|
||||
else call scan(.pcb);
|
||||
else goto op$err;
|
||||
else goto op$err;
|
||||
end;
|
||||
else if token(1) = 'U' then
|
||||
do;
|
||||
/* if debug then
|
||||
call print(.(cr,lf,'In User option$')); */
|
||||
call scan(.pcb);
|
||||
if ((pcb.tok$typ and t$mod) = 0) or bdos < bdos20 then
|
||||
goto op$err;
|
||||
do while (pcb.tok$typ and t$mod) <> 0 and
|
||||
pcb.scan$adr <> 0ffffh;
|
||||
if token(1) = 'A' and token(2) = 'L' then
|
||||
usr$vector = 0ffffh;
|
||||
else if (pcb.tok$typ and t$numeric) <> 0 and pcb.token$len < 3 then
|
||||
do;
|
||||
if pcb.token$len = 1 then
|
||||
temp = token(1) - '0';
|
||||
else
|
||||
temp = (token(1) - '0') * 10 + (token(2) - '0');
|
||||
if temp >= 0 and temp <= 15 then
|
||||
call set$vec(.usr$vector,temp);
|
||||
else goto op$err;
|
||||
end;
|
||||
else goto op$err;
|
||||
call scan(.pcb);
|
||||
end;
|
||||
end;
|
||||
else if token(1) = 'D' and (token(2) = 'R' or token(2) = 'I') then
|
||||
do; /* allow DRIVE or DISK */
|
||||
call scan(.pcb);
|
||||
if (pcb.tok$typ and t$mod) = 0 then
|
||||
goto op$err;
|
||||
do while (pcb.tok$typ and t$mod ) <> 0 and
|
||||
pcb.scan$adr <> 0ffffh;
|
||||
if token(1) = 'A' and token(2) = 'L' then
|
||||
do;
|
||||
drv$vector = 0ffffh;
|
||||
drv$vector = drv$vector and get$login;
|
||||
end;
|
||||
else if token(1) >= 'A' and token(1) <= 'P' then
|
||||
call set$vec(.drv$vector,token(1) - 'A');
|
||||
else goto op$err;
|
||||
call scan(.pcb);
|
||||
end;
|
||||
end; /* drive option */
|
||||
else goto op$err;
|
||||
end; /* options with modifiers */
|
||||
end; /* do while */
|
||||
|
||||
got$options = true;
|
||||
return;
|
||||
|
||||
op$err:
|
||||
call print(.('ERROR: Illegal Option or Modifier.',
|
||||
cr,lf,'$'));
|
||||
call terminate;
|
||||
end get$options;
|
||||
|
||||
get$file$spec: procedure;
|
||||
dcl i byte;
|
||||
if num$search$files < max$search$files then
|
||||
do;
|
||||
call move(f$namelen + f$typelen,.token(1),
|
||||
.search(num$search$files).name(0));
|
||||
|
||||
if search(num$search$files).name(f$name - 1) = ' ' and
|
||||
search(num$search$files).name(f$type - 1) = ' ' then
|
||||
search(num$search$files).anyfile = true; /* match on any file */
|
||||
else search(num$search$files).anyfile = false;/* speedier compare */
|
||||
|
||||
if token(0) = 0 then
|
||||
search(num$search$files).drv = 0ffh; /* no drive letter with */
|
||||
else /* file spec */
|
||||
search(num$search$files).drv = token(0) - 1;
|
||||
/* 0ffh in drv field indicates to look on all drives that will be */
|
||||
/* scanned as set by the "drive =" option, see "match:" proc in */
|
||||
/* search.plm module */
|
||||
|
||||
num$search$files = num$search$files + 1;
|
||||
end;
|
||||
else
|
||||
do; call print(.('File Spec Limit is $'));
|
||||
call p$decimal(max$search$files,100,true);
|
||||
call crlf;
|
||||
end;
|
||||
call scan(.pcb);
|
||||
end get$file$spec;
|
||||
|
||||
set$defaults: procedure;
|
||||
/* set defaults if not explicitly set by user */
|
||||
if not (find.dir or find.sys) then
|
||||
find.dir, find.sys = true;
|
||||
if not(find.ro or find.rw) then
|
||||
find.rw, find.ro = true;
|
||||
|
||||
if find.xfcb or find.nonxfcb then
|
||||
do; if format = form$short then
|
||||
format = form$full;
|
||||
end;
|
||||
else /* both xfcb and nonxfcb are off */
|
||||
find.nonxfcb, find.xfcb = true;
|
||||
|
||||
if num$search$files = 0 then
|
||||
do;
|
||||
search(num$search$files).anyfile = true;
|
||||
search(num$search$files).drv = 0ffh;
|
||||
num$search$files = 1;
|
||||
end;
|
||||
|
||||
if drv$vector = 0 then
|
||||
do i = 0 to num$search$files - 1;
|
||||
if search(i).drv = 0ffh then search(i).drv = cur$drv;
|
||||
call set$vec(.drv$vector,search(i).drv);
|
||||
end;
|
||||
else /* a "[drive =" option was found */
|
||||
do i = 0 to num$search$files - 1;
|
||||
if search(i).drv <> 0ffh and search(i).drv <> cur$drv then
|
||||
do; call print(.('ERROR: Illegal Global/Local ',
|
||||
'Drive Spec Mixing.',cr,lf,'$'));
|
||||
call terminate;
|
||||
end;
|
||||
end;
|
||||
if usr$vector = 0 then
|
||||
call set$vec(.usr$vector,get$usr);
|
||||
|
||||
/* set up default page size for display */
|
||||
/**** page$len = 23; /* number lines per screen page */
|
||||
|
||||
end set$defaults;
|
||||
|
||||
|
||||
dcl (save$uvec,temp) address;
|
||||
dcl i byte;
|
||||
declare last$dseg$byte byte
|
||||
initial (0);
|
||||
|
||||
plmstart:
|
||||
do;
|
||||
os = high(get$version);
|
||||
bdos = low(get$version);
|
||||
|
||||
if bdos < bdos22 /* or os <> ccpm86 */
|
||||
then do;
|
||||
/*call print(.('Requires Concurrent CP/M-86',cr,lf,'$'));*/
|
||||
call print(.('Requires BDOS 2.2 or greater.',cr,lf,'$'));
|
||||
call terminate; /* check to make sure function call is valid */
|
||||
end;
|
||||
else
|
||||
call set$console$mode;
|
||||
|
||||
/* note - initialized declarations set defaults */
|
||||
cur$drv = get$cur$drv;
|
||||
call scan$init(.pcb);
|
||||
call scan(.pcb);
|
||||
no$page$mode = false; /******** getscbbyte(nopage$mode$offset); ***whf***/
|
||||
got$options = false;
|
||||
do while pcb.scan$adr <> 0ffffh;
|
||||
if (pcb.tok$typ and t$op) <> 0 then
|
||||
if got$options = false then
|
||||
call get$options;
|
||||
else
|
||||
do;
|
||||
call print(.('ERROR: Options not grouped together.',
|
||||
cr,lf,'$'));
|
||||
call terminate;
|
||||
end;
|
||||
else if (pcb.tok$typ and t$filespec) <> 0 then
|
||||
call get$file$spec;
|
||||
else
|
||||
do;
|
||||
call print(.('ERROR: Illegal command tail.',cr,lf,'$'));
|
||||
call terminate;
|
||||
end;
|
||||
end;
|
||||
|
||||
call set$defaults;
|
||||
|
||||
/* main control loop */
|
||||
|
||||
call search$init; /* set up memory pointers for subsequent storage */
|
||||
|
||||
do while (cur$drv := get$nxt(.drv$vector)) <> 0ffh;
|
||||
call select$drive(cur$drv);
|
||||
save$uvec = usr$vector; /* user numbers to search on each drive */
|
||||
active$usr$vector = 0; /* users active on cur$drv */
|
||||
cur$usr = get$nxt(.usr$vector); /* get first user num and mask */
|
||||
get$all$dir$entries = false; /* off it off */
|
||||
if usr$vector <> 0 and format <> form$short then
|
||||
/* find high water mark if */
|
||||
do; /* more than one user requested */
|
||||
fcb(f$drvusr) = '?';
|
||||
i = search$first(.fcb); /* get first directory entry */
|
||||
temp = 0;
|
||||
do while i <> 255;
|
||||
temp = temp + 1;
|
||||
i = search$next;
|
||||
end; /* is there enough space in the */
|
||||
/* worst case ? */
|
||||
if maxb > mult23(temp) + shl(temp,1) then
|
||||
get$all$dir$entries = true; /* location of last possible */
|
||||
end; /* file info record and add */
|
||||
first$pass = true; /* room for sort indices */
|
||||
active$usr$vector = 0ffffh;
|
||||
do while cur$usr <> 0ffh;
|
||||
/* if debug then
|
||||
call print(.(cr,lf,'in user loop $')); */
|
||||
call set$vec(.temp,cur$usr);
|
||||
if (temp and active$usr$vector) <> 0 then
|
||||
do;
|
||||
if format <> form$short and
|
||||
(first$pass or not get$all$dir$entries) then
|
||||
do;
|
||||
call getfiles; /* collect files in memory and */
|
||||
first$pass = false; /* build the active usr vector */
|
||||
sorted = false; /* sort module will set sorted */
|
||||
if sort$op then /* to true, if successful sort */
|
||||
call sort;
|
||||
end;
|
||||
call display$files;
|
||||
end;
|
||||
cur$usr = get$nxt(.usr$vector);
|
||||
end;
|
||||
usr$vector = save$uvec; /* restore user vector for nxt */
|
||||
end; /* do while drv$usr drive scan */
|
||||
|
||||
|
||||
if not file$displayed and not message then
|
||||
call print(.(cr,lf,cr,lf,'No File',cr,lf,'$'));
|
||||
call terminate;
|
||||
|
||||
end;
|
||||
end sdir;
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,35 @@
|
||||
$title ('SDIR 8086 - Main Module')
|
||||
sdir:
|
||||
do;
|
||||
|
||||
$include (copyrt.lit)
|
||||
|
||||
/* commands used to generate */
|
||||
/*
|
||||
asm86 scd.a86
|
||||
plm86 main86.plm debug object(main86) optimize(3) 'p2' 'p3' 'p4'
|
||||
plm86 scan.plm debug object(scan) optimize(3) 'p2' 'p3' 'p4'
|
||||
plm86 search.plm debug object(search) optimize(3) 'p2' 'p3' 'p4'
|
||||
plm86 sort.plm debug object(sort) optimize(3) 'p2' 'p3' 'p4'
|
||||
plm86 disp.plm debug object(disp) optimize(3) 'p2' 'p3' 'p4'
|
||||
plm86 dpb86.plm debug object(dpb86) optimize(3) 'p2' 'p3' 'p4'
|
||||
plm86 util.plm debug object(util) optimize(3) 'p2' 'p3' 'p4'
|
||||
plm86 timest.plm debug object(timest) optimize(3) 'p2' 'p3' 'p4'
|
||||
link86 scd.obj,main86,scan,search,sort,disp,util,dpb86,timest to sdir86.lnk
|
||||
loc86 sdir86.lnk od(sm(code,dats,data,const,stack)) -
|
||||
ad(sm(code(0),dats(10000h))) ss(stack(+32))
|
||||
h86 sdir86
|
||||
|
||||
(on a micro)
|
||||
vax sdir86.h86 $fans
|
||||
gencmd sdir86 data[b1000 m3c5 x800]
|
||||
|
||||
* constants are last to force hex generation.
|
||||
* a minimum data of 3c5h paragraphs is 12K plus the data space
|
||||
* of SDIR, enough for 512 directory entries
|
||||
* the max is lowered from 0fffh to 800h
|
||||
(Aug 12, 1982 for CCP/M-86 IBM PC)
|
||||
*/
|
||||
|
||||
$include (main.plm)
|
||||
|
||||
@@ -0,0 +1,19 @@
|
||||
|
||||
/* definitions for assembly interface module */
|
||||
declare
|
||||
fcb (33) byte external, /* default file control block */
|
||||
maxb address external, /* top of memory */
|
||||
buff(128)byte external; /* default buffer */
|
||||
|
||||
mon1: procedure(f,a) external;
|
||||
declare f byte, a address;
|
||||
end mon1;
|
||||
|
||||
mon2: procedure(f,a) byte external;
|
||||
declare f byte, a address;
|
||||
end mon2;
|
||||
|
||||
mon3: procedure(f,a) address external;
|
||||
declare f byte, a address;
|
||||
end mon3;
|
||||
|
||||
@@ -0,0 +1,22 @@
|
||||
|
||||
declare
|
||||
pcb$structure literally 'structure (
|
||||
state address,
|
||||
scan$adr address,
|
||||
token$adr address,
|
||||
tok$typ byte,
|
||||
token$len byte,
|
||||
p$level byte,
|
||||
nxt$token byte)';
|
||||
|
||||
declare
|
||||
t$null lit '0',
|
||||
t$param lit '1',
|
||||
t$op lit '2',
|
||||
t$mod lit '4',
|
||||
t$identifier lit '8',
|
||||
t$string lit '16',
|
||||
t$numeric lit '32',
|
||||
t$filespec lit '64',
|
||||
t$error lit '128';
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,731 @@
|
||||
$title ('Utility Command Line Scanner')
|
||||
scanner:
|
||||
do;
|
||||
|
||||
$include(comlit.lit)
|
||||
$include(mon.plm)
|
||||
|
||||
dcl debug boolean initial (false);
|
||||
|
||||
dcl eob lit '0'; /* end of buffer */
|
||||
|
||||
$include(fcb.lit)
|
||||
|
||||
|
||||
/* -------- Some routines used for diagnostics if debug mode is on -------- */
|
||||
|
||||
printchar: procedure(char) external;
|
||||
declare char byte;
|
||||
end printchar;
|
||||
|
||||
printb: procedure external;
|
||||
end printb;
|
||||
|
||||
crlf: procedure external;
|
||||
end crlf;
|
||||
|
||||
pdecimal: procedure(v,prec,zerosup) external;
|
||||
/* print value v, 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 */
|
||||
d byte; /* current decimal digit */
|
||||
|
||||
end pdecimal;
|
||||
|
||||
/*
|
||||
show$buf: procedure;
|
||||
dcl i byte;
|
||||
i = 1;
|
||||
call crlf;
|
||||
call mon1(9,.('buff = $'));
|
||||
do while buff(i) <> 0;
|
||||
i = i + 1;
|
||||
end;
|
||||
buff(i) = '$';
|
||||
call mon1(9,.buff(1));
|
||||
buff(i) = 0;
|
||||
end show$buf; */
|
||||
|
||||
|
||||
/* -------- -------- */
|
||||
|
||||
white$space: procedure (str$adr) byte;
|
||||
dcl str$adr address,
|
||||
str based str$adr (1) byte,
|
||||
i byte;
|
||||
i = 0;
|
||||
do while (str(i) = ' ') or (str(i) = tab);
|
||||
i = i + 1;
|
||||
end;
|
||||
return(i);
|
||||
end white$space;
|
||||
|
||||
delimiter: procedure(char) boolean;
|
||||
dcl char byte;
|
||||
if char = '[' or char = ']' or char = '(' or char = ')' or
|
||||
char = '=' or char = ',' or char = 0 then
|
||||
return (true);
|
||||
return(false);
|
||||
end delimiter;
|
||||
|
||||
dcl string$marker lit '05ch';
|
||||
|
||||
deblank: procedure(buf$adr);
|
||||
dcl (buf$adr,dest) address,
|
||||
buf based buf$adr (128) byte,
|
||||
(i,numspaces) byte,
|
||||
string boolean;
|
||||
|
||||
string = false;
|
||||
if (numspaces := white$space(.buf(1))) > 0 then
|
||||
call move(buf(0) - numspaces + 1,.buf(numspaces+1),.buf(1));
|
||||
i = 1;
|
||||
do while buf(i) <> 0;
|
||||
|
||||
/* call show$buf;*/
|
||||
|
||||
do while ((numspaces := white$space(.buf(i))) = 0 and (buf(i) <> 0))
|
||||
and not string;
|
||||
/* call mon1(9,.(cr,lf,'2numspaces = $'));
|
||||
call pdecimal(numspaces,100,false);*/
|
||||
/* call show$buf;*/
|
||||
if buf(i) = '"' then
|
||||
do;
|
||||
string = true;
|
||||
buf(i) = string$marker;
|
||||
end;
|
||||
i = i + 1;
|
||||
end;
|
||||
|
||||
do while string and buf(i) <> 0;
|
||||
if buf(i) = '"' then
|
||||
if buf(i+1) = '"' then
|
||||
call move(buf(0) - i + 1,.buf(i+1), .buf(i));
|
||||
else
|
||||
do;
|
||||
buf(i) = string$marker;
|
||||
string = false;
|
||||
end;
|
||||
i = i + 1;
|
||||
end;
|
||||
|
||||
if (numspaces := white$space(.buf(i))) > 0 then
|
||||
do;
|
||||
/* call mon1(9,.(cr,lf,'1numspaces = $'));
|
||||
call pdecimal(numspaces,100,false);*/
|
||||
buf(i) = ' ';
|
||||
dest = .buf(i+1); /* save space for ',' */
|
||||
if i > 1 then
|
||||
if delimiter(buf(i-1)) or delimiter(buf(i+numspaces)) then
|
||||
/* write over ' ' with */
|
||||
dest = dest - 1; /* a = [ ] ( ) */
|
||||
|
||||
call move(((buf(0)+1)-(i+numspaces-1)),
|
||||
.buf(i+numspaces),dest);
|
||||
if buf(i) = '"' then
|
||||
string = true;
|
||||
i = i + 1;
|
||||
end;
|
||||
|
||||
end;
|
||||
if buf(i - 1) = ' ' then /* no trailing blanks */
|
||||
buf(i - 1) = 0;
|
||||
/* if debug then
|
||||
call show$buf; */
|
||||
end deblank;
|
||||
|
||||
upper$case: procedure (buf$adr);
|
||||
dcl buf$adr address,
|
||||
buf based buf$adr (1) byte,
|
||||
i byte;
|
||||
|
||||
i = 0;
|
||||
do while buf(i) <> eob;
|
||||
if buf(i) >= 'a' and buf(i) <= 'z' then
|
||||
buf(i) = buf(i) - ('a' - 'A');
|
||||
i = i + 1;
|
||||
end;
|
||||
end upper$case;
|
||||
|
||||
dcl option$max lit '11';
|
||||
dcl done$scan lit '0ffffh';
|
||||
dcl ident$max lit '11';
|
||||
dcl token$max lit '11';
|
||||
|
||||
dcl t$null lit '0',
|
||||
t$param lit '1',
|
||||
t$option lit '2',
|
||||
t$modifier lit '4',
|
||||
t$identifier lit '8',
|
||||
t$string lit '16',
|
||||
t$numeric lit '32',
|
||||
t$filespec lit '64',
|
||||
t$error lit '128';
|
||||
|
||||
dcl pcb$base address;
|
||||
dcl pcb based pcb$base structure (
|
||||
state address,
|
||||
scan$adr address,
|
||||
token$adr address,
|
||||
token$type byte,
|
||||
token$len byte,
|
||||
p$level byte,
|
||||
nxt$token byte);
|
||||
|
||||
dcl scan$adr address,
|
||||
inbuf based scan$adr (1) byte,
|
||||
in$ptr byte,
|
||||
token$adr address,
|
||||
token based token$adr (1) byte,
|
||||
t$ptr byte,
|
||||
(char, nxtchar, tcount) byte;
|
||||
|
||||
digit: procedure (char) boolean;
|
||||
dcl char byte;
|
||||
return (char >= '0' and char <= '9');
|
||||
end digit;
|
||||
|
||||
letter: procedure (char) boolean;
|
||||
dcl char byte;
|
||||
return (char >= 'A' and char <= 'Z');
|
||||
end letter;
|
||||
|
||||
eat$char: procedure;
|
||||
char = inbuf(in$ptr := inptr + 1);
|
||||
nxtchar = inbuf(in$ptr + 1);
|
||||
end eat$char;
|
||||
|
||||
put$char: procedure(charx);
|
||||
dcl charx byte;
|
||||
if pcb.token$adr <> 0ffffh then
|
||||
token(t$ptr := t$ptr + 1) = charx;
|
||||
end put$char;
|
||||
|
||||
get$identifier: procedure (max) byte;
|
||||
dcl max byte;
|
||||
|
||||
tcount = 0;
|
||||
/* call mon1(9,.(cr,lf,'getindentifier$'));*/
|
||||
if not letter(char) and char <> '$' then
|
||||
return(tcount);
|
||||
do while (letter(char) or digit(char) or char = '_' or
|
||||
char = '$' ) and tcount <= max;
|
||||
call put$char(char);
|
||||
call eat$char;
|
||||
tcount = tcount + 1;
|
||||
end;
|
||||
do while letter(char) or digit(char) or char = '_'
|
||||
or char = '$' ;
|
||||
call eat$char;
|
||||
tcount = tcount + 1;
|
||||
end;
|
||||
pcb.token$type = t$identifier;
|
||||
/* call mon1(9,.(cr,lf,'end of getident$')); */
|
||||
pcb.token$len = tcount;
|
||||
return(tcount);
|
||||
end get$identifier;
|
||||
|
||||
file$char: procedure (x) boolean;
|
||||
dcl x byte;
|
||||
return(letter(x) or digit(x) or x = '*' or x = '?'
|
||||
or x = '_' or x = '$');
|
||||
end file$char;
|
||||
|
||||
expand$wild$cards: procedure(field$size) boolean;
|
||||
dcl (i,leftover,field$size) byte,
|
||||
save$inptr address;
|
||||
|
||||
field$size = field$size + t$ptr;
|
||||
do while filechar(char) and t$ptr < field$size;
|
||||
if char = '*' then
|
||||
do; leftover = t$ptr;
|
||||
save$inptr = inptr;
|
||||
call eatchar;
|
||||
do while filechar(char);
|
||||
leftover = leftover + 1;
|
||||
call eatchar;
|
||||
end;
|
||||
if leftover >= field$size then /* too many chars */
|
||||
do; inptr = save$inptr;
|
||||
return(false);
|
||||
end;
|
||||
do i = 1 to field$size - leftover;
|
||||
call putchar('?');
|
||||
end;
|
||||
inptr = save$inptr;
|
||||
end;
|
||||
else
|
||||
call putchar(char);
|
||||
call eatchar;
|
||||
end;
|
||||
return(true);
|
||||
end expand$wild$cards;
|
||||
|
||||
get$file$spec: procedure boolean;
|
||||
dcl i byte;
|
||||
do i = 1 to f$name$len + f$type$len;
|
||||
token(i) = ' ';
|
||||
end;
|
||||
if nxtchar = ':' then
|
||||
if char >= 'A' and char <= 'P' then
|
||||
do;
|
||||
call putchar(char - 'A' + 1);
|
||||
call eat$char; /* skip ':' */
|
||||
call eat$char; /* 1st char of file name */
|
||||
end;
|
||||
else
|
||||
return(false);
|
||||
else
|
||||
call putchar(0); /* use default drive */
|
||||
|
||||
if not (letter(char) or char = '$' or char = '_'
|
||||
or char = '*' or char = '?' ) then /* no leading numerics */
|
||||
if token(0) = 0 then /* ambiguous with numeric token */
|
||||
return(false);
|
||||
|
||||
if not expand$wild$cards(f$namelen) then
|
||||
return(false); /* blank name is illegal */
|
||||
if char = '.' then
|
||||
do; call eat$char;
|
||||
if filechar(char) then
|
||||
do; t$ptr = f$namelen;
|
||||
if not expand$wild$cards(f$typelen) then
|
||||
return(false);
|
||||
end;
|
||||
end;
|
||||
|
||||
pcb.token$len = f$name$len + f$type$len + 1;
|
||||
pcb.token$type = t$file$spec;
|
||||
return(true);
|
||||
end get$file$spec;
|
||||
|
||||
get$numeric: procedure(max) boolean;
|
||||
dcl max byte;
|
||||
if not digit(char) then
|
||||
return(false);
|
||||
do while digit(char) and pcb.token$len <= max and
|
||||
char <> eob;
|
||||
call putchar(char);
|
||||
call eat$char;
|
||||
pcb.token$len = pcb.token$len + 1;
|
||||
end;
|
||||
if char = 'H' or char = 'D' or char = 'B' then
|
||||
if pcb.token$len < max then
|
||||
do;
|
||||
call putchar(char);
|
||||
call eat$char;
|
||||
pcb.token$len = pcb.token$len + 1;
|
||||
end;
|
||||
else
|
||||
return(false);
|
||||
pcb.token$type = t$numeric;
|
||||
return(true);
|
||||
end get$numeric;
|
||||
|
||||
get$string: procedure(max) boolean;
|
||||
dcl max byte;
|
||||
if char <> string$marker then
|
||||
return(false);
|
||||
call eatchar;
|
||||
do while char <> string$marker and char <> eob
|
||||
and pcb.token$len < token$max;
|
||||
call putchar(char);
|
||||
call eatchar;
|
||||
pcb.token$len = pcb.token$len + 1;
|
||||
end;
|
||||
|
||||
do while char <> string$marker and char <> eob;
|
||||
call eat$char;
|
||||
end;
|
||||
if char <> string$marker then
|
||||
return(false);
|
||||
pcb.token$type = t$string;
|
||||
call eat$char;
|
||||
return(true);
|
||||
end get$string;
|
||||
|
||||
get$token$all: procedure boolean;
|
||||
dcl save$inptr byte;
|
||||
|
||||
/* call mon1(9,.(cr,lf,'gettokenall$'));*/
|
||||
|
||||
save$inptr = in$ptr;
|
||||
if get$file$spec then
|
||||
return(true);
|
||||
|
||||
/* call mon1(9,.(cr,lf,'gettokenall - no file$')); */
|
||||
in$ptr = save$inptr - 1; /* need to re-scan, reset buffer pointers */
|
||||
call eat$char;
|
||||
t$ptr = 255;
|
||||
call putchar(0); /* zero drive byte */
|
||||
|
||||
if get$identifier(token$max) = 0 then
|
||||
if not get$string(token$max) then
|
||||
if not get$numeric(token$max) then
|
||||
return(false);
|
||||
/* call mon1(9,.(cr,lf,'end gettokenall$'));*/
|
||||
return(true);
|
||||
end get$token$all;
|
||||
|
||||
get$modifier: procedure boolean;
|
||||
if char = ',' or char = ')' or char = 0 then
|
||||
do;
|
||||
pcb.token$type = t$modifier or t$null;
|
||||
return(true);
|
||||
end;
|
||||
if get$token$all then
|
||||
do;
|
||||
pcb.token$type = pcb.token$type or t$modifier;
|
||||
return(true);
|
||||
end;
|
||||
return(false);
|
||||
end get$modifier;
|
||||
|
||||
get$option: procedure boolean;
|
||||
call putchar(0);
|
||||
if get$identifier(token$max) > 0 then
|
||||
do;
|
||||
pcb.token$type = pcb.token$type or t$option;
|
||||
if pcb.token$len > token$max then
|
||||
pcb.token$len = token$max;
|
||||
return(true);
|
||||
end;
|
||||
return(false);
|
||||
end get$option;
|
||||
|
||||
get$param: procedure boolean;
|
||||
if char = ',' or char = ')' or char = 0 then
|
||||
do;
|
||||
pcb.token$type = t$param or t$null;
|
||||
return(true);
|
||||
end;
|
||||
if get$token$all then
|
||||
do;
|
||||
pcb.token$type = pcb.token$type or t$param;
|
||||
return(true);
|
||||
end;
|
||||
return(false);
|
||||
end get$param;
|
||||
|
||||
dcl gotatoken boolean;
|
||||
dcl parens byte initial (0);
|
||||
|
||||
end$state: procedure boolean;
|
||||
if gotatoken then
|
||||
do;
|
||||
pcb.state = .end$state;
|
||||
return(true);
|
||||
end;
|
||||
pcb.token$type = t$null;
|
||||
pcb.scan$adr = 0ffffh;
|
||||
return(true);
|
||||
end end$state;
|
||||
|
||||
state8: procedure boolean reentrant;
|
||||
if debug then do;
|
||||
call mon1(9,.(cr,lf,'state8, char = $'));
|
||||
call printchar(char); end;
|
||||
if char = 0 then
|
||||
return(end$state);
|
||||
if char = ']' then
|
||||
do;
|
||||
call eatchar;
|
||||
if char = ',' or nxtchar = '(' or nxtchar = ')' then
|
||||
return(state2);
|
||||
else if char = 0 then
|
||||
return(end$state);
|
||||
else
|
||||
return(state1);
|
||||
end;
|
||||
else if char = ' ' or char = ',' then
|
||||
do;
|
||||
call eatchar;
|
||||
return(state3);
|
||||
end;
|
||||
return(state3);
|
||||
end state8;
|
||||
|
||||
state7:procedure boolean reentrant;
|
||||
if debug then do;
|
||||
call mon1(9,.(cr,lf,'state7, char = $'));
|
||||
call printchar(char); end;
|
||||
if char = 0 then
|
||||
return(end$state);
|
||||
if char = ' ' or char = ',' then
|
||||
do;
|
||||
call eat$char;
|
||||
return(state6);
|
||||
end;
|
||||
else
|
||||
if char = ')' then
|
||||
do;
|
||||
call eat$char;
|
||||
return(state8);
|
||||
end;
|
||||
return(false);
|
||||
end state7;
|
||||
|
||||
state6: procedure boolean reentrant;
|
||||
if debug then do;
|
||||
call mon1(9,.(cr,lf,'state6, char = $'));
|
||||
call printchar(char); end;
|
||||
if gotatoken then
|
||||
do;
|
||||
pcb.state = .state6;
|
||||
pcb.nxt$token = t$modifier;
|
||||
return(true);
|
||||
end;
|
||||
if (gotatoken := get$modifier) then
|
||||
return(state7);
|
||||
return(false);
|
||||
end state6;
|
||||
|
||||
state5:procedure boolean reentrant;
|
||||
if debug then do;
|
||||
call mon1(9,.(cr,lf,'state5, nxtchar = $'));
|
||||
call printchar(nxtchar); end;
|
||||
if char = '(' then
|
||||
do;
|
||||
call eat$char;
|
||||
return(state6);
|
||||
end;
|
||||
if gotatoken then
|
||||
do;
|
||||
pcb.state = .state5;
|
||||
pcb.nxt$token = t$modifier;
|
||||
return(true);
|
||||
end;
|
||||
if (gotatoken := get$modifier) then
|
||||
return(state8);
|
||||
return(false);
|
||||
end state5;
|
||||
|
||||
state4: procedure boolean reentrant;
|
||||
dcl temp byte;
|
||||
if debug then do;
|
||||
call mon1(9,.(cr,lf,'state4, char = $'));
|
||||
call printchar(char); end;
|
||||
if char = 0 then
|
||||
return(end$state);
|
||||
temp = char;
|
||||
call eatchar;
|
||||
if temp = ',' or temp = ' ' then
|
||||
return(state3);
|
||||
if temp = ']' then
|
||||
if char = '(' or char = ',' or char = ')' then
|
||||
return(state2);
|
||||
else if char = 0 then
|
||||
return(end$state);
|
||||
else
|
||||
return(state1);
|
||||
if temp = '=' then
|
||||
return(state5);
|
||||
return(false);
|
||||
end state4;
|
||||
|
||||
state3: procedure boolean reentrant;
|
||||
if debug then do;
|
||||
call mon1(9,.(cr,lf,'state3, char = $'));
|
||||
call printchar(char); end;
|
||||
if gotatoken then
|
||||
do;
|
||||
pcb.state = .state3;
|
||||
pcb.nxt$token = t$option;
|
||||
return(true);
|
||||
end;
|
||||
if (pcb.plevel := parens ) > 128 then
|
||||
return(false);
|
||||
if (gotatoken := get$option) then
|
||||
return(state4);
|
||||
return(false);
|
||||
end state3;
|
||||
|
||||
state2: procedure boolean reentrant;
|
||||
if debug then do;
|
||||
call mon1(9,.(cr,lf,'state2, char = $'));
|
||||
call printchar(char); end;
|
||||
do while char = ')' or char = 0;
|
||||
if char = 0 then
|
||||
return(end$state);
|
||||
call eat$char;
|
||||
parens = parens - 1;
|
||||
end;
|
||||
if char = '[' then
|
||||
do;
|
||||
call eat$char;
|
||||
return(state3);
|
||||
end;
|
||||
if char = ' ' or char = ',' or char = '(' then
|
||||
do;
|
||||
if char = '(' then
|
||||
parens = parens + 1;
|
||||
call eat$char;
|
||||
return(state1);
|
||||
end;
|
||||
return(state1);
|
||||
end state$2;
|
||||
|
||||
state1: procedure boolean reentrant;
|
||||
if debug then do;
|
||||
call mon1(9,.(cr,lf,'state1, char = $'));
|
||||
call printchar(char); end;
|
||||
|
||||
if gotatoken then
|
||||
do;
|
||||
pcb.nxt$token = t$param;
|
||||
pcb.state = .state1;
|
||||
return(true);
|
||||
end;
|
||||
do while char = '(' ;
|
||||
parens = parens + 1;
|
||||
call eat$char;
|
||||
end;
|
||||
if (pcb.plevel := parens) > 128 then
|
||||
return(false);
|
||||
if (gotatoken := get$param) then
|
||||
return(state2);
|
||||
return(false);
|
||||
end state1;
|
||||
|
||||
start$state: procedure boolean;
|
||||
if char = '@' then do;
|
||||
debug = true;
|
||||
call eat$char;
|
||||
call mon1(9,.(cr,lf,'startstate, char = $'));
|
||||
call printchar(char); end;
|
||||
|
||||
if char = 0 then
|
||||
return(end$state);
|
||||
if char = ')' then
|
||||
return(false);
|
||||
if char = '(' then
|
||||
do;
|
||||
parens = parens + 1;
|
||||
call eat$char;
|
||||
return(state1);
|
||||
end;
|
||||
if char = '[' then
|
||||
do;
|
||||
call eat$char;
|
||||
return(state3);
|
||||
end;
|
||||
if (gotatoken := get$param) then
|
||||
return(state2);
|
||||
return(false);
|
||||
end start$state;
|
||||
|
||||
/* display$all: procedure; /* called if debug set */
|
||||
|
||||
/* call mon1(9,.(cr,lf,'scanadr=$'));
|
||||
call pdecimal(pcb.scanadr,10000,false);
|
||||
call mon1(9,.(', tadr=$'));
|
||||
call pdecimal(pcb.token$adr,10000, false);
|
||||
call mon1(9,.(', tlen=$'));
|
||||
call pdecimal(double(pcb.token$len),100, false);
|
||||
call mon1(9,.(', ttype=$'));
|
||||
call pdecimal(double(pcb.token$type),100,false);
|
||||
call mon1(9,.(', plevel=$'));
|
||||
call pdecimal(double(pcb.plevel),100,false);
|
||||
call mon1(9,.(', ntok=$'));
|
||||
call pdecimal(double(pcb.nxt$token),100,false);
|
||||
|
||||
if (pcb.token$type and t$option) <> 0 then
|
||||
call mon1(9,.(cr,lf,'option =$'));
|
||||
if (pcb.token$type and t$param) <> 0 then
|
||||
call mon1(9,.(cr,lf,'parm =$'));
|
||||
if (pcb.token$type and t$modifier) <> 0 then
|
||||
call mon1(9,.(cr,lf,'modifier=$'));
|
||||
|
||||
if (pcb.token$type and t$filespec) <> 0 then
|
||||
do;
|
||||
if fcb(0) = 0 then
|
||||
call print$char('0');
|
||||
else call print$char(fcb(0) + 'A' - 1);
|
||||
call print$char(':');
|
||||
fcb(12) = '$';
|
||||
call mon1(9,.fcb(1));
|
||||
call mon1(9,.(' (filespec)$'));
|
||||
end;
|
||||
if ((pcb.token$type and t$string) or (pcb.token$type and
|
||||
t$identifier) or (pcb.token$type and t$numeric)) <> 0 then
|
||||
do;
|
||||
fcb(pcb.token$len + 1) = '$';
|
||||
call mon1(9,.fcb(1));
|
||||
end;
|
||||
if pcb.token$type = t$error then
|
||||
do;
|
||||
call mon1(9,.(cr,lf,'scanner error$'));
|
||||
return;
|
||||
end;
|
||||
|
||||
if (pcb.token$type and t$identifier) <> 0 then
|
||||
call mon1(9,.(' (identifier)$'));
|
||||
if (pcb.token$type and t$string) <> 0 then
|
||||
call mon1(9,.(' (string)$'));
|
||||
if (pcb.token$type and t$numeric) <> 0 then
|
||||
call mon1(9,.(' (numeric)$'));
|
||||
|
||||
if (pcb.nxt$token and t$option) <> 0 then
|
||||
call mon1(9,.(cr,lf,'nxt tok = option $'));
|
||||
if (pcb.nxt$token and t$param) <> 0 then
|
||||
call mon1(9,.(cr,lf,'nxt tok = parm $'));
|
||||
if (pcb.nxt$token and t$modifier) <> 0 then
|
||||
call mon1(9,.(cr,lf,'nxt tok = modifier$'));
|
||||
call crlf;
|
||||
|
||||
end display$all; */
|
||||
|
||||
scan: procedure (pcb$adr) public;
|
||||
|
||||
dcl status boolean,
|
||||
pcb$adr address;
|
||||
|
||||
pcb$base = pcb$adr;
|
||||
scan$adr = pcb.scan$adr;
|
||||
token$adr = pcb.token$adr;
|
||||
|
||||
in$ptr, t$ptr = 255;
|
||||
call eatchar;
|
||||
|
||||
gotatoken = false;
|
||||
pcb.nxt$token = t$null;
|
||||
pcb.token$len = 0;
|
||||
|
||||
if pcb.token$type = t$error then /* after one error, return */
|
||||
return; /* on any following calls */
|
||||
else if pcb.state = .start$state then
|
||||
status = start$state;
|
||||
else if pcb.state = .state$1 then
|
||||
status = state$1;
|
||||
else if pcb.state = .state$3 then
|
||||
status = state$3;
|
||||
else if pcb.state = .state$5 then
|
||||
status = state$5;
|
||||
else if pcb.state = .state$6 then
|
||||
status = state$6;
|
||||
else if pcb.state = .end$state then /* repeated calls go here */
|
||||
status = end$state; /* after first end$state */
|
||||
else
|
||||
status = false;
|
||||
|
||||
if not status then
|
||||
pcb.token$type = t$error;
|
||||
|
||||
if pcb.scan$adr <> 0ffffh then
|
||||
pcb.scan$adr = pcb.scan$adr + inptr;
|
||||
/* if debug then
|
||||
call display$all; */
|
||||
end scan;
|
||||
|
||||
scan$init: procedure(pcb$adr) public;
|
||||
dcl pcb$adr address;
|
||||
|
||||
pcb$base = pcb$adr;
|
||||
call deblank(pcb.scan$adr);
|
||||
call upper$case(pcb.scan$adr := pcb.scan$adr + 1);
|
||||
pcb.state = .start$state;
|
||||
end scan$init;
|
||||
|
||||
end scanner;
|
||||
@@ -0,0 +1,23 @@
|
||||
$!
|
||||
$! Compile SDIR.CMD for
|
||||
$! Concurrent CP/M-86 vers 2.0
|
||||
$! This version came from CP/M Plus
|
||||
$! Using PL/M-86 compiler on VAX
|
||||
$!
|
||||
$ ccpmsetup
|
||||
$ assign 'f$directory()' f1:
|
||||
$
|
||||
$ plm86 main86.plm debug object(main86) optimize(3) 'p1' 'p2' xref
|
||||
$ plm86 scan.plm debug object(scan) optimize(3) 'p1' 'p2' xref
|
||||
$ plm86 search.plm debug object(search) optimize(3) 'p1' 'p2' xref
|
||||
$ plm86 sort.plm debug object(sort) optimize(3) 'p1' 'p2' xref
|
||||
$ plm86 disp.plm debug object(disp) optimize(3) 'p1' 'p2' xref
|
||||
$ plm86 dpb86.plm debug object(dpb86) optimize(3) 'p1' 'p2' xref
|
||||
$ plm86 util.plm debug object(util) optimize(3) 'p1' 'p2' xref
|
||||
$ plm86 timest.plm debug object(timest) optimize(3) 'p1' 'p2' xref
|
||||
$ link86 f2:scd.obj,main86,scan,search,sort,disp,util,dpb86,timest -
|
||||
to sdir.lnk
|
||||
$ loc86 sdir.lnk od(sm(code,dats,data,const,stack)) -
|
||||
ad(sm(code(0),dats(10000h))) ss(stack(+32)) to sdir.
|
||||
$ h86 sdir
|
||||
$
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,17 @@
|
||||
$ ccpmsetup
|
||||
$ assign 'f$directory()' f1:
|
||||
$
|
||||
$ plm86 main86.plm debug object(main86) optimize(3) 'p1' 'p2' 'p3'
|
||||
$ !plm86 scan.plm debug object(scan) optimize(3) 'p1' 'p2' 'p3'
|
||||
$ !plm86 search.plm debug object(search) optimize(3) 'p1' 'p2' 'p3'
|
||||
$ !plm86 sort.plm debug object(sort) optimize(3) 'p1' 'p2' 'p3'
|
||||
$ plm86 disp.plm debug object(disp) optimize(3) 'p1' 'p2' 'p3'
|
||||
$ !plm86 dpb86.plm debug object(dpb86) optimize(3) 'p1' 'p2' 'p3'
|
||||
$ !plm86 util.plm debug object(util) optimize(3) 'p1' 'p2' 'p3'
|
||||
$ !plm86 timest.plm debug object(timest) optimize(3) 'p1' 'p2' 'p3'
|
||||
$ link86 f2:scd.obj,main86,scan,search,sort,disp,util,dpb86,timest -
|
||||
to sdir.lnk
|
||||
$ loc86 sdir.lnk od(sm(code,dats,data,const,stack)) -
|
||||
ad(sm(code(0),dats(10000h))) ss(stack(+32)) to sdir.
|
||||
$ h86 sdir
|
||||
|
||||
@@ -0,0 +1,22 @@
|
||||
|
||||
declare /* what kind of file user wants to find */
|
||||
find$structure lit 'structure (
|
||||
dir byte,
|
||||
sys byte,
|
||||
ro byte,
|
||||
rw byte,
|
||||
pass byte,
|
||||
xfcb byte,
|
||||
nonxfcb byte,
|
||||
exclude byte)';
|
||||
|
||||
declare
|
||||
max$search$files literally '10';
|
||||
|
||||
declare
|
||||
search$structure lit 'structure(
|
||||
drv byte,
|
||||
name(8) byte,
|
||||
type(3) byte,
|
||||
anyfile boolean)'; /* match on any drive if true */
|
||||
|
||||
@@ -0,0 +1,826 @@
|
||||
PL/M-86 COMPILER SDIR - SEARCH FOR FILES PAGE 1
|
||||
|
||||
|
||||
ISIS-II PL/M-86 V2.0 COMPILATION OF MODULE SEARCH
|
||||
OBJECT MODULE PLACED IN SEARCH
|
||||
COMPILER INVOKED BY: :F0: SEARCH.PLM DEBUG OBJECT(SEARCH) OPTIMIZE(3) XREF
|
||||
|
||||
|
||||
|
||||
$title ('SDIR - Search For Files')
|
||||
1 search:
|
||||
do;
|
||||
/* search module for extended dir */
|
||||
|
||||
$include (comlit.lit)
|
||||
=
|
||||
2 1 = declare
|
||||
= lit literally 'literally',
|
||||
= dcl lit 'declare',
|
||||
= true lit '0ffh',
|
||||
= false lit '0',
|
||||
= boolean lit 'byte',
|
||||
= forever lit 'while true',
|
||||
= cr lit '13',
|
||||
= lf lit '10',
|
||||
= tab lit '9',
|
||||
= ctrlc lit '3',
|
||||
= ff lit '12',
|
||||
= page$len$offset lit '1ch',
|
||||
= nopage$mode$offset lit '2Ch',
|
||||
= sectorlen lit '128';
|
||||
$include (mon.plm)
|
||||
=
|
||||
= /* definitions for assembly interface module */
|
||||
3 1 = declare
|
||||
= fcb (33) byte external, /* default file control block */
|
||||
= maxb address external, /* top of memory */
|
||||
= buff(128)byte external; /* default buffer */
|
||||
=
|
||||
4 1 = mon1: procedure(f,a) external;
|
||||
5 2 = declare f byte, a address;
|
||||
6 2 = end mon1;
|
||||
=
|
||||
7 1 = mon2: procedure(f,a) byte external;
|
||||
8 2 = declare f byte, a address;
|
||||
9 2 = end mon2;
|
||||
=
|
||||
10 1 = mon3: procedure(f,a) address external;
|
||||
11 2 = declare f byte, a address;
|
||||
12 2 = end mon3;
|
||||
=
|
||||
|
||||
13 1 dcl debug boolean external;
|
||||
|
||||
14 1 dcl first$pass boolean external;
|
||||
15 1 dcl get$all$dir$entries boolean external;
|
||||
16 1 dcl usr$vector address external;
|
||||
17 1 dcl active$usr$vector address external;
|
||||
18 1 dcl used$de address public; /* used directory entries */
|
||||
19 1 dcl filesfound address public; /* num files collected in memory */
|
||||
PL/M-86 COMPILER SDIR - SEARCH FOR FILES PAGE 2
|
||||
|
||||
|
||||
|
||||
$include(fcb.lit)
|
||||
=
|
||||
20 1 = declare
|
||||
= f$drvusr lit '0', /* drive/user byte */
|
||||
= f$name lit '1', /* file name */
|
||||
= f$namelen lit '8', /* file name length */
|
||||
= f$type lit '9', /* file type field */
|
||||
= f$typelen lit '3', /* type length */
|
||||
= 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', /* extent */
|
||||
= f$s1 lit '13', /* module byte */
|
||||
= f$rc lit '15', /* record count */
|
||||
= f$diskmap lit '16', /* file disk map */
|
||||
= diskmaplen lit '16', /* disk map length */
|
||||
= f$drvusr2 lit '16', /* fcb2 */
|
||||
= f$name2 lit '17',
|
||||
= f$type2 lit '25',
|
||||
= f$cr lit '32', /* current record */
|
||||
= f$rrec lit '33', /* random record */
|
||||
= f$rreco lit '35'; /* " " overflow */
|
||||
=
|
||||
$include(xfcb.lit)
|
||||
=
|
||||
21 1 = declare /* XFCB */
|
||||
= xfcb$type lit '10h', /* 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 '24', /* creation/access time stamp */
|
||||
= xf$update lit '28'; /* update time stamp */
|
||||
=
|
||||
22 1 = declare /* directory label: special case of XFCB */
|
||||
= dirlabeltype lit '20h', /* identifier on disk */
|
||||
= dl$password lit '128', /* masks on data byte */
|
||||
= dl$access lit '64',
|
||||
= dl$update lit '32',
|
||||
= dl$makexfcb lit '16',
|
||||
= dl$exists lit '1';
|
||||
=
|
||||
23 1 = declare /* password mode of xfcb */
|
||||
= pm$read lit '80h',
|
||||
= pm$write lit '40h',
|
||||
= pm$delete lit '20h';
|
||||
=
|
||||
|
||||
24 1 declare
|
||||
sfcb$type lit '21H',
|
||||
deleted$type lit '0E5H';
|
||||
|
||||
$include (search.lit)
|
||||
=
|
||||
25 1 = declare /* what kind of file user wants to find */
|
||||
= find$structure lit 'structure (
|
||||
= dir byte,
|
||||
PL/M-86 COMPILER SDIR - SEARCH FOR FILES PAGE 3
|
||||
|
||||
|
||||
= sys byte,
|
||||
= ro byte,
|
||||
= rw byte,
|
||||
= pass byte,
|
||||
= xfcb byte,
|
||||
= nonxfcb byte,
|
||||
= exclude byte)';
|
||||
=
|
||||
26 1 = declare
|
||||
= max$search$files literally '10';
|
||||
=
|
||||
27 1 = declare
|
||||
= search$structure lit 'structure(
|
||||
= drv byte,
|
||||
= name(8) byte,
|
||||
= type(3) byte,
|
||||
= anyfile boolean)'; /* match on any drive if true */
|
||||
=
|
||||
28 1 dcl find find$structure external; /* what kind of files to look for */
|
||||
29 1 dcl num$search$files byte external;
|
||||
30 1 dcl search (max$search$files) search$structure external;
|
||||
/* file specs to match on */
|
||||
|
||||
/* other globals */
|
||||
|
||||
31 1 dcl cur$usr byte external,
|
||||
cur$drv byte external, /* current drive " " */
|
||||
dir$label byte public; /* directory label for BDOS 3.0 */
|
||||
|
||||
|
||||
/* -------- BDOS calls -------- */
|
||||
|
||||
32 1 read$char: procedure byte;
|
||||
33 2 return mon2 (1,0);
|
||||
34 2 end read$char;
|
||||
|
||||
|
||||
/* -------- in sort.plm -------- */
|
||||
|
||||
35 1 mult23: procedure(f$info$index) address external;
|
||||
36 2 dcl f$info$index address;
|
||||
37 2 end mult23;
|
||||
|
||||
|
||||
/* -------- in util.plm -------- */
|
||||
|
||||
38 1 print: procedure(string$adr) external;
|
||||
39 2 dcl string$adr address;
|
||||
40 2 end print;
|
||||
|
||||
41 1 print$char: procedure(char) external;
|
||||
42 2 dcl char byte;
|
||||
43 2 end print$char;
|
||||
|
||||
44 1 pdecimal:procedure(val,prec,zsup) external;
|
||||
45 2 dcl (val, prec) address;
|
||||
46 2 dcl zsup boolean;
|
||||
PL/M-86 COMPILER SDIR - SEARCH FOR FILES PAGE 4
|
||||
|
||||
|
||||
47 2 end pdecimal;
|
||||
|
||||
48 1 printfn: procedure(fnameadr) external;
|
||||
49 2 dcl fnameadr address;
|
||||
50 2 end printfn;
|
||||
|
||||
51 1 crlf: procedure external; /* print carriage return, linefeed */
|
||||
52 2 end crlf;
|
||||
|
||||
53 1 add3byte: procedure(byte3adr,num) external;
|
||||
54 2 dcl (byte3adr,num) address;
|
||||
55 2 end add3byte;
|
||||
|
||||
/* add three byte number to 3 byte accumulater */
|
||||
56 1 add3byte3: procedure(totalb,numb) external;
|
||||
57 2 dcl (totalb,numb) address;
|
||||
58 2 end add3byte3;
|
||||
|
||||
/* divide 3 byte value by 8 */
|
||||
59 1 shr3byte: procedure(byte3adr) external;
|
||||
60 2 dcl byte3adr address;
|
||||
61 2 end shr3byte;
|
||||
|
||||
/* -------- In dpb86.plm -------- */
|
||||
|
||||
$include(dpb.lit)
|
||||
=
|
||||
= /* indices into disk parameter block, used as parameters to dpb procedure */
|
||||
=
|
||||
62 1 = dcl spt$w lit '0',
|
||||
= blkshf$b lit '2',
|
||||
= blkmsk$b lit '3',
|
||||
= extmsk$b lit '4',
|
||||
= blkmax$w lit '5',
|
||||
= dirmax$w lit '7',
|
||||
= dirblk$w lit '9',
|
||||
= chksiz lit '11',
|
||||
= offset$w lit '13';
|
||||
=
|
||||
|
||||
63 1 dcl k$per$block byte external; /* set in dpb module */
|
||||
|
||||
64 1 base$dpb: procedure external;
|
||||
65 2 end base$dpb;
|
||||
|
||||
66 1 dpb$byte: procedure(param) byte external;
|
||||
67 2 dcl param byte;
|
||||
68 2 end dpb$byte;
|
||||
|
||||
69 1 dpb$word: procedure(param) address external;
|
||||
70 2 dcl param byte;
|
||||
71 2 end dpb$word;
|
||||
|
||||
|
||||
/* -------- Some Utility Routines -------- */
|
||||
|
||||
72 1 check$console$status: procedure byte;
|
||||
PL/M-86 COMPILER SDIR - SEARCH FOR FILES PAGE 5
|
||||
|
||||
|
||||
73 2 return mon2 (11,0);
|
||||
74 2 end check$console$status;
|
||||
|
||||
75 1 search$first: procedure (fcb$address) byte public;
|
||||
76 2 declare fcb$address address; /* shared with disp.plm */
|
||||
77 2 return mon2 (17,fcb$address); /* for short display */
|
||||
78 2 end search$first;
|
||||
|
||||
79 1 search$next: procedure byte public; /* shared with disp.plm */
|
||||
80 2 return mon2 (18,0);
|
||||
81 2 end search$next;
|
||||
|
||||
82 1 terminate: procedure external; /* in main.plm */
|
||||
83 2 end terminate;
|
||||
|
||||
84 1 set$vec: procedure(vector,value) external; /* in main.plm */
|
||||
85 2 dcl vector address,
|
||||
value byte;
|
||||
86 2 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)
|
||||
=
|
||||
= /* file info record for SDIR - note if this structure changes in size */
|
||||
= /* the multXX: routine in the sort.plm module must also change */
|
||||
=
|
||||
87 1 = declare
|
||||
= f$info$structure lit 'structure(
|
||||
= usr byte, name (8) byte, type (3) byte, onekblocks address,
|
||||
= kbytes address, recs$lword address, recs$hbyte byte,
|
||||
= hash$link address, x$i$adr address)';
|
||||
88 1 = declare
|
||||
= x$info$structure lit 'structure (
|
||||
= create (4) byte,
|
||||
= update (4) byte,
|
||||
= passmode byte)';
|
||||
=
|
||||
|
||||
89 1 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,
|
||||
sfcb$adr address,
|
||||
PL/M-86 COMPILER SDIR - SEARCH FOR FILES PAGE 6
|
||||
|
||||
|
||||
dir$type based sfcb$adr byte,
|
||||
sfcbs$present byte,
|
||||
x$i$adr address public,
|
||||
xfcb$info based x$i$adr x$info$structure;
|
||||
|
||||
90 1 compare: procedure(length, str1$adr, str2$adr) boolean;
|
||||
91 2 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 */
|
||||
|
||||
92 2 do i = 0 to length - 1;
|
||||
93 3 if ((str1(i) and 7fh) <> (str2(i) and 7fh)) and str2(i) <> '?' then
|
||||
94 3 return(false);
|
||||
95 3 end;
|
||||
96 2 return(true);
|
||||
97 2 end compare;
|
||||
|
||||
98 1 match: procedure boolean public;
|
||||
99 2 dcl i byte,
|
||||
temp address;
|
||||
100 2 if (i := (buf$fcb(f$drvusr) and 0fh)) <> cur$usr then
|
||||
101 2 if not get$all$dir$entries then /* Not looking for this user */
|
||||
102 2 return(false); /* and not buffering all other*/
|
||||
else /* specified user files on */
|
||||
103 2 do; temp = 0; /* this drive. */
|
||||
105 3 call set$vec(.temp,i);
|
||||
106 3 if (temp and usr$vector) = 0 then /* Getting all dir entries, */
|
||||
107 3 return(false); /* with user number corresp'g */
|
||||
108 3 end; /* to a bit on in usr$vector */
|
||||
|
||||
109 2 if usr$vector <> 0 and i <> 0 and first$pass <> 0 then
|
||||
110 2 call set$vec(.active$usr$vector,i); /* skip cur$usr files */
|
||||
/* build active usr vector for this drive */
|
||||
|
||||
111 2 do i = 0 to num$search$files - 1;
|
||||
112 3 if search(i).drv = 0ffh or search(i).drv = cur$drv then
|
||||
/* match on any drive if 0ffh */
|
||||
113 3 if search(i).anyfile = true then
|
||||
114 3 return(not find.exclude); /* file found */
|
||||
115 3 else if compare(11,.buf$fcb(f$name),.search(i).name(0)) then
|
||||
116 3 return(not find.exclude); /* file found */
|
||||
end;
|
||||
118 2 return(find.exclude); /* file not found */
|
||||
119 2 end match; /* find.exclude = the exclude option value */
|
||||
|
||||
120 1 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 */
|
||||
|
||||
121 1 hash$look$up: procedure boolean;
|
||||
122 2 dcl (i,found,hash$index) byte;
|
||||
123 2 hash$index = 0;
|
||||
PL/M-86 COMPILER SDIR - SEARCH FOR FILES PAGE 7
|
||||
|
||||
|
||||
124 2 do i = f$name to f$namelen + f$typelen;
|
||||
125 3 hash$index = hash$index + (buf$fcb(i) and 7fh); /* attributes may */
|
||||
126 3 end; /* only be set w/ 1st extent */
|
||||
127 2 hash$index = hash$index + cur$usr;
|
||||
128 2 hash$index = hash$index and (hash$table$size - 1);
|
||||
129 2 hash$entry$adr = .hash$table(hash$index); /* put new entry in table if */
|
||||
130 2 f$i$adr = hash$table(hash$index); /* unused ( = 0) */
|
||||
|
||||
131 2 found = false;
|
||||
132 2 do while f$i$adr <> 0 and not found;
|
||||
133 3 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
|
||||
134 3 found = true;
|
||||
else /* table entry used - collison */
|
||||
135 3 do; hash$entry$adr = .file$info.hash$link; /* resolve by linked */
|
||||
137 4 f$i$adr = file$info.hash$link; /* list */
|
||||
138 4 end;
|
||||
139 3 end;
|
||||
140 2 if f$i$adr = 0 then
|
||||
141 2 return(false); /* didn't find it, used hash$entry to keep new info */
|
||||
142 2 else return(true); /* found it, file$info at matched entry */
|
||||
143 2 end hash$look$up;
|
||||
|
||||
PL/M-86 COMPILER SDIR - SEARCH FOR FILES PAGE 8
|
||||
|
||||
|
||||
$eject
|
||||
144 1 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 ------------------------- */
|
||||
|
||||
|
||||
145 2 dcl (i, j, d$map$cnt) byte,
|
||||
temp address;
|
||||
|
||||
146 2 store$file: procedure;
|
||||
147 3 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 */
|
||||
|
||||
148 3 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 */
|
||||
149 3 d$map$cnt = 0; /* count kilobytes for current dir entry */
|
||||
150 3 i = 1; /* 1 or 2 byte block numbers ? */
|
||||
151 3 if dpb$word(blk$max$w) > 255 then
|
||||
152 3 i = 2;
|
||||
153 3 do j = f$diskmap to f$diskmap + diskmaplen - 1 by i;
|
||||
PL/M-86 COMPILER SDIR - SEARCH FOR FILES PAGE 9
|
||||
|
||||
|
||||
154 4 temp = buf$fcb(j);
|
||||
155 4 if i = 2 then /* word block numbers */
|
||||
156 4 temp = temp or buf$fcb(j+1);
|
||||
157 4 if temp <> 0 then /* allocated */
|
||||
158 4 d$map$cnt = d$map$cnt + 1;
|
||||
159 4 end;
|
||||
160 3 if d$map$cnt > 0 then
|
||||
161 3 do;
|
||||
162 4 call add3byte
|
||||
(.file$info.recs$lword,
|
||||
d$map$cnt * (dpb$byte(blkmsk$b) + 1) -
|
||||
( (128 - buf$fcb(f$rc)) and dpb$byte(blkmsk$b) )
|
||||
);
|
||||
163 4 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 */
|
||||
164 4 file$info.kbytes = file$info.kbytes + d$map$cnt * k$per$block;
|
||||
165 4 end;
|
||||
166 3 end;
|
||||
|
||||
167 2 if buf$fcb(f$drvusr) <> sfcb$type then do; /* don't put SFCB's in table */
|
||||
169 3 if not hash$look$up then /* not in table already */
|
||||
/* hash$entry is where to put adr of new entry */
|
||||
170 3 do; /* copy to new position in file info array */
|
||||
171 4 if (temp := mult23(files$found + 1)) > x$i$adr then
|
||||
172 4 return(false); /* out of memory */
|
||||
173 4 if (temp < first$f$i$adr) then
|
||||
174 4 return(false); /* wrap around - out of memory */
|
||||
175 4 f$i$adr = (last$f$i$adr := last$f$i$adr + size(file$info));
|
||||
176 4 filesfound = filesfound + 1;
|
||||
177 4 call move(f$namelen + f$typelen, .buf$fcb(f$name),.file$info.name);
|
||||
178 4 file$info.usr = buf$fcb(f$drvusr) and 0fh;
|
||||
179 4 file$info.onekblocks,file$info.kbytes,file$info.recs$lword,
|
||||
file$info.recs$hbyte, file$info.x$i$adr,file$info.hash$link = 0;
|
||||
180 4 hash$entry = f$i$adr; /* save the address of file$info */
|
||||
181 4 end; /* zero totals for the new file */
|
||||
182 3 end;
|
||||
|
||||
/* else hash$lookup has set f$i$adr to the file entry already in the */
|
||||
/* hash table */
|
||||
|
||||
183 2 if sfcbs$present then do; /* save sfcb,xfcb or fcb type info */
|
||||
185 3 if (buf$fcb(f$drvusr) and xfcb$type) = 0 then do;
|
||||
187 4 if buf$fcb(f$drvusr) <> sfcb$type then do;
|
||||
189 5 if buf$fcb(f$ex) <= dpb$byte(extmsk$b) then do;
|
||||
/* first extent? then store sfcb info into xfcb table */
|
||||
191 6 if last$f$i$adr + size(file$info) > x$i$adr - size(xfcb$info) then
|
||||
192 6 return(false); /* out of memory */
|
||||
193 6 x$i$adr = x$i$adr - size(xfcb$info);
|
||||
194 6 call move(9,sfcb$adr,.xfcb$info.create);
|
||||
195 6 file$info.x$i$adr = x$i$adr;
|
||||
196 6 end;
|
||||
197 5 call store$file;
|
||||
198 5 end;
|
||||
199 4 end;
|
||||
PL/M-86 COMPILER SDIR - SEARCH FOR FILES PAGE 10
|
||||
|
||||
|
||||
200 3 end;
|
||||
201 2 else do; /* no SFCB's present */
|
||||
202 3 if (buf$fcb(f$drvusr) and xfcb$type) <> 0 then do; /* XFCB */
|
||||
204 4 if last$f$i$adr + size(file$info) > x$i$adr - size(xfcb$info) then
|
||||
205 4 return(false); /* out of memory */
|
||||
206 4 x$i$adr = x$i$adr - size(xfcb$info);
|
||||
207 4 call move(8,.buf$fcb(xf$create),.xfcb$info.create);
|
||||
208 4 xfcb$info.passmode = buf$fcb(xf$passmode);
|
||||
209 4 file$info.x$i$adr = x$i$adr;
|
||||
210 4 end;
|
||||
211 3 else call store$file; /* must be a regular fcb then */
|
||||
212 3 end;
|
||||
213 2 return(true); /* success */
|
||||
214 2 end store$file$info;
|
||||
|
||||
|
||||
/* Module Entry Point */
|
||||
|
||||
215 1 get$files: procedure public; /* with one scan through directory get */
|
||||
216 2 dcl dcnt byte; /* files from currently selected drive */
|
||||
|
||||
217 2 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 */
|
||||
|
||||
218 2 do dcnt = 0 to hash$table$size - 1; /* init hash table */
|
||||
219 3 hash$table(dcnt) = 0;
|
||||
220 3 end;
|
||||
|
||||
221 2 x$i$adr = maxb; /* top of mem, put xfcb info here */
|
||||
222 2 call base$dpb;
|
||||
223 2 dir$label,filesfound, used$de = 0;
|
||||
|
||||
224 2 fcb(f$drvusr) = '?'; /* match all dir entries */
|
||||
225 2 dcnt = search$first(.fcb);
|
||||
226 2 sfcb$adr = 96 + .buff; /* determine if SFCB's are present */
|
||||
227 2 if dir$type = sfcb$type then
|
||||
228 2 do;
|
||||
229 3 sfcbs$present = true;
|
||||
230 3 used$de = shr(1+dpb$word(dirmax$w),2); /* count all sfcb's once */
|
||||
231 3 end;
|
||||
else
|
||||
232 2 sfcbs$present = false;
|
||||
233 2 do while dcnt <> 255;
|
||||
234 3 buf$fcb$adr = shl(dcnt and 11b,5)+.buff; /* dcnt mod 4 * 32 */
|
||||
235 3 if sfcbs$present then
|
||||
236 3 sfcb$adr = 97 + (dcnt * 10) + .buff; /* SFCB time & date stamp adr */
|
||||
237 3 if (buf$fcb(f$drvusr) <> deleted$type) then
|
||||
238 3 do;
|
||||
239 4 if (buf$fcb(f$drvusr) <> sfcb$type) then
|
||||
240 4 used$de = used$de + 1;
|
||||
241 4 if buf$fcb(f$drvusr) = dirlabel$type then /* dir label ? */
|
||||
242 4 dir$label = buf$fcb(f$ex); /* save label info */
|
||||
243 4 else if match then
|
||||
244 4 do;
|
||||
245 5 if not store$file$info then /* store fcb or xfcb info */
|
||||
PL/M-86 COMPILER SDIR - SEARCH FOR FILES PAGE 11
|
||||
|
||||
|
||||
246 5 do; /* out of space */
|
||||
247 6 call print (.('Out of Memory',cr,lf,'$'));
|
||||
248 6 return;
|
||||
249 6 end;
|
||||
250 5 end;
|
||||
end;
|
||||
/*call break;*/
|
||||
252 3 dcnt = search$next; /* to next entry in directory */
|
||||
253 3 end; /* of do while dcnt <> 255 */
|
||||
|
||||
254 2 end get$files;
|
||||
|
||||
255 1 search$init: procedure public; /* called once from main.plm */
|
||||
256 2 if (first$f$i$adr := (.hash$table + size(hash$table))) + size(file$info)
|
||||
> maxb then
|
||||
257 2 do;
|
||||
258 3 call print(.('Not Enough Memory',cr,lf,'$'));
|
||||
259 3 call terminate;
|
||||
260 3 end;
|
||||
261 2 end search$init;
|
||||
|
||||
262 1 end search;
|
||||
PL/M-86 COMPILER SDIR - SEARCH FOR FILES PAGE 12
|
||||
|
||||
|
||||
CROSS-REFERENCE LISTING
|
||||
-----------------------
|
||||
|
||||
|
||||
DEFN ADDR SIZE NAME, ATTRIBUTES, AND REFERENCES
|
||||
----- ------ ----- --------------------------------
|
||||
|
||||
|
||||
7 0000H 2 A. . . . . . . . . WORD PARAMETER 8
|
||||
10 0000H 2 A. . . . . . . . . WORD PARAMETER 11
|
||||
4 0000H 2 A. . . . . . . . . WORD PARAMETER 5
|
||||
17 0000H 2 ACTIVEUSRVECTOR. . WORD EXTERNAL(10) 110
|
||||
53 0000H ADD3BYTE . . . . . PROCEDURE EXTERNAL(22) STACK=0000H 162
|
||||
56 0000H ADD3BYTE3. . . . . PROCEDURE EXTERNAL(23) STACK=0000H
|
||||
30 000CH 1 ANYFILE. . . . . . BYTE MEMBER(SEARCH) 113
|
||||
64 0000H BASEDPB. . . . . . PROCEDURE EXTERNAL(26) STACK=0000H 222
|
||||
62 BLKMAXW. . . . . . LITERALLY 151
|
||||
62 BLKMSKB. . . . . . LITERALLY 162 163
|
||||
62 BLKSHFB. . . . . . LITERALLY
|
||||
2 BOOLEAN. . . . . . LITERALLY 13 14 15 30 46 90 98 121 144
|
||||
3 0000H 128 BUFF . . . . . . . BYTE ARRAY(128) EXTERNAL(2) 226 234 236
|
||||
89 0000H 32 BUFFCB . . . . . . BYTE BASED(BUFFCBADR) ARRAY(32) 100 115 125 133 147 148
|
||||
154 156 162 163 167 177 178 185 187 189 202 207 208 237
|
||||
239 241 242
|
||||
89 0004H 2 BUFFCBADR. . . . . WORD PUBLIC 89 100 115 125 133 147 148 154 156 162
|
||||
163 167 177 178 185 187 189 202 207 208 234 237 239 241
|
||||
242
|
||||
59 0000H 2 BYTE3ADR . . . . . WORD PARAMETER 60
|
||||
53 0000H 2 BYTE3ADR . . . . . WORD PARAMETER 54
|
||||
41 0000H 1 CHAR . . . . . . . BYTE PARAMETER 42
|
||||
72 000FH 15 CHECKCONSOLESTATUS PROCEDURE BYTE STACK=0008H
|
||||
62 CHKSIZ . . . . . . LITERALLY
|
||||
90 003DH 65 COMPARE. . . . . . PROCEDURE BYTE STACK=0008H 115 133
|
||||
2 CR . . . . . . . . LITERALLY 247 258
|
||||
89 0000H 4 CREATE . . . . . . BYTE ARRAY(4) MEMBER(XFCBINFO) 194 207
|
||||
51 0000H CRLF . . . . . . . PROCEDURE EXTERNAL(21) STACK=0000H
|
||||
2 CTRLC. . . . . . . LITERALLY
|
||||
31 0000H 1 CURDRV . . . . . . BYTE EXTERNAL(15) 112
|
||||
31 0000H 1 CURUSR . . . . . . BYTE EXTERNAL(14) 100 127
|
||||
2 DCL. . . . . . . . LITERALLY
|
||||
216 0020H 1 DCNT . . . . . . . BYTE 218 219 225 233 234 236 252
|
||||
13 0000H 1 DEBUG. . . . . . . BYTE EXTERNAL(6)
|
||||
24 DELETEDTYPE. . . . LITERALLY 237
|
||||
28 0000H 1 DIR. . . . . . . . BYTE MEMBER(FIND)
|
||||
62 DIRBLKW. . . . . . LITERALLY
|
||||
31 0016H 1 DIRLABEL . . . . . BYTE PUBLIC 223 242
|
||||
22 DIRLABELTYPE . . . LITERALLY 241
|
||||
62 DIRMAXW. . . . . . LITERALLY 230
|
||||
89 0000H 1 DIRTYPE. . . . . . BYTE BASED(SFCBADR) 227
|
||||
20 DISKMAPLEN . . . . LITERALLY 153
|
||||
22 DLACCESS . . . . . LITERALLY
|
||||
22 DLEXISTS . . . . . LITERALLY
|
||||
22 DLMAKEXFCB . . . . LITERALLY
|
||||
22 DLPASSWORD . . . . LITERALLY
|
||||
22 DLUPDATE . . . . . LITERALLY
|
||||
145 001FH 1 DMAPCNT. . . . . . BYTE 149 158 160 162 163 164
|
||||
66 0000H DPBBYTE. . . . . . PROCEDURE BYTE EXTERNAL(27) STACK=0000H 162 163 189
|
||||
PL/M-86 COMPILER SDIR - SEARCH FOR FILES PAGE 13
|
||||
|
||||
|
||||
69 0000H DPBWORD. . . . . . PROCEDURE WORD EXTERNAL(28) STACK=0000H 151 230
|
||||
30 0000H 1 DRV. . . . . . . . BYTE MEMBER(SEARCH) 112
|
||||
28 0007H 1 EXCLUDE. . . . . . BYTE MEMBER(FIND) 114 116 118
|
||||
62 EXTMSKB. . . . . . LITERALLY 189
|
||||
4 0000H 1 F. . . . . . . . . BYTE PARAMETER 5
|
||||
10 0000H 1 F. . . . . . . . . BYTE PARAMETER 11
|
||||
7 0000H 1 F. . . . . . . . . BYTE PARAMETER 8
|
||||
2 FALSE. . . . . . . LITERALLY 94 102 107 131 141 172 174 192 205 232
|
||||
20 FARC . . . . . . . LITERALLY 148
|
||||
3 0000H 33 FCB. . . . . . . . BYTE ARRAY(33) EXTERNAL(0) 224 225
|
||||
75 0004H 2 FCBADDRESS . . . . WORD PARAMETER AUTOMATIC 76 77
|
||||
20 FCR. . . . . . . . LITERALLY
|
||||
20 FDIRSYS. . . . . . LITERALLY
|
||||
20 FDISKMAP . . . . . LITERALLY 153
|
||||
20 FDRVUSR. . . . . . LITERALLY 100 133 167 178 185 187 202 224 237 239 241
|
||||
20 FDRVUSR2 . . . . . LITERALLY
|
||||
20 FEX. . . . . . . . LITERALLY 189 242
|
||||
2 FF . . . . . . . . LITERALLY
|
||||
89 0008H 2 FIADR. . . . . . . WORD PUBLIC 89 130 132 133 136 137 140 147 148 162
|
||||
163 164 175 177 178 179 180 195 209
|
||||
89 0000H 23 FILEINFO . . . . . STRUCTURE BASED(FIADR) 133 136 137 147 148 162 163 164
|
||||
175 177 178 179 191 195 204 209 217 256
|
||||
19 0002H 2 FILESFOUND . . . . WORD PUBLIC 171 176 223
|
||||
28 0000H 8 FIND . . . . . . . STRUCTURE EXTERNAL(11) 114 116 118
|
||||
25 FINDSTRUCTURE. . . LITERALLY 28
|
||||
35 0000H 2 FINFOINDEX . . . . WORD PARAMETER 36
|
||||
87 FINFOSTRUCTURE . . LITERALLY 89
|
||||
89 0006H 2 FIRSTFIADR . . . . WORD PUBLIC 173 217 256
|
||||
14 0000H 1 FIRSTPASS. . . . . BYTE EXTERNAL(7) 109
|
||||
20 FNAME. . . . . . . LITERALLY 115 124 133 147 177
|
||||
20 FNAME2 . . . . . . LITERALLY
|
||||
48 0000H 2 FNAMEADR . . . . . WORD PARAMETER 49
|
||||
20 FNAMELEN . . . . . LITERALLY 124 133 147 177
|
||||
2 FOREVER. . . . . . LITERALLY
|
||||
122 001BH 1 FOUND. . . . . . . BYTE 131 132 134
|
||||
20 FRC. . . . . . . . LITERALLY 162 163
|
||||
20 FRREC. . . . . . . LITERALLY
|
||||
20 FRRECO . . . . . . LITERALLY
|
||||
20 FRW. . . . . . . . LITERALLY
|
||||
20 FS1. . . . . . . . LITERALLY
|
||||
20 FTYPE. . . . . . . LITERALLY
|
||||
20 FTYPE2 . . . . . . LITERALLY
|
||||
20 FTYPELEN . . . . . LITERALLY 124 133 147 177
|
||||
15 0000H 1 GETALLDIRENTRIES . BYTE EXTERNAL(8) 101
|
||||
215 043AH 234 GETFILES . . . . . PROCEDURE PUBLIC STACK=0016H
|
||||
120 0000H 2 HASHENTRY. . . . . WORD BASED(HASHENTRYADR) 180
|
||||
120 0012H 2 HASHENTRYADR . . . WORD 120 129 136 180
|
||||
122 001CH 1 HASHINDEX. . . . . BYTE 123 125 127 128 129 130
|
||||
89 0013H 2 HASHLINK . . . . . WORD MEMBER(FILEINFO) 136 137 179
|
||||
121 0146H 189 HASHLOOKUP . . . . PROCEDURE BYTE STACK=000EH 169
|
||||
120 0000H 256 HASHTABLE. . . . . WORD ARRAY(128) AT 129 130 219 256
|
||||
120 HASHTABLESIZE. . . LITERALLY 120 128 218
|
||||
145 001DH 1 I. . . . . . . . . BYTE 150 152 153 155
|
||||
99 0019H 1 I. . . . . . . . . BYTE 100 105 109 110 111 112 113 115
|
||||
122 001AH 1 I. . . . . . . . . BYTE 124 125
|
||||
91 0018H 1 I. . . . . . . . . BYTE 92 93
|
||||
145 001EH 1 J. . . . . . . . . BYTE 153 154 156
|
||||
PL/M-86 COMPILER SDIR - SEARCH FOR FILES PAGE 14
|
||||
|
||||
|
||||
89 000EH 2 KBYTES . . . . . . WORD MEMBER(FILEINFO) 164 179
|
||||
63 0000H 1 KPERBLOCK. . . . . BYTE EXTERNAL(25) 163 164
|
||||
89 000AH 2 LASTFIADR. . . . . WORD PUBLIC 175 191 204 217
|
||||
90 0008H 1 LENGTH . . . . . . BYTE PARAMETER AUTOMATIC 91 92
|
||||
2 LF . . . . . . . . LITERALLY 247 258
|
||||
2 LIT. . . . . . . . LITERALLY 2 20 21 22 23 24 25 27 62 87 88
|
||||
120
|
||||
98 007EH 200 MATCH. . . . . . . PROCEDURE BYTE PUBLIC STACK=000CH 243
|
||||
3 0000H 2 MAXB . . . . . . . WORD EXTERNAL(1) 221 256
|
||||
26 MAXSEARCHFILES . . LITERALLY 30
|
||||
0000H MEMORY . . . . . . BYTE ARRAY(0) 120
|
||||
4 0000H MON1 . . . . . . . PROCEDURE EXTERNAL(3) STACK=0000H
|
||||
7 0000H MON2 . . . . . . . PROCEDURE BYTE EXTERNAL(4) STACK=0000H 33 73 77 80
|
||||
10 0000H MON3 . . . . . . . PROCEDURE WORD EXTERNAL(5) STACK=0000H
|
||||
MOVE . . . . . . . BUILTIN 147 177 194 207
|
||||
35 0000H MULT23 . . . . . . PROCEDURE WORD EXTERNAL(16) STACK=0000H 171
|
||||
89 0001H 8 NAME . . . . . . . BYTE ARRAY(8) MEMBER(FILEINFO) 133 147 148 177
|
||||
30 0001H 8 NAME . . . . . . . BYTE ARRAY(8) MEMBER(SEARCH) 115
|
||||
28 0006H 1 NONXFCB. . . . . . BYTE MEMBER(FIND)
|
||||
2 NOPAGEMODEOFFSET . LITERALLY
|
||||
53 0000H 2 NUM. . . . . . . . WORD PARAMETER 54
|
||||
56 0000H 2 NUMB . . . . . . . WORD PARAMETER 57
|
||||
29 0000H 1 NUMSEARCHFILES . . BYTE EXTERNAL(12) 111
|
||||
62 OFFSETW. . . . . . LITERALLY
|
||||
89 000CH 2 ONEKBLOCKS . . . . WORD MEMBER(FILEINFO) 163 179
|
||||
2 PAGELENOFFSET. . . LITERALLY
|
||||
69 0000H 1 PARAM. . . . . . . BYTE PARAMETER 70
|
||||
66 0000H 1 PARAM. . . . . . . BYTE PARAMETER 67
|
||||
28 0004H 1 PASS . . . . . . . BYTE MEMBER(FIND)
|
||||
21 PASSLEN. . . . . . LITERALLY
|
||||
89 0008H 1 PASSMODE . . . . . BYTE MEMBER(XFCBINFO) 208
|
||||
44 0000H PDECIMAL . . . . . PROCEDURE EXTERNAL(19) STACK=0000H
|
||||
23 PMDELETE . . . . . LITERALLY
|
||||
23 PMREAD . . . . . . LITERALLY
|
||||
23 PMWRITE. . . . . . LITERALLY
|
||||
44 0000H 2 PREC . . . . . . . WORD PARAMETER 45
|
||||
38 0000H PRINT. . . . . . . PROCEDURE EXTERNAL(17) STACK=0000H 247 258
|
||||
41 0000H PRINTCHAR. . . . . PROCEDURE EXTERNAL(18) STACK=0000H
|
||||
48 0000H PRINTFN. . . . . . PROCEDURE EXTERNAL(20) STACK=0000H
|
||||
32 0000H 15 READCHAR . . . . . PROCEDURE BYTE STACK=0008H
|
||||
89 0012H 1 RECSHBYTE. . . . . BYTE MEMBER(FILEINFO) 179
|
||||
89 0010H 2 RECSLWORD. . . . . WORD MEMBER(FILEINFO) 162 179
|
||||
28 0002H 1 RO . . . . . . . . BYTE MEMBER(FIND)
|
||||
28 0003H 1 RW . . . . . . . . BYTE MEMBER(FIND)
|
||||
1 0000H SEARCH . . . . . . PROCEDURE STACK=0000H
|
||||
30 0000H 130 SEARCH . . . . . . STRUCTURE ARRAY(10) EXTERNAL(13) 112 113 115
|
||||
75 001EH 16 SEARCHFIRST. . . . PROCEDURE BYTE PUBLIC STACK=000AH 225
|
||||
255 0524H 30 SEARCHINIT . . . . PROCEDURE PUBLIC STACK=0006H
|
||||
79 002EH 15 SEARCHNEXT . . . . PROCEDURE BYTE PUBLIC STACK=0008H 252
|
||||
27 SEARCHSTRUCTURE. . LITERALLY 30
|
||||
2 SECTORLEN. . . . . LITERALLY
|
||||
84 0000H SETVEC . . . . . . PROCEDURE EXTERNAL(30) STACK=0000H 105 110
|
||||
89 000CH 2 SFCBADR. . . . . . WORD 89 194 226 227 236
|
||||
89 0017H 1 SFCBSPRESENT . . . BYTE 183 229 232 235
|
||||
24 SFCBTYPE . . . . . LITERALLY 167 187 227 239
|
||||
SHL. . . . . . . . BUILTIN 234
|
||||
SHR. . . . . . . . BUILTIN 163 230
|
||||
PL/M-86 COMPILER SDIR - SEARCH FOR FILES PAGE 15
|
||||
|
||||
|
||||
59 0000H SHR3BYTE . . . . . PROCEDURE EXTERNAL(24) STACK=0000H
|
||||
SIZE . . . . . . . BUILTIN 175 191 193 204 206 217 256
|
||||
62 SPTW . . . . . . . LITERALLY
|
||||
146 0338H 258 STOREFILE. . . . . PROCEDURE STACK=000CH 197 211
|
||||
144 0203H 309 STOREFILEINFO. . . PROCEDURE BYTE STACK=0012H 245
|
||||
91 0000H 1 STR1 . . . . . . . BYTE BASED(STR1ADR) ARRAY(1) 93
|
||||
90 0006H 2 STR1ADR. . . . . . WORD PARAMETER AUTOMATIC 91 93
|
||||
91 0000H 1 STR2 . . . . . . . BYTE BASED(STR2ADR) ARRAY(1) 93
|
||||
90 0004H 2 STR2ADR. . . . . . WORD PARAMETER AUTOMATIC 91 93
|
||||
38 0000H 2 STRINGADR. . . . . WORD PARAMETER 39
|
||||
28 0001H 1 SYS. . . . . . . . BYTE MEMBER(FIND)
|
||||
2 TAB. . . . . . . . LITERALLY
|
||||
145 0014H 2 TEMP . . . . . . . WORD 154 156 157 171 173
|
||||
99 0010H 2 TEMP . . . . . . . WORD 104 105 106
|
||||
82 0000H TERMINATE. . . . . PROCEDURE EXTERNAL(29) STACK=0000H 259
|
||||
56 0000H 2 TOTALB . . . . . . WORD PARAMETER 57
|
||||
2 TRUE . . . . . . . LITERALLY 96 113 134 142 213 229
|
||||
89 0009H 3 TYPE . . . . . . . BYTE ARRAY(3) MEMBER(FILEINFO)
|
||||
30 0009H 3 TYPE . . . . . . . BYTE ARRAY(3) MEMBER(SEARCH)
|
||||
89 0004H 4 UPDATE . . . . . . BYTE ARRAY(4) MEMBER(XFCBINFO)
|
||||
18 0000H 2 USEDDE . . . . . . WORD PUBLIC 223 230 240
|
||||
89 0000H 1 USR. . . . . . . . BYTE MEMBER(FILEINFO) 133 178
|
||||
16 0000H 2 USRVECTOR. . . . . WORD EXTERNAL(9) 106 109
|
||||
44 0000H 2 VAL. . . . . . . . WORD PARAMETER 45
|
||||
84 0000H 1 VALUE. . . . . . . BYTE PARAMETER 85
|
||||
84 0000H 2 VECTOR . . . . . . WORD PARAMETER 85
|
||||
28 0005H 1 XFCB . . . . . . . BYTE MEMBER(FIND)
|
||||
89 0000H 9 XFCBINFO . . . . . STRUCTURE BASED(XIADR) 191 193 194 204 206 207 208
|
||||
21 XFCBTYPE . . . . . LITERALLY 185 202
|
||||
21 XFCREATE . . . . . LITERALLY 207
|
||||
21 XFPASS . . . . . . LITERALLY
|
||||
21 XFPASSMODE . . . . LITERALLY 208
|
||||
21 XFUPDATE . . . . . LITERALLY
|
||||
89 000EH 2 XIADR. . . . . . . WORD PUBLIC 89 171 191 193 194 195 204 206 207 208
|
||||
209 221
|
||||
89 0015H 2 XIADR. . . . . . . WORD MEMBER(FILEINFO) 179 195 209
|
||||
88 XINFOSTRUCTURE . . LITERALLY 89
|
||||
44 0000H 1 ZSUP . . . . . . . BYTE PARAMETER 46
|
||||
|
||||
|
||||
|
||||
MODULE INFORMATION:
|
||||
|
||||
CODE AREA SIZE = 0542H 1346D
|
||||
CONSTANT AREA SIZE = 0024H 36D
|
||||
VARIABLE AREA SIZE = 0021H 33D
|
||||
MAXIMUM STACK SIZE = 0016H 22D
|
||||
553 LINES READ
|
||||
0 PROGRAM ERROR(S)
|
||||
|
||||
END OF PL/M-86 COMPILATION
|
||||
@@ -0,0 +1,424 @@
|
||||
$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
|
||||
sfcb$type lit '21H',
|
||||
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 address;
|
||||
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,
|
||||
sfcb$adr address,
|
||||
dir$type based sfcb$adr byte,
|
||||
sfcbs$present byte,
|
||||
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;
|
||||
|
||||
store$file: procedure;
|
||||
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;
|
||||
|
||||
if buf$fcb(f$drvusr) <> sfcb$type then do; /* don't put SFCB's in table */
|
||||
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 */
|
||||
end;
|
||||
|
||||
/* else hash$lookup has set f$i$adr to the file entry already in the */
|
||||
/* hash table */
|
||||
|
||||
if sfcbs$present then do; /* save sfcb,xfcb or fcb type info */
|
||||
if (buf$fcb(f$drvusr) and xfcb$type) = 0 then do;
|
||||
if buf$fcb(f$drvusr) <> sfcb$type then do;
|
||||
if buf$fcb(f$ex) <= dpb$byte(extmsk$b) then do;
|
||||
/* first extent? then store sfcb info into xfcb table */
|
||||
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(9,sfcb$adr,.xfcb$info.create);
|
||||
file$info.x$i$adr = x$i$adr;
|
||||
end;
|
||||
call store$file;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
else do; /* no SFCB's present */
|
||||
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 call store$file; /* must be a regular fcb then */
|
||||
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);
|
||||
sfcb$adr = 96 + .buff; /* determine if SFCB's are present */
|
||||
if dir$type = sfcb$type then
|
||||
do;
|
||||
sfcbs$present = true;
|
||||
used$de = shr(1+dpb$word(dirmax$w),2); /* count all sfcb's once */
|
||||
end;
|
||||
else
|
||||
sfcbs$present = false;
|
||||
do while dcnt <> 255;
|
||||
buf$fcb$adr = shl(dcnt and 11b,5)+.buff; /* dcnt mod 4 * 32 */
|
||||
if sfcbs$present then
|
||||
sfcb$adr = 97 + (dcnt * 10) + .buff; /* SFCB time & date stamp adr */
|
||||
if (buf$fcb(f$drvusr) <> deleted$type) then
|
||||
do;
|
||||
if (buf$fcb(f$drvusr) <> sfcb$type) then
|
||||
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;
|
||||
@@ -0,0 +1,273 @@
|
||||
PL/M-86 COMPILER SDIR - SORT MODULE PAGE 1
|
||||
|
||||
|
||||
ISIS-II PL/M-86 V2.0 COMPILATION OF MODULE SORT
|
||||
OBJECT MODULE PLACED IN SORT
|
||||
COMPILER INVOKED BY: :F0: SORT.PLM DEBUG OBJECT(SORT) OPTIMIZE(3) XREF
|
||||
|
||||
|
||||
|
||||
$title ('SDIR - Sort Module')
|
||||
1 sort:
|
||||
do;
|
||||
/* sort module for extended dir */
|
||||
|
||||
$include(comlit.lit)
|
||||
=
|
||||
2 1 = declare
|
||||
= lit literally 'literally',
|
||||
= dcl lit 'declare',
|
||||
= true lit '0ffh',
|
||||
= false lit '0',
|
||||
= boolean lit 'byte',
|
||||
= forever lit 'while true',
|
||||
= cr lit '13',
|
||||
= lf lit '10',
|
||||
= tab lit '9',
|
||||
= ctrlc lit '3',
|
||||
= ff lit '12',
|
||||
= page$len$offset lit '1ch',
|
||||
= nopage$mode$offset lit '2Ch',
|
||||
= sectorlen lit '128';
|
||||
|
||||
3 1 print: procedure(str$adr) external; /* in util.plm */
|
||||
4 2 dcl str$adr address;
|
||||
5 2 end print;
|
||||
|
||||
6 1 dcl sorted boolean public; /* set by this module if successful sort */
|
||||
|
||||
$include(finfo.lit)
|
||||
=
|
||||
= /* file info record for SDIR - note if this structure changes in size */
|
||||
= /* the multXX: routine in the sort.plm module must also change */
|
||||
=
|
||||
7 1 = declare
|
||||
= f$info$structure lit 'structure(
|
||||
= usr byte, name (8) byte, type (3) byte, onekblocks address,
|
||||
= kbytes address, recs$lword address, recs$hbyte byte,
|
||||
= hash$link address, x$i$adr address)';
|
||||
8 1 = declare
|
||||
= x$info$structure lit 'structure (
|
||||
= create (4) byte,
|
||||
= update (4) byte,
|
||||
= passmode byte)';
|
||||
=
|
||||
|
||||
9 1 declare
|
||||
buf$fcb$adr address external, /* index into directory buffer */
|
||||
buf$fcb based buf$fcb$adr (32) byte,
|
||||
/* fcb template for dir */
|
||||
|
||||
PL/M-86 COMPILER SDIR - SORT MODULE PAGE 2
|
||||
|
||||
|
||||
(f$i$adr, first$f$i$adr, last$f$i$adr, x$i$adr, filesfound)
|
||||
address external,
|
||||
/* indices into file$info array */
|
||||
file$info based f$i$adr f$info$structure,
|
||||
|
||||
mid$adr address,
|
||||
mid$file$info based mid$adr f$info$structure;
|
||||
|
||||
|
||||
10 1 mult23: procedure(index) address public;
|
||||
11 2 dcl index address; /* return address of file$info numbered by index */
|
||||
12 2 return shl(index, 4) + shl(index,2) + shl(index,1) + index + first$f$i$adr;
|
||||
/* index * size(file$info) + base of file$info array */
|
||||
13 2 end mult23;
|
||||
|
||||
14 1 lessthan: procedure( str1$adr, str2$adr) boolean;
|
||||
15 2 dcl (i,c1,c2) byte, /* true if str1 < str2 */
|
||||
(str1$adr, str2$adr) address, /* sorting on name and type field */
|
||||
str1 based str1$adr (1) byte, /* only, assumed to be first in */
|
||||
str2 based str2$adr (1) byte; /* file$info record */
|
||||
16 2 do i = 1 to 11;
|
||||
17 3 if (c1:=(str1(i) and 7fh)) <> (c2:=(str2(i) and 7fh)) then
|
||||
18 3 return(c1 < c2);
|
||||
19 3 end;
|
||||
20 2 return(false);
|
||||
21 2 end lessthan;
|
||||
|
||||
22 1 dcl f$i$indices$base address public,
|
||||
f$i$indices based f$i$indices$base (1) address;
|
||||
|
||||
23 1 qsort: procedure(l,r); /* no recursive quick sort, sorting largest */
|
||||
24 2 dcl (l,r,i,j,temp) address,/* partition first */
|
||||
stacksiz lit '14', /* should always be able to sort 2 ** stacksiz */
|
||||
stack (stack$siz) structure (l address, r address),
|
||||
sp byte;
|
||||
|
||||
25 2 sp = 0; stack(0).l = l; stack(0).r = r;
|
||||
|
||||
28 2 do while sp < stack$siz - 1;
|
||||
29 3 l = stack(sp).l; r = stack(sp).r; sp = sp - 1;
|
||||
32 3 do while l < r;
|
||||
33 4 i = l; j = r;
|
||||
35 4 mid$adr = mult23(f$i$indices(shr(l+r,1)));
|
||||
36 4 do while i <= j;
|
||||
37 5 f$i$adr = mult23(f$i$indices(i));
|
||||
38 5 do while lessthan(f$i$adr,mid$adr);
|
||||
39 6 i = i + 1;
|
||||
40 6 f$i$adr = mult23(f$i$indices(i));
|
||||
41 6 end;
|
||||
42 5 f$i$adr = mult23(f$i$indices(j));
|
||||
43 5 do while lessthan(mid$adr,f$i$adr);
|
||||
44 6 j = j - 1;
|
||||
45 6 f$i$adr = mult23(f$i$indices(j));
|
||||
46 6 end;
|
||||
47 5 if i <= j then
|
||||
48 5 do; temp = f$i$indices(i); f$i$indices(i) = f$i$indices(j);
|
||||
51 6 f$i$indices(j) = temp;
|
||||
PL/M-86 COMPILER SDIR - SORT MODULE PAGE 3
|
||||
|
||||
|
||||
52 6 i = i + 1;
|
||||
53 6 if j > 0 then j = j - 1;
|
||||
55 6 end;
|
||||
56 5 end; /* while i <= j */
|
||||
57 4 if j - l < r - i then /* which partition is larger */
|
||||
58 4 do; if i < r then
|
||||
60 5 do; sp = sp + 1; stack(sp).l = i; stack(sp).r = r;
|
||||
64 6 end;
|
||||
65 5 r = j; /* continue sorting left partition */
|
||||
66 5 end;
|
||||
else
|
||||
67 4 do; if l < j then
|
||||
69 5 do; sp = sp + 1; stack(sp).l = l; stack(sp).r = j;
|
||||
73 6 end;
|
||||
74 5 l = i; /* continue sorting right partition */
|
||||
75 5 end;
|
||||
76 4 end; /* while l < r */
|
||||
77 3 end; /* while sp < stack$siz - 1 */
|
||||
78 2 if sp <> 255 then
|
||||
79 2 call print(.(cr,lf,lf,'Sort Stack Overflow',cr,lf,'$'));
|
||||
80 2 else sorted = true;
|
||||
81 2 end qsort;
|
||||
|
||||
82 1 sort: procedure public;
|
||||
83 2 dcl i address;
|
||||
84 2 f$i$indices$base = last$f$i$adr + size(file$info);
|
||||
85 2 if filesfound < 2 then
|
||||
86 2 return;
|
||||
87 2 if shr((x$i$adr - f$i$indices$base),1) < filesfound then
|
||||
88 2 do;
|
||||
89 3 call print(.('Not Enough Memory for Sort',cr,lf,'$'));
|
||||
90 3 return;
|
||||
91 3 end;
|
||||
92 2 do i = 0 to filesfound - 1;
|
||||
93 3 f$i$indices(i) = i; /* initialize f$i$indices */
|
||||
94 3 end;
|
||||
95 2 call qsort(0,filesfound - 1);
|
||||
96 2 sorted = true;
|
||||
97 2 end sort;
|
||||
|
||||
98 1 end sort;
|
||||
PL/M-86 COMPILER SDIR - SORT MODULE PAGE 4
|
||||
|
||||
|
||||
CROSS-REFERENCE LISTING
|
||||
-----------------------
|
||||
|
||||
|
||||
DEFN ADDR SIZE NAME, ATTRIBUTES, AND REFERENCES
|
||||
----- ------ ----- --------------------------------
|
||||
|
||||
|
||||
2 BOOLEAN. . . . . . LITERALLY 6 14
|
||||
9 0000H 32 BUFFCB . . . . . . BYTE BASED(BUFFCBADR) ARRAY(32)
|
||||
9 0000H 2 BUFFCBADR. . . . . WORD EXTERNAL(1) 9
|
||||
15 0046H 1 C1 . . . . . . . . BYTE 17 18
|
||||
15 0047H 1 C2 . . . . . . . . BYTE 17 18
|
||||
2 CR . . . . . . . . LITERALLY 79 89
|
||||
2 CTRLC. . . . . . . LITERALLY
|
||||
2 DCL. . . . . . . . LITERALLY
|
||||
2 FALSE. . . . . . . LITERALLY 20
|
||||
2 FF . . . . . . . . LITERALLY
|
||||
9 0000H 2 FIADR. . . . . . . WORD EXTERNAL(2) 9 37 38 40 42 43 45
|
||||
22 0000H 2 FIINDICES. . . . . WORD BASED(FIINDICESBASE) ARRAY(1) 35 37 40 42 45 49
|
||||
50 51 93
|
||||
22 0002H 2 FIINDICESBASE. . . WORD PUBLIC 22 35 37 40 42 45 49 50 51 84
|
||||
87 93
|
||||
9 0000H 23 FILEINFO . . . . . STRUCTURE BASED(FIADR) 84
|
||||
9 0000H 2 FILESFOUND . . . . WORD EXTERNAL(6) 85 87 92 95
|
||||
7 FINFOSTRUCTURE . . LITERALLY 9
|
||||
9 0000H 2 FIRSTFIADR . . . . WORD EXTERNAL(3) 12
|
||||
2 FOREVER. . . . . . LITERALLY
|
||||
9 0013H 2 HASHLINK . . . . . WORD MEMBER(MIDFILEINFO)
|
||||
9 0013H 2 HASHLINK . . . . . WORD MEMBER(FILEINFO)
|
||||
15 0045H 1 I. . . . . . . . . BYTE 16 17
|
||||
24 0004H 2 I. . . . . . . . . WORD 33 36 37 39 40 47 49 50 52 57 59 62
|
||||
74
|
||||
83 0042H 2 I. . . . . . . . . WORD 92 93
|
||||
10 0004H 2 INDEX. . . . . . . WORD PARAMETER AUTOMATIC 11 12
|
||||
24 0006H 2 J. . . . . . . . . WORD 34 36 42 44 45 47 50 51 53 54 57 65
|
||||
68 72
|
||||
9 000EH 2 KBYTES . . . . . . WORD MEMBER(MIDFILEINFO)
|
||||
9 000EH 2 KBYTES . . . . . . WORD MEMBER(FILEINFO)
|
||||
23 0006H 2 L. . . . . . . . . WORD PARAMETER AUTOMATIC 24 26 29 32 33 35 57 68
|
||||
71 74
|
||||
24 0000H 2 L. . . . . . . . . WORD MEMBER(STACK) 26 29 62 71
|
||||
9 0000H 2 LASTFIADR. . . . . WORD EXTERNAL(4) 84
|
||||
14 0025H 66 LESSTHAN . . . . . PROCEDURE BYTE STACK=0006H 38 43
|
||||
2 LF . . . . . . . . LITERALLY 79 89
|
||||
2 LIT. . . . . . . . LITERALLY 2 7 8 24
|
||||
9 0000H 2 MIDADR . . . . . . WORD 9 35 38 43
|
||||
9 0000H 23 MIDFILEINFO. . . . STRUCTURE BASED(MIDADR)
|
||||
10 0000H 37 MULT23 . . . . . . PROCEDURE WORD PUBLIC STACK=0004H 35 37 40 42 45
|
||||
9 0001H 8 NAME . . . . . . . BYTE ARRAY(8) MEMBER(MIDFILEINFO)
|
||||
9 0001H 8 NAME . . . . . . . BYTE ARRAY(8) MEMBER(FILEINFO)
|
||||
2 NOPAGEMODEOFFSET . LITERALLY
|
||||
9 000CH 2 ONEKBLOCKS . . . . WORD MEMBER(MIDFILEINFO)
|
||||
9 000CH 2 ONEKBLOCKS . . . . WORD MEMBER(FILEINFO)
|
||||
2 PAGELENOFFSET. . . LITERALLY
|
||||
3 0000H PRINT. . . . . . . PROCEDURE EXTERNAL(0) STACK=0000H 79 89
|
||||
23 0067H 373 QSORT. . . . . . . PROCEDURE STACK=000EH 95
|
||||
PL/M-86 COMPILER SDIR - SORT MODULE PAGE 5
|
||||
|
||||
|
||||
23 0004H 2 R. . . . . . . . . WORD PARAMETER AUTOMATIC 24 27 30 32 34 35 57 59
|
||||
63 65
|
||||
24 0002H 2 R. . . . . . . . . WORD MEMBER(STACK) 27 30 63 72
|
||||
9 0012H 1 RECSHBYTE. . . . . BYTE MEMBER(MIDFILEINFO)
|
||||
9 0012H 1 RECSHBYTE. . . . . BYTE MEMBER(FILEINFO)
|
||||
9 0010H 2 RECSLWORD. . . . . WORD MEMBER(MIDFILEINFO)
|
||||
9 0010H 2 RECSLWORD. . . . . WORD MEMBER(FILEINFO)
|
||||
2 SECTORLEN. . . . . LITERALLY
|
||||
SHL. . . . . . . . BUILTIN 12
|
||||
SHR. . . . . . . . BUILTIN 35 87
|
||||
SIZE . . . . . . . BUILTIN 84
|
||||
1 0000H SORT . . . . . . . PROCEDURE STACK=0000H
|
||||
82 01DCH 102 SORT . . . . . . . PROCEDURE PUBLIC STACK=0012H
|
||||
6 0044H 1 SORTED . . . . . . BYTE PUBLIC 80 96
|
||||
24 0048H 1 SP . . . . . . . . BYTE 25 28 29 30 31 61 62 63 70 71 72 78
|
||||
24 000AH 56 STACK. . . . . . . STRUCTURE ARRAY(14) 26 27 29 30 62 63 71 72
|
||||
24 STACKSIZ . . . . . LITERALLY 24 28
|
||||
15 0000H 1 STR1 . . . . . . . BYTE BASED(STR1ADR) ARRAY(1) 17
|
||||
14 0006H 2 STR1ADR. . . . . . WORD PARAMETER AUTOMATIC 15 17
|
||||
15 0000H 1 STR2 . . . . . . . BYTE BASED(STR2ADR) ARRAY(1) 17
|
||||
14 0004H 2 STR2ADR. . . . . . WORD PARAMETER AUTOMATIC 15 17
|
||||
3 0000H 2 STRADR . . . . . . WORD PARAMETER 4
|
||||
2 TAB. . . . . . . . LITERALLY
|
||||
24 0008H 2 TEMP . . . . . . . WORD 49 51
|
||||
2 TRUE . . . . . . . LITERALLY 80 96
|
||||
9 0009H 3 TYPE . . . . . . . BYTE ARRAY(3) MEMBER(MIDFILEINFO)
|
||||
9 0009H 3 TYPE . . . . . . . BYTE ARRAY(3) MEMBER(FILEINFO)
|
||||
9 0000H 1 USR. . . . . . . . BYTE MEMBER(MIDFILEINFO)
|
||||
9 0000H 1 USR. . . . . . . . BYTE MEMBER(FILEINFO)
|
||||
9 0015H 2 XIADR. . . . . . . WORD MEMBER(MIDFILEINFO)
|
||||
9 0015H 2 XIADR. . . . . . . WORD MEMBER(FILEINFO)
|
||||
9 0000H 2 XIADR. . . . . . . WORD EXTERNAL(5) 87
|
||||
8 XINFOSTRUCTURE . . LITERALLY
|
||||
|
||||
|
||||
|
||||
MODULE INFORMATION:
|
||||
|
||||
CODE AREA SIZE = 0242H 578D
|
||||
CONSTANT AREA SIZE = 0036H 54D
|
||||
VARIABLE AREA SIZE = 0049H 73D
|
||||
MAXIMUM STACK SIZE = 0012H 18D
|
||||
149 LINES READ
|
||||
0 PROGRAM ERROR(S)
|
||||
|
||||
END OF PL/M-86 COMPILATION
|
||||
@@ -0,0 +1,118 @@
|
||||
$title ('SDIR - Sort Module')
|
||||
sort:
|
||||
do;
|
||||
/* sort module for extended dir */
|
||||
|
||||
$include(comlit.lit)
|
||||
|
||||
print: procedure(str$adr) external; /* in util.plm */
|
||||
dcl str$adr address;
|
||||
end print;
|
||||
|
||||
dcl sorted boolean public; /* set by this module if successful sort */
|
||||
|
||||
$include(finfo.lit)
|
||||
|
||||
declare
|
||||
buf$fcb$adr address external, /* index into directory buffer */
|
||||
buf$fcb based buf$fcb$adr (32) byte,
|
||||
/* fcb template for dir */
|
||||
|
||||
(f$i$adr, first$f$i$adr, last$f$i$adr, x$i$adr, filesfound)
|
||||
address external,
|
||||
/* indices into file$info array */
|
||||
file$info based f$i$adr f$info$structure,
|
||||
|
||||
mid$adr address,
|
||||
mid$file$info based mid$adr f$info$structure;
|
||||
|
||||
|
||||
mult23: procedure(index) address public;
|
||||
dcl index address; /* return address of file$info numbered by index */
|
||||
return shl(index, 4) + shl(index,2) + shl(index,1) + index + first$f$i$adr;
|
||||
/* index * size(file$info) + base of file$info array */
|
||||
end mult23;
|
||||
|
||||
lessthan: procedure( str1$adr, str2$adr) boolean;
|
||||
dcl (i,c1,c2) byte, /* true if str1 < str2 */
|
||||
(str1$adr, str2$adr) address, /* sorting on name and type field */
|
||||
str1 based str1$adr (1) byte, /* only, assumed to be first in */
|
||||
str2 based str2$adr (1) byte; /* file$info record */
|
||||
do i = 1 to 11;
|
||||
if (c1:=(str1(i) and 7fh)) <> (c2:=(str2(i) and 7fh)) then
|
||||
return(c1 < c2);
|
||||
end;
|
||||
return(false);
|
||||
end lessthan;
|
||||
|
||||
dcl f$i$indices$base address public,
|
||||
f$i$indices based f$i$indices$base (1) address;
|
||||
|
||||
qsort: procedure(l,r); /* no recursive quick sort, sorting largest */
|
||||
dcl (l,r,i,j,temp) address,/* partition first */
|
||||
stacksiz lit '14', /* should always be able to sort 2 ** stacksiz */
|
||||
stack (stack$siz) structure (l address, r address),
|
||||
sp byte;
|
||||
|
||||
sp = 0; stack(0).l = l; stack(0).r = r;
|
||||
|
||||
do while sp < stack$siz - 1;
|
||||
l = stack(sp).l; r = stack(sp).r; sp = sp - 1;
|
||||
do while l < r;
|
||||
i = l; j = r;
|
||||
mid$adr = mult23(f$i$indices(shr(l+r,1)));
|
||||
do while i <= j;
|
||||
f$i$adr = mult23(f$i$indices(i));
|
||||
do while lessthan(f$i$adr,mid$adr);
|
||||
i = i + 1;
|
||||
f$i$adr = mult23(f$i$indices(i));
|
||||
end;
|
||||
f$i$adr = mult23(f$i$indices(j));
|
||||
do while lessthan(mid$adr,f$i$adr);
|
||||
j = j - 1;
|
||||
f$i$adr = mult23(f$i$indices(j));
|
||||
end;
|
||||
if i <= j then
|
||||
do; temp = f$i$indices(i); f$i$indices(i) = f$i$indices(j);
|
||||
f$i$indices(j) = temp;
|
||||
i = i + 1;
|
||||
if j > 0 then j = j - 1;
|
||||
end;
|
||||
end; /* while i <= j */
|
||||
if j - l < r - i then /* which partition is larger */
|
||||
do; if i < r then
|
||||
do; sp = sp + 1; stack(sp).l = i; stack(sp).r = r;
|
||||
end;
|
||||
r = j; /* continue sorting left partition */
|
||||
end;
|
||||
else
|
||||
do; if l < j then
|
||||
do; sp = sp + 1; stack(sp).l = l; stack(sp).r = j;
|
||||
end;
|
||||
l = i; /* continue sorting right partition */
|
||||
end;
|
||||
end; /* while l < r */
|
||||
end; /* while sp < stack$siz - 1 */
|
||||
if sp <> 255 then
|
||||
call print(.(cr,lf,lf,'Sort Stack Overflow',cr,lf,'$'));
|
||||
else sorted = true;
|
||||
end qsort;
|
||||
|
||||
sort: procedure public;
|
||||
dcl i address;
|
||||
f$i$indices$base = last$f$i$adr + size(file$info);
|
||||
if filesfound < 2 then
|
||||
return;
|
||||
if shr((x$i$adr - f$i$indices$base),1) < filesfound then
|
||||
do;
|
||||
call print(.('Not Enough Memory for Sort',cr,lf,'$'));
|
||||
return;
|
||||
end;
|
||||
do i = 0 to filesfound - 1;
|
||||
f$i$indices(i) = i; /* initialize f$i$indices */
|
||||
end;
|
||||
call qsort(0,filesfound - 1);
|
||||
sorted = true;
|
||||
end sort;
|
||||
|
||||
end sort;
|
||||
@@ -0,0 +1,382 @@
|
||||
PL/M-86 COMPILER SDIR - DISPLAY TIME STAMPS PAGE 1
|
||||
|
||||
|
||||
ISIS-II PL/M-86 V2.0 COMPILATION OF MODULE TIMESTAMP
|
||||
OBJECT MODULE PLACED IN TIMEST
|
||||
COMPILER INVOKED BY: :F0: TIMEST.PLM DEBUG OBJECT(TIMEST) OPTIMIZE(3) XREF
|
||||
|
||||
|
||||
|
||||
$title('SDIR - Display Time Stamps')
|
||||
1 timestamp:
|
||||
do;
|
||||
/* Display time stamp module for extended directory */
|
||||
/* Time & Date ASCII Conversion Code */
|
||||
/* From MP/M 1.1 TOD program */
|
||||
|
||||
$include(comlit.lit)
|
||||
=
|
||||
2 1 = declare
|
||||
= lit literally 'literally',
|
||||
= dcl lit 'declare',
|
||||
= true lit '0ffh',
|
||||
= false lit '0',
|
||||
= boolean lit 'byte',
|
||||
= forever lit 'while true',
|
||||
= cr lit '13',
|
||||
= lf lit '10',
|
||||
= tab lit '9',
|
||||
= ctrlc lit '3',
|
||||
= ff lit '12',
|
||||
= page$len$offset lit '1ch',
|
||||
= nopage$mode$offset lit '2Ch',
|
||||
= sectorlen lit '128';
|
||||
|
||||
3 1 print$char: procedure (char) external;
|
||||
4 2 declare char byte;
|
||||
5 2 end print$char;
|
||||
|
||||
6 1 terminate: procedure external;
|
||||
7 2 end terminate;
|
||||
|
||||
8 1 declare tod$adr address;
|
||||
9 1 declare tod based tod$adr structure (
|
||||
opcode byte,
|
||||
date address,
|
||||
hrs byte,
|
||||
min byte,
|
||||
sec byte,
|
||||
ASCII (21) byte );
|
||||
|
||||
10 1 declare string$adr address;
|
||||
11 1 declare string based string$adr (1) byte;
|
||||
12 1 declare index byte;
|
||||
|
||||
13 1 emitchar: procedure(c);
|
||||
14 2 declare c byte;
|
||||
15 2 string(index := index + 1) = c;
|
||||
16 2 end emitchar;
|
||||
|
||||
17 1 emitn: procedure(a);
|
||||
PL/M-86 COMPILER SDIR - DISPLAY TIME STAMPS PAGE 2
|
||||
|
||||
|
||||
18 2 declare a address;
|
||||
19 2 declare c based a byte;
|
||||
20 2 do while c <> '$';
|
||||
21 3 string(index := index + 1) = c;
|
||||
22 3 a = a + 1;
|
||||
23 3 end;
|
||||
24 2 end emitn;
|
||||
|
||||
25 1 emit$bcd: procedure(b);
|
||||
26 2 declare b byte;
|
||||
27 2 call emitchar('0'+b);
|
||||
28 2 end emit$bcd;
|
||||
|
||||
29 1 emit$bcd$pair: procedure(b);
|
||||
30 2 declare b byte;
|
||||
31 2 call emit$bcd(shr(b,4));
|
||||
32 2 call emit$bcd(b and 0fh);
|
||||
33 2 end emit$bcd$pair;
|
||||
|
||||
34 1 emit$colon: procedure(b);
|
||||
35 2 declare b byte;
|
||||
36 2 call emit$bcd$pair(b);
|
||||
37 2 call emitchar(':');
|
||||
38 2 end emit$colon;
|
||||
|
||||
39 1 emit$bin$pair: procedure(b);
|
||||
40 2 declare b byte;
|
||||
41 2 call emit$bcd(b/10); /* makes garbage if not < 10 */
|
||||
42 2 call emit$bcd(b mod 10);
|
||||
43 2 end emit$bin$pair;
|
||||
|
||||
44 1 emit$slant: procedure(b);
|
||||
45 2 declare b byte;
|
||||
46 2 call emit$bin$pair(b);
|
||||
47 2 call emitchar('/');
|
||||
48 2 end emit$slant;
|
||||
|
||||
49 1 declare
|
||||
base$year lit '78', /* base year for computations */
|
||||
base$day lit '0', /* starting day for base$year 0..6 */
|
||||
month$days (*) address data
|
||||
/* jan feb mar apr may jun jul aug sep oct nov dec */
|
||||
( 000,031,059,090,120,151,181,212,243,273,304,334);
|
||||
|
||||
50 1 leap$days: procedure(y,m) byte;
|
||||
51 2 declare (y,m) byte;
|
||||
/* compute days accumulated by leap years */
|
||||
52 2 declare yp byte;
|
||||
53 2 yp = shr(y,2); /* yp = y/4 */
|
||||
54 2 if (y and 11b) = 0 and month$days(m) < 59 then
|
||||
/* y not 00, y mod 4 = 0, before march, so not leap yr */
|
||||
55 2 return yp - 1;
|
||||
/* otherwise, yp is the number of accumulated leap days */
|
||||
56 2 return yp;
|
||||
57 2 end leap$days;
|
||||
|
||||
58 1 declare word$value address;
|
||||
PL/M-86 COMPILER SDIR - DISPLAY TIME STAMPS PAGE 3
|
||||
|
||||
|
||||
|
||||
59 1 get$next$digit: procedure byte;
|
||||
/* get next lsd from word$value */
|
||||
60 2 declare lsd byte;
|
||||
61 2 lsd = word$value mod 10;
|
||||
62 2 word$value = word$value / 10;
|
||||
63 2 return lsd;
|
||||
64 2 end get$next$digit;
|
||||
|
||||
65 1 bcd:
|
||||
procedure (val) byte;
|
||||
66 2 declare val byte;
|
||||
67 2 return shl((val/10),4) + val mod 10;
|
||||
68 2 end bcd;
|
||||
|
||||
69 1 declare (month, day, year, hrs, min, sec) byte;
|
||||
|
||||
70 1 bcd$pair: procedure(a,b) byte;
|
||||
71 2 declare (a,b) byte;
|
||||
72 2 return shl(a,4) or b;
|
||||
73 2 end bcd$pair;
|
||||
|
||||
|
||||
74 1 compute$year: procedure;
|
||||
/* compute year from number of days in word$value */
|
||||
75 2 declare year$length address;
|
||||
76 2 year = base$year;
|
||||
77 2 do while true;
|
||||
78 3 year$length = 365;
|
||||
79 3 if (year and 11b) = 0 then /* leap year */
|
||||
80 3 year$length = 366;
|
||||
81 3 if word$value <= year$length then
|
||||
82 3 return;
|
||||
83 3 word$value = word$value - year$length;
|
||||
84 3 year = year + 1;
|
||||
85 3 end;
|
||||
86 2 end compute$year;
|
||||
|
||||
87 1 declare
|
||||
week$day byte, /* day of week 0 ... 6 */
|
||||
day$list (*) byte data
|
||||
('Sun$Mon$Tue$Wed$Thu$Fri$Sat$'),
|
||||
leap$bias byte; /* bias for feb 29 */
|
||||
|
||||
88 1 compute$month: procedure;
|
||||
89 2 month = 12;
|
||||
90 2 do while month > 0;
|
||||
91 3 if (month := month - 1) < 2 then /* jan or feb */
|
||||
92 3 leapbias = 0;
|
||||
93 3 if month$days(month) + leap$bias < word$value then return;
|
||||
95 3 end;
|
||||
96 2 end compute$month;
|
||||
|
||||
97 1 declare
|
||||
date$test byte, /* true if testing date */
|
||||
test$value address; /* sequential date value under test */
|
||||
|
||||
PL/M-86 COMPILER SDIR - DISPLAY TIME STAMPS PAGE 4
|
||||
|
||||
|
||||
98 1 get$date$time: procedure;
|
||||
/* get date and time */
|
||||
99 2 hrs = tod.hrs;
|
||||
100 2 min = tod.min;
|
||||
101 2 sec = tod.sec;
|
||||
102 2 word$value = tod.date;
|
||||
/* word$value contains total number of days */
|
||||
103 2 week$day = (word$value + base$day - 1) mod 7;
|
||||
104 2 call compute$year;
|
||||
/* year has been set, word$value is remainder */
|
||||
105 2 leap$bias = 0;
|
||||
106 2 if (year and 11b) = 0 and word$value > 59 then
|
||||
107 2 /* after feb 29 on leap year */ leap$bias = 1;
|
||||
108 2 call compute$month;
|
||||
109 2 day = word$value - (month$days(month) + leap$bias);
|
||||
110 2 month = month + 1;
|
||||
111 2 end get$date$time;
|
||||
|
||||
112 1 emit$date$time: procedure;
|
||||
113 2 if tod.opcode = 0 then
|
||||
114 2 do;
|
||||
115 3 call emitn(.day$list(shl(week$day,2)));
|
||||
116 3 call emitchar(' ');
|
||||
117 3 end;
|
||||
118 2 call emit$slant(month);
|
||||
119 2 call emit$slant(day);
|
||||
120 2 call emit$bin$pair(year);
|
||||
121 2 call emitchar(' ');
|
||||
122 2 call emit$colon(hrs);
|
||||
123 2 call emit$colon(min);
|
||||
124 2 if tod.opcode = 0 then
|
||||
125 2 call emit$bcd$pair(sec);
|
||||
126 2 end emit$date$time;
|
||||
|
||||
127 1 tod$ASCII:
|
||||
procedure (parameter);
|
||||
128 2 declare parameter address;
|
||||
129 2 declare ret address;
|
||||
|
||||
130 2 ret = 0;
|
||||
131 2 tod$adr = parameter;
|
||||
132 2 string$adr = .tod.ASCII;
|
||||
133 2 if (tod.opcode = 0) or (tod.opcode = 3) then
|
||||
134 2 do;
|
||||
135 3 call get$date$time;
|
||||
136 3 index = -1;
|
||||
137 3 call emit$date$time;
|
||||
138 3 end;
|
||||
else
|
||||
139 2 call terminate; /* error */
|
||||
140 2 end tod$ASCII;
|
||||
|
||||
141 1 declare lcltod structure (
|
||||
opcode byte,
|
||||
date address,
|
||||
hrs byte,
|
||||
min byte,
|
||||
PL/M-86 COMPILER SDIR - DISPLAY TIME STAMPS PAGE 5
|
||||
|
||||
|
||||
sec byte,
|
||||
ASCII (21) byte );
|
||||
|
||||
142 1 display$time$stamp: procedure (tsadr) public;
|
||||
143 2 dcl tsadr address,
|
||||
i byte;
|
||||
|
||||
144 2 lcltod.opcode = 3; /* display time and date stamp, no seconds */
|
||||
145 2 call move (4,tsadr,.lcltod.date); /* don't copy seconds */
|
||||
|
||||
146 2 call tod$ASCII (.lcltod);
|
||||
147 2 do i = 0 to 13;
|
||||
148 3 call printchar (lcltod.ASCII(i));
|
||||
149 3 end;
|
||||
150 2 end display$time$stamp;
|
||||
|
||||
151 1 dcl last$data$byte byte initial(0);
|
||||
|
||||
152 1 end timestamp;
|
||||
PL/M-86 COMPILER SDIR - DISPLAY TIME STAMPS PAGE 6
|
||||
|
||||
|
||||
CROSS-REFERENCE LISTING
|
||||
-----------------------
|
||||
|
||||
|
||||
DEFN ADDR SIZE NAME, ATTRIBUTES, AND REFERENCES
|
||||
----- ------ ----- --------------------------------
|
||||
|
||||
|
||||
17 0004H 2 A. . . . . . . . . WORD PARAMETER AUTOMATIC 18 19 20 21 22
|
||||
70 0006H 1 A. . . . . . . . . BYTE PARAMETER AUTOMATIC 71 72
|
||||
141 0006H 21 ASCII. . . . . . . BYTE ARRAY(21) MEMBER(LCLTOD) 148
|
||||
9 0006H 21 ASCII. . . . . . . BYTE ARRAY(21) MEMBER(TOD) 132
|
||||
34 0004H 1 B. . . . . . . . . BYTE PARAMETER AUTOMATIC 35 36
|
||||
70 0004H 1 B. . . . . . . . . BYTE PARAMETER AUTOMATIC 71 72
|
||||
29 0004H 1 B. . . . . . . . . BYTE PARAMETER AUTOMATIC 30 31 32
|
||||
44 0004H 1 B. . . . . . . . . BYTE PARAMETER AUTOMATIC 45 46
|
||||
39 0004H 1 B. . . . . . . . . BYTE PARAMETER AUTOMATIC 40 41 42
|
||||
25 0004H 1 B. . . . . . . . . BYTE PARAMETER AUTOMATIC 26 27
|
||||
49 BASEDAY. . . . . . LITERALLY 103
|
||||
49 BASEYEAR . . . . . LITERALLY 76
|
||||
65 0108H 39 BCD. . . . . . . . PROCEDURE BYTE STACK=0006H
|
||||
70 012FH 17 BCDPAIR. . . . . . PROCEDURE BYTE STACK=0006H
|
||||
2 BOOLEAN. . . . . . LITERALLY
|
||||
13 0004H 1 C. . . . . . . . . BYTE PARAMETER AUTOMATIC 14 15
|
||||
19 0000H 1 C. . . . . . . . . BYTE BASED(A) 20 21
|
||||
3 0000H 1 CHAR . . . . . . . BYTE PARAMETER 4
|
||||
88 0175H 59 COMPUTEMONTH . . . PROCEDURE STACK=0002H 108
|
||||
74 0140H 53 COMPUTEYEAR. . . . PROCEDURE STACK=0002H 104
|
||||
2 CR . . . . . . . . LITERALLY
|
||||
2 CTRLC. . . . . . . LITERALLY
|
||||
141 0001H 2 DATE . . . . . . . WORD MEMBER(LCLTOD) 145
|
||||
9 0001H 2 DATE . . . . . . . WORD MEMBER(TOD) 102
|
||||
97 0017H 1 DATETEST . . . . . BYTE
|
||||
69 0010H 1 DAY. . . . . . . . BYTE 109 119
|
||||
87 0018H 28 DAYLIST. . . . . . BYTE ARRAY(28) DATA 115
|
||||
2 DCL. . . . . . . . LITERALLY
|
||||
142 02AFH 64 DISPLAYTIMESTAMP . PROCEDURE PUBLIC STACK=0026H
|
||||
25 0044H 16 EMITBCD. . . . . . PROCEDURE STACK=000AH 31 32 41 42
|
||||
29 0054H 27 EMITBCDPAIR. . . . PROCEDURE STACK=0010H 36 125
|
||||
39 0082H 39 EMITBINPAIR. . . . PROCEDURE STACK=0010H 46 120
|
||||
13 0000H 28 EMITCHAR . . . . . PROCEDURE STACK=0004H 27 37 47 116 121
|
||||
34 006FH 19 EMITCOLON. . . . . PROCEDURE STACK=0016H 122 123
|
||||
112 021AH 95 EMITDATETIME . . . PROCEDURE STACK=001AH 137
|
||||
17 001CH 40 EMITN. . . . . . . PROCEDURE STACK=0004H 115
|
||||
44 00A9H 19 EMITSLANT. . . . . PROCEDURE STACK=0016H 118 119
|
||||
2 FALSE. . . . . . . LITERALLY
|
||||
2 FF . . . . . . . . LITERALLY
|
||||
2 FOREVER. . . . . . LITERALLY
|
||||
98 01B0H 106 GETDATETIME. . . . PROCEDURE STACK=0006H 135
|
||||
59 00E8H 32 GETNEXTDIGIT . . . PROCEDURE BYTE STACK=0002H
|
||||
141 0003H 1 HRS. . . . . . . . BYTE MEMBER(LCLTOD)
|
||||
69 0012H 1 HRS. . . . . . . . BYTE 99 122
|
||||
9 0003H 1 HRS. . . . . . . . BYTE MEMBER(TOD) 99
|
||||
143 0033H 1 I. . . . . . . . . BYTE 147 148
|
||||
12 000CH 1 INDEX. . . . . . . BYTE 15 21 136
|
||||
151 0034H 1 LASTDATABYTE . . . BYTE INITIAL
|
||||
141 0018H 27 LCLTOD . . . . . . STRUCTURE 144 145 146 148
|
||||
PL/M-86 COMPILER SDIR - DISPLAY TIME STAMPS PAGE 7
|
||||
|
||||
|
||||
87 0016H 1 LEAPBIAS . . . . . BYTE 92 93 105 107 109
|
||||
50 00BCH 44 LEAPDAYS . . . . . PROCEDURE BYTE STACK=0006H
|
||||
2 LF . . . . . . . . LITERALLY
|
||||
2 LIT. . . . . . . . LITERALLY 2 49
|
||||
60 000EH 1 LSD. . . . . . . . BYTE 61 63
|
||||
50 0004H 1 M. . . . . . . . . BYTE PARAMETER AUTOMATIC 51 54
|
||||
69 0013H 1 MIN. . . . . . . . BYTE 100 123
|
||||
9 0004H 1 MIN. . . . . . . . BYTE MEMBER(TOD) 100
|
||||
141 0004H 1 MIN. . . . . . . . BYTE MEMBER(LCLTOD)
|
||||
69 000FH 1 MONTH. . . . . . . BYTE 89 90 91 93 109 110 118
|
||||
49 0000H 24 MONTHDAYS. . . . . WORD ARRAY(12) DATA 54 93 109
|
||||
MOVE . . . . . . . BUILTIN 145
|
||||
2 NOPAGEMODEOFFSET . LITERALLY
|
||||
9 0000H 1 OPCODE . . . . . . BYTE MEMBER(TOD) 113 124 133
|
||||
141 0000H 1 OPCODE . . . . . . BYTE MEMBER(LCLTOD) 144
|
||||
2 PAGELENOFFSET. . . LITERALLY
|
||||
127 0004H 2 PARAMETER. . . . . WORD PARAMETER AUTOMATIC 128 131
|
||||
3 0000H PRINTCHAR. . . . . PROCEDURE EXTERNAL(0) STACK=0000H 148
|
||||
129 000AH 2 RET. . . . . . . . WORD 130
|
||||
69 0014H 1 SEC. . . . . . . . BYTE 101 125
|
||||
9 0005H 1 SEC. . . . . . . . BYTE MEMBER(TOD) 101
|
||||
141 0005H 1 SEC. . . . . . . . BYTE MEMBER(LCLTOD)
|
||||
2 SECTORLEN. . . . . LITERALLY
|
||||
SHL. . . . . . . . BUILTIN 67 72 115
|
||||
SHR. . . . . . . . BUILTIN 31 53
|
||||
11 0000H 1 STRING . . . . . . BYTE BASED(STRINGADR) ARRAY(1) 15 21
|
||||
10 0002H 2 STRINGADR. . . . . WORD 11 15 21 132
|
||||
2 TAB. . . . . . . . LITERALLY
|
||||
6 0000H TERMINATE. . . . . PROCEDURE EXTERNAL(1) STACK=0000H 139
|
||||
97 0008H 2 TESTVALUE. . . . . WORD
|
||||
1 0000H TIMESTAMP. . . . . PROCEDURE STACK=0000H
|
||||
9 0000H 27 TOD. . . . . . . . STRUCTURE BASED(TODADR) 99 100 101 102 113 124 132 133
|
||||
|
||||
8 0000H 2 TODADR . . . . . . WORD 9 99 100 101 102 113 124 131 132 133
|
||||
127 0279H 54 TODASCII . . . . . PROCEDURE STACK=0020H 146
|
||||
2 TRUE . . . . . . . LITERALLY 77
|
||||
142 0004H 2 TSADR. . . . . . . WORD PARAMETER AUTOMATIC 143 145
|
||||
65 0004H 1 VAL. . . . . . . . BYTE PARAMETER AUTOMATIC 66 67
|
||||
87 0015H 1 WEEKDAY. . . . . . BYTE 103 115
|
||||
58 0004H 2 WORDVALUE. . . . . WORD 61 62 81 83 93 102 103 106 109
|
||||
50 0006H 1 Y. . . . . . . . . BYTE PARAMETER AUTOMATIC 51 53 54
|
||||
69 0011H 1 YEAR . . . . . . . BYTE 76 79 84 106 120
|
||||
75 0006H 2 YEARLENGTH . . . . WORD 78 80 81 83
|
||||
52 000DH 1 YP . . . . . . . . BYTE 53 55 56
|
||||
|
||||
|
||||
|
||||
MODULE INFORMATION:
|
||||
|
||||
CODE AREA SIZE = 02EFH 751D
|
||||
CONSTANT AREA SIZE = 0034H 52D
|
||||
VARIABLE AREA SIZE = 0035H 53D
|
||||
MAXIMUM STACK SIZE = 0026H 38D
|
||||
241 LINES READ
|
||||
0 PROGRAM ERROR(S)
|
||||
|
||||
END OF PL/M-86 COMPILATION
|
||||
@@ -0,0 +1,225 @@
|
||||
$title('SDIR - Display Time Stamps')
|
||||
timestamp:
|
||||
do;
|
||||
/* Display time stamp module for extended directory */
|
||||
/* Time & Date ASCII Conversion Code */
|
||||
/* From MP/M 1.1 TOD program */
|
||||
|
||||
$include(comlit.lit)
|
||||
|
||||
print$char: procedure (char) external;
|
||||
declare char byte;
|
||||
end print$char;
|
||||
|
||||
terminate: procedure external;
|
||||
end terminate;
|
||||
|
||||
declare tod$adr address;
|
||||
declare tod based tod$adr structure (
|
||||
opcode byte,
|
||||
date address,
|
||||
hrs byte,
|
||||
min byte,
|
||||
sec byte,
|
||||
ASCII (21) byte );
|
||||
|
||||
declare string$adr address;
|
||||
declare string based string$adr (1) byte;
|
||||
declare index byte;
|
||||
|
||||
emitchar: procedure(c);
|
||||
declare c byte;
|
||||
string(index := index + 1) = c;
|
||||
end emitchar;
|
||||
|
||||
emitn: procedure(a);
|
||||
declare a address;
|
||||
declare c based a byte;
|
||||
do while c <> '$';
|
||||
string(index := index + 1) = c;
|
||||
a = a + 1;
|
||||
end;
|
||||
end emitn;
|
||||
|
||||
emit$bcd: procedure(b);
|
||||
declare b byte;
|
||||
call emitchar('0'+b);
|
||||
end emit$bcd;
|
||||
|
||||
emit$bcd$pair: procedure(b);
|
||||
declare b byte;
|
||||
call emit$bcd(shr(b,4));
|
||||
call emit$bcd(b and 0fh);
|
||||
end emit$bcd$pair;
|
||||
|
||||
emit$colon: procedure(b);
|
||||
declare b byte;
|
||||
call emit$bcd$pair(b);
|
||||
call emitchar(':');
|
||||
end emit$colon;
|
||||
|
||||
emit$bin$pair: procedure(b);
|
||||
declare b byte;
|
||||
call emit$bcd(b/10); /* makes garbage if not < 10 */
|
||||
call emit$bcd(b mod 10);
|
||||
end emit$bin$pair;
|
||||
|
||||
emit$slant: procedure(b);
|
||||
declare b byte;
|
||||
call emit$bin$pair(b);
|
||||
call emitchar('/');
|
||||
end emit$slant;
|
||||
|
||||
declare
|
||||
base$year lit '78', /* base year for computations */
|
||||
base$day lit '0', /* starting day for base$year 0..6 */
|
||||
month$days (*) address data
|
||||
/* jan feb mar apr may jun jul aug sep oct nov dec */
|
||||
( 000,031,059,090,120,151,181,212,243,273,304,334);
|
||||
|
||||
leap$days: procedure(y,m) byte;
|
||||
declare (y,m) byte;
|
||||
/* compute days accumulated by leap years */
|
||||
declare yp byte;
|
||||
yp = shr(y,2); /* yp = y/4 */
|
||||
if (y and 11b) = 0 and month$days(m) < 59 then
|
||||
/* y not 00, y mod 4 = 0, before march, so not leap yr */
|
||||
return yp - 1;
|
||||
/* otherwise, yp is the number of accumulated leap days */
|
||||
return yp;
|
||||
end leap$days;
|
||||
|
||||
declare word$value address;
|
||||
|
||||
get$next$digit: procedure byte;
|
||||
/* get next lsd from word$value */
|
||||
declare lsd byte;
|
||||
lsd = word$value mod 10;
|
||||
word$value = word$value / 10;
|
||||
return lsd;
|
||||
end get$next$digit;
|
||||
|
||||
bcd:
|
||||
procedure (val) byte;
|
||||
declare val byte;
|
||||
return shl((val/10),4) + val mod 10;
|
||||
end bcd;
|
||||
|
||||
declare (month, day, year, hrs, min, sec) byte;
|
||||
|
||||
bcd$pair: procedure(a,b) byte;
|
||||
declare (a,b) byte;
|
||||
return shl(a,4) or b;
|
||||
end bcd$pair;
|
||||
|
||||
|
||||
compute$year: procedure;
|
||||
/* compute year from number of days in word$value */
|
||||
declare year$length address;
|
||||
year = base$year;
|
||||
do while true;
|
||||
year$length = 365;
|
||||
if (year and 11b) = 0 then /* leap year */
|
||||
year$length = 366;
|
||||
if word$value <= year$length then
|
||||
return;
|
||||
word$value = word$value - year$length;
|
||||
year = year + 1;
|
||||
end;
|
||||
end compute$year;
|
||||
|
||||
declare
|
||||
week$day byte, /* day of week 0 ... 6 */
|
||||
day$list (*) byte data
|
||||
('Sun$Mon$Tue$Wed$Thu$Fri$Sat$'),
|
||||
leap$bias byte; /* bias for feb 29 */
|
||||
|
||||
compute$month: procedure;
|
||||
month = 12;
|
||||
do while month > 0;
|
||||
if (month := month - 1) < 2 then /* jan or feb */
|
||||
leapbias = 0;
|
||||
if month$days(month) + leap$bias < word$value then return;
|
||||
end;
|
||||
end compute$month;
|
||||
|
||||
declare
|
||||
date$test byte, /* true if testing date */
|
||||
test$value address; /* sequential date value under test */
|
||||
|
||||
get$date$time: procedure;
|
||||
/* get date and time */
|
||||
hrs = tod.hrs;
|
||||
min = tod.min;
|
||||
sec = tod.sec;
|
||||
word$value = tod.date;
|
||||
/* word$value contains total number of days */
|
||||
week$day = (word$value + base$day - 1) mod 7;
|
||||
call compute$year;
|
||||
/* year has been set, word$value is remainder */
|
||||
leap$bias = 0;
|
||||
if (year and 11b) = 0 and word$value > 59 then
|
||||
/* after feb 29 on leap year */ leap$bias = 1;
|
||||
call compute$month;
|
||||
day = word$value - (month$days(month) + leap$bias);
|
||||
month = month + 1;
|
||||
end get$date$time;
|
||||
|
||||
emit$date$time: procedure;
|
||||
if tod.opcode = 0 then
|
||||
do;
|
||||
call emitn(.day$list(shl(week$day,2)));
|
||||
call emitchar(' ');
|
||||
end;
|
||||
call emit$slant(month);
|
||||
call emit$slant(day);
|
||||
call emit$bin$pair(year);
|
||||
call emitchar(' ');
|
||||
call emit$colon(hrs);
|
||||
call emit$colon(min);
|
||||
if tod.opcode = 0 then
|
||||
call emit$bcd$pair(sec);
|
||||
end emit$date$time;
|
||||
|
||||
tod$ASCII:
|
||||
procedure (parameter);
|
||||
declare parameter address;
|
||||
declare ret address;
|
||||
|
||||
ret = 0;
|
||||
tod$adr = parameter;
|
||||
string$adr = .tod.ASCII;
|
||||
if (tod.opcode = 0) or (tod.opcode = 3) then
|
||||
do;
|
||||
call get$date$time;
|
||||
index = -1;
|
||||
call emit$date$time;
|
||||
end;
|
||||
else
|
||||
call terminate; /* error */
|
||||
end tod$ASCII;
|
||||
|
||||
declare lcltod structure (
|
||||
opcode byte,
|
||||
date address,
|
||||
hrs byte,
|
||||
min byte,
|
||||
sec byte,
|
||||
ASCII (21) byte );
|
||||
|
||||
display$time$stamp: procedure (tsadr) public;
|
||||
dcl tsadr address,
|
||||
i byte;
|
||||
|
||||
lcltod.opcode = 3; /* display time and date stamp, no seconds */
|
||||
call move (4,tsadr,.lcltod.date); /* don't copy seconds */
|
||||
|
||||
call tod$ASCII (.lcltod);
|
||||
do i = 0 to 13;
|
||||
call printchar (lcltod.ASCII(i));
|
||||
end;
|
||||
end display$time$stamp;
|
||||
|
||||
dcl last$data$byte byte initial(0);
|
||||
|
||||
end timestamp;
|
||||
@@ -0,0 +1,315 @@
|
||||
PL/M-86 COMPILER SDIR - UTILITY ROUTINES PAGE 1
|
||||
|
||||
|
||||
ISIS-II PL/M-86 V2.0 COMPILATION OF MODULE UTILITY
|
||||
OBJECT MODULE PLACED IN UTIL
|
||||
COMPILER INVOKED BY: :F0: UTIL.PLM DEBUG OBJECT(UTIL) OPTIMIZE(3) XREF
|
||||
|
||||
|
||||
|
||||
$title('SDIR - Utility Routines')
|
||||
1 utility:
|
||||
do;
|
||||
|
||||
/* Utility Module for SDIR */
|
||||
|
||||
$include(comlit.lit)
|
||||
=
|
||||
2 1 = declare
|
||||
= lit literally 'literally',
|
||||
= dcl lit 'declare',
|
||||
= true lit '0ffh',
|
||||
= false lit '0',
|
||||
= boolean lit 'byte',
|
||||
= forever lit 'while true',
|
||||
= cr lit '13',
|
||||
= lf lit '10',
|
||||
= tab lit '9',
|
||||
= ctrlc lit '3',
|
||||
= ff lit '12',
|
||||
= page$len$offset lit '1ch',
|
||||
= nopage$mode$offset lit '2Ch',
|
||||
= sectorlen lit '128';
|
||||
|
||||
|
||||
/* -------- arithmetic functions -------- */
|
||||
|
||||
3 1 add3byte: procedure(byte3adr,num) public;
|
||||
4 2 dcl (byte3adr,num) address,
|
||||
b3 based byte3adr structure (
|
||||
lword address,
|
||||
hbyte byte),
|
||||
temp address;
|
||||
|
||||
5 2 temp = b3.lword;
|
||||
6 2 if (b3.lword := b3.lword + num) < temp then /* overflow */
|
||||
7 2 b3.hbyte = b3.hbyte + 1;
|
||||
8 2 end add3byte;
|
||||
|
||||
/* add three byte number to 3 byte value structure */
|
||||
9 1 add3byte3: procedure(totalb,numb) public;
|
||||
10 2 dcl (totalb,numb) address,
|
||||
num based numb structure (
|
||||
lword address,
|
||||
hbyte byte),
|
||||
total based totalb structure (
|
||||
lword address,
|
||||
hbyte byte);
|
||||
|
||||
11 2 call add3byte(totalb,num.lword);
|
||||
12 2 total.hbyte = num.hbyte + total.hbyte;
|
||||
PL/M-86 COMPILER SDIR - UTILITY ROUTINES PAGE 2
|
||||
|
||||
|
||||
13 2 end add3byte3;
|
||||
|
||||
/* divide 3 byte value by 8 */
|
||||
14 1 shr3byte: procedure(byte3adr) public;
|
||||
15 2 dcl byte3adr address,
|
||||
b3 based byte3adr structure (
|
||||
lword address,
|
||||
hbyte byte),
|
||||
temp1 based byte3adr (2) byte,
|
||||
temp2 byte;
|
||||
|
||||
16 2 temp2 = ror(b3.hbyte,3) and 11100000b; /* get 3 bits */
|
||||
17 2 b3.hbyte = shr(b3.hbyte,3);
|
||||
18 2 b3.lword = shr(b3.lword,3);
|
||||
19 2 temp1(1) = temp1(1) or temp2; /* or in 3 bits from hbyte */
|
||||
20 2 end shr3byte;
|
||||
|
||||
|
||||
/* ------- print routines -------- */
|
||||
|
||||
21 1 mon1: procedure(f,a) external;
|
||||
22 2 declare f byte, a address;
|
||||
23 2 end mon1;
|
||||
|
||||
/*break: procedure external;
|
||||
end break;*/
|
||||
|
||||
$include(fcb.lit)
|
||||
=
|
||||
24 1 = declare
|
||||
= f$drvusr lit '0', /* drive/user byte */
|
||||
= f$name lit '1', /* file name */
|
||||
= f$namelen lit '8', /* file name length */
|
||||
= f$type lit '9', /* file type field */
|
||||
= f$typelen lit '3', /* type length */
|
||||
= 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', /* extent */
|
||||
= f$s1 lit '13', /* module byte */
|
||||
= f$rc lit '15', /* record count */
|
||||
= f$diskmap lit '16', /* file disk map */
|
||||
= diskmaplen lit '16', /* disk map length */
|
||||
= f$drvusr2 lit '16', /* fcb2 */
|
||||
= f$name2 lit '17',
|
||||
= f$type2 lit '25',
|
||||
= f$cr lit '32', /* current record */
|
||||
= f$rrec lit '33', /* random record */
|
||||
= f$rreco lit '35'; /* " " overflow */
|
||||
=
|
||||
|
||||
/* BDOS calls */
|
||||
|
||||
25 1 print$char: procedure(char) public;
|
||||
26 2 declare char byte;
|
||||
27 2 call mon1(2,char);
|
||||
28 2 end print$char;
|
||||
PL/M-86 COMPILER SDIR - UTILITY ROUTINES PAGE 3
|
||||
|
||||
|
||||
|
||||
29 1 print: procedure(string$adr) public;
|
||||
30 2 dcl string$adr address;
|
||||
31 2 call mon1(9,string$adr);
|
||||
32 2 end print;
|
||||
|
||||
33 1 printb: procedure public;
|
||||
34 2 call print$char(' ');
|
||||
35 2 end printb;
|
||||
|
||||
36 1 crlf: procedure public;
|
||||
37 2 call print$char(cr);
|
||||
38 2 call print$char(lf);
|
||||
39 2 end crlf;
|
||||
|
||||
40 1 printfn: procedure(fname$adr) public;
|
||||
41 2 dcl fname$adr address,
|
||||
file$name based fname$adr (1) byte,
|
||||
i byte; /* <filename> ' ' <filetype> */
|
||||
|
||||
42 2 do i = 0 to f$namelen - 1;
|
||||
43 3 call printchar(file$name(i) and 7fh);
|
||||
44 3 end;
|
||||
45 2 call printchar(' ');
|
||||
46 2 do i = f$namelen to f$namelen + f$typelen - 1;
|
||||
47 3 call printchar(file$name(i) and 7fh);
|
||||
48 3 end;
|
||||
49 2 end printfn;
|
||||
|
||||
50 1 pdecimal: procedure(v,prec,zerosup) public;
|
||||
/* print value v, field size = (log10 prec) + 1 */
|
||||
/* with leading zero suppression if zerosup = true */
|
||||
51 2 declare v address, /* value to print */
|
||||
prec address, /* precision */
|
||||
zerosup boolean, /* zero suppression flag */
|
||||
d byte; /* current decimal digit */
|
||||
|
||||
52 2 do while prec <> 0;
|
||||
53 3 d = v / prec; /* get next digit */
|
||||
54 3 v = v mod prec; /* get remainder back to v */
|
||||
55 3 prec = prec / 10; /* ready for next digit */
|
||||
56 3 if prec <> 0 and zerosup and d = 0 then
|
||||
57 3 call printb;
|
||||
else
|
||||
58 3 do;
|
||||
59 4 zerosup = false;
|
||||
60 4 call printchar('0'+d);
|
||||
61 4 end;
|
||||
62 3 end;
|
||||
63 2 end pdecimal;
|
||||
|
||||
64 1 p3byte: procedure(byte3adr,prec) public;
|
||||
/* print 3 byte value with 0 suppression */
|
||||
65 2 dcl byte3adr address, /* assume high order bit is < 10 */
|
||||
prec address,
|
||||
b3 based byte3adr structure (
|
||||
lword address,
|
||||
PL/M-86 COMPILER SDIR - UTILITY ROUTINES PAGE 4
|
||||
|
||||
|
||||
hbyte byte),
|
||||
i byte;
|
||||
|
||||
/* prec = 1 for 6 chars, 2 for 7 */
|
||||
66 2 if b3.hbyte <> 0 then
|
||||
67 2 do;
|
||||
68 3 call pdecimal(b3.hbyte,prec,true); /* 3 for 8 chars printed */
|
||||
69 3 call pdecimal(b3.lword,10000,false);
|
||||
70 3 end;
|
||||
else
|
||||
71 2 do;
|
||||
72 3 i = 1;
|
||||
73 3 do while i <= prec;
|
||||
74 4 call printb;
|
||||
75 4 i = i * 10;
|
||||
76 4 end;
|
||||
77 3 call pdecimal(b3.lword,10000,true);
|
||||
78 3 end;
|
||||
79 2 end p3byte;
|
||||
|
||||
80 1 end utility;
|
||||
PL/M-86 COMPILER SDIR - UTILITY ROUTINES PAGE 5
|
||||
|
||||
|
||||
CROSS-REFERENCE LISTING
|
||||
-----------------------
|
||||
|
||||
|
||||
DEFN ADDR SIZE NAME, ATTRIBUTES, AND REFERENCES
|
||||
----- ------ ----- --------------------------------
|
||||
|
||||
|
||||
21 0000H 2 A. . . . . . . . . WORD PARAMETER 22
|
||||
3 0000H 29 ADD3BYTE . . . . . PROCEDURE PUBLIC STACK=0006H 11
|
||||
9 001DH 30 ADD3BYTE3. . . . . PROCEDURE PUBLIC STACK=000EH
|
||||
4 0000H 3 B3 . . . . . . . . STRUCTURE BASED(BYTE3ADR) 5 6 7
|
||||
15 0000H 3 B3 . . . . . . . . STRUCTURE BASED(BYTE3ADR) 16 17 18
|
||||
65 0000H 3 B3 . . . . . . . . STRUCTURE BASED(BYTE3ADR) 66 68 69 77
|
||||
2 BOOLEAN. . . . . . LITERALLY 51
|
||||
3 0006H 2 BYTE3ADR . . . . . WORD PARAMETER AUTOMATIC 4 5 6 7
|
||||
64 0006H 2 BYTE3ADR . . . . . WORD PARAMETER AUTOMATIC 65 66 68 69 77
|
||||
14 0004H 2 BYTE3ADR . . . . . WORD PARAMETER AUTOMATIC 15 16 17 18 19
|
||||
25 0004H 1 CHAR . . . . . . . BYTE PARAMETER AUTOMATIC 26 27
|
||||
2 CR . . . . . . . . LITERALLY 37
|
||||
36 0087H 17 CRLF . . . . . . . PROCEDURE PUBLIC STACK=000EH
|
||||
2 CTRLC. . . . . . . LITERALLY
|
||||
51 0004H 1 D. . . . . . . . . BYTE 53 56 60
|
||||
2 DCL. . . . . . . . LITERALLY
|
||||
24 DISKMAPLEN . . . . LITERALLY
|
||||
21 0000H 1 F. . . . . . . . . BYTE PARAMETER 22
|
||||
2 FALSE. . . . . . . LITERALLY 59 69
|
||||
24 FARC . . . . . . . LITERALLY
|
||||
24 FCR. . . . . . . . LITERALLY
|
||||
24 FDIRSYS. . . . . . LITERALLY
|
||||
24 FDISKMAP . . . . . LITERALLY
|
||||
24 FDRVUSR. . . . . . LITERALLY
|
||||
24 FDRVUSR2 . . . . . LITERALLY
|
||||
24 FEX. . . . . . . . LITERALLY
|
||||
2 FF . . . . . . . . LITERALLY
|
||||
41 0000H 1 FILENAME . . . . . BYTE BASED(FNAMEADR) ARRAY(1) 43 47
|
||||
24 FNAME. . . . . . . LITERALLY
|
||||
24 FNAME2 . . . . . . LITERALLY
|
||||
40 0004H 2 FNAMEADR . . . . . WORD PARAMETER AUTOMATIC 41 43 47
|
||||
24 FNAMELEN . . . . . LITERALLY 42 46
|
||||
2 FOREVER. . . . . . LITERALLY
|
||||
24 FRC. . . . . . . . LITERALLY
|
||||
24 FRREC. . . . . . . LITERALLY
|
||||
24 FRRECO . . . . . . LITERALLY
|
||||
24 FRW. . . . . . . . LITERALLY
|
||||
24 FS1. . . . . . . . LITERALLY
|
||||
24 FTYPE. . . . . . . LITERALLY
|
||||
24 FTYPE2 . . . . . . LITERALLY
|
||||
24 FTYPELEN . . . . . LITERALLY 46
|
||||
65 0002H 1 HBYTE. . . . . . . BYTE MEMBER(B3) 66 68
|
||||
15 0002H 1 HBYTE. . . . . . . BYTE MEMBER(B3) 16 17
|
||||
10 0002H 1 HBYTE. . . . . . . BYTE MEMBER(TOTAL) 12
|
||||
10 0002H 1 HBYTE. . . . . . . BYTE MEMBER(NUM) 12
|
||||
4 0002H 1 HBYTE. . . . . . . BYTE MEMBER(B3) 7
|
||||
65 0005H 1 I. . . . . . . . . BYTE 72 73 75
|
||||
41 0003H 1 I. . . . . . . . . BYTE 42 43 46 47
|
||||
2 LF . . . . . . . . LITERALLY 38
|
||||
PL/M-86 COMPILER SDIR - UTILITY ROUTINES PAGE 6
|
||||
|
||||
|
||||
2 LIT. . . . . . . . LITERALLY 2 24
|
||||
15 0000H 2 LWORD. . . . . . . WORD MEMBER(B3) 18
|
||||
10 0000H 2 LWORD. . . . . . . WORD MEMBER(TOTAL)
|
||||
10 0000H 2 LWORD. . . . . . . WORD MEMBER(NUM) 11
|
||||
4 0000H 2 LWORD. . . . . . . WORD MEMBER(B3) 5 6
|
||||
65 0000H 2 LWORD. . . . . . . WORD MEMBER(B3) 69 77
|
||||
21 0000H MON1 . . . . . . . PROCEDURE EXTERNAL(0) STACK=0000H 27 31
|
||||
2 NOPAGEMODEOFFSET . LITERALLY
|
||||
10 0000H 3 NUM. . . . . . . . STRUCTURE BASED(NUMB) 11 12
|
||||
3 0004H 2 NUM. . . . . . . . WORD PARAMETER AUTOMATIC 4 6
|
||||
9 0004H 2 NUMB . . . . . . . WORD PARAMETER AUTOMATIC 10 11 12
|
||||
64 0143H 89 P3BYTE . . . . . . PROCEDURE PUBLIC STACK=0020H
|
||||
2 PAGELENOFFSET. . . LITERALLY
|
||||
50 00EDH 86 PDECIMAL . . . . . PROCEDURE PUBLIC STACK=0018H 68 69 77
|
||||
64 0004H 2 PREC . . . . . . . WORD PARAMETER AUTOMATIC 65 68 73
|
||||
50 0006H 2 PREC . . . . . . . WORD PARAMETER AUTOMATIC 51 52 53 54 55 56
|
||||
29 006CH 16 PRINT. . . . . . . PROCEDURE PUBLIC STACK=000AH
|
||||
33 007CH 11 PRINTB . . . . . . PROCEDURE PUBLIC STACK=000EH 57 74
|
||||
25 0059H 19 PRINTCHAR. . . . . PROCEDURE PUBLIC STACK=000AH 34 37 38 43 45 47 60
|
||||
40 0098H 85 PRINTFN. . . . . . PROCEDURE PUBLIC STACK=0010H
|
||||
ROR. . . . . . . . BUILTIN 16
|
||||
2 SECTORLEN. . . . . LITERALLY
|
||||
SHR. . . . . . . . BUILTIN 17 18
|
||||
14 003BH 30 SHR3BYTE . . . . . PROCEDURE PUBLIC STACK=0004H
|
||||
29 0004H 2 STRINGADR. . . . . WORD PARAMETER AUTOMATIC 30 31
|
||||
2 TAB. . . . . . . . LITERALLY
|
||||
4 0000H 2 TEMP . . . . . . . WORD 5 6
|
||||
15 0000H 2 TEMP1. . . . . . . BYTE BASED(BYTE3ADR) ARRAY(2) 19
|
||||
15 0002H 1 TEMP2. . . . . . . BYTE 16 19
|
||||
10 0000H 3 TOTAL. . . . . . . STRUCTURE BASED(TOTALB) 12
|
||||
9 0006H 2 TOTALB . . . . . . WORD PARAMETER AUTOMATIC 10 11 12
|
||||
2 TRUE . . . . . . . LITERALLY 68 77
|
||||
1 0000H UTILITY. . . . . . PROCEDURE STACK=0000H
|
||||
50 0008H 2 V. . . . . . . . . WORD PARAMETER AUTOMATIC 51 53 54
|
||||
50 0004H 1 ZEROSUP. . . . . . BYTE PARAMETER AUTOMATIC 51 56 59
|
||||
|
||||
|
||||
|
||||
MODULE INFORMATION:
|
||||
|
||||
CODE AREA SIZE = 019CH 412D
|
||||
CONSTANT AREA SIZE = 0000H 0D
|
||||
VARIABLE AREA SIZE = 0006H 6D
|
||||
MAXIMUM STACK SIZE = 0020H 32D
|
||||
186 LINES READ
|
||||
0 PROGRAM ERROR(S)
|
||||
|
||||
END OF PL/M-86 COMPILATION
|
||||
@@ -0,0 +1,148 @@
|
||||
$title('SDIR - Utility Routines')
|
||||
utility:
|
||||
do;
|
||||
|
||||
/* Utility Module for SDIR */
|
||||
|
||||
$include(comlit.lit)
|
||||
|
||||
|
||||
/* -------- arithmetic functions -------- */
|
||||
|
||||
add3byte: procedure(byte3adr,num) public;
|
||||
dcl (byte3adr,num) address,
|
||||
b3 based byte3adr structure (
|
||||
lword address,
|
||||
hbyte byte),
|
||||
temp address;
|
||||
|
||||
temp = b3.lword;
|
||||
if (b3.lword := b3.lword + num) < temp then /* overflow */
|
||||
b3.hbyte = b3.hbyte + 1;
|
||||
end add3byte;
|
||||
|
||||
/* add three byte number to 3 byte value structure */
|
||||
add3byte3: procedure(totalb,numb) public;
|
||||
dcl (totalb,numb) address,
|
||||
num based numb structure (
|
||||
lword address,
|
||||
hbyte byte),
|
||||
total based totalb structure (
|
||||
lword address,
|
||||
hbyte byte);
|
||||
|
||||
call add3byte(totalb,num.lword);
|
||||
total.hbyte = num.hbyte + total.hbyte;
|
||||
end add3byte3;
|
||||
|
||||
/* divide 3 byte value by 8 */
|
||||
shr3byte: procedure(byte3adr) public;
|
||||
dcl byte3adr address,
|
||||
b3 based byte3adr structure (
|
||||
lword address,
|
||||
hbyte byte),
|
||||
temp1 based byte3adr (2) byte,
|
||||
temp2 byte;
|
||||
|
||||
temp2 = ror(b3.hbyte,3) and 11100000b; /* get 3 bits */
|
||||
b3.hbyte = shr(b3.hbyte,3);
|
||||
b3.lword = shr(b3.lword,3);
|
||||
temp1(1) = temp1(1) or temp2; /* or in 3 bits from hbyte */
|
||||
end shr3byte;
|
||||
|
||||
|
||||
/* ------- print routines -------- */
|
||||
|
||||
mon1: procedure(f,a) external;
|
||||
declare f byte, a address;
|
||||
end mon1;
|
||||
|
||||
/*break: procedure external;
|
||||
end break;*/
|
||||
|
||||
$include(fcb.lit)
|
||||
|
||||
/* BDOS calls */
|
||||
|
||||
print$char: procedure(char) public;
|
||||
declare char byte;
|
||||
call mon1(2,char);
|
||||
end print$char;
|
||||
|
||||
print: procedure(string$adr) public;
|
||||
dcl string$adr address;
|
||||
call mon1(9,string$adr);
|
||||
end print;
|
||||
|
||||
printb: procedure public;
|
||||
call print$char(' ');
|
||||
end printb;
|
||||
|
||||
crlf: procedure public;
|
||||
call print$char(cr);
|
||||
call print$char(lf);
|
||||
end crlf;
|
||||
|
||||
printfn: procedure(fname$adr) public;
|
||||
dcl fname$adr address,
|
||||
file$name based fname$adr (1) byte,
|
||||
i byte; /* <filename> ' ' <filetype> */
|
||||
|
||||
do i = 0 to f$namelen - 1;
|
||||
call printchar(file$name(i) and 7fh);
|
||||
end;
|
||||
call printchar(' ');
|
||||
do i = f$namelen to f$namelen + f$typelen - 1;
|
||||
call printchar(file$name(i) and 7fh);
|
||||
end;
|
||||
end printfn;
|
||||
|
||||
pdecimal: procedure(v,prec,zerosup) public;
|
||||
/* print value v, 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 */
|
||||
d byte; /* current decimal digit */
|
||||
|
||||
do while prec <> 0;
|
||||
d = v / prec; /* get next digit */
|
||||
v = v mod prec; /* get remainder back to v */
|
||||
prec = prec / 10; /* ready for next digit */
|
||||
if prec <> 0 and zerosup and d = 0 then
|
||||
call printb;
|
||||
else
|
||||
do;
|
||||
zerosup = false;
|
||||
call printchar('0'+d);
|
||||
end;
|
||||
end;
|
||||
end pdecimal;
|
||||
|
||||
p3byte: procedure(byte3adr,prec) public;
|
||||
/* print 3 byte value with 0 suppression */
|
||||
dcl byte3adr address, /* assume high order bit is < 10 */
|
||||
prec address,
|
||||
b3 based byte3adr structure (
|
||||
lword address,
|
||||
hbyte byte),
|
||||
i byte;
|
||||
|
||||
/* prec = 1 for 6 chars, 2 for 7 */
|
||||
if b3.hbyte <> 0 then
|
||||
do;
|
||||
call pdecimal(b3.hbyte,prec,true); /* 3 for 8 chars printed */
|
||||
call pdecimal(b3.lword,10000,false);
|
||||
end;
|
||||
else
|
||||
do;
|
||||
i = 1;
|
||||
do while i <= prec;
|
||||
call printb;
|
||||
i = i * 10;
|
||||
end;
|
||||
call pdecimal(b3.lword,10000,true);
|
||||
end;
|
||||
end p3byte;
|
||||
|
||||
end utility;
|
||||
@@ -0,0 +1,8 @@
|
||||
declare
|
||||
bdos20 lit '20h',
|
||||
bdos22 lit '22h',
|
||||
bdos30 lit '30h',
|
||||
mpm lit '01h',
|
||||
cpm86 lit '10h',
|
||||
mpm86 lit '11h',
|
||||
ccpm86 lit '14h';
|
||||
@@ -0,0 +1,22 @@
|
||||
|
||||
declare /* XFCB */
|
||||
xfcb$type lit '10h', /* 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 '24', /* creation/access time stamp */
|
||||
xf$update lit '28'; /* update time stamp */
|
||||
|
||||
declare /* directory label: special case of XFCB */
|
||||
dirlabeltype lit '20h', /* identifier on disk */
|
||||
dl$password lit '128', /* masks on data byte */
|
||||
dl$access lit '64',
|
||||
dl$update lit '32',
|
||||
dl$makexfcb lit '16',
|
||||
dl$exists lit '1';
|
||||
|
||||
declare /* password mode of xfcb */
|
||||
pm$read lit '80h',
|
||||
pm$write lit '40h',
|
||||
pm$delete lit '20h';
|
||||
|
||||
Reference in New Issue
Block a user