seppdroid/Digital-Research-Source-Code
1
0
Fork 0
mirror of https://github.com/SEPPDROID/Digital-Research-Source-Code.git synced 2025-10-25 17:34:06 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity
Files
f5ed2b0a4d18444304007f20e459be89b797c67b
Digital-Research-Source-Code/CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 2.0 SOURCE/pip/pip.lst
Sepp J Morris 31738079c4 Upload 
Digital Research
2020-11-06 18:50:37 +01:00

2562 lines
122 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 PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 1
ISIS-II PL/M-86 V2.0 COMPILATION OF MODULE PIPMOD
OBJECT MODULE PLACED IN PIP.OBJ
COMPILER INVOKED BY: :F0: PIP.PLM XREF OPTIMIZE(3) DEBUG DATE(2/9/83)
$title('PERIPHERAL INTERCHANGE PROGRAM')
1 PIPMOD:
DO;
/* P E R I P H E R A L I N T E R C H A N G E P R O G R A M
COPYRIGHT (C) 1976, 1977, 1978, 1979, 1980, 1981, 1982, 1983
DIGITAL RESEARCH
BOX 579
PACIFIC GROVE, CA
93950
Revised:
17 Jan 80 by Thomas Rolander (MP/M 1.1)
05 Oct 81 by Ray Pedrizetti (MP/M-86 2.0)
18 Dec 81 by Ray Pedrizetti (CP/M-86 1.1)
29 Jun 82 by Ray Pedrizetti (CCP/M-86 3.0) */
/* Command lines used for CMD file generation */
/* (on VAX)
asm86 scd1.a86
asm86 inpout.a86
plm86 pip.plm debug xref optimize(3)
link86 scd1.obj,inpout.obj,pip.obj, to pip.lnk
loc86 pip.lnk od(sm(code,dats,data,const,stack)) -
ad(sm(code(0), dats(10000h))) ss(stack(+32)) to pip.
h86 pip
(on a micro)
vax pip.h86 $fans
gencmd pip data[b1000 m280 xfff]
* note the beginning of the data segment will change when
* the program is changed. see the 'MP2' file generated
* by LOC86. the constants are last to force hex generation
*/
/* Compiler Directives */
$set (mpm)
$reset (cpm3)
$cond
2 1 declare /* resets stack for error handling */
reset label external;
3 1 DECLARE
MAXB ADDRESS EXTERNAL, /* ADDR FIELD OF JMP BDOS */
FCB (33) BYTE EXTERNAL, /* DEFAULT FILE CONTROL BLOCK */
BUFF(128)BYTE EXTERNAL; /* DEFAULT BUFFER */
4 1 declare
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 2
retry byte initial(0); /* true if error has occured */
5 1 OUTD: PROCEDURE(B) external;
6 2 DECLARE B BYTE;
/* SEND B TO OUT: DEVICE */
7 2 END OUTD;
8 1 INPD: PROCEDURE BYTE external;
9 2 END INPD;
10 1 MON1: PROCEDURE(F,A) EXTERNAL;
11 2 DECLARE F BYTE,
A ADDRESS;
12 2 END MON1;
13 1 MON2: PROCEDURE(F,A) BYTE EXTERNAL;
14 2 DECLARE F BYTE,
A ADDRESS;
15 2 END MON2;
16 1 MON3: PROCEDURE(F,A) ADDRESS EXTERNAL;
17 2 DECLARE F BYTE,
A ADDRESS;
18 2 END MON3;
19 1 plm: procedure public;
20 2 DECLARE
$if mpm
VERSION LITERALLY '0031H', /* REQUIRED FOR BDOS 3.1 OPERATION */
$else
VERSION LITERALLY '0022H', /* REQUIRED FOR OPERATION */
$endif
ENDFILE LITERALLY '1AH'; /* END OF FILE MARK */
21 2 DECLARE COPYRIGHT(*) BYTE DATA (
$if cpm3
' (02/07/83) CP/M 3 PIP VERS 3.1 ');
$else
' (02/07/83) CCP/M-86 PIP VERS 3.1 ');
$endif
/* LITERAL DECLARATIONS */
22 2 DECLARE
LIT LITERALLY 'LITERALLY',
LPP LIT '60', /* LINES PER PAGE */
TAB LIT '09H', /* HORIZONTAL TAB */
FF LIT '0CH', /* FORM FEED */
LA LIT '05FH', /* LEFT ARROW */
LB LIT '05BH', /* LEFT BRACKET */
RB LIT '05DH', /* RIGHT BRACKET */
FSIZE LIT '33',
FRSIZE LIT '36', /* SIZE OF RANDOM FCB */
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 3
NSIZE LIT '8',
FNSIZE LIT '11',
FEXT LIT '9',
FEXTL LIT '3',
/* scanner return type code */
outt LIT '0', /* output device */
PRNT LIT '1', /* PRINTER */
LSTT LIT '2', /* list device */
axot lit '3', /* auxilary output device */
FILE LIT '4', /* file type */
auxt lit '5', /* auxilary input/output device */
CONS LIT '6', /* CONSOLE */
axit LIT '7', /* auxilary input device */
inpt lit '8', /* input device */
NULT LIT '9', /* nul characters */
EOFT LIT '10', /* EOF character */
ERR LIT '11', /* error type */
SPECL LIT '12', /* special character */
DISKNAME LIT '13'; /* diskname letter */
23 2 DECLARE
SEARFCB LIT 'FCB'; /* SEARCH FCB IN MULTI COPY */
24 2 DECLARE
TRUE LIT '1',
FALSE LIT '0',
FOREVER LIT 'WHILE TRUE',
cntrlc lit '3',
CR LIT '13',
LF LIT '10',
WHAT LIT '63';
$if mpm
25 2 declare
maxmcnt lit '128', /* maximum multi sector count */
maxmbuf lit '16384'; /* maximum multi sector buffer size */
$endif
26 2 DECLARE
COLUMN BYTE, /* COLUMN COUNT FOR PRINTER TABS */
LINENO BYTE, /* LINE WITHIN PAGE */
FEEDBASE BYTE, /* USED TO FEED SEARCH CHARACTERS */
FEEDLEN BYTE, /* LENGTH OF FEED STRING */
MATCHLEN BYTE, /* USED IN MATCHING STRINGS */
QUITLEN BYTE, /* USED TO TERMINATE QUIT COMMAND */
CDISK BYTE, /* CURRENT DISK */
SBLEN ADDRESS, /* SOURCE BUFFER LENGTH */
DBLEN ADDRESS, /* DEST BUFFER LENGTH */
tblen address, /* temp buffer length */
SBASE ADDRESS, /* SOURCE BUFFER BASE */
/* THE VECTORS DBUFF AND SBUFF ARE DECLARED WITH DIMENSION
1024, BUT ACTUALLY VARY WITH THE FREE MEMORY SIZE */
DBUFF(1024) BYTE AT (.MEMORY), /* DESTINATION BUFFER */
SBUFF BASED SBASE (1024) BYTE, /* SOURCE BUFFER */
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 4
/* source fcb, password and password mode */
source structure (
fcb(frsize) byte,
$if mpm
pwnam(nsize) byte,
pwmode byte,
$endif
user byte,
type byte ),
/* temporary destination fcb, password and password mode */
dest structure (
fcb(frsize) byte,
$if mpm
pwnam(nsize) byte,
pwmode byte,
$endif
user byte,
type byte ),
/* original destination fcb, password and password mode */
odest structure (
fcb(frsize) byte,
$if mpm
pwnam(nsize) byte,
pwmode byte,
$endif
user byte,
type byte ),
filsize(3) byte, /* file size random record number */
DESTR ADDRESS AT(.DEST.FCB(33)), /* RANDOM RECORD POSITION */
SOURCER ADDRESS AT(.SOURCE.FCB(33)), /* RANDOM RECORD POSITION */
DESTR2 BYTE AT(.DEST.FCB(35)), /* RANDOM RECORD POSITION R2 */
SOURCER2 BYTE AT(.SOURCE.FCB(35)), /* RANDOM RECORD POSITION R2 */
extsave byte, /* temp extent byte for bdos bug */
nsbuf address, /* next source buffer */
$if mpm
bufsize address, /* multsect buffer size */
mseccnt byte, /* last multi sector count value */
$endif
NSOURCE ADDRESS, /* NEXT SOURCE CHARACTER */
NDEST ADDRESS; /* NEXT DESTINATION CHARACTER */
27 2 DECLARE
fastcopy byte, /* true if copy directly to dbuf */
dblbuf byte, /* true if both source and dest buffer used */
concat byte, /* true if concatination command */
ambig byte, /* true if file is ambig type */
dfile byte, /* true if dest is file type */
sfile byte, /* true if source is file type */
made byte, /* true if destination file already made */
opened byte, /* true if source file open */
endofsrc byte, /* true if end of source file */
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 5
nendcmd byte, /* true if not end of command tail */
insparc byte, /* true if in middle of sparce file */
sparfil byte, /* true if sparce file being copied */
MULTCOM BYTE, /* true if processing multiple commands */
PUTNUM BYTE, /* SET WHEN READY FOR NEXT LINE NUM */
CONCNT BYTE, /* COUNTER FOR CONSOLE READY CHECK */
CHAR BYTE, /* LAST CHARACTER SCANNED */
FLEN BYTE; /* FILE NAME LENGTH */
28 2 declare
f1 byte, /* f1 user attribute flag */
f2 byte, /* f2 user attribute flag */
f3 byte, /* f3 user attribute flag */
f4 byte, /* f4 user attribute flag */
ro byte, /* read only attribute flag */
sys byte, /* system attribute flag */
$if mpm
exten byte, /* extention error code */
odcnt byte, /* saves dcnt for open dest file */
eretry byte, /* error return flag */
$endif
dcnt byte; /* error code or directory code */
29 2 DECLARE CBUFF(130) BYTE, /* COMMAND BUFFER */
MAXLEN BYTE AT (.CBUFF(0)), /* MAX BUFFER LENGTH */
COMLEN BYTE AT (.CBUFF(1)), /* CURRENT LENGTH */
COMBUFF(128) BYTE AT (.CBUFF(2)), /* COMMAND BUFFER CONTENTS */
CBP BYTE; /* COMMAND BUFFER POINTER */
30 2 DECLARE
CUSER BYTE, /* CURRENT USER NUMBER */
last$user byte;
31 2 DECLARE /* CONTROL TOGGLE VECTOR */
CONT(26) BYTE, /* ONE FOR EACH ALPHABETIC */
/* 00 01 02 03 04 05 06 07 08 09 10 11 12 13
A B C D E F G H I J K L M N
14 15 16 17 18 19 20 21 22 23 24 25
O P Q R S T U V W X Y Z */
archiv byte at(.cont(0)), /* file archive */
confrm byte at(.cont(2)), /* confirm copy */
DELET BYTE AT(.CONT(3)), /* DELETE CHARACTERS */
ECHO BYTE AT(.CONT(4)), /* ECHO CONSOLE CHARACTERS */
FORMF BYTE AT(.CONT(5)), /* FORM FILTER */
GETU BYTE AT(.CONT(6)), /* GET FILE, USER # */
HEXT BYTE AT(.CONT(7)), /* HEX FILE TRANSFER */
IGNOR BYTE AT(.CONT(8)), /* IGNORE :00 RECORD ON FILE */
kilds byte at(.cont(10)), /* kill filename display */
LOWER BYTE AT(.CONT(11)), /* TRANSLATE TO LOWER CASE */
NUMB BYTE AT(.CONT(13)), /* NUMBER OUTPUT LINES */
OBJ BYTE AT(.CONT(14)), /* OBJECT FILE TRANSFER */
PAGCNT BYTE AT(.CONT(15)), /* PAGE LENGTH */
QUITS BYTE AT(.CONT(16)), /* QUIT COPY */
RSYS BYTE AT(.CONT(17)), /* READ SYSTEM FILES */
STARTS BYTE AT(.CONT(18)), /* START COPY */
TABS BYTE AT(.CONT(19)), /* TAB SET */
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 6
UPPER BYTE AT(.CONT(20)), /* UPPER CASE TRANSLATE */
VERIF BYTE AT(.CONT(21)), /* VERIFY EQUAL FILES ONLY */
WRROF BYTE AT(.CONT(22)), /* WRITE TO R/O FILE */
ZEROP BYTE AT(.CONT(25)); /* ZERO PARITY ON INPUT */
32 2 DECLARE ZEROSUP BYTE, /* ZERO SUPPRESSION */
(C3,C2,C1) BYTE; /* LINE COUNT ON PRINTER */
$if mpm
33 2 retcodes: procedure(a);
34 3 declare a address;
35 3 dcnt = low(a);
36 3 exten = high(a);
37 3 end retcodes;
$endif
38 2 BOOT: PROCEDURE;
/* SYSTEM REBOOT */
39 3 CALL MON1(0,0);
40 3 END BOOT;
41 2 RDCHAR: PROCEDURE BYTE;
/* READ CONSOLE CHARACTER */
42 3 RETURN MON2(1,0);
43 3 END RDCHAR;
44 2 PRINTCHAR: PROCEDURE(CHAR);
45 3 DECLARE CHAR BYTE;
46 3 CALL MON1(2,CHAR AND 7FH);
47 3 END PRINTCHAR;
48 2 CRLF: PROCEDURE;
49 3 CALL PRINTCHAR(CR);
50 3 CALL PRINTCHAR(LF);
51 3 END CRLF;
52 2 printx: procedure(a);
53 3 declare a address;
54 3 call mon1(9,a);
55 3 end printx;
56 2 PRINT: PROCEDURE(A);
57 3 DECLARE A ADDRESS;
/* PRINT THE STRING STARTING AT ADDRESS A UNTIL THE
NEXT DOLLAR SIGN IS ENCOUNTERED */
58 3 CALL CRLF;
59 3 CALL printx(A);
60 3 END PRINT;
61 2 RDCOM: PROCEDURE;
/* READ INTO COMMAND BUFFER */
62 3 MAXLEN = 128;
63 3 CALL MON1(10,.MAXLEN);
64 3 END RDCOM;
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 7
65 2 CVERSION: PROCEDURE ADDRESS;
66 3 RETURN MON3(12,0); /* VERSION NUMBER */
67 3 END CVERSION;
68 2 SETDMA: PROCEDURE(A);
69 3 DECLARE A ADDRESS;
70 3 CALL MON1(26,A);
71 3 END SETDMA;
$if mpm
72 2 setpw: procedure(fcba);
73 3 declare fcba address;
74 3 declare fcbs based fcba structure (
fcb(frsize) byte,
pwnam(nsize) byte );
75 3 call setdma(.fcbs.pwnam(0));
76 3 end setpw;
$endif
77 2 OPEN: PROCEDURE(fcba);
78 3 DECLARE fcba ADDRESS;
79 3 declare fcb based fcba (frsize) byte;
$if mpm
80 3 CALL SETPW(fcba);
81 3 call retcodes(mon3(15,fcba));
$else
dcnt = mon2(15,fcba);
$endif
82 3 if dcnt <> 255 and rol(fcb(8),1) then
83 3 do; call mon1(16,fcba);
85 4 dcnt = 255;
$if mpm
86 4 exten = 0;
$endif
87 4 end;
88 3 END OPEN;
89 2 CLOSE: PROCEDURE(FCB);
90 3 DECLARE FCB ADDRESS;
$if mpm
91 3 call retcodes(MON3(16,FCB));
$else
dcnt = MON2(16,FCB);
$endif
92 3 END CLOSE;
93 2 SEARCH: PROCEDURE(FCB);
94 3 DECLARE FCB ADDRESS;
$if mpm
95 3 call retcodes(MON3(17,FCB));
$else
dcnt = MON2(17,FCB);
$endif
96 3 END SEARCH;
97 2 SEARCHN: PROCEDURE;
$if mpm
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 8
98 3 call retcodes(MON3(18,0));
$else
dcnt = MON2(18,0);
$endif
99 3 END SEARCHN;
100 2 DELETE: PROCEDURE(FCB);
101 3 DECLARE FCB ADDRESS;
$if mpm
102 3 CALL SETPW(FCB);
103 3 call retcodes(MON3(19,FCB));
$else
CALL MON1(19,FCB);
$endif
104 3 END DELETE;
105 2 DISKRD: PROCEDURE(FCB);
106 3 DECLARE FCB ADDRESS;
$if mpm
107 3 call retcodes(MON3(20,FCB));
$else
dcnt = MON2(20,FCB);
$endif
108 3 END DISKRD;
109 2 DISKWRITE: PROCEDURE(FCB);
110 3 DECLARE FCB ADDRESS;
$if mpm
111 3 call retcodes(MON3(21,FCB));
$else
dcnt = MON2(21,FCB);
$endif
112 3 END DISKWRITE;
113 2 MAKE: procedure(fcba);
114 3 declare fcba address;
$if mpm
115 3 declare fcbs based fcba structure (
fcb(frsize) byte,
pwnam(nsize) byte );
116 3 if fcbs.pwnam(0) = 0 then /* zero if no password */
117 3 fcbs.fcb(6) = fcbs.fcb(6) and 7fh; /* reset password attribute */
118 3 else do;
119 4 fcbs.fcb(6) = fcbs.fcb(6) or 80h; /* set password attribute */
120 4 call setdma(.fcbs.pwnam(0)); /* set password dma */
121 4 end;
122 3 call retcodes(mon3(22,fcba));
$else
dcnt = mon2(22,fcba);
$endif
123 3 END MAKE;
124 2 RENAME: PROCEDURE(FCB);
125 3 DECLARE FCB ADDRESS;
$if mpm
126 3 CALL SETPW(FCB);
127 3 call retcodes(MON3(23,FCB)) ;
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 9
$else
dcnt = MON2(23,FCB);
$endif
128 3 END RENAME;
129 2 getdisk: procedure byte;
130 3 return mon2(25,0);
131 3 end getdisk;
132 2 SETIND: PROCEDURE(FCB);
133 3 DECLARE FCB ADDRESS;
$if mpm
134 3 call retcodes(MON3(30,FCB));
$else
dcnt = MON2(30,FCB);
$endif
135 3 END SETIND;
136 2 GETUSER: PROCEDURE BYTE;
137 3 RETURN MON2(32,0FFH);
138 3 END GETUSER;
139 2 SETUSER: PROCEDURE(USER);
140 3 DECLARE USER BYTE;
141 3 if last$user <> user then
142 3 CALL MON1(32,(last$user:=USER));
143 3 END SETUSER;
144 2 SETCUSER: PROCEDURE;
145 3 CALL SETUSER(CUSER);
146 3 END SETCUSER;
147 2 setduser: procedure;
148 3 call setuser(odest.user);
149 3 end setduser;
150 2 SETSUSER: PROCEDURE;
151 3 CALL SETUSER(source.user);
152 3 END SETSUSER;
153 2 RD$RANDOM: PROCEDURE(FCB) BYTE;
154 3 DECLARE FCB ADDRESS;
$if mpm
155 3 call retcodes(mon3(33,fcb));
$else
dcnt = mon2(33,fcb);
$endif
156 3 return dcnt;
157 3 END RD$RANDOM;
158 2 write$random: procedure(fcb) byte;
159 3 declare fcb address;
$if mpm
160 3 call retcodes(mon3(34,fcb));
$else
dcnt = mon2(34,fcb);
$endif
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 10
161 3 return dcnt;
162 3 end write$random;
163 2 retfsize: procedure(fcb) byte;
164 3 declare fcb address;
165 3 return mon2(35,fcb);
166 3 end retfsize;
167 2 SET$RANDOM: PROCEDURE(FCB);
168 3 DECLARE FCB ADDRESS;
/* SET RANDOM RECORD POSITION */
169 3 CALL MON1(36,FCB);
170 3 END SET$RANDOM;
$if mpm
171 2 multsect: procedure(cnt);
172 3 declare cnt byte;
173 3 if mseccnt <> cnt then
174 3 call mon1(44,(mseccnt := cnt));
175 3 end multsect;
176 2 flushbuf: procedure;
177 3 call mon1(48, 0ffh); /* 0FFH = flush and discard buffers */
178 3 end flushbuf;
179 2 conatlst: procedure byte;
180 3 return mon2(161,0);
181 3 end conatlst;
$endif
182 2 MOVE: PROCEDURE(S,D,N);
183 3 DECLARE (S,D) ADDRESS, N BYTE;
184 3 DECLARE A BASED S BYTE, B BASED D BYTE;
185 3 DO WHILE (N:=N-1) <> 255;
186 4 B = A; S = S+1; D = D+1;
189 4 END;
190 3 END MOVE;
/* errtype error messages */
191 2 declare er00(*) byte data ('DISK READ$');
192 2 declare er01(*) byte data ('DISK WRITE$');
193 2 declare er02(*) byte data ('VERIFY$');
194 2 declare er03(*) byte data ('INVALID DESTINATION$');
195 2 declare er04(*) byte data ('INVALID SOURCE$');
196 2 declare er05(*) byte data ('USER ABORTED$');
197 2 declare er06(*) byte data ('BAD PARAMETER$');
198 2 declare er07(*) byte data ('INVALID USER NUMBER$');
199 2 declare er08(*) byte data ('INVALID FORMAT$');
200 2 declare er09(*) byte data ('HEX RECORD CHECKSUM$');
201 2 declare er10(*) byte data ('FILE NOT FOUND$');
202 2 declare er11(*) byte data ('START NOT FOUND$');
203 2 declare er12(*) byte data ('QUIT NOT FOUND$');
204 2 declare er13(*) byte data ('INVALID HEX DIGIT$');
205 2 declare er14(*) byte data ('CLOSE FILE$');
206 2 declare er15(*) byte data ('UNEXPECTED END OF HEX FILE$');
207 2 declare er16(*) byte data ('INVALID SEPARATOR$');
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 11
208 2 declare er17(*) byte data ('NO DIRECTORY SPACE$');
209 2 declare er18(*) byte data ('INVALID FORMAT WITH SPARCE FILE$');
$if mpm
210 2 declare er19(*) byte data ('MAKE FILE$');
211 2 declare er20(*) byte data ('OPEN FILE$');
212 2 declare er21(*) byte data ('PRINTER BUSY$');
213 2 declare er22(*) byte data ('CAN''T DELETE TEMP FILE$');
$endif
214 2 declare errmsg(*) address data(
.er00,.er01,.er02,.er03,.er04,
.er05,.er06,.er07,.er08,.er09,
.er10,.er11,.er12,.er13,.er14,
.er15,.er16,.er17,.er18
$if mpm
,.er19,.er20,.er21,.er22
$endif
);
215 2 declare sper00(*) byte data ('NO DIRECTORY SPACE$');
216 2 declare sper01(*) byte data ('NO DATA BLOCK$');
217 2 declare sper02(*) byte data ('CAN''T CLOSE CURRENT EXTENT$');
218 2 declare sper03(*) byte data ('SEEK TO UNWRITTEN EXTENT$');
219 2 declare sper05(*) byte data ('RANDOM RECORD OUT OF RANGE$');
220 2 declare sper06(*) byte data ('RECORDS DON''T MATCH$');
221 2 declare sper07(*) byte data ('RECORD LOCKED$');
222 2 declare sper08(*) byte data ('INVALID FILENAME$');
223 2 declare sper09(*) byte data ('FCB CHECKSUM$');
224 2 declare numspmsgs lit '10'; /* number of extended messages */
225 2 declare special$msg(numspmsgs) address data(
.sper00,.sper01,.sper02,.sper03,.sper00,
.sper05,.sper06,.sper07,.sper08,.sper09);
$if mpm
/* extended error messages */
226 2 declare ex00(*) byte data ('$'); /* NO MESSAGE */
227 2 declare ex01(*) byte data ('NONRECOVERABLE$');
228 2 declare ex02(*) byte data ('R/O DISK$');
229 2 declare ex03(*) byte data ('R/O FILE$');
230 2 declare ex04(*) byte data ('INVALID DISK SELECT$');
231 2 declare ex05(*) byte data ('INCOMPATIBLE MODE$');
232 2 declare ex07(*) byte data ('INVALID PASSWORD$');
233 2 declare ex08(*) byte data ('ALREADY EXISTS$');
234 2 declare ex10(*) byte data ('LIMIT EXCEEDED$');
235 2 declare nummsgs lit '11'; /* number of extended messages */
236 2 declare extmsg(nummsgs) address data(
.ex00,.ex01,.ex02,.ex03,.ex04,
.ex05,.sper09,.ex07,.ex08,.sper08,
.ex10);
$endif
237 2 error$cleanup: procedure;
$if mpm
238 3 call multsect(1);
$endif
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 12
239 3 eretry = 0; /* initialize to no error retry */
240 3 if opened then /* if source file opened */
241 3 do; call setsuser;
243 4 call close(.source);
244 4 opened = false;
245 4 end;
246 3 if made then
247 3 do; call setduser;
249 4 call close(.dest);
250 4 call delete(.dest); /* delete destination scratch file */
251 4 end;
/* Zero the command length in case this is a single command */
252 3 comlen = 0;
253 3 retry = true;
254 3 call print(.('ERROR: $'));
255 3 end error$cleanup;
256 2 error: procedure (errtype);
257 3 declare errtype byte;
258 3 call error$cleanup;
259 3 call printx(errmsg(errtype));
260 3 call crlf;
261 3 go to reset;
262 3 end error;
263 2 xerror: procedure (funcno,fileadr);
264 3 declare temp byte,
i byte,
sdcnt byte,
sexten byte,
funcno byte,
fileadr address,
fcb based fileadr (fsize) byte;
265 3 declare message$index$tbl(17) byte data
(2,18,13,15,9,3,10,20,14,10,22,17,19,0,1,0,1);
266 3 sdcnt = dcnt;
267 3 sexten = exten;
268 3 call error$cleanup;
269 3 if (funcno < 6) or (sdcnt <> 0ffh) then
270 3 sexten = 0;
271 3 else sexten = sexten and 0fh;
272 3 call printx(errmsg(message$index$tbl(funcno)));
273 3 if (funcno > 12) and (funcno < 17) and
(sdcnt <> 0ffh) and (sdcnt <= numspmsgs) then
274 3 do; call printchar(' ');
276 4 call printx(special$msg(sdcnt-1));
277 4 sexten = 0;
278 4 end;
$if mpm
279 3 if sexten < nummsgs then
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 13
280 3 do; call printchar(' ');
282 4 call printx(extmsg(sexten));
283 4 end;
$endif
284 3 call printx(.(' - $'));
285 3 if fileadr <> 0 then
286 3 do; call printchar('A' + fcb(0) - 1);
288 4 call printchar(':');
289 4 do i = 1 to fnsize;
290 5 if (temp := fcb(i) and 07fh) <> ' ' then
291 5 do; if i = fext then call printchar('.');
294 6 call printchar(temp);
295 6 end;
296 5 end;
297 4 end;
298 3 call crlf;
299 3 if (sdcnt = 3) or (sdcnt = 4) or (sdcnt = 6) or (sdcnt = 8) then
300 3 eretry = ambig;
else
301 3 if (sexten = 3) or ((sexten > 4) and (sexten < 9)) or (sexten > 9) then
302 3 eretry = ambig;
go to reset;
304 3 end xerror;
305 2 FORMERR: PROCEDURE;
306 3 call error(8); /* invalid format */
307 3 END FORMERR;
308 2 CONBRK: PROCEDURE;
/* CHECK CONSOLE CHARACTER READY */
309 3 if mon2(11,0) <> 0 then
310 3 if mon2(6,0fdh) = cntrlc then
311 3 call error(5);
312 3 END CONBRK;
313 2 MAXSIZE: procedure byte;
/* three byte compare of random record field
returns true if source.fcb.ranrec >= filesize */
314 3 if (source.fcb(35) < filsize(2)) then
315 3 return false;
316 3 if (source.fcb(35) = filsize(2)) then
317 3 do;
318 4 if (source.fcb(34) < filsize(1)) then
319 4 return false;
320 4 if (source.fcb(34) = filsize(1)) then
321 4 do;
322 5 if (source.fcb(33) < filsize(0)) then
323 5 return false;
324 5 end;
325 4 end;
326 3 return true;
327 3 end maxsize;
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 14
328 2 SETUPDEST: PROCEDURE;
329 3 call setduser; /* destination user */
$if mpm
330 3 call move(.odest,.dest,(frsize + nsize + 1)); /* save original dest */
$else
call move(.odest,.dest,(frsize + 1)); /* save original dest */
$endif
/* MOVE THREE CHARACTER EXTENT INTO DEST FCB */
331 3 CALL MOVE(.('$$$'),.DEST.FCB(FEXT),FEXTL);
$if mpm
332 3 odest.fcb(6) = odest.fcb(6) or 80h;
333 3 call open(.odest); /* try to open destination file */
334 3 odcnt = dcnt; /* and save error code */
335 3 if odcnt <> 255 then
336 3 call close(.odest);
337 3 else if (exten and 0fh) <> 0 then /* file exists */
338 3 call xerror(7,.odest); /* but can't open - error */
CALL DELETE(.DEST); /* REMOVE OLD $$$ FILE */
340 3 if dcnt = 255 and exten <> 0 then
/* cant delete temp file */
341 3 call xerror(10,.dest);
342 3 CALL MAKE(.DEST); /* CREATE A NEW ONE */
343 3 IF DCNT = 255 THEN
344 3 if (exten and 0fh) = 0 then
345 3 call xerror(11,.dest); /* no directory space */
346 3 else call xerror(12,.dest); /* make file error */
$else
CALL DELETE(.DEST); /* REMOVE OLD $$$ FILE */
CALL MAKE(.DEST); /* CREATE A NEW ONE */
IF DCNT = 255 THEN
call 17,.dest); /* no directory space */
$endif
347 3 DEST.FCB(32) = 0;
348 3 made = true;
349 3 END SETUPDEST;
350 2 SETUPSOURCE: PROCEDURE;
351 3 declare (i,j) byte;
352 3 CALL SETSUSER; /* SOURCE USER */
$if mpm
353 3 source.fcb(6) = source.fcb(6) or 80h;
$endif
354 3 CALL OPEN(.SOURCE); /* open source */
355 3 if dcnt <> 255 then
356 3 opened = true;
357 3 IF (NOT RSYS) AND ROL(SOURCE.FCB(10),1) THEN
/* skip system file */
358 3 DCNT = 255;
359 3 IF DCNT = 255 THEN
$if mpm
360 3 if (exten and 0fh) = 0 then
361 3 call xerror(6,.source); /* file not found */
else
362 3 call xerror(7,.source); /* open file error */
$else
call xerror(6,.source); /* file not found */
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 15
$endif
363 3 f1 = source.fcb(1) and 80h; /* save file atributes */
364 3 f2 = source.fcb(2) and 80h;
365 3 f3 = source.fcb(3) and 80h;
366 3 f4 = source.fcb(4) and 80h;
367 3 ro = source.fcb(9) and 80h;
368 3 sys = source.fcb(10) and 80h;
369 3 dcnt = retfsize(.source);
370 3 call move(.source.fcb(33),.filsize,3);
371 3 SOURCE.FCB(32) = 0;
372 3 source.fcb(33),source.fcb(34),source.fcb(35) = 0;
/* cause immediate read with no preceding write */
373 3 NSOURCE = 0ffffh;
374 3 END SETUPSOURCE;
375 2 WRITEDEST: PROCEDURE;
/* WRITE OUTPUT BUFFERS UP TO BUT NOT INCLUDING POSITION
NDEST - THE LOW ORDER 7 BITS OF NDEST ARE ZERO */
376 3 DECLARE (J,DATAOK) BYTE,
(tdest,n) address;
377 3 if not made then call setupdest;
379 3 if (n := ndest and 0ff80h) = 0 then return;
381 3 tdest = 0;
382 3 call setduser; /* destination user */
383 3 if (sparfil := (sparfil or insparc)) then
/* set up fcb from random record no. */
384 3 do;
$if mpm
385 4 call multsect(1);
$endif
386 4 CALL SETDMA(.dbuff(tdest));
387 4 if write$random(.dest) <> 0 then
388 4 call xerror(16,.dest); /* DISK WRITE ERROR */
389 4 end;
else
390 3 CALL SETRANDOM(.DEST); /* SET BASE RECORD FOR VERIFY */
$if mpm
391 3 if fastcopy then
392 3 do; bufsize = maxmbuf;
394 4 call multsect(maxmcnt);
395 4 end;
else
396 3 do; bufsize = 128;
398 4 call multsect(1);
399 4 end;
$endif
400 3 do while n - tdest > 127;
$if mpm
401 4 if fastcopy and (n - tdest < maxmbuf) then
402 4 do; bufsize = n - tdest;
404 5 call multsect(low(shr(bufsize,7)));
405 5 end;
$endif
/* SET DMA ADDRESS TO NEXT BUFFER */
406 4 CALL SETDMA(.dbuff(tdest));
407 4 call diskwrite(.dest);
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 16
408 4 IF dcnt <> 0 THEN
409 4 call xerror(14,.dest); /* DISK WRITE ERROR */
$if mpm
410 4 tdest = tdest + bufsize;
$else
tdest = tdest + 128;
$endif
411 4 END;
412 3 IF VERIF THEN /* VERIFY DATA WRITTEN OK */
413 3 DO;
414 4 call flushbuf;
415 4 tdest = 0;
$if mpm
416 4 call multsect(1);
$endif
417 4 CALL SETDMA(.BUFF); /* FOR COMPARE */
418 4 do while tdest < n;
419 5 DATAOK = (RDRANDOM(.DEST) = 0);
420 5 if (DESTR := DESTR + 1) = 0 then /* 3 byte inc for */
421 5 destr2 = destr2 + 1; /* next random record */
422 5 J = 0;
/* PERFORM COMPARISON */
423 5 DO WHILE DATAOK AND J < 80H;
424 6 DATAOK = (BUFF(J) = DBUFF(tdest+J));
425 6 J = J + 1;
426 6 END;
427 5 tdest = tdest + 128;
428 5 IF NOT DATAOK THEN
429 5 call xerror(0,.dest); /* VERIFY ERROR */
430 5 END;
431 4 call diskrd(.dest);
/* NOW READY TO CONTINUE THE WRITE OPERATION */
432 4 END;
433 3 CALL SETRANDOM(.DEST); /* set base record for sparce copy */
434 3 call move(.dbuff(tdest),.dbuff(0),low(ndest := ndest - tdest));
435 3 END WRITEDEST;
436 2 FILLSOURCE: PROCEDURE;
/* FILL THE SOURCE BUFFER */
437 3 call conbrk;
$if mpm
438 3 if fastcopy then
439 3 do; bufsize = maxmbuf;
441 4 call multsect(maxmcnt);
442 4 end;
443 3 else do;
444 4 bufsize = 128;
445 4 call multsect(1);
446 4 end;
$endif
447 3 CALL SETSUSER; /* SOURCE USER NUMBER SET */
448 3 nsource = nsbuf;
449 3 do while sblen - nsbuf > 127;
450 4 if fastcopy and (sblen - nsbuf < maxmbuf) then
451 4 do; bufsize = (sblen - nsbuf) and 0ff80h;
453 5 call multsect(low(shr(bufsize,7)));
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 17
454 5 end;
/* SET DMA ADDRESS TO NEXT BUFFER POSIITION */
455 4 CALL SETDMA(.SBUFF(nsbuf));
456 4 extsave = source.fcb(12); /* save extent field */
457 4 call diskrd(.source);
458 4 IF dcnt <> 0 THEN
459 4 DO; IF dcnt <> 1 THEN
461 5 call xerror(13,.source); /* DISK READ ERROR */
/* END - OF - FILE */
$if mpm
462 5 if fastcopy then /* add no. sectors copied */
463 5 nsbuf = nsbuf + shl(double(exten),7);
/* nsbuf = nsbuf + shl(double(exten and 0f0h),3); */
$endif
/* check boundry condition for bug in bdos and correct */
464 5 if (source.fcb(12) <> extsave) and (source.fcb(32) = 80h) then
465 5 source.fcb(32) = 0; /* zero current record */
466 5 call set$random(.source);
467 5 if (insparc := not maxsize) then
468 5 do;
469 6 if concat or (not fastcopy) then
/* invalid format with sparce file */
470 6 call xerror(1,.source);
471 6 end;
else
472 5 do;
473 6 call close(.source);
474 6 opened = false;
475 6 end;
476 5 endofsrc = true; /* set end of source file */
477 5 SBUFF(nsbuf) = ENDFILE; return;
479 5 END;
ELSE
$if mpm
480 4 nsbuf = nsbuf + bufsize;
$else
nsbuf = nsbuf + 128;
$endif
481 4 END;
482 3 END FILLSOURCE;
483 2 PUTDCHAR: PROCEDURE(B);
484 3 DECLARE B BYTE;
/* WRITE BYTE B TO THE DESTINATION DEVICE GIVEN BY ODEST.TYPE */
485 3 IF B >= ' ' THEN
486 3 DO; COLUMN = COLUMN + 1;
488 4 IF DELET > 0 THEN /* MAY BE PAST RIGHT SIDE */
489 4 DO; IF COLUMN > DELET THEN RETURN;
492 5 END;
493 4 END;
494 3 if echo then call mon1(2,b); /* echo to console */
496 3 do case odest.type;
/* CASE 0 IS OUT */
497 4 CALL OUTD(B);
/* CASE 1 IS PRN, TABS EXPANDED, LINES LISTED */
498 4 call mon1(5,b);
/* CASE 2 IS LST */
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 18
499 4 CALL MON1(5,B);
/* CASE 3 IS axo */
500 4 axocase:
$if not mpm
CALL MON1(4,B);
$else
call error(3); /* invalid destination */
$endif
/* CASE 4 IS DESTINATION FILE */
501 4 DO;
502 5 IF NDEST >= DBLEN THEN CALL WRITEDEST;
504 5 DBUFF(NDEST) = B;
505 5 NDEST = NDEST+1;
506 5 END;
/* CASE 5 IS AUX */
507 4 goto axocase;
/* CASE 6 IS CON */
508 4 CALL MON1(2,B);
509 4 END; /* of case */
510 3 END PUTDCHAR;
511 2 PUTDESTC: PROCEDURE(B);
512 3 DECLARE (B,I) BYTE;
/* WRITE DESTINATION CHARACTER, TAB EXPANSION */
513 3 IF B <> TAB THEN CALL PUTDCHAR(B);
515 3 ELSE IF TABS = 0 THEN CALL PUTDCHAR(B);
ELSE /* B IS TAB CHAR, TABS > 0 */
517 3 DO; I = COLUMN;
519 4 DO WHILE I >= TABS;
520 5 I = I - TABS;
521 5 END;
522 4 I = TABS - I;
523 4 DO WHILE I > 0;
524 5 I = I - 1;
525 5 CALL PUTDCHAR(' ');
526 5 END;
527 4 END;
528 3 IF B = CR THEN COLUMN = 0;
530 3 END PUTDESTC;
531 2 PRINT1: PROCEDURE(B);
532 3 DECLARE B BYTE;
533 3 IF (ZEROSUP := ZEROSUP AND B = 0) THEN
534 3 CALL PUTDESTC(' ');
ELSE
535 3 CALL PUTDESTC('0'+B);
536 3 END PRINT1;
537 2 PRINTDIG: PROCEDURE(D);
538 3 DECLARE D BYTE;
539 3 CALL PRINT1(SHR(D,4)); CALL PRINT1(D AND 1111B);
541 3 END PRINTDIG;
542 2 NEWLINE: PROCEDURE;
543 3 DECLARE ONE BYTE;
544 3 ONE = 1;
545 3 ZEROSUP = (NUMB = 1);
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 19
546 3 C1 = DEC(C1+ONE); C2 = DEC(C2 PLUS 0); C3 = DEC(C3 PLUS 0);
549 3 CALL PRINTDIG(C3); CALL PRINTDIG(C2); CALL PRINTDIG(C1);
552 3 IF NUMB = 1 THEN /* USUALLY PRINTER OUTPUT */
553 3 DO; CALL PUTDESTC(':'); CALL PUTDESTC(' ');
556 4 END;
ELSE
557 3 CALL PUTDESTC(TAB);
558 3 END NEWLINE;
559 2 PUTDEST: PROCEDURE(B);
560 3 DECLARE (I,B) BYTE;
/* WRITE DESTINATION CHARACTER, CHECK TABS AND LINES */
561 3 IF FORMF THEN /* SKIP FORM FEEDS */
562 3 DO; IF B = FF THEN RETURN;
565 4 END;
566 3 IF PUTNUM THEN /* END OF LINE OR START OF FILE */
567 3 DO;
568 4 IF (B <> FF) and (b <> endfile) THEN
569 4 DO; /* NOT FORM FEED or end of file */
570 5 IF (I:=PAGCNT) <> 0 THEN /* PAGE EJECT */
571 5 DO; IF I=1 THEN I=LPP;
574 6 IF (LINENO := LINENO + 1) >= I THEN
575 6 DO; LINENO = 0; /* NEW PAGE */
577 7 CALL PUTDESTC(FF);
578 7 END;
579 6 END;
580 5 IF NUMB > 0 THEN
581 5 CALL NEWLINE;
582 5 PUTNUM = FALSE;
583 5 END;
584 4 END;
585 3 IF B = FF THEN LINENO = 0;
587 3 CALL PUTDESTC(B);
588 3 IF B = LF THEN PUTNUM = TRUE;
590 3 END PUTDEST;
591 2 UTRAN: PROCEDURE(B) BYTE;
592 3 DECLARE B BYTE;
/* TRANSLATE ALPHA TO UPPER CASE */
593 3 IF B >= 110$0001B AND B <= 111$1010B THEN /* LOWER CASE */
594 3 B = B AND 101$1111B; /* TO UPPER CASE */
595 3 RETURN B;
596 3 END UTRAN;
597 2 LTRAN: PROCEDURE(B) BYTE;
598 3 DECLARE B BYTE;
/* TRANSLATE TO LOWER CASE ALPHA */
599 3 IF B >= 'A' AND B <= 'Z' THEN
600 3 B = B OR 10$0000B; /* TO LOWER */
601 3 RETURN B;
602 3 END LTRAN;
603 2 GETSOURCEC: PROCEDURE BYTE;
/* READ NEXT SOURCE CHARACTER */
604 3 DECLARE (B,CONCHK) BYTE;
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 20
605 3 CONCHK = TRUE; /* CONSOLE STATUS CHECK BELOW */
606 3 DO CASE source.type;
/* CASE 0 IS out */
607 4 go to notsource;
/* CASE 1 IS prn */
608 4 go to notsource;
/* CASE 2 IS lst */
609 4 notsource:
call error(4); /* INVALID SOURCE */
/* CASE 3 IS axo */
610 4 go to notsource;
/* CASE 4 IS SOURCE FILE */
611 4 DO;
612 5 IF NSOURCE >= SBLEN THEN
613 5 do; if dblbuf or (not dfile) then
615 6 nsbuf = 0;
616 6 else if (nsource <> 0ffffh) then
617 6 do; call writedest;
619 7 nsbuf = ndest;
620 7 end;
CALL FILLSOURCE;
622 6 end;
623 5 B = SBUFF(NSOURCE);
624 5 NSOURCE = NSOURCE + 1;
625 5 END;
/* CASE 5 IS AUX */
626 4 goto axicase;
/* CASE 6 IS CON */
627 4 DO; CONCHK = FALSE; /* DON'T CHECK CONSOLE STATUS */
629 5 B = MON2(1,0);
630 5 END;
/* CASE 7 IS axi */
631 4 axicase:
$if not mpm
B = MON2(3,0) AND 7FH;
$else
go to notsource;
$endif
/* CASE 7 IS INP */
632 4 B = INPD;
633 4 END; /* OF CASES */
634 3 IF CONCHK THEN /* TEST FOR CONSOLE CHAR READY */
635 3 DO;
636 4 IF obj THEN /* SOURCE IS AN OBJECT FILE */
637 4 CONCHK = ((CONCNT := CONCNT + 1) = 0);
ELSE /* ASCII */
638 4 CONCHK = (B = LF);
639 4 IF CONCHK THEN
640 4 DO;
641 5 call CONBRK;
642 5 END;
643 4 END;
644 3 IF ZEROP THEN B = B AND 7FH;
646 3 IF UPPER THEN RETURN UTRAN(B);
648 3 IF LOWER THEN RETURN LTRAN(B);
650 3 RETURN B;
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 21
651 3 END GETSOURCEC;
652 2 GETSOURCE: PROCEDURE BYTE;
/* GET NEXT SOURCE CHARACTER */
653 3 DECLARE CHAR BYTE;
654 3 MATCH: PROCEDURE(B) BYTE;
/* MATCH START AND QUIT STRINGS */
655 4 DECLARE (B,C) BYTE;
656 4 IF (C:=COMBUFF(B:=(B+MATCHLEN))) = ENDFILE THEN /* END MATCH */
657 4 DO; COMBUFF(B) = CHAR; /* SAVE CURRENT CHARACTER */
659 5 RETURN TRUE;
660 5 END;
661 4 IF C = CHAR THEN MATCHLEN = MATCHLEN + 1;
ELSE
663 4 MATCHLEN = 0; /* NO MATCH */
664 4 RETURN FALSE;
665 4 END MATCH;
666 3 IF QUITLEN > 0 THEN
667 3 DO; IF (QUITLEN := QUITLEN - 1) = 1 THEN RETURN LF;
670 4 RETURN ENDFILE; /* TERMINATED WITH CR,LF,ENDFILE */
671 4 END;
672 3 DO FOREVER; /* LOOKING FOR START */
673 4 IF FEEDLEN > 0 THEN /* GET SEARCH CHARACTERS */
674 4 DO; FEEDLEN = FEEDLEN - 1;
676 5 CHAR = COMBUFF(FEEDBASE);
677 5 FEEDBASE = FEEDBASE + 1;
678 5 RETURN CHAR;
679 5 END;
680 4 IF (CHAR := GETSOURCEC) = ENDFILE THEN RETURN ENDFILE;
682 4 IF STARTS > 0 THEN /* LOOKING FOR START STRING */
683 4 DO; IF MATCH(STARTS) THEN
685 5 DO; FEEDBASE = STARTS; STARTS = 0;
688 6 FEEDLEN = MATCHLEN + 1;
689 6 matchlen = 0;
690 6 END; /* OTHERWISE NO MATCH, SKIP CHARACTER */
691 5 END;
692 4 ELSE IF QUITS > 0 THEN /* PASS CHARACTERS TIL MATCH */
693 4 DO; IF MATCH(QUITS) THEN
695 5 DO; QUITS = 0; QUITLEN = 2;
/* SUBSEQUENTLY RETURN CR, LF, ENDFILE */
698 6 RETURN CR;
699 6 END;
700 5 RETURN CHAR;
701 5 END;
ELSE
702 4 RETURN CHAR;
703 4 END; /* OF DO FOREVER */
704 3 END GETSOURCE;
705 2 RD$EOF: PROCEDURE BYTE;
/* RETURN TRUE IF END OF FILE */
706 3 CHAR = GETSOURCE;
707 3 IF obj THEN RETURN (endofsrc and (nsource > nsbuf));
709 3 RETURN (CHAR = ENDFILE);
710 3 END RD$EOF;
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 22
711 2 HEXRECORD: PROCEDURE;
712 3 DECLARE (h, hbuf, RL, CS, RT) BYTE,
zerorec byte, /* true if last record had length of zero */
LDA ADDRESS; /* LOAD ADDRESS WHICH FOLLOWS : */
713 3 ckhex: procedure byte;
714 4 IF H - '0' <= 9 THEN
715 4 RETURN H-'0';
716 4 IF H - 'A' > 5 THEN
717 4 CALL xerror(2,.source); /* invalid hex digit */
718 4 RETURN H - 'A' + 10;
719 4 end ckhex;
720 3 rdhex: procedure byte;
721 4 call putdest(h := getsource);
722 4 return ckhex;
723 4 end rdhex;
724 3 RDCS: PROCEDURE BYTE;
/* READ BYTE WITH CHECKSUM */
725 4 RETURN CS := CS + (SHL(RDHEX,4) OR RDHEX);
726 4 END RDCS;
727 3 RDADDR: PROCEDURE ADDRESS;
/* READ DOUBLE BYTE WITH CHECKSUM */
728 4 RETURN SHL(DOUBLE(RDCS),8) OR RDCS;
729 4 END RDADDR;
/* READ HEX FILE AND CHECK EACH RECORD
FOR VALID DIGITS, AND PROPER CHECKSUM */
730 3 zerorec = false;
/* READ NEXT RECORD */
731 3 h = getsource;
732 3 do forever;
/* SCAN FOR THE ':' */
733 4 DO WHILE h <> ':';
734 5 IF (h = ENDFILE) THEN
735 5 do; if zerorec then return;
738 6 CALL xerror(3,.source); /* unexpected end of hex file */
739 6 end;
740 5 call putdest(h);
741 5 h = getsource;
742 5 END;
/* ':' FOUND */
/* check for end of hex record */
743 4 h = getsource;
744 4 rl = shl(ckhex,4);
745 4 hbuf = h; h = getsource;
747 4 rl = rl or ckhex;
748 4 if (rl = 0) then zerorec = true;
750 4 else zerorec = false;
751 4 if (zerorec and ignor) then
752 4 do while (h <> ':') and (h <> endfile);
753 5 h = getsource;
754 5 end;
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 23
755 4 else do; call putdest(':');
757 5 call putdest(hbuf);
758 5 call putdest(h);
759 5 cs = rl;
760 5 LDA = RDADDR; /* LOAD ADDRESS */
/* READ WORDS UNTIL RECORD LENGTH EXHAUSTED */
761 5 RT = RDCS; /* RECORD TYPE */
762 5 DO WHILE RL <> 0; RL = RL - 1;
764 6 hbuf = RDCS;
/* INCREMENT LA HERE FOR EXACT ADDRESS */
765 6 END;
/* CHECK SUM */
766 5 IF rdcs <> 0 THEN
767 5 CALL xerror(4,.source); /* hex record checksum */
768 5 h = getsource;
769 5 end;
770 4 end; /* do forever */
771 3 END HEXRECORD;
772 2 CK$STRINGS: PROCEDURE;
773 3 IF STARTS > 0 THEN
774 3 call error(11); /* START NOT FOUND */
775 3 IF QUITS > 0 THEN
776 3 call error(12); /* QUIT NOT FOUND */
777 3 END CK$STRINGS;
778 2 CLOSEDEST: PROCEDURE;
779 3 DO WHILE (LOW(NDEST) AND 7FH) <> 0;
780 4 CALL PUTDEST(ENDFILE);
781 4 END;
782 3 CALL CK$STRINGS;
783 3 CALL WRITEDEST;
784 3 call setduser; /* destination user */
785 3 CALL CLOSE(.DEST);
786 3 IF DCNT = 255 THEN
$if mpm
787 3 call xerror(8,.dest); /* CLOSE FILE */
788 3 IF odcnt <> 255 THEN /* FILE EXISTS */
789 3 do;
$else
call xerror(8,.dest); /* CLOSE FILE */
call open(.odest);
IF DCNT <> 255 THEN /* FILE EXISTS */
DO; call close(.odest);
$endif
790 4 IF ROL(odest.fcb(9),1) THEN /* READ ONLY */
791 4 DO;
792 5 IF NOT WRROF THEN
793 5 DO;
794 6 do while ((dcnt <> 'Y') and (dcnt <> 'N'));
795 7 CALL PRINT (.('DESTINATION IS R/O, DELETE (Y/N)? $'));
796 7 dcnt = utran(rdchar);
797 7 end;
798 6 IF dcnt <> 'Y' THEN
799 6 DO; CALL PRINT(.('**NOT DELETED**$'));
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 24
801 7 CALL CRLF;
802 7 CALL DELETE(.DEST);
803 7 RETURN;
804 7 END;
805 6 CALL CRLF;
806 6 END;
807 5 END;
/* reset r/o and sys attributes */
808 4 odest.fcb(9) = odest.fcb(9) and 7fh;
809 4 odest.fcb(10) = odest.fcb(10) AND 7FH;
810 4 CALL SETIND(.odest);
811 4 CALL DELETE(.odest);
812 4 END;
813 3 CALL MOVE(.odest.fcb,.dest.fcb(16),16); /* READY FOR RENAME */
814 3 CALL RENAME(.DEST);
/* set destination attributes same as source */
815 3 odest.fcb(1) = (odest.fcb(1) and 07fh) or f1;
816 3 odest.fcb(2) = (odest.fcb(2) and 07fh) or f2;
817 3 odest.fcb(3) = (odest.fcb(3) and 07fh) or f3;
818 3 odest.fcb(4) = (odest.fcb(4) and 07fh) or f4;
819 3 odest.fcb(8) = (odest.fcb(8) and 07fh);
820 3 odest.fcb(9) = (odest.fcb(9) and 07fh) or ro;
821 3 odest.fcb(10) = (odest.fcb(10) and 07fh) or sys;
822 3 odest.fcb(11) = (odest.fcb(11) and 07fh);
823 3 call setind(.odest);
824 3 if archiv then /* set archive bit */
825 3 do; call setsuser;
827 4 source.fcb(11) = source.fcb(11) or 080h;
828 4 source.fcb(12) = 0;
829 4 call setind(.source);
830 4 end;
831 3 END CLOSEDEST;
832 2 SIZE$MEMORY: PROCEDURE;
/* SET UP SOURCE AND DESTINATION BUFFERS */
833 3 if not dblbuf then
834 3 do; /* ABSORB THE SOURCE BUFFER INTO THE DEST BUFFER */
835 4 sbase = .memory;
836 4 sblen,dblen = ((maxb - .memory) and 0ff80h) - 128;
837 4 end;
838 3 else do; /* may need to write destination buffer */
839 4 sblen,dblen = (shr((maxb - .memory),1) and 0ff80h) - 128;
840 4 sbase = .memory + dblen + 128;
841 4 if ndest >= dblen then call writedest;
843 4 nsbuf = 0;
844 4 end;
845 3 END SIZE$MEMORY;
846 2 setupeob: procedure;
/* sets nsbuf to end of source buffer */
847 3 declare i byte;
848 3 if (not obj) and (nsbuf <> 0) then
849 3 do; tblen = nsbuf - 128;
851 4 do i = 0 to 128;
852 5 if (sbuff(tblen + i)) = endfile then
853 5 do; nsbuf = tblen + i;
855 6 return;
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 25
856 6 end;
857 5 end;
858 4 end;
859 3 end setupeob;
860 2 SIMPLECOPY: PROCEDURE;
861 3 DECLARE I BYTE;
862 3 declare
fast lit '0', /* fast file to file copy */
chrt lit '1', /* character transfer option */
dubl lit '2'; /* double buffer required for file copy */
863 3 declare optype(26) byte data (
/* option type for each option character */
fast, /* for A option */
fast, /* for B option */
fast, /* for C option */
dubl, /* for D option */
chrt, /* for E option */
dubl, /* for F option */
fast, /* for G option */
chrt, /* for H option */
dubl, /* for I option */
fast, /* for J option */
fast, /* for K option */
chrt, /* for L option */
fast, /* for M option */
dubl, /* for N option */
fast, /* for O option */
dubl, /* for P option */
dubl, /* for Q option */
fast, /* for R option */
dubl, /* for S option */
dubl, /* for T option */
chrt, /* for U option */
fast, /* for V option */
fast, /* for W option */
fast, /* for X option */
fast, /* for Y option */
chrt); /* for Z option */
864 3 chkrandom: procedure;
865 4 call setsuser;
866 4 call set$random(.source);
$if mpm
867 4 call multsect(1);
$endif
868 4 call setdma(.buff);
869 4 do forever;
870 5 if (((dcnt := rd$random(.source)) = 0) or maxsize) then
871 5 do; destr = sourcer;
873 6 destr2 = sourcer2;
874 6 endofsrc = false;
875 6 return;
876 6 end;
877 5 if dcnt = 1 then
878 5 do; if (sourcer := sourcer + 1) = 0 then
880 6 sourcer2 = sourcer2 + 1;
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 26
881 6 end;
882 5 else if dcnt = 4 then
883 5 do;
884 6 if (sourcer := (sourcer + 128) and 0ff80h) = 0 then
885 6 sourcer2 = sourcer2 + 1;
886 6 end;
else
887 5 call xerror(15,.source);
888 5 end;
889 4 end chkrandom;
890 3 fastcopy = (sfile and dfile);
891 3 endofsrc = false;
892 3 dblbuf = false;
893 3 sparfil = false;
894 3 insparc = false;
/* LOOK FOR PARAMETERS */
895 3 DO I = 0 TO 25;
896 4 IF CONT(I) <> 0 THEN
897 4 DO;
898 5 IF optype(i) = chrt THEN
899 5 FASTCOPY = FALSE;
else
900 5 if optype(i) = dubl then
901 5 do; dblbuf = (sfile and dfile);
903 6 fastcopy = false;
904 6 end;
END;
906 4 END;
907 3 CALL SIZE$MEMORY;
908 3 if sfile then
909 3 CALL SETUPSOURCE;
/* FILES READY FOR COPY */
910 3 if fastcopy then
911 3 do while not endofsrc;
912 4 CALL FILLSOURCE;
913 4 if endofsrc and concat then
914 4 do; call setupeob;
916 5 ndest = nsbuf;
917 5 if nendcmd then return;
919 5 end;
920 4 ndest = nsbuf;
921 4 CALL WRITEDEST;
922 4 nsbuf = ndest;
923 4 if (endofsrc and insparc) then
924 4 call chkrandom;
925 4 end;
926 3 else do;
/* PERFORM THE ACTUAL COPY FUNCTION */
927 4 IF HEXT OR IGNOR THEN /* HEX FILE */
928 4 call hexrecord;
ELSE
929 4 DO WHILE NOT RD$EOF;
930 5 CALL PUTDEST(CHAR);
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 27
931 5 END;
932 4 if concat and nendcmd then
933 4 do; nsbuf = ndest;
935 5 return;
936 5 end;
937 4 end;
938 3 if dfile then
939 3 CALL CLOSEDEST;
940 3 END SIMPLECOPY;
941 2 MULTCOPY: PROCEDURE;
942 3 DECLARE (NEXTDIR, NDCNT, NCOPIED) ADDRESS;
943 3 PRNAME: PROCEDURE;
/* PRINT CURRENT FILE NAME */
944 4 DECLARE (I,C) BYTE;
945 4 CALL CRLF;
946 4 DO I = 1 TO FNSIZE;
947 5 IF (C := odest.fcb(I)) <> ' ' THEN
948 5 DO; IF I = FEXT THEN CALL PRINTCHAR('.');
951 6 CALL PRINTCHAR(C);
952 6 END;
953 5 END;
954 4 END PRNAME;
955 3 archck: procedure byte;
/* check if archive bit is set in any extent of source file */
956 4 if not archiv then
957 4 return 1;
958 4 call setsuser;
959 4 source.fcb(12) = what;
960 4 call search(.source);
961 4 do while dcnt <> 255;
962 5 call move(.buff+shl(dcnt and 11b,5)+1,.source.fcb(1),15);
963 5 if not rol(source.fcb(11),1) then
964 5 return 1;
965 5 call searchn;
966 5 end;
967 4 return 0;
968 4 end archck;
$if mpm
/* initialize counters if not error retry */
969 3 if eretry = 0 then NEXTDIR, NCOPIED = 0;
$else
/* initialize counters */
NEXTDIR, NCOPIED = 0;
$endif
971 3 DO FOREVER;
/* FIND A MATCHING ENTRY */
972 4 CALL SETSUSER; /* SOURCE USER */
973 4 CALL SETDMA(.BUFF);
974 4 searfcb(12) = 0;
975 4 CALL SEARCH(.SEARFCB);
976 4 NDCNT = 0;
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 28
977 4 DO WHILE (DCNT <> 255) AND NDCNT < NEXTDIR;
978 5 NDCNT = NDCNT + 1;
979 5 CALL SEARCHN;
980 5 END;
/* FILE CONTROL BLOCK IN BUFFER */
981 4 IF DCNT = 255 THEN
982 4 DO; IF NCOPIED = 0 THEN
984 5 call xerror(9,.searfcb); /* file not found */
985 5 if not kilds then
986 5 CALL CRLF;
987 5 RETURN;
988 5 END;
989 4 NEXTDIR = NDCNT + 1;
/* GET THE FILE CONTROL BLOCK NAME TO DEST */
990 4 CALL MOVE(.BUFF + SHL(DCNT AND 11B,5)+1,.odest.fcb(1),15);
991 4 CALL MOVE(.odest.fcb(1),.SOURCE.FCB(1),15); /* FILL BOTH FCB'S */
992 4 if archck then
993 4 do; odest.fcb(12) = 0;
995 5 source.fcb(12) = 0;
996 5 IF RSYS OR NOT ROL(odest.fcb(10),1) THEN /* OK TO READ */
997 5 DO; if not kilds then /* kill display option */
999 6 do; IF NCOPIED = 0 THEN
1001 7 CALL PRINT(.('COPYING -$'));
1002 7 dcnt = false;
1003 7 do while ((dcnt <> 'Y') and (dcnt <> 'N'));
1004 8 call prname;
1005 8 if confrm then
1006 8 do; call printx(.(' (Y/N)? $'));
1008 9 dcnt = utran(rdchar);
1009 9 end;
else
1010 8 dcnt = 'Y';
1011 8 end;
1012 7 end;
1013 6 ncopied = ncopied + 1;
1014 6 made = false; /* destination file not made */
1015 6 if (dcnt = 'Y') or (kilds) then
1016 6 CALL SIMPLECOPY;
1017 6 END;
1018 5 end;
1019 4 END;
1020 3 END MULTCOPY;
1021 2 CK$DISK: PROCEDURE;
/* error if same user and same disk */
1022 3 IF (odest.user = source.user) and (odest.fcb(0) = source.fcb(0)) THEN
1023 3 CALL FORMERR;
1024 3 END CK$DISK;
1025 2 GNC: PROCEDURE BYTE;
1026 3 IF (CBP := CBP + 1) >= COMLEN THEN RETURN CR;
1028 3 RETURN UTRAN(COMBUFF(CBP));
1029 3 END GNC;
1030 2 DEBLANK: PROCEDURE;
1031 3 DO WHILE (CHAR := GNC) = ' ';
1032 4 END;
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 29
1033 3 END DEBLANK;
1034 2 CK$EOL: PROCEDURE;
1035 3 CALL DEBLANK;
1036 3 IF CHAR <> CR THEN CALL FORMERR;
1038 3 END CK$EOL;
1039 2 SCAN: PROCEDURE(FCBA);
1040 3 DECLARE FCBA ADDRESS, /* ADDRESS OF FCB TO FILL */
fcbs based fcba structure ( /* FCB STRUCTURE */
fcb(frsize) byte,
$if mpm
pwnam(nsize) byte,
pwmode byte,
$endif
user byte,
type byte );
1041 3 DECLARE (I,K) BYTE; /* TEMP COUNTERS */
/* SCAN LOOKS FOR THE NEXT DELIMITER, DEVICE NAME, OR FILE NAME.
THE VALUE OF CBP MUST BE 255 UPON ENTRY THE FIRST TIME */
1042 3 DELIMITER: PROCEDURE(C) BYTE;
1043 4 DECLARE (I,C) BYTE;
1044 4 DECLARE DEL(*) BYTE DATA
(' =.:;,<>',CR,LA,LB,RB);
1045 4 DO I = 0 TO LAST(DEL);
1046 5 IF C = DEL(I) THEN RETURN TRUE;
1048 5 END;
1049 4 RETURN FALSE;
1050 4 END DELIMITER;
1051 3 PUTCHAR: PROCEDURE;
1052 4 FCBS.FCB(FLEN:=FLEN+1) = CHAR;
1053 4 IF CHAR = WHAT THEN AMBIG = TRUE; /* CONTAINS AMBIGUOUS REF */
1055 4 END PUTCHAR;
1056 3 FILLQ: PROCEDURE(LEN);
/* FILL CURRENT NAME OR TYPE WITH QUESTION MARKS */
1057 4 DECLARE LEN BYTE;
1058 4 CHAR = WHAT; /* QUESTION MARK */
1059 4 DO WHILE FLEN < LEN;
1060 5 CALL PUTCHAR;
1061 5 END;
1062 4 END FILLQ;
1063 3 SCANPAR: PROCEDURE;
1064 4 DECLARE (I,J) BYTE;
/* SCAN OPTIONAL PARAMETERS */
1065 4 CHAR = GNC; /* SCAN PAST BRACKET */
1066 4 DO WHILE NOT(CHAR = CR OR CHAR = RB);
1067 5 IF (I := CHAR - 'A') > 25 THEN /* NOT ALPHA */
1068 5 DO; IF CHAR = ' ' THEN
1070 6 CHAR = GNC;
ELSE
1071 6 call error(6); /* BAD PARAMETER */
1072 6 END;
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 30
ELSE
1073 5 DO; /* SCAN PARAMETER VALUE */
1074 6 IF CHAR = 'S' OR CHAR = 'Q' THEN
1075 6 DO; /* START OR QUIT COMMAND */
1076 7 J = CBP + 1; /* START OF STRING */
1077 7 DO WHILE NOT ((CHAR := GNC) = ENDFILE OR CHAR = CR);
1078 8 END;
1079 7 CHAR=GNC;
1080 7 END;
1081 6 ELSE IF (J := (CHAR := GNC) - '0') > 9 THEN
1082 6 J = 1;
ELSE
1083 6 DO WHILE (K := (CHAR := GNC) - '0') <= 9;
1084 7 J = J * 10 + K;
1085 7 END;
1086 6 CONT(I) = J;
1087 6 IF I = 6 THEN /* SET SOURCE USER */
1088 6 DO;
1089 7 IF J > 15 THEN
1090 7 call error(7); /* INVALID USER NUMBER */
1091 7 fcbs.user = J;
1092 7 END;
1093 6 END;
1094 5 END;
1095 4 CHAR = GNC;
1096 4 END SCANPAR;
/* scan procedure entry point */
/* INITIALIZE FILE CONTROL BLOCK TO EMPTY */
1097 3 fcbs.type = ERR; CHAR = ' '; FLEN = 0;
$if mpm
1100 3 DO WHILE FLEN < (FRSIZE + NSIZE);
1101 4 IF FLEN = FNSIZE THEN CHAR = 0;
1103 4 ELSE IF FLEN = FRSIZE THEN CHAR = ' ';
call putchar;
1106 4 END;
1107 3 fcbs.pwnam(0) = 0;
1108 3 fcbs.pwmode = 1;
$else
DO WHILE FLEN < FRSIZE -1;
IF FLEN = FNSIZE THEN CHAR = 0;
CALL PUTCHAR;
END;
$endif
1109 3 fcbs.fcb(0) = cdisk +1; /* initialize to current disk */
1110 3 fcbs.user = cuser; /* and current user */
/* CLEAR PARAMETERS */
1111 3 DO I = 0 TO 25; CONT(I) = 0;
1113 4 END;
1114 3 FEEDLEN,MATCHLEN,QUITLEN = 0;
/* DEBLANK COMMAND BUFFER */
1115 3 CALL DEBLANK;
/* CHECK PERIPHERALS AND DISK FILES */
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 31
/* SCAN NEXT NAME */
1116 3 DO FOREVER;
1117 4 FLEN = 0;
1118 4 DO WHILE NOT DELIMITER(CHAR);
1119 5 IF FLEN >= NSIZE THEN /* ERROR, FILE NAME TOO LONG */
1120 5 RETURN;
1121 5 IF CHAR = '*' THEN CALL FILLQ(NSIZE);
1123 5 ELSE CALL PUTCHAR;
1124 5 CHAR = GNC;
1125 5 END;
/* CHECK FOR DISK NAME OR DEVICE NAME */
1126 4 IF CHAR = ':' THEN
1127 4 DO; IF FLEN = 1 THEN
/* MAY BE DISK NAME A ... P */
1129 5 DO;
1130 6 IF (fcbs.fcb(0) := fcbs.fcb(1) - 'A' + 1) > 16 THEN
1131 6 RETURN; /* ERROR, INVALID DISK NAME */
1132 6 CALL DEBLANK; /* MAY BE DISK NAME ONLY */
1133 6 IF DELIMITER(CHAR) THEN
1134 6 DO; IF CHAR = LB THEN
1136 7 CALL SCANPAR;
1137 7 CBP = CBP - 1;
1138 7 fcbs.type = DISKNAME;
1139 7 RETURN;
1140 7 END;
1141 6 END;
ELSE
/* MAY BE A THREE CHARACTER DEVICE NAME */
1142 5 IF FLEN <> 3 THEN /* ERROR, CANNOT BE DEVICE NAME */
1143 5 RETURN;
ELSE
/* LOOK FOR DEVICE NAME */
1144 5 DO; DECLARE (I,J,K) BYTE, M LITERALLY '10',
IO(*) BYTE DATA
('OUTPRNLSTAXO',
0,0,0, /* fake area for file type */
'AUX',
'CONAXIINPNULEOF',0);
1146 6 J = 255;
1147 6 DO K = 0 TO M;
1148 7 I = 0;
1149 7 DO WHILE ((I:=I+1) <= 3) AND
IO(J+I) = fcbs.fcb(I);
1150 8 END;
1151 7 IF I = 4 THEN /* COMPLETE MATCH */
1152 7 DO; fcbs.type = k;
/* SCAN PARAMETERS */
1154 8 IF GNC = LB THEN CALL SCANPAR;
1156 8 CBP = CBP - 1;
1157 8 RETURN;
1158 8 END;
1159 7 J = J + 3; /* OTHERWISE TRY NEXT DEVICE */
1160 7 END;
1161 6 RETURN; /* ERROR, NO DEVICE NAME MATCH */
1162 6 END;
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 32
1163 5 IF CHAR = LB THEN /* PARAMETERS FOLLOW */
1164 5 CALL SCANPAR;
1165 5 END;
ELSE
/* CHAR IS NOT ':', SO FILE NAME IS SET. SCAN REMAINDER */
1166 4 DO; IF FLEN = 0 THEN /* ERROR, NO PRIMARY NAME */
1168 5 RETURN;
1169 5 FLEN = NSIZE;
1170 5 IF CHAR = '.' THEN /* SCAN FILE TYPE */
1171 5 DO WHILE NOT DELIMITER(CHAR := GNC);
1172 6 IF FLEN >= FNSIZE THEN
1173 6 RETURN; /* ERROR, TYPE FIELD TOO LONG */
1174 6 IF CHAR = '*' THEN CALL FILLQ(FNSIZE);
1176 6 ELSE CALL PUTCHAR;
1177 6 END;
$if mpm
1178 5 FLEN = 0;
1179 5 IF CHAR = ';' THEN /* SCAN PASSWORD */
1180 5 DO WHILE NOT DELIMITER(CHAR := GNC);
1181 6 IF FLEN >= NSIZE THEN
1182 6 /* ERROR, PW TOO LONG */ RETURN;
ELSE /* SAVE PASSWORD */
1183 6 FCBS.PWNAM(FLEN) = CHAR;
1184 6 FLEN = FLEN + 1;
1185 6 END;
$endif
1186 5 IF CHAR = LB THEN
1187 5 CALL SCANPAR;
/* RESCAN DELIMITER NEXT TIME AROUND */
1188 5 CBP = CBP - 1;
1189 5 fcbs.type = FILE;
1190 5 FCBS.FCB(32) = 0;
1191 5 RETURN;
1192 5 END;
1193 4 END;
1194 3 END SCAN;
/* PLM (PIP) ENTRY POINT */
/* BUFFER AT 80H CONTAINS REMAINDER OF LINE TYPED
FOLLOWING THE COMMAND 'PIP' - IF ZERO THEN PROMPT TIL CR */
1195 2 if not retry then
1196 2 do; CALL MOVE(.BUFF,.COMLEN,80H);
1198 3 MULTCOM = (COMLEN = 0);
/* GET CURRENT CP/M VERSION */
1199 3 IF low(CVERSION) < VERSION THEN
1200 3 DO;
$if cpm3
CALL PRINT(.('REQUIRES CP/M 3$'));
$else
1201 4 CALL PRINT(.('REQUIRES CONCURRENT CP/M-86$'));
$endif
1202 4 CALL BOOT;
1203 4 END;
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 33
1204 3 call mon1(45,255); /* set return error mode */
$if cpm3
call mon1(109,1); /* set CP/M 3 control-C status mode */
$endif
1205 3 if multcom then
1206 3 do;
$if cpm3
call printx(.('CP/M 3 PIP VERSION 3.1$'));
$else
1207 4 call printx(.('CONCURRENT CP/M-86 PIP VERSION 3.1$'));
$endif
1208 4 call crlf;
1209 4 end;
1210 3 cuser,last$user = getuser; /* GET CURRENT USER */
1211 3 cdisk = getdisk; /* GET CURRENT DISK */
$if mpm
1212 3 mseccnt = 1;
$endif
1213 3 eretry = false; /* need to initialize here for first time */
1214 3 end;
/* START HERE ON RESET EXIT FROM THE PROCEDURE 'ERROR' */
$if mpm
1215 2 if eretry <> 0 then
1216 2 do; call multcopy;
1218 3 comlen = multcom;
1219 3 end;
$endif
/* MAIN PROCESSING LOOP. PROCESS UNTIL CR ONLY */
1220 2 DO FOREVER;
1221 3 C1, C2, C3 = 0; /* LINE COUNT = 000000 */
1222 3 CONCNT,COLUMN = 0; /* PRINTER TABS */
1223 3 ndest,nsbuf = 0;
1224 3 ambig = false;
1225 3 made = false; /* destination file not made */
1226 3 opened = false; /* source file not opened */
1227 3 concat = false;
1228 3 eretry = false;
1229 3 PUTNUM = TRUE; /* ACTS LIKE LF OCCURRED ON ASCII FILE */
1230 3 dfile,sfile = true;
1231 3 nendcmd = true;
1232 3 LINENO = 254; /* INCREMENTED TO 255 > PAGCNT */
/* READ FROM CONSOLE IF NOT A ONELINER */
1233 3 IF MULTCOM THEN
1234 3 DO; CALL PRINTCHAR('*'); CALL RDCOM;
1237 4 CALL CRLF;
1238 4 END;
1239 3 CBP = 255;
1240 3 IF COMLEN = 0 THEN /* character = <CR> */
1241 3 do; call setcuser; /* restore current user */
1243 4 CALL BOOT; /* normal exit from pip here */
1244 4 end;
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 34
/* LOOK FOR SPECIAL CASES FIRST */
1245 3 CALL SCAN(.odest);
1246 3 if ambig then
1247 3 call xerror(5,.odest); /* invalid destination */
1248 3 call deblank; /* check for equal sign or left arrow */
1249 3 if (char <> '=') and (char <> la) then call formerr;
1251 3 call scan(.source);
1252 3 IF odest.type = DISKNAME THEN
1253 3 DO;
1254 4 IF source.type <> file then call formerr;
1256 4 CALL CK$EOL;
1257 4 CALL CK$DISK;
1258 4 odest.type = file; /* set for character transfer */
/* MAY BE MULTI COPY */
1259 4 IF AMBIG THEN /* FORM IS A:=B:AFN */
1260 4 DO;
1261 5 CALL MOVE(.source.fcb(0),.searfcb(0),frsize);
1262 5 CALL MULTCOPY;
1263 5 END;
1264 4 ELSE DO; /* FORM IS A:=B:UFN */
1265 5 CALL MOVE(.source.fcb(1),.odest.fcb(1),frsize - 1);
1266 5 CALL SIMPLECOPY;
1267 5 END;
1268 4 END;
1269 3 else IF (odest.type = FILE) and (source.type = DISKNAME) THEN
1270 3 DO;
1271 4 CALL CK$EOL;
1272 4 CALL CK$DISK;
1273 4 source.type = file; /* set for character transfer */
$if mpm
1274 4 call move(.odest.fcb(1),.source.fcb(1),(frsize+nsize));
$else
call move(.odest.fcb(1),.source.fcb(1),(frsize - 1));
$endif
1275 4 CALL SIMPLECOPY;
1276 4 END;
1277 3 else if (odest.type > cons) then
1278 3 call error(3); /* invalid destination */
1279 3 else do;
1280 4 IF odest.type <> FILE THEN dfile = false;
$if not mpm
/* no conditional attach list device */
$else
1282 4 if (odest.type = prnt or odest.type = lstt) then
1283 4 if conatlst = 255 then
1284 4 call error(21); /* printer busy */
$endif
/* SCAN AND COPY UNTIL CR */
1285 4 DO WHILE nendcmd;
1286 5 sfile = true;
1287 5 call deblank;
1288 5 IF (CHAR <> ',' AND CHAR <> CR) THEN
1289 5 call error(16); /* invalid separator */
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 35
1290 5 concat = concat or (nendcmd := (char = ','));
1291 5 IF odest.type = PRNT THEN
1292 5 DO; NUMB = 1;
1294 6 IF TABS = 0 THEN TABS = 8;
1296 6 IF PAGCNT = 0 THEN PAGCNT = 1;
1298 6 END;
1299 5 IF (source.type < file) or (source.type > eoft) or ambig THEN
1300 5 call error(4); /* invalid source */
1301 5 IF source.type <> FILE THEN /* NOT A SOURCE FILE */
1302 5 sfile = false;
1303 5 IF source.type = NULT THEN
/* SEND 40 NULLS TO OUTPUT DEVICE */
1304 5 DO sfile = 0 TO 39; CALL PUTDEST(0);
1306 6 END;
1307 5 ELSE IF source.type = EOFT THEN
1308 5 CALL PUTDEST(ENDFILE);
1309 5 else call simplecopy;
1310 5 CALL CK$STRINGS;
/* READ ENDFILE, GO TO NEXT SOURCE */
1311 5 if nendcmd then call scan(.source);
1313 5 END;
1314 4 end;
/* COMLEN SET TO 0 IF NOT PROCESSING MULTIPLE COMMANDS */
1315 3 COMLEN = MULTCOM;
1316 3 END; /* DO FOREVER */
1317 2 end plm;
1318 1 END;
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 36
CROSS-REFERENCE LISTING
-----------------------
DEFN ADDR SIZE NAME, ATTRIBUTES, AND REFERENCES
----- ------ ----- --------------------------------
52 0004H 2 A. . . . . . . . . WORD PARAMETER AUTOMATIC 53 54
10 0000H 2 A. . . . . . . . . WORD PARAMETER 11
68 0004H 2 A. . . . . . . . . WORD PARAMETER AUTOMATIC 69 70
184 0000H 1 A. . . . . . . . . BYTE BASED(S) 186
13 0000H 2 A. . . . . . . . . WORD PARAMETER 14
33 0004H 2 A. . . . . . . . . WORD PARAMETER AUTOMATIC 34 35 36
56 0004H 2 A. . . . . . . . . WORD PARAMETER AUTOMATIC 57 59
16 0000H 2 A. . . . . . . . . WORD PARAMETER 17
27 00BBH 1 AMBIG. . . . . . . BYTE 300 302 1054 1224 1246 1259 1299
955 15F7H 84 ARCHCK . . . . . . PROCEDURE BYTE STACK=0012H 992
31 0158H 1 ARCHIV . . . . . . BYTE AT 824 956
22 AUXT . . . . . . . LITERALLY
631 0E1CH AXICASE. . . . . . LABEL 626
22 AXIT . . . . . . . LITERALLY
500 0BC1H AXOCASE. . . . . . LABEL 507
22 AXOT . . . . . . . LITERALLY
531 0004H 1 B. . . . . . . . . BYTE PARAMETER AUTOMATIC 532 533 535
597 0004H 1 B. . . . . . . . . BYTE PARAMETER AUTOMATIC 598 599 600 601
654 0004H 1 B. . . . . . . . . BYTE PARAMETER AUTOMATIC 655 656 658
184 0000H 1 B. . . . . . . . . BYTE BASED(D) 186
559 0004H 1 B. . . . . . . . . BYTE PARAMETER AUTOMATIC 560 563 568 585 587 588
591 0004H 1 B. . . . . . . . . BYTE PARAMETER AUTOMATIC 592 593 594 595
483 0004H 1 B. . . . . . . . . BYTE PARAMETER AUTOMATIC 484 485 495 497 498 499 504 508
511 0004H 1 B. . . . . . . . . BYTE PARAMETER AUTOMATIC 512 513 514 516 528
5 0000H 1 B. . . . . . . . . BYTE PARAMETER 6
604 0181H 1 B. . . . . . . . . BYTE 623 629 632 638 645 647 649 650
38 029DH 14 BOOT . . . . . . . PROCEDURE STACK=0008H 1202 1243
3 0000H 128 BUFF . . . . . . . BYTE ARRAY(128) EXTERNAL(3) 417 424 868 962 973 990 1197
26 000AH 2 BUFSIZE. . . . . . WORD 393 397 403 404 410 440 444 452 453 480
655 0184H 1 C. . . . . . . . . BYTE 656 661
944 018EH 1 C. . . . . . . . . BYTE 947 951
1042 0004H 1 C. . . . . . . . . BYTE PARAMETER AUTOMATIC 1043 1046
32 0175H 1 C1 . . . . . . . . BYTE 546 551 1221
32 0174H 1 C2 . . . . . . . . BYTE 547 550 1221
32 0173H 1 C3 . . . . . . . . BYTE 548 549 1221
29 0155H 1 CBP. . . . . . . . BYTE 1026 1028 1076 1137 1156 1188 1239
29 00D3H 130 CBUFF. . . . . . . BYTE ARRAY(130) 29
26 0025H 1 CDISK. . . . . . . BYTE 1109 1211
27 00C7H 1 CHAR . . . . . . . BYTE 706 709 930 1031 1036 1052 1053 1058 1065 1066 1067 1069
1070 1074 1077 1079 1081 1083 1095 1098 1102 1104 1118 1121 1124 1126
1133 1135 1163 1170 1171 1174 1179 1180 1183 1186 1249 1288 1290
44 0004H 1 CHAR . . . . . . . BYTE PARAMETER AUTOMATIC 45 46
653 0183H 1 CHAR . . . . . . . BYTE 658 661 676 678 680 700 702
864 13F2H 127 CHKRANDOM. . . . . PROCEDURE STACK=0026H 924
862 CHRT . . . . . . . LITERALLY 863 898
1021 164BH 26 CKDISK . . . . . . PROCEDURE STACK=0028H 1257 1272
1034 1699H 18 CKEOL. . . . . . . PROCEDURE STACK=0028H 1256 1271
713 1096H 42 CKHEX. . . . . . . PROCEDURE BYTE STACK=0026H 722 744 747
772 1103H 31 CKSTRINGS. . . . . PROCEDURE STACK=0024H 782 1310
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 37
89 0382H 20 CLOSE. . . . . . . PROCEDURE STACK=000AH 243 249 336 473 785
778 1122H 315 CLOSEDEST. . . . . PROCEDURE STACK=0050H 939
171 0004H 1 CNT. . . . . . . . BYTE PARAMETER AUTOMATIC 172 173 174
24 CNTRLC . . . . . . LITERALLY 310
26 001FH 1 COLUMN . . . . . . BYTE 487 490 518 529 1222
29 00D5H 128 COMBUFF. . . . . . BYTE ARRAY(128) AT 656 658 676 1028
29 00D4H 1 COMLEN . . . . . . BYTE AT 252 1026 1197 1198 1218 1240 1315
179 0535H 15 CONATLST . . . . . PROCEDURE BYTE STACK=0008H 1283
308 0715H 39 CONBRK . . . . . . PROCEDURE STACK=0024H 437 641
27 00BAH 1 CONCAT . . . . . . BYTE 469 913 932 1227 1290
604 0182H 1 CONCHK . . . . . . BYTE 605 628 634 637 638 639
27 00C6H 1 CONCNT . . . . . . BYTE 637 1222
31 015AH 1 CONFRM . . . . . . BYTE AT 1005
22 CONS . . . . . . . LITERALLY 1277
31 0158H 26 CONT . . . . . . . BYTE ARRAY(26) 31 896 1086 1112
21 0058H 34 COPYRIGHT. . . . . BYTE ARRAY(34) DATA
24 CR . . . . . . . . LITERALLY 49 528 698 1027 1036 1044 1066 1077 1288
48 02CFH 17 CRLF . . . . . . . PROCEDURE STACK=000EH 58 260 298 801 805 945 986 1208
1237
712 0188H 1 CS . . . . . . . . BYTE 725 759
30 0156H 1 CUSER. . . . . . . BYTE 145 1110 1210
65 0314H 15 CVERSION . . . . . PROCEDURE WORD STACK=0008H 1199
182 0006H 2 D. . . . . . . . . WORD PARAMETER AUTOMATIC 183 184 186 188
537 0004H 1 D. . . . . . . . . BYTE PARAMETER AUTOMATIC 538 539 540
376 017DH 1 DATAOK . . . . . . BYTE 419 423 424 428
27 00B9H 1 DBLBUF . . . . . . BYTE 614 833 892 902
26 0002H 2 DBLEN. . . . . . . WORD 502 836 839 840 841
26 0000H 1024 DBUFF. . . . . . . BYTE ARRAY(1024) AT 386 406 424 434 504
28 00D2H 1 DCNT . . . . . . . BYTE 35 82 85 156 161 266 334 340 343 355 358 359
369 408 458 460 786 794 796 798 870 877 882 961 962 977
981 990 1002 1003 1008 1010 1015
1030 168AH 15 DEBLANK. . . . . . PROCEDURE STACK=000CH 1035 1115 1132 1248 1287
DEC. . . . . . . . BUILTIN 546 547 548
1044 0340H 12 DEL. . . . . . . . BYTE ARRAY(12) DATA 1045 1046
31 015BH 1 DELET. . . . . . . BYTE AT 488 490
100 03BDH 26 DELETE . . . . . . PROCEDURE STACK=0016H 250 339 802 811
1042 18E4H 46 DELIMITER. . . . . PROCEDURE BYTE STACK=0004H 1118 1133 1171 1180
26 0055H 47 DEST . . . . . . . STRUCTURE 26 249 250 330 331 339 341 342 345 346 347
387 388 390 407 409 419 429 431 433 785 787 802 813 814
26 0076H 2 DESTR. . . . . . . WORD AT 420 872
26 0078H 1 DESTR2 . . . . . . BYTE AT 421 873
27 00BCH 1 DFILE. . . . . . . BYTE 614 890 902 938 1230 1281
22 DISKNAME . . . . . LITERALLY 1138 1252 1269
105 03D7H 20 DISKRD . . . . . . PROCEDURE STACK=000AH 431 457
109 03EBH 20 DISKWRITE. . . . . PROCEDURE STACK=000AH 407
DOUBLE . . . . . . BUILTIN 463 728
862 DUBL . . . . . . . LITERALLY 863 900
31 015CH 1 ECHO . . . . . . . BYTE AT 494
20 ENDFILE. . . . . . LITERALLY 477 568 656 670 680 681 709 734 752 780 852
1077 1308
27 00C0H 1 ENDOFSRC . . . . . BYTE 476 708 874 891 911 913 923
22 EOFT . . . . . . . LITERALLY 1299 1307
191 007AH 10 ER00 . . . . . . . BYTE ARRAY(10) DATA 214
192 0084H 11 ER01 . . . . . . . BYTE ARRAY(11) DATA 214
193 008FH 7 ER02 . . . . . . . BYTE ARRAY(7) DATA 214
194 0096H 20 ER03 . . . . . . . BYTE ARRAY(20) DATA 214
195 00AAH 15 ER04 . . . . . . . BYTE ARRAY(15) DATA 214
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 38
196 00B9H 13 ER05 . . . . . . . BYTE ARRAY(13) DATA 214
197 00C6H 14 ER06 . . . . . . . BYTE ARRAY(14) DATA 214
198 00D4H 20 ER07 . . . . . . . BYTE ARRAY(20) DATA 214
199 00E8H 15 ER08 . . . . . . . BYTE ARRAY(15) DATA 214
200 00F7H 20 ER09 . . . . . . . BYTE ARRAY(20) DATA 214
201 010BH 15 ER10 . . . . . . . BYTE ARRAY(15) DATA 214
202 011AH 16 ER11 . . . . . . . BYTE ARRAY(16) DATA 214
203 012AH 15 ER12 . . . . . . . BYTE ARRAY(15) DATA 214
204 0139H 18 ER13 . . . . . . . BYTE ARRAY(18) DATA 214
205 014BH 11 ER14 . . . . . . . BYTE ARRAY(11) DATA 214
206 0156H 27 ER15 . . . . . . . BYTE ARRAY(27) DATA 214
207 0171H 18 ER16 . . . . . . . BYTE ARRAY(18) DATA 214
208 0183H 19 ER17 . . . . . . . BYTE ARRAY(19) DATA 214
209 0196H 32 ER18 . . . . . . . BYTE ARRAY(32) DATA 214
210 01B6H 10 ER19 . . . . . . . BYTE ARRAY(10) DATA 214
211 01C0H 10 ER20 . . . . . . . BYTE ARRAY(10) DATA 214
212 01CAH 13 ER21 . . . . . . . BYTE ARRAY(13) DATA 214
213 01D7H 23 ER22 . . . . . . . BYTE ARRAY(23) DATA 214
28 00D1H 1 ERETRY . . . . . . BYTE 239 300 302 969 1213 1215 1228
22 ERR. . . . . . . . LITERALLY 1097
214 0000H 46 ERRMSG . . . . . . WORD ARRAY(23) DATA 259 272
256 05B8H 26 ERROR. . . . . . . PROCEDURE STACK=0020H 306 311 500 609 774 776 1071 1090
1278 1284 1289 1300
237 0569H 79 ERRORCLEANUP . . . PROCEDURE STACK=001AH 258 268
256 0004H 1 ERRTYPE. . . . . . BYTE PARAMETER AUTOMATIC 257 259
226 029EH 1 EX00 . . . . . . . BYTE ARRAY(1) DATA 236
227 029FH 15 EX01 . . . . . . . BYTE ARRAY(15) DATA 236
228 02AEH 9 EX02 . . . . . . . BYTE ARRAY(9) DATA 236
229 02B7H 9 EX03 . . . . . . . BYTE ARRAY(9) DATA 236
230 02C0H 20 EX04 . . . . . . . BYTE ARRAY(20) DATA 236
231 02D4H 18 EX05 . . . . . . . BYTE ARRAY(18) DATA 236
232 02E6H 17 EX07 . . . . . . . BYTE ARRAY(17) DATA 236
233 02F7H 15 EX08 . . . . . . . BYTE ARRAY(15) DATA 236
234 0306H 15 EX10 . . . . . . . BYTE ARRAY(15) DATA 236
28 00CFH 1 EXTEN. . . . . . . BYTE 36 86 267 337 340 344 360 463
236 0042H 22 EXTMSG . . . . . . WORD ARRAY(11) DATA 282
26 00B6H 1 EXTSAVE. . . . . . BYTE 456 464
16 0000H 1 F. . . . . . . . . BYTE PARAMETER 17
13 0000H 1 F. . . . . . . . . BYTE PARAMETER 14
10 0000H 1 F. . . . . . . . . BYTE PARAMETER 11
28 00C9H 1 F1 . . . . . . . . BYTE 363 815
28 00CAH 1 F2 . . . . . . . . BYTE 364 816
28 00CBH 1 F3 . . . . . . . . BYTE 365 817
28 00CCH 1 F4 . . . . . . . . BYTE 366 818
24 FALSE. . . . . . . LITERALLY 244 315 319 323 474 582 628 664 730 750 874
891 892 893 894 899 903 1002 1014 1049 1213 1224 1225 1226 1227
1228 1281 1302
862 FAST . . . . . . . LITERALLY 863
27 00B8H 1 FASTCOPY . . . . . BYTE 391 401 438 450 462 469 890 899 903 910
109 0004H 2 FCB. . . . . . . . WORD PARAMETER AUTOMATIC 110 111
105 0004H 2 FCB. . . . . . . . WORD PARAMETER AUTOMATIC 106 107
100 0004H 2 FCB. . . . . . . . WORD PARAMETER AUTOMATIC 101 102 103
93 0004H 2 FCB. . . . . . . . WORD PARAMETER AUTOMATIC 94 95
89 0004H 2 FCB. . . . . . . . WORD PARAMETER AUTOMATIC 90 91
74 0000H 36 FCB. . . . . . . . BYTE ARRAY(36) MEMBER(FCBS)
3 0000H 33 FCB. . . . . . . . BYTE ARRAY(33) EXTERNAL(2) 974 975 984 1261
264 0000H 33 FCB. . . . . . . . BYTE BASED(FILEADR) ARRAY(33) 287 290
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 39
167 0004H 2 FCB. . . . . . . . WORD PARAMETER AUTOMATIC 168 169
79 0000H 36 FCB. . . . . . . . BYTE BASED(FCBA) ARRAY(36) 82
115 0000H 36 FCB. . . . . . . . BYTE ARRAY(36) MEMBER(FCBS) 117 119
124 0004H 2 FCB. . . . . . . . WORD PARAMETER AUTOMATIC 125 126 127
26 0000H 36 FCB. . . . . . . . BYTE ARRAY(36) MEMBER(ODEST) 332 790 808 809 813 815 816
817 818 819 820 821 822 947 990 991 994 996 1022 1265 1274
26 0000H 36 FCB. . . . . . . . BYTE ARRAY(36) MEMBER(DEST) 26 331 347 813
163 0004H 2 FCB. . . . . . . . WORD PARAMETER AUTOMATIC 164 165
158 0004H 2 FCB. . . . . . . . WORD PARAMETER AUTOMATIC 159 160
153 0004H 2 FCB. . . . . . . . WORD PARAMETER AUTOMATIC 154 155
1040 0000H 36 FCB. . . . . . . . BYTE ARRAY(36) MEMBER(FCBS) 1052 1109 1130 1149 1190
26 0000H 36 FCB. . . . . . . . BYTE ARRAY(36) MEMBER(SOURCE) 26 314 316 318 320 322 353
357 363 364 365 366 367 368 370 371 372 456 464 465 827
828 959 962 963 991 995 1022 1261 1265 1274
132 0004H 2 FCB. . . . . . . . WORD PARAMETER AUTOMATIC 133 134
1039 001CH 2 FCBA . . . . . . . WORD PARAMETER 1040 1052 1091 1097 1107 1108 1109 1110 1130 1138
1149 1153 1183 1189 1190
77 0004H 2 FCBA . . . . . . . WORD PARAMETER AUTOMATIC 78 79 80 81 82 84
72 0004H 2 FCBA . . . . . . . WORD PARAMETER AUTOMATIC 73 74 75
113 0004H 2 FCBA . . . . . . . WORD PARAMETER AUTOMATIC 114 115 116 117 119 120 122
74 0000H 44 FCBS . . . . . . . STRUCTURE BASED(FCBA) 75
1040 0000H 47 FCBS . . . . . . . STRUCTURE BASED(FCBA) 1052 1091 1097 1107 1108 1109 1110 1130
1138 1149 1153 1183 1189 1190
115 0000H 44 FCBS . . . . . . . STRUCTURE BASED(FCBA) 116 117 119 120
26 0021H 1 FEEDBASE . . . . . BYTE 676 677 686
26 0022H 1 FEEDLEN. . . . . . BYTE 673 675 688 1114
22 FEXT . . . . . . . LITERALLY 292 331 949
22 FEXTL. . . . . . . LITERALLY 331
22 FF . . . . . . . . LITERALLY 563 568 577 585
22 FILE . . . . . . . LITERALLY 1189 1254 1258 1269 1273 1280 1299 1301
263 0004H 2 FILEADR. . . . . . WORD PARAMETER AUTOMATIC 264 285 287 290
1056 1937H 25 FILLQ. . . . . . . PROCEDURE STACK=0008H 1122 1175
436 0A5CH 273 FILLSOURCE . . . . PROCEDURE STACK=0028H 621 912
26 00B3H 3 FILSIZE. . . . . . BYTE ARRAY(3) 314 316 318 320 322 370
27 00C8H 1 FLEN . . . . . . . BYTE 1052 1059 1099 1100 1101 1103 1117 1119 1128 1142 1167 1169
1172 1178 1181 1183 1184
176 0526H 15 FLUSHBUF . . . . . PROCEDURE STACK=0008H 414
22 FNSIZE . . . . . . LITERALLY 289 946 1101 1172 1175
24 FOREVER. . . . . . LITERALLY 672 732 869 971 1116 1220
305 070AH 11 FORMERR. . . . . . PROCEDURE STACK=0024H 1023 1037 1250 1255
31 015DH 1 FORMF. . . . . . . BYTE AT 561
22 FRSIZE . . . . . . LITERALLY 26 74 79 115 330 1040 1100 1103 1261 1265 1274
22 FSIZE. . . . . . . LITERALLY 264
263 0006H 1 FUNCNO . . . . . . BYTE PARAMETER AUTOMATIC 264 269 272 273
129 044AH 15 GETDISK. . . . . . PROCEDURE BYTE STACK=0008H 1211
652 0E95H 160 GETSOURCE. . . . . PROCEDURE BYTE STACK=0032H 706 721 731 741 743 746 753
768
603 0DA7H 238 GETSOURCEC . . . . PROCEDURE BYTE STACK=002EH 680
31 015EH 1 GETU . . . . . . . BYTE AT
136 046DH 15 GETUSER. . . . . . PROCEDURE BYTE STACK=0008H 1210
1025 1665H 37 GNC. . . . . . . . PROCEDURE BYTE STACK=0008H 1031 1065 1070 1077 1079 1081 1083
1095 1124 1154 1171 1180
712 0185H 1 H. . . . . . . . . BYTE 714 715 716 718 721 731 733 734 740 741 743 745
746 752 753 758 768
712 0186H 1 HBUF . . . . . . . BYTE 745 757 764
711 0FA5H 241 HEXRECORD. . . . . PROCEDURE STACK=0060H 928
31 015FH 1 HEXT . . . . . . . BYTE AT 927
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 40
HIGH . . . . . . . BUILTIN 36
1064 0192H 1 I. . . . . . . . . BYTE 1067 1086 1087
1043 0191H 1 I. . . . . . . . . BYTE 1045 1046
1041 018FH 1 I. . . . . . . . . BYTE 1111 1112
944 018DH 1 I. . . . . . . . . BYTE 946 947 949
847 018BH 1 I. . . . . . . . . BYTE 851 852 854
560 0180H 1 I. . . . . . . . . BYTE 570 572 573 574
512 017EH 1 I. . . . . . . . . BYTE 518 519 520 522 523 524
351 017AH 1 I. . . . . . . . . BYTE
264 0177H 1 I. . . . . . . . . BYTE 289 290 292
1145 0194H 1 I. . . . . . . . . BYTE 1148 1149 1151
861 018CH 1 I. . . . . . . . . BYTE 895 896 898 900
31 0160H 1 IGNOR. . . . . . . BYTE AT 751 927
8 0000H INPD . . . . . . . PROCEDURE BYTE EXTERNAL(5) STACK=0000H 632
22 INPT . . . . . . . LITERALLY
27 00C2H 1 INSPARC. . . . . . BYTE 383 467 894 923
1145 034CH 34 IO . . . . . . . . BYTE ARRAY(34) DATA 1149
1064 0193H 1 J. . . . . . . . . BYTE 1076 1081 1082 1084 1086 1089 1091
1145 0195H 1 J. . . . . . . . . BYTE 1146 1149 1159
376 017CH 1 J. . . . . . . . . BYTE 422 423 424 425
351 017BH 1 J. . . . . . . . . BYTE
1145 0196H 1 K. . . . . . . . . BYTE 1147 1153
1041 0190H 1 K. . . . . . . . . BYTE 1083 1084
31 0162H 1 KILDS. . . . . . . BYTE AT 985 998 1015
22 LA . . . . . . . . LITERALLY 1044 1249
LAST . . . . . . . BUILTIN 1045
30 0157H 1 LASTUSER . . . . . BYTE 141 142 1210
22 LB . . . . . . . . LITERALLY 1044 1135 1154 1163 1186
712 0014H 2 LDA. . . . . . . . WORD 760
1056 0004H 1 LEN. . . . . . . . BYTE PARAMETER AUTOMATIC 1057 1059
24 LF . . . . . . . . LITERALLY 50 588 638 669
26 0020H 1 LINENO . . . . . . BYTE 574 576 586 1232
22 LIT. . . . . . . . LITERALLY 22 23 24 25 224 235 862
LOW. . . . . . . . BUILTIN 35 404 434 453 779 1199
31 0163H 1 LOWER. . . . . . . BYTE AT 648
22 LPP. . . . . . . . LITERALLY 573
22 LSTT . . . . . . . LITERALLY 1282
597 0D8DH 26 LTRAN. . . . . . . PROCEDURE BYTE STACK=0004H 649
1145 M. . . . . . . . . LITERALLY 1147
27 00BEH 1 MADE . . . . . . . BYTE 246 348 377 1014 1225
113 03FFH 49 MAKE . . . . . . . PROCEDURE STACK=0010H 342
654 0F35H 66 MATCH. . . . . . . PROCEDURE BYTE STACK=0004H 684 694
26 0023H 1 MATCHLEN . . . . . BYTE 656 662 663 688 689 1114
3 0000H 2 MAXB . . . . . . . WORD EXTERNAL(1) 836 839
29 00D3H 1 MAXLEN . . . . . . BYTE AT 62 63
25 MAXMBUF. . . . . . LITERALLY 393 401 440 450
25 MAXMCNT. . . . . . LITERALLY 394 441
313 073CH 56 MAXSIZE. . . . . . PROCEDURE BYTE STACK=0002H 467 870
0000H MEMORY . . . . . . BYTE ARRAY(0) 26 835 836 839 840
265 0315H 17 MESSAGEINDEXTBL. . BYTE ARRAY(17) DATA 272
10 0000H MON1 . . . . . . . PROCEDURE EXTERNAL(6) STACK=0000H 39 46 54 63 70 84
142 169 174 177 495 498 499 508 1204
13 0000H MON2 . . . . . . . PROCEDURE BYTE EXTERNAL(7) STACK=0000H 42 130 137 165 180
309 310 629
16 0000H MON3 . . . . . . . PROCEDURE WORD EXTERNAL(8) STACK=0000H 66 81 91 95 98
103 107 111 122 127 134 155 160
182 0544H 37 MOVE . . . . . . . PROCEDURE STACK=0008H 330 331 370 434 813 962 990 991
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 41
1197 1261 1265 1274
26 00B7H 1 MSECCNT. . . . . . BYTE 173 174 1212
27 00C4H 1 MULTCOM. . . . . . BYTE 1198 1205 1218 1233 1315
941 1471H 330 MULTCOPY . . . . . PROCEDURE STACK=0068H 1217 1262
171 050AH 28 MULTSECT . . . . . PROCEDURE STACK=000AH 238 385 394 398 404 416 441 445
453 867
376 0012H 2 N. . . . . . . . . WORD 379 400 401 403 418
182 0004H 1 N. . . . . . . . . BYTE PARAMETER AUTOMATIC 183 185
942 001AH 2 NCOPIED. . . . . . WORD 970 983 1000 1013
942 0018H 2 NDCNT. . . . . . . WORD 976 977 978 989
26 000EH 2 NDEST. . . . . . . WORD 379 434 502 504 505 619 779 841 916 920 922 934
1223
27 00C1H 1 NENDCMD. . . . . . BYTE 917 932 1231 1285 1290 1311
542 0C98H 90 NEWLINE. . . . . . PROCEDURE STACK=0046H 581
942 0016H 2 NEXTDIR. . . . . . WORD 970 977 989
609 0DBCH NOTSOURCE. . . . . LABEL 607 608 610 631
26 0008H 2 NSBUF. . . . . . . WORD 448 449 450 452 455 463 477 480 615 619 708 843
848 850 854 916 920 922 934 1223
22 NSIZE. . . . . . . LITERALLY 26 74 115 330 1040 1100 1119 1122 1169 1181 1274
26 000CH 2 NSOURCE. . . . . . WORD 373 448 612 616 623 624 708
22 NULT . . . . . . . LITERALLY 1303
31 0165H 1 NUMB . . . . . . . BYTE AT 545 552 580 1293
235 NUMMSGS. . . . . . LITERALLY 236 279
224 NUMSPMSGS. . . . . LITERALLY 225 273
31 0166H 1 OBJ. . . . . . . . BYTE AT 636 707 848
28 00D0H 1 ODCNT. . . . . . . BYTE 334 335 788
26 0084H 47 ODEST. . . . . . . STRUCTURE 148 330 332 333 336 338 496 790 808 809 810
811 813 815 816 817 818 819 820 821 822 823 947 990 991
994 996 1022 1245 1247 1252 1258 1265 1269 1274 1277 1280 1282 1291
543 017FH 1 ONE. . . . . . . . BYTE 544 546
77 0344H 62 OPEN . . . . . . . PROCEDURE STACK=0016H 333 354
27 00BFH 1 OPENED . . . . . . BYTE 240 244 356 474 1226
863 0326H 26 OPTYPE . . . . . . BYTE ARRAY(26) DATA 898 900
5 0000H OUTD . . . . . . . PROCEDURE EXTERNAL(4) STACK=0000H 497
22 OUTT . . . . . . . LITERALLY
31 0167H 1 PAGCNT . . . . . . BYTE AT 570 1296 1297
1 0000H PIPMOD . . . . . . PROCEDURE STACK=0000H
19 0000H 648 PLM. . . . . . . . PROCEDURE PUBLIC STACK=006CH
56 02F0H 16 PRINT. . . . . . . PROCEDURE STACK=0014H 254 795 800 1001 1201
531 0C55H 40 PRINT1 . . . . . . PROCEDURE STACK=003CH 539 540
44 02BAH 21 PRINTCHAR. . . . . PROCEDURE STACK=000AH 49 50 275 281 287 288 293 294
950 951 1235
537 0C7DH 27 PRINTDIG . . . . . PROCEDURE STACK=0042H 549 550 551
52 02E0H 16 PRINTX . . . . . . PROCEDURE STACK=000AH 59 259 272 276 282 284 1007 1207
943 15BBH 60 PRNAME . . . . . . PROCEDURE STACK=0012H 1004
22 PRNT . . . . . . . LITERALLY 1282 1291
1051 1912H 37 PUTCHAR. . . . . . PROCEDURE STACK=0002H 1060 1105 1123 1176
483 0B6DH 143 PUTDCHAR . . . . . PROCEDURE STACK=0030H 514 516 525
559 0CF2H 129 PUTDEST. . . . . . PROCEDURE STACK=004CH 721 740 756 757 758 780 930 1305
1308
511 0BFCH 89 PUTDESTC . . . . . PROCEDURE STACK=0036H 534 535 554 555 557 577 587
27 00C5H 1 PUTNUM . . . . . . BYTE 566 582 589 1229
1040 002CH 1 PWMODE . . . . . . BYTE MEMBER(FCBS) 1108
26 002CH 1 PWMODE . . . . . . BYTE MEMBER(ODEST)
26 002CH 1 PWMODE . . . . . . BYTE MEMBER(DEST)
26 002CH 1 PWMODE . . . . . . BYTE MEMBER(SOURCE)
74 0024H 8 PWNAM. . . . . . . BYTE ARRAY(8) MEMBER(FCBS) 75
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 42
1040 0024H 8 PWNAM. . . . . . . BYTE ARRAY(8) MEMBER(FCBS) 1107 1183
26 0024H 8 PWNAM. . . . . . . BYTE ARRAY(8) MEMBER(ODEST)
26 0024H 8 PWNAM. . . . . . . BYTE ARRAY(8) MEMBER(DEST)
26 0024H 8 PWNAM. . . . . . . BYTE ARRAY(8) MEMBER(SOURCE)
115 0024H 8 PWNAM. . . . . . . BYTE ARRAY(8) MEMBER(FCBS) 116 120
26 0024H 1 QUITLEN. . . . . . BYTE 666 668 697 1114
31 0168H 1 QUITS. . . . . . . BYTE AT 692 694 696 775
22 RB . . . . . . . . LITERALLY 1044 1066
727 10ECH 23 RDADDR . . . . . . PROCEDURE WORD STACK=005CH 760
41 02ABH 15 RDCHAR . . . . . . PROCEDURE BYTE STACK=0008H 796 1008
61 0300H 20 RDCOM. . . . . . . PROCEDURE STACK=0008H 1236
724 10D2H 26 RDCS . . . . . . . PROCEDURE BYTE STACK=0056H 728 761 764 766
705 0F77H 46 RDEOF. . . . . . . PROCEDURE BYTE STACK=0036H 929
720 10C0H 18 RDHEX. . . . . . . PROCEDURE BYTE STACK=0050H 725
153 04BCH 23 RDRANDOM . . . . . PROCEDURE BYTE STACK=000AH 419 870
124 0430H 26 RENAME . . . . . . PROCEDURE STACK=0016H 814
2 0000H RESET. . . . . . . LABEL EXTERNAL(0) 261 303
33 0288H 21 RETCODES . . . . . PROCEDURE STACK=0004H 81 91 95 98 103 107 111 122
127 134 155 160
163 04EAH 16 RETFSIZE . . . . . PROCEDURE BYTE STACK=000AH 369
4 001EH 1 RETRY. . . . . . . BYTE INITIAL 253 1195
712 0187H 1 RL . . . . . . . . BYTE 744 747 748 759 762 763
28 00CDH 1 RO . . . . . . . . BYTE 367 820
ROL. . . . . . . . BUILTIN 82 357 790 963 996
31 0169H 1 RSYS . . . . . . . BYTE AT 357 996
712 0189H 1 RT . . . . . . . . BYTE 761
182 0008H 2 S. . . . . . . . . WORD PARAMETER AUTOMATIC 183 184 186 187
26 0006H 2 SBASE. . . . . . . WORD 26 455 477 623 835 840 852
26 0000H 2 SBLEN. . . . . . . WORD 449 450 452 612 836 839
26 0000H 1024 SBUFF. . . . . . . BYTE BASED(SBASE) ARRAY(1024) 455 477 623 852
1039 16ABH 569 SCAN . . . . . . . PROCEDURE STACK=0028H 1245 1251 1312
1063 1950H 240 SCANPAR. . . . . . PROCEDURE STACK=0024H 1136 1155 1164 1187
264 0178H 1 SDCNT. . . . . . . BYTE 266 269 273 276 299
93 0396H 20 SEARCH . . . . . . PROCEDURE STACK=000AH 960 975
97 03AAH 19 SEARCHN. . . . . . PROCEDURE STACK=0008H 965 979
23 SEARFCB. . . . . . LITERALLY 975 984 1261
144 0498H 12 SETCUSER . . . . . PROCEDURE STACK=000EH 1242
68 0323H 16 SETDMA . . . . . . PROCEDURE STACK=000AH 75 120 386 406 417 455 868 973
147 04A4H 12 SETDUSER . . . . . PROCEDURE STACK=000EH 248 329 382 784
132 0459H 20 SETIND . . . . . . PROCEDURE STACK=000AH 810 823 829
72 0333H 17 SETPW. . . . . . . PROCEDURE STACK=0010H 80 102 126
167 04FAH 16 SETRANDOM. . . . . PROCEDURE STACK=000AH 390 433 466 866
150 04B0H 12 SETSUSER . . . . . PROCEDURE STACK=000EH 242 352 447 826 865 958 972
328 0774H 160 SETUPDEST. . . . . PROCEDURE STACK=0026H 378
846 12B4H 70 SETUPEOB . . . . . PROCEDURE STACK=0002H 915
350 0814H 176 SETUPSOURCE. . . . PROCEDURE STACK=0026H 909
139 047CH 28 SETUSER. . . . . . PROCEDURE STACK=000AH 145 148 151
264 0179H 1 SEXTEN . . . . . . BYTE 267 270 271 277 279 282 301
27 00BDH 1 SFILE. . . . . . . BYTE 890 902 908 1230 1286 1302 1304
SHL. . . . . . . . BUILTIN 463 725 728 744 962 990
SHR. . . . . . . . BUILTIN 404 453 539 839
860 12FAH 248 SIMPLECOPY . . . . PROCEDURE STACK=0064H 1016 1266 1275 1309
832 125DH 87 SIZEMEMORY . . . . PROCEDURE STACK=002EH 907
26 0026H 47 SOURCE . . . . . . STRUCTURE 26 151 243 314 316 318 320 322 353 354 357
361 362 363 364 365 366 367 368 369 370 371 372 456 457
461 464 465 466 470 473 606 717 738 767 827 828 829 866
870 887 959 960 962 963 991 995 1022 1251 1254 1261 1265 1269
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 43
1273 1274 1299 1301 1303 1307 1312
26 0047H 2 SOURCER. . . . . . WORD AT 872 879 884
26 0049H 1 SOURCER2 . . . . . BYTE AT 873 880 885
27 00C3H 1 SPARFIL. . . . . . BYTE 383 893
225 002EH 20 SPECIALMSG . . . . WORD ARRAY(10) DATA 276
22 SPECL. . . . . . . LITERALLY
215 01EEH 19 SPER00 . . . . . . BYTE ARRAY(19) DATA 225
216 0201H 14 SPER01 . . . . . . BYTE ARRAY(14) DATA 225
217 020FH 27 SPER02 . . . . . . BYTE ARRAY(27) DATA 225
218 022AH 25 SPER03 . . . . . . BYTE ARRAY(25) DATA 225
219 0243H 27 SPER05 . . . . . . BYTE ARRAY(27) DATA 225
220 025EH 20 SPER06 . . . . . . BYTE ARRAY(20) DATA 225
221 0272H 14 SPER07 . . . . . . BYTE ARRAY(14) DATA 225
222 0280H 17 SPER08 . . . . . . BYTE ARRAY(17) DATA 225 236
223 0291H 13 SPER09 . . . . . . BYTE ARRAY(13) DATA 225 236
31 016AH 1 STARTS . . . . . . BYTE AT 682 684 686 687 773
28 00CEH 1 SYS. . . . . . . . BYTE 368 821
22 TAB. . . . . . . . LITERALLY 513 557
31 016BH 1 TABS . . . . . . . BYTE AT 515 519 520 522 1294 1295
26 0004H 2 TBLEN. . . . . . . WORD 850 852 854
376 0010H 2 TDEST. . . . . . . WORD 381 386 400 401 403 406 410 415 418 424 427 434
264 0176H 1 TEMP . . . . . . . BYTE 290 294
24 TRUE . . . . . . . LITERALLY 253 326 348 356 476 589 605 659 672 732 749
869 971 1047 1054 1116 1220 1229 1230 1231 1286
1040 002EH 1 TYPE . . . . . . . BYTE MEMBER(FCBS) 1097 1138 1153 1189
26 002EH 1 TYPE . . . . . . . BYTE MEMBER(ODEST) 496 1252 1258 1269 1277 1280 1282 1291
26 002EH 1 TYPE . . . . . . . BYTE MEMBER(DEST)
26 002EH 1 TYPE . . . . . . . BYTE MEMBER(SOURCE) 606 1254 1269 1273 1299 1301 1303 1307
31 016CH 1 UPPER. . . . . . . BYTE AT 646
1040 002DH 1 USER . . . . . . . BYTE MEMBER(FCBS) 1091 1110
26 002DH 1 USER . . . . . . . BYTE MEMBER(ODEST) 148 1022
26 002DH 1 USER . . . . . . . BYTE MEMBER(DEST)
26 002DH 1 USER . . . . . . . BYTE MEMBER(SOURCE) 151 1022
139 0004H 1 USER . . . . . . . BYTE PARAMETER AUTOMATIC 140 141 142
591 0D73H 26 UTRAN. . . . . . . PROCEDURE BYTE STACK=0004H 647 796 1008 1028
31 016DH 1 VERIF. . . . . . . BYTE AT 412
20 VERSION. . . . . . LITERALLY 1199
24 WHAT . . . . . . . LITERALLY 959 1053 1058
375 08C4H 408 WRITEDEST. . . . . PROCEDURE STACK=002AH 503 618 783 842 921
158 04D3H 23 WRITERANDOM. . . . PROCEDURE BYTE STACK=000AH 387
31 016EH 1 WRROF. . . . . . . BYTE AT 792
263 05D2H 312 XERROR . . . . . . PROCEDURE STACK=0022H 338 341 345 346 361 362 388 409
429 461 470 717 738 767 787 887 984 1247
31 0171H 1 ZEROP. . . . . . . BYTE AT 644
712 018AH 1 ZEROREC. . . . . . BYTE 730 736 749 750 751
32 0172H 1 ZEROSUP. . . . . . BYTE 533 545
MODULE INFORMATION:
CODE AREA SIZE = 1A40H 6720D
CONSTANT AREA SIZE = 0402H 1026D
VARIABLE AREA SIZE = 0197H 407D
MAXIMUM STACK SIZE = 006CH 108D
1964 LINES READ
PL/M-86 COMPILER PERIPHERAL INTERCHANGE PROGRAM 2/9/83 PAGE 44
0 PROGRAM ERROR(S)
END OF PL/M-86 COMPILATION
Reference in New Issue View Git Blame Copy Permalink