Files
Sepp J Morris 31738079c4 Upload
Digital Research
2020-11-06 18:50:37 +01:00

636 lines
27 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

PL/M-86 COMPILER ERAQ: ERASE FILE WITH QUERY PAGE 1
ISIS-II PL/M-86 V2.0 COMPILATION OF MODULE ERASEQ
OBJECT MODULE PLACED IN ERAQ.OBJ
COMPILER INVOKED BY: :F0: ERAQ.PLM XREF OPTIMIZE(3) DEBUG
$title ('ERAQ: Erase File with Query')
1 eraseq:
do;
/*
Revised:
19 Jan 80 by Thomas Rolander
20 July 81 by Doug Huskey
6 Aug 81 by Danny Horovitz
31 Jan 83 by Bill Fitler
*/
$include (:f2:copyrt.lit)
=
= /*
= Copyright (C) 1983
= Digital Research
= P.O. Box 579
= Pacific Grove, CA 93950
= */
=
$include (:f2:vaxcmd.lit)
=
= /**** VAX commands for generation - read the name of this program
= for PROGNAME below.
=
= $ util := PROGNAME
= $ ccpmsetup ! set up environment
= $ assign 'f$directory()' f1: ! use local dir for temp files
= $ plm86 'util'.plm xref 'p1' optimize(3) debug
= $ link86 f2:scd.obj, 'util'.obj to 'util'.lnk
= $ loc86 'util'.lnk od(sm(code,dats,data,stack,const)) -
= ad(sm(code(0),dats(10000h))) ss(stack(+32)) to 'util'.
= $ h86 'util'
=
= ***** Then, on a micro:
= A>vax progname.h86 $fans
= A>gencmd progname data[b1000]
=
= ***** Notes: Stack is increased for interrupts. Const(ants) are last
= to force hex generation.
= ****/
$include (:f2:vermpm.lit)
=
= /* This utility requires MP/M or Concurrent function calls */
=
= /****** commented out for CCP/M-86 :
= declare Ver$OS literally '11h',
= Ver$Needs$OS literally '''Requires MP/M-86''';
PL/M-86 COMPILER ERAQ: ERASE FILE WITH QUERY PAGE 2
= ******/
=
2 1 = declare Ver$OS literally '14h',
= Ver$Needs$OS literally '''Requires Concurrent CP/M-86''';
=
=
3 1 = declare Ver$Mask literally '0fdh'; /* mask out Is_network bit */
=
4 1 = declare Ver$BDOS literally '30h'; /* minimal BDOS version rqd */
=
5 1 declare
true literally '1',
false literally '0',
forever literally 'while true',
lit literally 'literally',
proc literally 'procedure',
dcl literally 'declare',
addr literally 'address',
cr literally '13',
lf literally '10',
ctrlc literally '3',
ctrlx literally '18h',
bksp literally '8';
/**************************************
* *
* B D O S INTERFACE *
* *
**************************************/
6 1 mon1:
procedure (func,info) external;
7 2 declare func byte;
8 2 declare info address;
9 2 end mon1;
10 1 mon2:
procedure (func,info) byte external;
11 2 declare func byte;
12 2 declare info address;
13 2 end mon2;
14 1 mon3:
procedure (func,info) address external;
15 2 declare func byte;
16 2 declare info address;
17 2 end mon3;
18 1 declare cmdrv byte external; /* command drive */
19 1 declare fcb (1) byte external; /* 1st default fcb */
20 1 declare fcb16 (1) byte external; /* 2nd default fcb */
21 1 declare pass0 address external; /* 1st password ptr */
PL/M-86 COMPILER ERAQ: ERASE FILE WITH QUERY PAGE 3
22 1 declare len0 byte external; /* 1st passwd length */
23 1 declare pass1 address external; /* 2nd password ptr */
24 1 declare len1 byte external; /* 2nd passwd length */
25 1 declare tbuff (1) byte external; /* default dma buffer */
/**************************************
* *
* B D O S Externals *
* *
**************************************/
26 1 read$console:
procedure byte;
27 2 return mon2 (1,0);
28 2 end read$console;
29 1 printchar:
procedure(char);
30 2 declare char byte;
31 2 call mon1(2,char);
32 2 end printchar;
33 1 conin:
procedure byte;
34 2 return mon2(6,0fdh);
35 2 end conin;
36 1 print$buf:
procedure (buffer$address);
37 2 declare buffer$address address;
38 2 call mon1 (9,buffer$address);
39 2 end print$buf;
40 1 check$con$stat:
procedure byte;
41 2 return mon2(11,0);
42 2 end check$con$stat;
43 1 version: procedure address;
/* returns current cp/m version # */
44 2 return mon3(12,0);
45 2 end version;
46 1 setdma: procedure(dma);
47 2 declare dma address;
48 2 call mon1(26,dma);
49 2 end setdma;
50 1 search$first:
procedure (fcb$address) byte;
51 2 declare fcb$address address;
52 2 return mon2 (17,fcb$address);
53 2 end search$first;
54 1 search$next:
PL/M-86 COMPILER ERAQ: ERASE FILE WITH QUERY PAGE 4
procedure byte;
55 2 return mon2 (18,0);
56 2 end search$next;
57 1 delete$file:
procedure (fcb$address) address;
58 2 declare fcb$address address;
59 2 return mon3 (19,fcb$address);
60 2 end delete$file;
61 1 get$user$code:
procedure byte;
62 2 return mon2 (32,0ffh);
63 2 end get$user$code;
/* 0ff => return BDOS errors */
64 1 return$errors:
procedure;
65 2 call mon1 (45,0ffh);
66 2 end return$errors;
67 1 terminate:
procedure;
68 2 call mon1 (143,0);
69 2 end terminate;
70 1 declare
parse$fn structure (
buff$adr address,
fcb$adr address);
71 1 declare (saveax,savecx) word external; /* reg return vals, set in mon1 */
72 1 parse: procedure;
73 2 declare (retcode,errcode) word;
74 2 call mon1(152,.parse$fn);
75 2 retcode = saveax;
76 2 errcode = savecx;
77 2 if retcode = 0ffffh then /* parse returned an error */
78 2 do;
79 3 call print$buf(.('Invalid Filespec$'));
80 3 if errcode = 23 then call print$buf(.(' (drive)$'));
82 3 else if errcode = 24 then call print$buf(.(' (filename)$'));
84 3 else if errcode = 25 then call print$buf(.(' (filetype)$'));
86 3 else if errcode = 38 then call print$buf(.(' (password)$'));
call print$buf(.('.',13,10,'$')); call terminate;
90 3 end;
91 2 end parse;
/**************************************
* *
* GLOBAL VARIABLES *
* *
**************************************/
PL/M-86 COMPILER ERAQ: ERASE FILE WITH QUERY PAGE 5
92 1 declare xfcb byte initial(0);
93 1 declare successful lit '0FFh';
94 1 declare dir$entries (128) structure (
file (12) byte );
95 1 declare dir$entry$adr address;
96 1 declare dir$entry based dir$entry$adr (1) byte;
/**************************************
* *
* S U B R O U T I N E S *
* *
**************************************/
/* upper case character from console */
97 1 crlf: proc;
98 2 call printchar(cr);
99 2 call printchar(lf);
100 2 end crlf;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* fill string @ s for c bytes with f */
101 1 fill: proc(s,f,c);
102 2 dcl s addr,
(f,c) byte,
a based s byte;
103 2 do while (c:=c-1)<>255;
104 3 a = f;
105 3 s = s+1;
106 3 end;
107 2 end fill;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* error message routine */
108 1 error: proc(code);
109 2 declare
code byte;
110 2 call printchar(' ');
111 2 if code=1 then
112 2 call print$buf(.(cr,lf,'Disk I/O Error.$'));
113 2 if code=2 then
114 2 call print$buf(.(cr,lf,'Drive $'));
115 2 if code = 3 or code = 2 then
116 2 call print$buf(.('Read Only$'));
117 2 if code = 4 then
118 2 call print$buf(.(cr,lf,'Invalid Filespec (drive).$'));
119 2 if code = 5 then
120 2 call print$buf(.('Currently Opened$'));
121 2 if code = 7 then
122 2 call print$buf(.('Password Error$'));
PL/M-86 COMPILER ERAQ: ERASE FILE WITH QUERY PAGE 6
123 2 if code < 3 or code = 4 then
124 2 call terminate;
125 2 end error;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* try to delete fcb at fcb$address
return error code if unsuccessful */
126 1 delete:
procedure(fcb$address) byte;
127 2 declare
fcb$address address,
fcbv based fcb$address (32) byte,
error$code address,
code byte;
128 2 if xfcb then
129 2 fcbv(5) = fcbv(5) or 80h;
130 2 call setdma(.fcb16); /* password */
131 2 fcbv(0) = fcb(0); /* drive */
132 2 error$code = delete$file(fcb$address);
133 2 fcbv(5) = fcbv(5) and 7fh; /* reset xfcb bit */
134 2 if low(error$code) = 0FFh then do;
136 3 code = high(error$code);
137 3 if (code=1) or (code=2) then
138 3 call error(code);
139 3 return code;
140 3 end;
141 2 return successful;
142 2 end delete;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* upper case character from console */
143 1 ucase: proc byte;
144 2 dcl c byte;
145 2 if (c:=conin) >= 'a' then
146 2 if c < '{' then
147 2 return(c-20h);
148 2 return c;
149 2 end ucase;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* get password and place at fcb + 16 */
150 1 getpasswd: proc;
151 2 dcl (i,c) byte;
152 2 call print$buf(.('Password ? ','$'));
153 2 retry:
call fill(.fcb16,' ',8);
154 2 do i = 0 to 7;
155 3 nxtchr:
if (c:=ucase) >= ' ' then
156 3 fcb16(i)=c;
157 3 if c = cr then
PL/M-86 COMPILER ERAQ: ERASE FILE WITH QUERY PAGE 7
158 3 goto exit;
159 3 if c = ctrlx then
160 3 goto retry;
161 3 if c = bksp then do;
163 4 if i<1 then
164 4 goto retry;
165 4 else do;
166 5 fcb16(i:=i-1)=' ';
167 5 goto nxtchr;
168 5 end;
169 4 end;
170 3 if c = 3 then
171 3 call terminate;
172 3 end;
173 2 exit:
c = check$con$stat;
174 2 end getpasswd;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* error on deleting a file */
175 1 file$err: procedure(code);
176 2 declare code byte;
177 2 call crlf;
178 2 call print$buf(.('Not erased, $'));
179 2 call error(code);
180 2 call crlf;
181 2 end file$err;
/**************************************
* *
* M A I N P R O G R A M *
* *
**************************************/
182 1 declare (i,j,k,code,response,user,dcnt) byte;
183 1 declare ver address;
184 1 declare last$dseg$byte byte
initial (0);
185 1 plm$start: procedure public;
186 2 ver = version;
187 2 if low(ver) < Ver$BDOS or (high(ver) and Ver$Mask) = 0 then do;
189 3 call print$buf (.(cr,lf,Ver$Needs$OS,'$'));
190 3 call mon1(0,0);
191 3 end;
192 2 if fcb(17) <> ' ' then
193 2 if fcb(17) = 'X' then
194 2 xfcb = true;
195 2 else do;
196 3 call print$buf (.(
PL/M-86 COMPILER ERAQ: ERASE FILE WITH QUERY PAGE 8
'Invalid Command Option.$'));
197 3 call terminate;
198 3 end;
199 2 parse$fn.buff$adr = .tbuff(1);
200 2 parse$fn.fcb$adr = .fcb;
201 2 call parse;
202 2 if fcb(0) = 0 then
203 2 fcb(0) = low (mon2 (25,0)) + 1;
204 2 i = -1;
205 2 user = get$user$code;
206 2 call return$errors;
207 2 dcnt = search$first (.fcb);
208 2 do while dcnt <> 0ffh;
209 3 dir$entry$adr = .tbuff(ror(dcnt,3) and 110$0000b);
210 3 if dir$entry(0) = user then
211 3 do;
212 4 if (i:=i+1) = 128 then
213 4 do;
214 5 call print$buf (.(
'Too many directory entries for query.','$'));
215 5 call terminate;
216 5 end;
217 4 call move (12,.dir$entry(1),.dir$entries(i));
218 4 end;
219 3 dcnt = search$next;
220 3 end;
221 2 if i = -1 then
222 2 do;
223 3 call print$buf (.(
'File Not Found.','$'));
224 3 end;
else
225 2 do j = 0 to i;
226 3 call printchar ('A'+fcb(0)-1);
227 3 call printchar (':');
228 3 call printchar (' ');
229 3 do k = 0 to 10;
230 4 if k = 8
then call printchar ('.');
232 4 call printchar (dir$entries(j).file(k) and 07FH);
233 4 end;
234 3 call printchar (' ');
235 3 call printchar ('?');
236 3 response = read$console;
237 3 call printchar (0dh);
238 3 call printchar (0ah);
239 3 if (response = 'y') or
(response = 'Y') then
240 3 do;
241 4 call move (12,.dir$entries(j),.fcb(1));
242 4 if (code:=delete(.fcb)) <> successful then do;
244 5 if code < 3 or code = 4 then
245 5 call error(code); /* fatal errors */
246 5 else if code = 7 then do;
248 6 call file$err(code);
PL/M-86 COMPILER ERAQ: ERASE FILE WITH QUERY PAGE 9
249 6 call getpasswd;
250 6 code = delete(.fcb);
251 6 end;
if code <> successful then
253 5 call file$err(code);
254 5 call crlf;
255 5 end;
256 4 end;
257 3 end;
258 2 call terminate;
259 2 end plm$start;
260 1 end eraseq;
PL/M-86 COMPILER ERAQ: ERASE FILE WITH QUERY PAGE 10
CROSS-REFERENCE LISTING
-----------------------
DEFN ADDR SIZE NAME, ATTRIBUTES, AND REFERENCES
----- ------ ----- --------------------------------
102 0000H 1 A. . . . . . . . . BYTE BASED(S) 104
5 ADDR . . . . . . . LITERALLY 102
5 BKSP . . . . . . . LITERALLY 161
70 0000H 2 BUFFADR. . . . . . WORD MEMBER(PARSEFN) 199
36 0004H 2 BUFFERADDRESS. . . WORD PARAMETER AUTOMATIC 37 38
151 0612H 1 C. . . . . . . . . BYTE 155 156 157 159 161 170 173
101 0004H 1 C. . . . . . . . . BYTE PARAMETER AUTOMATIC 102 103
144 0610H 1 C. . . . . . . . . BYTE 145 146 147 148
29 0004H 1 CHAR . . . . . . . BYTE PARAMETER AUTOMATIC 30 31
40 0041H 15 CHECKCONSTAT . . . PROCEDURE BYTE STACK=0008H 173
18 0000H 1 CMDRV. . . . . . . BYTE EXTERNAL(3)
175 0004H 1 CODE . . . . . . . BYTE PARAMETER AUTOMATIC 176 179
108 0004H 1 CODE . . . . . . . BYTE PARAMETER AUTOMATIC 109 111 113 115 117 119 121 123
127 060FH 1 CODE . . . . . . . BYTE 136 137 138 139
182 0616H 1 CODE . . . . . . . BYTE 242 244 245 246 248 250 252 253
33 0022H 15 CONIN. . . . . . . PROCEDURE BYTE STACK=0008H 145
5 CR . . . . . . . . LITERALLY 98 112 114 118 157 189
97 0130H 17 CRLF . . . . . . . PROCEDURE STACK=000EH 177 180 254
5 CTRLC. . . . . . . LITERALLY
5 CTRLX. . . . . . . LITERALLY 159
5 DCL. . . . . . . . LITERALLY
182 0619H 1 DCNT . . . . . . . BYTE 207 208 209 219
126 01D1H 87 DELETE . . . . . . PROCEDURE BYTE STACK=0016H 242 250
57 008EH 16 DELETEFILE . . . . PROCEDURE WORD STACK=000AH 132
94 0008H 1536 DIRENTRIES . . . . STRUCTURE ARRAY(128) 217 232 241
96 0000H 1 DIRENTRY . . . . . BYTE BASED(DIRENTRYADR) ARRAY(1) 210 217
95 0608H 2 DIRENTRYADR. . . . WORD 96 209 210 217
46 0004H 2 DMA. . . . . . . . WORD PARAMETER AUTOMATIC 47 48
1 0000H ERASEQ . . . . . . PROCEDURE STACK=0000H
73 0006H 2 ERRCODE. . . . . . WORD 76 80 82 84 86
108 0161H 112 ERROR. . . . . . . PROCEDURE STACK=0010H 138 179 245
127 060AH 2 ERRORCODE. . . . . WORD 132 134 136
173 02C1H EXIT . . . . . . . LABEL 158
101 0006H 1 F. . . . . . . . . BYTE PARAMETER AUTOMATIC 102 104
5 FALSE. . . . . . . LITERALLY
19 0000H 1 FCB. . . . . . . . BYTE ARRAY(1) EXTERNAL(4) 131 192 193 200 202 203 207 226
241 242 250
20 0000H 1 FCB16. . . . . . . BYTE ARRAY(1) EXTERNAL(5) 130 153 156 166
50 0004H 2 FCBADDRESS . . . . WORD PARAMETER AUTOMATIC 51 52
126 0004H 2 FCBADDRESS . . . . WORD PARAMETER AUTOMATIC 127 129 131 132 133
57 0004H 2 FCBADDRESS . . . . WORD PARAMETER AUTOMATIC 58 59
70 0002H 2 FCBADR . . . . . . WORD MEMBER(PARSEFN) 200
127 0000H 32 FCBV . . . . . . . BYTE BASED(FCBADDRESS) ARRAY(32) 129 131 133
94 0000H 12 FILE . . . . . . . BYTE ARRAY(12) MEMBER(DIRENTRIES) 232
175 02C9H 26 FILEERR. . . . . . PROCEDURE STACK=0016H 248 253
101 0141H 32 FILL . . . . . . . PROCEDURE STACK=0008H 153
5 FOREVER. . . . . . LITERALLY
6 0000H 1 FUNC . . . . . . . BYTE PARAMETER 7
PL/M-86 COMPILER ERAQ: ERASE FILE WITH QUERY PAGE 11
14 0000H 1 FUNC . . . . . . . BYTE PARAMETER 15
10 0000H 1 FUNC . . . . . . . BYTE PARAMETER 11
150 0248H 129 GETPASSWD. . . . . PROCEDURE STACK=0010H 249
61 009EH 15 GETUSERCODE. . . . PROCEDURE BYTE STACK=0008H 205
HIGH . . . . . . . BUILTIN 136 187
182 0613H 1 I. . . . . . . . . BYTE 204 212 217 221 225
151 0611H 1 I. . . . . . . . . BYTE 154 156 163 166
14 0000H 2 INFO . . . . . . . WORD PARAMETER 16
10 0000H 2 INFO . . . . . . . WORD PARAMETER 12
6 0000H 2 INFO . . . . . . . WORD PARAMETER 8
182 0614H 1 J. . . . . . . . . BYTE 225 232 241
182 0615H 1 K. . . . . . . . . BYTE 229 230 232
184 061AH 1 LASTDSEGBYTE . . . BYTE INITIAL
22 0000H 1 LEN0 . . . . . . . BYTE EXTERNAL(7)
24 0000H 1 LEN1 . . . . . . . BYTE EXTERNAL(9)
5 LF . . . . . . . . LITERALLY 99 112 114 118 189
5 LIT. . . . . . . . LITERALLY 93
LOW. . . . . . . . BUILTIN 134 187 203
6 0000H MON1 . . . . . . . PROCEDURE EXTERNAL(0) STACK=0000H 31 38 48 65 68 74
190
10 0000H MON2 . . . . . . . PROCEDURE BYTE EXTERNAL(1) STACK=0000H 27 34 41 52 55
62 203
14 0000H MON3 . . . . . . . PROCEDURE WORD EXTERNAL(2) STACK=0000H 44 59
MOVE . . . . . . . BUILTIN 217 241
155 026BH NXTCHR . . . . . . LABEL 167
72 00CBH 101 PARSE. . . . . . . PROCEDURE STACK=000EH 201
70 0000H 4 PARSEFN. . . . . . STRUCTURE 74 199 200
21 0000H 2 PASS0. . . . . . . WORD EXTERNAL(6)
23 0000H 2 PASS1. . . . . . . WORD EXTERNAL(8)
185 02E3H 500 PLMSTART . . . . . PROCEDURE PUBLIC STACK=001AH
36 0031H 16 PRINTBUF . . . . . PROCEDURE STACK=000AH 79 81 83 85 87 88 112 114
116 118 120 122 152 178 189 196 214 223
29 000FH 19 PRINTCHAR. . . . . PROCEDURE STACK=000AH 98 99 110 226 227 228 231 232
234 235 237 238
5 PROC . . . . . . . LITERALLY 97 101 108 143 150
26 0000H 15 READCONSOLE. . . . PROCEDURE BYTE STACK=0008H 236
182 0617H 1 RESPONSE . . . . . BYTE 236 239
73 0004H 2 RETCODE. . . . . . WORD 75 77
153 0252H RETRY. . . . . . . LABEL 160 164
64 00ADH 15 RETURNERRORS . . . PROCEDURE STACK=0008H 206
ROR. . . . . . . . BUILTIN 209
101 0008H 2 S. . . . . . . . . WORD PARAMETER AUTOMATIC 102 104 105
71 0000H 2 SAVEAX . . . . . . WORD EXTERNAL(11) 75
71 0000H 2 SAVECX . . . . . . WORD EXTERNAL(12) 76
50 006FH 16 SEARCHFIRST. . . . PROCEDURE BYTE STACK=000AH 207
54 007FH 15 SEARCHNEXT . . . . PROCEDURE BYTE STACK=0008H 219
46 005FH 16 SETDMA . . . . . . PROCEDURE STACK=000AH 130
93 SUCCESSFUL . . . . LITERALLY 141 242 252
25 0000H 1 TBUFF. . . . . . . BYTE ARRAY(1) EXTERNAL(10) 199 209
67 00BCH 15 TERMINATE. . . . . PROCEDURE STACK=0008H 89 124 171 197 215 258
5 TRUE . . . . . . . LITERALLY 194
143 0228H 32 UCASE. . . . . . . PROCEDURE BYTE STACK=000CH 155
182 0618H 1 USER . . . . . . . BYTE 205 210
183 060CH 2 VER. . . . . . . . WORD 186 187
4 VERBDOS. . . . . . LITERALLY 187
3 VERMASK. . . . . . LITERALLY 187
2 VERNEEDSOS . . . . LITERALLY 189
PL/M-86 COMPILER ERAQ: ERASE FILE WITH QUERY PAGE 12
2 VEROS. . . . . . . LITERALLY
43 0050H 15 VERSION. . . . . . PROCEDURE WORD STACK=0008H 186
92 060EH 1 XFCB . . . . . . . BYTE INITIAL 128 194
MODULE INFORMATION:
CODE AREA SIZE = 04D7H 1239D
CONSTANT AREA SIZE = 0128H 296D
VARIABLE AREA SIZE = 061BH 1563D
MAXIMUM STACK SIZE = 001AH 26D
463 LINES READ
0 PROGRAM ERROR(S)
END OF PL/M-86 COMPILATION