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 = */ 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