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) DIGITAL RESEARCH
	   NOVEMBER, 1976
	   */
	DECLARE COPYRIGHT(*) BYTE DATA (
		'   COPYRIGHT (C) 1976, DIGITAL RESEARCH. PIP VERS 1.5');
	
	DECLARE INPLOC ADDRESS DATA (183H); /* ADDRESS OF INP, DEVICE */
	DECLARE OUTLOC ADDRESS DATA (106H); /* ADDRESS OF OUT, DEVICE */
	
	OUT: PROCEDURE (B);
		DECLARE B BYTE;
		/* SEND B TO OUT, DEVICE */
		CALL OUTLOC;
		END OUT;
	
	INP: PROCEDURE BYTE;
		CALL INPLOC;
		/* PATCHED TO RETURN REG-A */
		RETURN 0;
		END INP;
	
	TIMEOUT: PROCEDURE;
		/* WAIT FOR 50 MSEC */
		CALL TIME(250); CALL TIME(250);
		END TIMEOUT;
	
	/* LITERAL DECLARATIONS */
	DECLARE
		LIT LITERALLY 'LITERALLY',
		ENDFILE LIT '1AH',
		TAB LIT '9H',
		LA LIT '5FH',
		LB LIT '5BH',				/* LEFT BRACKET */
		RB LIT '5DH',				/* RIGHT BRACKET */
		XOFF LIT '13H',				/* TRANSMIT BUFFER FUNCTION */
	
		RDR LIT '5',
		LST LIT '10',
		PUMP LIT '15',				/* POSITION OF 'PUN' + 1 */
		CONP LIT '19',				/* CONSOLE */
		NULP LIT '19',				/* NUL, BEFORE INCREMENT */
		EOFP LIT '20',				/* EOF, BEFORE INCREMENT */
		HSRDR LIT 'RDR',			/* READER DEVICES */
		PRNT  LIT '10',				/* PRINTER */
		
		FSIZE LIT '33',
		NSIZE LIT '8',
		FNSIZE LIT '11',
		MDISK LIT '1',
		FNAM LIT '8',
		FEXT LIT '9',
		FEXTL LIT '3',
		FREEL LIT '12',               /* REEL NUMBER FIELD OF FCB */
		HBUFS LIT '80',               /* 'HEX' BUFFER SIZE */
		
		ERR LIT '0',
		SPECL LIT '1',
		FILE LIT '2',
		PERIPH LIT '3',
		DISK NAME LIT '4';
	
	DECLARE
		EXIT ADDRESS INITIAL(0H),		/* REBOOT ADDRESS UPON GOMPLETION */
		COLUMN BYTE,					/* COLUMN COUNT FOR PRINTER TABS */
		AMBIG BYTE,						/* SET FOR AMBIGUOUS FILE REFS */
		PARSET BYTE,					/* TRUE IF PARAMETERS PRESENT */
		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 */
		NBUF BYTE,						/* NUM BUFFERS-l IN SBUFF AND DBUFF */
		CDISK BYTE,						/* CURRENT DISK */
		BUFFER (128) BYTE AT (8BH),		/* DEFAULT BUFFER */
		SEARFCB (FSIZE) BYTE AT (5CH),	/* SEARCH FCB IN MULTI COPY */
		MEMSIZE ADDRESS AT (6H),		/* MEMORY SIZE */
		SBLEN ADDRESS,					/* SOURCE BUFFER LENGTH */
		DBLEN ADDRESS,					/* BEST 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 */
		SDISK BYTE,						/* SOURCE DISK */
		(SCOM, DHEX) BYTE,				/* SOURCE IS 'GOM' FILE IF TRUE */
										/* DEST IS 'HEX' FILE IF TRUE */
		SOURCE (FSIZE) BYTE,			/* SOURCE FCB */
		DEST (FSIZE) BYTE,				/* DESTINATION FCB */
		DDISK BYTE,						/* DESTINATION DISK */
		HBUFF(HBUFS) BYTE,				/* HEX FILE BUFFER */
		HSOURCE BYTE,					/* NEXT HEX SOURCE CHARACTER */
		
		NSOURCE ADDRESS,				/* NEXT SOURCE CHARACTER */
		HARDEOF ADDRESS,				/* SET TO NSOURCE ON REAL EOF */
		NDEST ADDRESS;					/* NEXT DESTINATION CHARACTER */
	
	DECLARE
		PDEST BYTE,						/* DESTINATION DEVICE */
		PSOURCE BYTE;					/* CURRENT SOURCE DEVICE */
		
		DECLARE
		MULTCOM BYTE,					/* FALSE IF PROCESSING ONE LIKE */
		PUTNUM BYTE,					/* SET WHEN READY FOR NEXT LINE NJM */
		CONCNT BYTE,					/* COUNTER FOR CONSOLE READY CHECK */
		CHAR  BYTE,						/* LAST CHARACTER SCANNED */
		TYPE  BYTE,						/* TYPE OF CHARACTER SCANNED */
		FLEN  BYTE;						/* FILE NAME LENGTH */
	
	$INCLUDE (:F1:CPIO.PLB)
	MON1: PROCEDURE(F,A);
		DECLARE F BYTE,
			A ADDRESS;
		L1: GO TO L1;					/* PATCHED WITH JMP 0005 */
		END MON1;
	
	MON2: PROCEDURE(F,A) BYTE;
		DECLARE F BYTE,
			A ADDRESS;
		L2: GO TO L2;					/* PATCHED WITH JMP 0005 */
		RETURN 0;
		END MON2;
	
	READRDR: PROCEDURE BYTE;
		/* READ CURRENT READER DEVICE */
		RETURN MON2(3,0);
		END READRDR;
	
	READCHAR: PROCEDURE BYTE;
		/* READ CONSOLE CHARACTER */
		RETURN MON2(1,8);
		END READCHAR;
	
	DECLARE
		TRUE LITERALLY '1',
		FALSE LITERALLY '0',
		FOREVER LITERALLY 'WHILE TRUE',
		CR LITERALLY '13',
		LF LITERALLY '10',
		WHAT LITERALLY '63';
	
	PRINTCHAR: PROCEDURE (CHAR);
		DECLARE CHAR BYTE;
		CALL MON1(2,CHAR);
		END PRINTCHAR;
	
	CRLF: PROCEDURE;
		CALL PRINTCMAR(CR);
		CALL PRINTCHAR(LF);
		END CRLF;
	
	PRINT: PROCEDURE(A);
		DECLARE A ADDRESS;
		/* PRINT THE STRING STARTING AT ADDRESS A UNTIL THE
		   NEXT DOLLAR SIGN IS ENCOUNTERED */
		CALL CRLF;
		CALL MON1(9,A);
		END PRINT;
	
	DECLARE DCNT BYTE;
	
	INITIALIZE: PROCEDURE;
		CALL MON1(13,0);
		END INITIALIZE;
	
	SELECT: PROCEDURE(D);
		DECLARE D BYTE;
		CALL MON1(14,D);
		END SELECT;
	
	OPEN: PROCEDURE(FCB);
		DECLARE FCB ADDRESS;
		DCNT = MON2(15,FCB);
		END OPEN;
	
	CLOSE: PROCEDURE(FCB);
		DECLARE FCB ADDRESS;
		DCNT = MON2(16,FCB);
		END CLOSE;
	
	SEARCH: PROCEDURE(FCB);
		DECLARE FCB ADDRESS;
		DCNT = MON2(17,FCB);
		END SEARCH;
	
	SEARCHN: PROCEDURE;
		DCNT = MON2(18,0);
		END SEARCHN;
	
	DELETE: PROCEDURE(FCB);
		DECLARE FCB ADDRESS;
		CALL MON1(19,FCB);
		END DELETE;
	
	DISKREAD: PROCEDURE(FCB) BYTE;
		DECLARE FCB ADDRESS;
		RETURN MON2(20,FCB);
		END DISKREAD;
	
	DISKWRITE: PROCEDURE(FCB) BYTE;
		DECLARE FCB ADDRESS;
		RETURN MON2(21,FCB);
		END DISKWRITE;
	
	MAKE: PROCEDURE(FCB);
		DECLARE FCB ADDRESS;
		DCNT = MON2(22,FCB);
		END MAKE;
	
	RENAME: PROCEDURE(FCB);
		DECLARE FCB ADDRESS;
		CALL MON1(23,FCB);
		END RENAME;
	
	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 */
		DECLARE (TCBP,CBP) BYTE;			/* TEMP CBP, COMMAND BUFFER POINTER */
		
		READCOM: PROCEDURE;
		/* READ INTO COMMAND BUFFER */
		MAXLEN = 128;
		CALL MON1(10, MAXLEN);
		END READCOM;
	
	DECLARE MCBP BYTE;
	
	CONBRK: PROCEDURE BYTE;
		/* CHECK CONSOLE CHARACTER READY */
		RETURN MON2(11,0);
		END CONBRK;
	
	DECLARE IOBYTE BYTE AT (3H); /* INTEL IOBYTE */
	
	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 26 21 22 23 24 25
		   O  P  Q  R  S  T  U  V  W  X  Y  Z  */
		BLOCK  BYTE  AT(.CONT(1)),       /* BLOCK MODE TRANSFER */
		DELET  BYTE  AT(.CONT(3)),       /* DELETE CHARACTERS */
		ECHO   BYTE  AT(.CONT(4)),       /* ECHO CONSOLE CHARACTERS */
		NEXT   BYTE  AT(.CONT(7)),       /* HEX FILE TRANSFER */
		IGNOR  BYTE  AT(.CONT(8)),       /* IGNORE,00 RECORD ON FILE */
		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 */
		QUITS  BYTE  AT(.CONT(16)),      /* QUIT COPY */
		STARTS BYTE  AT(.CONT(18)),      /* START COPY */
		TABS   BYTE  AT(.CONT(19)),      /* TAB SET */
		UPPER  BYTE  AT(.CONT(20)),      /* UPPER CASE TRANSLATE */
		VERIF  BYTE  AT(.CONT(21)),      /* VERIFY EQUAL FILES ONLY */
		ZEROP  BYTE  AT(.CONT(25));      /* ZERO PARITY ON INPUT */
	
	LIFTHEAD: PROCEDURE;
		CALL MON1(12,B);
		END LIFTHEAD;
	
	SETDMA: PROCEDURE(A);
		DECLARE A ADDRESS;
		CALL MON1(26,A);
		END SETDMA;
	
	/* INTELLEC 8 INTEL/ICOM READER INPUT */
	
	INTIN: PROCEDURE BYTE;
		/* READ THE INTEL / ICOM READER */
		DECLARE PTRI LITERALLY '3',			/* DATA */
			PTRS LITERALLY '1',				/* STATUS */
			PTRC LITERALLY '1',				/* COMMAND */
			
			PTRG LITERALLY '0CH',			/* GO */
			PTPH LITERALLY '00H';			/* STOP */
		
		/* STROBE THE READER */
		OUTPUT(PTRC) = PTRG;
		OUTPUT(PTRC) = PTRH;
		DO WHILE NOT ROL(INPUT(PTRS),3);	/* NOT READY */
			END;
		/* DATA READY */
		RETURN INPUT(PTRI) AND 7FH;
		END INTIN;
	
	DECLARE ZEROSUP BYTE;					/* ZERO SUPPRESSION */
	(C3,C2,C1) BYTE;						/* LINE COUNT ON PRINTER */
	
	ERROR:  PROCEDURE(A);
		DECLARE A ADDRESS, I BYTE;
		CALL PRINT(A); CALL PRINTCHAR(','); CALL PRINTCHAR(' ');
		DO I = TCBP TO CBP;
			IF I < COMLEN THEN CALL PRINTCHAR(COMBUFF(I));
			END;
		
		/* ZERO THE COMLEN IN CASE THIS IS A SINGLE COMMAND */
		COMLEN = 0;
		/* DELETE ANY $$$ SUB FILES IN CASE BATCH PROCESSING */
		CALL DELETE(.(0,'$$$     SUB',0));
		CALL CRLF;
		GO TO RETRY;
		END ERROR;
	
	MOVE: PROCEDURE(S,D,N);
		DECLARE (S,D ) ADDRESS, N BYTE;
		DECLARE A BASED S BYTE, B BASED D BYTE;
		DO WHILE (N:=N-1) <> 255;
			B = A; S = S+1; D = D+1;
			END;
		END MOVE;
	
	FILLSOURCE: PROCEDURE;
		/* FILL THE SOURCE BUFFERS */
		DECLARE (I,J) BYTE;
		NSOURCE = 0;
		CALL SELECT(SDISK);
		DO I = 0 TO NBUF;
			/* SET DMA ADDRESS TO NEXT BUFFER POSIITION */
			CALL SETDMA(.SBUFF(NSOURCE));
			IF (J := DISKREAD(.SOURCE)) <> 0 THEN
				DO; IF J <> I THEN
					CALL ERROR(.('DISK READ ERROR$'));
				/* END - OF - FILE */
				HARDEOF = NSOURCE; /* SET HARD END-OF-FILE */
				SBUFF(NSOURCE) = ENDFILE; I = NBUF;
				END; ELSE
				NSOURCE = NSOURCE + 128;
			END ;
		NSOURCE = 0;
		END FILLSOURCE;
	
	WRITEDEST: PROCEDURE;
		/* WRITE OUTPUT BUFFERS UP TO BUT NOT INCLUDING POSITION
		   NDEST - THE LOW ORDER 7 BITS OF NDEST ARE ZERO */
		DECLARE (I, J, N) BYTE;
		DECLARE DMA ADDRESS;
		DECLARE (EXTCNT, DATAOK) BYTE;
		IF (N := LOW(SHR(NDEST,7)) - 1) = 255 THEN RETURN ;
		EXTCNT,NDEST = 0;
		CALL SELECT(DDISK);
		DO I = 0 TO N;
			/* SET DMA ADDRESS TO NEXT BUFFER */
			DMA = .DBUFF(NDEST);
			IF VERIF THEN						/* VERIFY MODE */
				DO;
				IF DEST(32) = 127 THEN			/* END OF EXTENT */
					DO; CALL MOVE(DMA,80H,80H);
					DMA = 80H; EXTCNT = EXTCNT + 1;
					END;
				END;
			CALL SETDMA(DMA);
			IF DISKWRITE(.DEST) <> 0 THEN
				CALL ERROR(.('DISK WRITE ERROR#'));
			NDEST + NDEST + 128;
			END;
		IF VERIF THEN /* VERIFY DATA WRITTEN OK */
			DO; I = N + 1; /* NUMBER OF BUFFERS */
			NDEST = 0;
			IF EXTCNT <> 0 THEN							/* WENT OVER CURRENT EXTENT */
				DO; CALL SETDMA(80H); CALL CLOSE(.DEST);
				DEST(FREEL) = DEST(FREEL) - EXTCNT;
				J = DEST(32);							/* SAVE CURRENT RECORD NUMBER */
				CALL OPEN (.DEST);
				/* ONE OR TWO EXTENTS WHERE WRITTEN */
				1 = 1 - 128;
				/* 1 MAY BE (TWO'S COMPLEMENT) NEGATIVE */
				DEST (32) = (J - I) AND 7FH;
				END; ELSE
				DEST(32) = DEST (32) - 1;				/* NEXT TO READ */
			CALL SETDMA(80H); /* FOR COMPARE */
			DO 1 - 0 TO N;
				DATAOK = DISKREAD(.DEST) = 0;
				J = 0;
				/* PERFORM COMPARISON */
				DO WHILE DATAOK AND J < 80H;
					DATAOK = BUFFER(J) = DBUFF(NDEST+J);
					J = J + 1;
					END;
				NDEST = NDEST + 128;
				IF NOT DATAOK THEN
					CALL ERROR(.('VERIFY ERROR#'));
				END;
			IF DEST(32) = 128 /* THEN INTO NEXT EXTENT */
				DO; DEST(FREEL) = DEST(FREEL) + 1;
				CALL OPEN(.DEST);
				END;
			END;
		NDEST = 0;
		END WRITEDEST;
	
	PUTDESTC: PROCEDURE(B);
		DECLARE (B,IOB) BYTE;
		/* WRITE BYTE B TO THE DESTINATION DEVICE GIVEN BY PDEST */
		IF B >= ' ' THEN
			DO; COLUMN = COLUMN + 1;
			IF DELET > 0 THEN /* MAY BE PAST RIGHT SIDE */
				DO; IF COLUMN > DELET THEN RETURN;
				END;
			END;
		IOB = IOBYTE; /* IN CASE IT IS ALTERED */
		DO CASE PDEST;
			/* CASE 0 IS THE DESTINATION FILE */
			DO;
				IF NDEST >= DBLEN THEN CALL WRITEDEST;
				DBUFF(NDEST) = B;
				HDEST = NDEST + 1;
				END;
			/* CASE 1 IS ARD (ADDMASTER) */
			GO TO NOTDEST;
			/* CASE 2 IS IRD (INTEL/IGON) */
			GO TO NOTDEST;
			/* CASE 3 IS PTR */
			GO TO NOTDEST;
			/* CASE 4 IS UR1 */
			GO TO NOTDEST;
			/* CASE 5 IS UR2 */
			GO TO NOTDEST;
			/* CASE 6 IS RDR */
			NOTDEST;
			CALL ERROR(.('NOT A CHARACTER SINK#'));
			/* CASE 7 IS OUT */
			CALL OUT(B);
			/* CASE 8 IS LPT */
			DO; IOBYTE = 1000$0000B; GO TO LSTL;
				END;
			/* CASE 9 IS UL1 */
			DO; IOBYTE = 1100$0000B; GO TO LSTL;
				END;
			/* CASE 10 IS PRN (TABS EXPANDED, LINES LISTED, CHANGED TO LST) */
			DO; IOBYTE = 1000$0000B; GO TO LSTL;
				END;
			/* CASE 11 IS LST */
			LSTL:
			CALL MON1(5,B);
			/* CASE 12 IS PTP */
			DO; IOBYTE = 0001$0000B; GO TO PUNL;
				END;
			/* CASE 13 IS UP1 */
			DO; IOBYTE = 0010$0000B; GO TO PUNL;
				END;
			/* CASE 14 IS UP2 */
			DO; IOBYTE = 0011$0000B; GO TO PUNL;
				END;
			/* CASE 15 IS PUN */
			PUNL:
			CALL MON1(4,B);
			/* CASE 16 IS TTY */
			DO; IOBYTE = 0; GO TO CONL;
				END;
			/* CASE 17 IS CRT */
			DO; IOBYTE = 1; GO TO CONL;
				END;
			/* CASE 18 IS UC1 */
			DO; IOBYTE = 11B; GO TO CONL;
				END;
			/* CASE 19 IS CON */
			CONL:
			CALL MON1(2,B);
			END;
		IOBYTE = IOB;
		END PUTDESTC;
	
	PRINT1: PROCEDURE(B);
		DECLARE B BYTE;
		IF (ZEROSUP = ZEROSUP AND B = 0) THEN CALL PUTDESTC(' '); ELSE
			CALL PUTDESTC('0'+ B);
		END PRINT1;
	
	PRINTDIG: PROCEDURE(D);
		DECLARE D BYTE;
		CALL PRINT1(SHR(D,4)); CALL PRINT1(D AND 1111B);
		END PRINTDIG;
	
	NEWLINE: PROCEDURE;
		ZEROSUP = 1;
		C1 = DEC(C1+ZEROSUP); C2 = DEC(C2 PLUS 0); C3 = DEC(C3 PLUS 0);
		CALL PRINTDIG(C3); CALL PRINTDIG(C2); CALL PRINTDIG(C1);
		CALL PUTDESTC(' ');
		PUTNUM = FALSE;
		END NEWLINE;
	
	CLEARBUFF PROCEDURE;
		/* CLEAR OUTPUT BUFFER IN BLOCK MODE TRANSM1SION */
		DECLARE HA ADDRESS;
		DECLARE I BYTE;
		I = LOW(NDEST) AHD 7FH;  /* REMAINING PARTIAL BUFFER LENGTH */
		HA = NDEST AND 0FF80H;   /* START OF SEGMENT NOT WRITTEN */
		CALL WRITEDEST;          /* CLEARS BUFFERS */
		CALL MOVE(.DBUFF(NA),.DBUFF,I);
		/* DATA MOVED TO BEGINNING OF BUFFER */
		NDEST = I;
		END CLEARBUFF;
	
	PUTDEST: PROCEDURE(B);
		DECLARE (I,B) BYTE;
		/* WRITE DESTINATION CHARACTER, CHECK TABS AND LINES */
		IF NUMB AND PUTNUM THEN CALL NEWLINE;
		IF BLOCK THEN /* BLOCK MODE TRANSFER */
			DO;
			IF B = XOFF AND PDEST = 0 THEN
				DO; CALL CLEARBUFF; /* BUFFERS WRITTEN */
				RETURN; /* DON'T PASS THE X-OFF */
				END;
			END;
		IF B = TAB THEN /* EXPAND TO NEXT TAB POSITION */
			DO; IF TABS > 0 THEN
				DO; I = COLUMN;
				IF NUMB THEN I = I - 7; /* STARTING BIAS ON LINE */
				DO WHILE I >= TABS;
					I = I - TABS;
					END;
				I = TABS - I;
				DO WHILE I > 0;
					I = I - I; CALL PUTDESTC(' ');
					END;
				END;
			ELSE CALL PUTDESTC(B);
			END; ELSE
			DO;
			CALL PUTDESTC(B);
			IF B = CR THEN COLUMN = 0; ELSE
			/* MAY NEED NEWLINE NEXT TIME AROUND */
			PUTNUM = B = LF;
			END;
		END PUTDEST;
	
	UTRAN: PROCEDURE(B) BYTE;
		DECLARE B BYTE;
		/* TRANSLATE ALPHA TO UPPER CASE */
		IF B >= 110$0001B AND B <= 111$1010B THEN /* LOWER CASE */
			B = B AND 101$1111B; /* TO UPPER CASE */
		RETURN B;
		END UTRAN;
	
	LTRAN: PROCEDURE(B) BYTE;
		DECLARE B BYTE;
		/* TRANSLATE TO LOWER CASE  ALPHA */
		IF  B >= 'A' AND B <= 'Z' THEN B = B OR 10$0000B; /* TO LOWER */
		RETURN B;
		END LTRAN;
	
	GETSOURCEC: PROCEDURE BYTE;
		/* READ NEXT SOURCE CHARACTER */
		DECLARE (IOB,B,CONCHK) BYTE;
		
		IF PSOURCE - 1 <= RDR THEN  /* 1 ... RDR+1 */
			DO; IF (BLOCK OR NEXT) AND CONBRK THEN
				DO;
				IF READCHAR = ENDFILE THEN RETURN ENDFILE;
				CALL PRINT(.('READER STOPPING',CR,LF,'$'));
				RETURN XOFF;
				END;
			END;
		CONCHK = TRUE; /* CONSOLE STATUS CHECK BELOW */
		IOB = IOBYTE; /* SAVE IT IN CASE IT IS ALTERED */
		DO CASE PSOURCE;
			/* CASE 0 IS SOURCE FILE */
			DO; IF NSOURCE >= SBLEN THEN CALL FILLSOURCE;
				B = SBUFF(NSOURCE);
				NSOURCE = NSOURCE + 1;
				END;
			/* CASE 1 IS INP */
			B = INP;
			/* CASE 2 IS IRD (INTEL/ICOM) */
			B = INTIN;
			/* CASE 3 IS PTR */
			DO; IOBYTE = 0000$0100B; GO TO RDRL;
				END;
			/* CASE 4 IS UR1 */
			DO; IOBYTE = 0000$1000B; GO TO RDRL;
				END;
			/* CASE 5 IS UR2 */
			DO; IOBYTE = 0000*1100B; GO TO RDRL;
				END ;
			/* CASE 6 IS RDR */
			RDRL:
			B = MON 2(3,0) AND 7FH;
			/* CASE 7 IS OUT */
			GO TO NOTSOURCE;
			/* CASE 8 IS LPT */
			GO TO NOTSOURCE;
			/* CASE 9 IS UL1 */
			GO TO NOTSOURCE;
			/* CASE 10 IS PRN */
			GO TO NOTSOURCE;
			/* CASE 11 IS LST */
			GO TO NOTSOURCE;
			/* CASE 12 IS PTP */
			GO TO NOTSOURCE;
			/* CASE 13 IS UP1
			   GO TO NOTSOURCE;
			   CASE 14 IS UP2 */
			GO TO NOTSOURCE;
			/* CASE 15 IS PUN */
			NOTSOURCE:
			DO; CALL ERROR(.('NOT A CHARACTER SOURCE$'));
				END;
			/* CASE 16 IS TTY */
			DO; IOBYTE = 0; GO TO CONL;
				END;
			/* CASE 17 IS CRT */
			DO; IOBYTE = 01B; GO TO CONL;
				END;
			/* CASE 18 IS UC1 */
			DO; IOBYTE = 11B; GO TO CONL;
				END;
			/* CASE 19 IS CON */
			CONL:
			DO; CONCHK = FALSE; /* DON'T CHECK CONSOLE STATUS */
				B = MON2(1,0) ;
				END ;
			END; /* OF CASES */
		IOBYTE = IOB; /* RESTORE IOBYTE */
		IF ECHO THEN /* COPY TO CONSOLE DEVICE */
			DO; IOB = PDEST; PDEST = CONP; CALL PUTDEST(B);
			PDEST = IOB;
			END;
		IF CONCHK THEN /* TEST FOR CONSOLE CHAR READY */
			DO;
			IF SCOM THEN /* SOURCE IS A COM FILE */
				CONCHK = (CONCNT:= CONCNT + 1) = 0; ELSE /* ASCII */
				CONCHK = B = LF;
			IF CONCHK THEN
				DO; IF CONBRK THEN
					DO;
					IF READCHAR = ENDFILE THEN RETURN ENDFILE;
					CALL ERROR(.('ABORTED$'));
					END;
				END;
			END;
		IF ZEROP THEN B = B AND 7FH;
		IF UPPER THEN RETURN UTRAN(B);
		IF LOWER THEN RETURN LTRAN(B);
		RETURN B;
		END GETSOURCEC;
	
	GETSOURCE: PROCEDURE BYTE;
		/* GET NEXT SOURCE CHARACTER */
		DECLARE CHAR BYTE;
		MATCH: PROCEDURE(B) BYTE;
			/* MATCH START AND QUIT STRINGS */
			DECLARE (B,C) BYTE;
			IF (C:=COMBUFF(B:=(B+MATCHLEN))) = ENDFILE THEN /* END HATCH */
				DO; COMBUFF(B) = CHAR; /* SAVE CURRENT CHARACTER */
				RETURN TRUE;
				END;
			IF C = CHAR THEN MATCHLEN = MATCHLEN + 1; ELSE
			MATCHLEN = 0; /* NO MATCH */
			RETURN FALSE;
			END MATCH;
		IF QUITLEN > 0 THEN
			DO; IF (QUITLEN := QUITLEN - 1) = 1 THEN RETURN LF;
			RETURN ENDFILE; /* TERMINATED WITH CR,LF,ENDF1LE */
			END;
		DO FOREVER; /* LOOKING FOR START */
			IF FEEDLEN > 0 THEN /* GET SEARCH CHARACTERS */
				DO; FEEDLEN = FEEDLEN - 1;
				CHAR = COMBUFF(FEEDBASE);
				FEEDBASE = FEEDBASE + 1;
				RETURN CHAR;
				END;
			IF (CHAR = GETSOURCEC) = ENDFILE THEN RETURN ENDFILE;
			IF STARTS > 0 THEN /* LOOKING FOR START STRING */
				DO; IF MATCH(STARTS) THEN
					DO; FEEDBASE = STARTS; STARTS = 0;
					FEEDLEN = MATCHLEN + 1;
					END; /* OTHERWISE NO MATCH, SKIP CHARACTER */
				END; ELSE
				IF QUITS > 0 THEN /* PASS CHARACTERS TIL MATCH */
				DO; IF MATCH(QUITS) THEN
					DO; QUITS = 0; QUITLEN = 2;
					/* SUBSEQUENTLY RETURN CR, LF, ENDFILE */
					RETURN CR;
					END;
				RETURN CHAR;
				END; ELSE
				RETURN CHAR;
			END; /* OF DO FOREVER */
		END GETSOURCE;
	
	DECLARE DISK BYTE;                /* SELECTED DISK */
	GNC: PROCEDURE BYTE;
		IF (CBP := CBP + I) >+ COMLEN THEN RETURN CR;
		RETURN UTRAN(COMBUFF(CBP));
		END GNC;
	
	DEBLANK: PROCEDURE;
		DO WHILE (CHAR := GNC) = ' ';
			END;
		END DEBLANK;
	
	SCAN: PROCEDURE (FCBA);
		DECLARE FCBA ADDRESS,				/* ADDRESS OF FCB TO FILL */
			FCB BASED FCBA (FSIZE) BYTE;	/* FCB TEMPLATE */
		DECLARE (I,J,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 */
		
		DELIMITER: PROCEDURE(C) BYTE;
			DECLARE (I,C) BYTE;
			DECLARE DEL(*) BYTE DATA
				(' =.:,<>',CR,LA,LB,RB);
			DO I = 0 TO LAST(DEL);
				IF C = DEL(I) THEN RETURN TRUE;
				END;
			RETURN FALSE;
			END DELIMITER;
		
		PUTCHAR: PROCEDURE;
			FCB(FLEN:=FLEN+1) = CHAR;
			IF CHAR = WHAT THEN AMBIG = TRUE; /* CONTAINS AMBIGUOUS REF */
			END PUTCHAR;
		
		FILLQ: PROCEDURE(LEN);
			/* FILL CURRENT NAME OR TYPE WITH QUESTION MARKS */
			DECLARE LEN BYTE;
			CHAR = WHAT; /* QUESTION MARK */
			DO WHILE FLEN < LEN;
				CALL PUTCHAR;
				END;
			END FILLQ;
		
		GETFCB: PROCEDURE(I) BYTE;
			DECLARE I BYTE;
			RETURN FCB(I);
			END GETFCB;
		
		SCANPAR: PROCEDURE;
			DECLARE (I,J) BYTE;
			/* SCAN OPTIONAL PARAMETERS */
			PARSET = TRUE;
			CHAR = GNC; /* SCAN PAST BRACKET */
			DO WHILE NOT(CHAR = CR OR CHAR = RB);
				IF (I := CHAR - 'A') > 25 THEN /* NOT ALPHA */
					DO; IF CHAR = ' ' THEN CHAR = GNC; ELSE
					CALL ERROR(.('BAD PARAMETER$'));
					END; ELSE
					DO; /* SCAN PARAMETER VALUE */
					IF CHAR = 'S' OR CHAR = 'Q' THEN
						DO; /* START OR QUIT COMMAND */
						J = CBP + 1; /* START OF STRING */
						DO WHILE NOT ((CHAR := GNC) = ENDFILE OR CHAR = CR);
							END;
						CHAR=GNC;
						END; ELSE
						IF (J := (CHAR := GNC) - 'B') > 9 THEN J = I;
					ELSE
						DO WHILE (K := (CHAR := GNC) - 'B') <= 9;
						J = J + 10 + K;
						END;
					CONT (I) = J;
					END;
				END;
			CHAR = GNC;
			END SCANPAR;
		
		CHKSET: PROCEDURE;
			IF CHAR = LA THEN CHAR = '=';
			END CHKSET;
		
		/* INITIALIZE FILE CONTROL BLOCK TO EMPTY */
		AMBIG = FALSE; TYPE = ERR; CHAR = ' '; FLEN = 0;
		DO WHILE FLEN < FSIZE-1;
			IF FLEN = FNSIZE THEN CHAR = 0;
			CALL PUTCHAR;
			END;
		
		/* DEBLANK COMMAND BUFFER */
		CALL DEBLANK;
		
		/* SAVE STARTING POSITION OF SCAN FOR DIAGNOSTICS */
		TCBP = CBP;
		
		/* MAY BE A SEPARATOR */
		IF DELIMITER(CHAR) THEN
			DO; CALL CHKSET;
		TYPE = SPECL; RETURN;
		END;
	
	/* CHECK PERIPHERALS AND DISK FILES */
	DISK = 0;
	/* CLEAR PARAMETERS */
	DO I = 0 TO 25; CONT(I) = 0;
		END;
	
	PARSET = FALSE;
	FEEDLEN,MATCHLEN,QUITLEN = 0;
	/* SCAN NEXT NAME */
	DO FOREVER;
		FLEN = 0;
		DO WHILE NOT DELIMITER(CHAR);
			IF FLEN >= NSIZE THEN /* ERROR: FILE NAME TOO LONG */
				RETURN;
			IF CHAR = '+' THEN CALL FILLQ(NSIZE); ELSE CALL PUTCHAR;
			CHAR = GNC;
			END;
		
		/* CHECK FOR DISK NAME OR DEVICE NAME */
		IF CHAR = ':' THEN
			DO; IF DISK <> 0 THEN RETURN; /* ALREADY SET */
			IF FLEN = 1 THEN
				/* MAY BE DISK NAME A ... Z */
			DO;
				IF (DISK := GETFCB(1) - 'A' + 1> >26 THEN
					/* ERROR: INVALID DISK NAME */ RETURN;
				CALL DEBLANK; /* MAY BE DISK NAME ONLY */
				IF DELIMITER(CHAR) THEN
					DO; IF CHAR = LB THEN CALL
						SCANPAR;
					CBP = CBP - 1;
					TYPE = DISKNAME;
					RETURN;
					END;
				END; ELSE
				
			/* MAY BE A THREE CHARACTER DEVICE NAME */
			IF FLEN <> 3 THEN /* ERROR: CANNOT BE DEVICE NAME */
				RETURN; ELSE
				
			/* LOOK FOR DEVICE NAME */
			DO; DECLARE (I,J,K) BYTE, M LITERALLY '20',
				IO(*) BYTE DATA
				('INPIRDPTRUR1UR2RDROUTLPTUL1PRNLST',
				'PTPUP1UP2PUNTTYGRTUC1CONNULEOF',0);
				/* NOTE THAT ALL READER-LIKE DEVICES MUST BE
				   PLACED BEFORE 'RDR', AND ALL LISTING-LIKE DEVICES
				   MUST APPEAR BELOW LST, BUT ABOVE RDR. THE LITERAL
				   DECLARATIONS FOR RDR, LST, AND  PUMP MUST INDICATE
				   THE POSITIONS OF THESE DEVICES IN THE LIST */
				J = 255;
				DO K = 0 TO M;
					I = 0;
					DO WHILE ((I:=I+1) <= 3) AND
						IO(J+I) = GETFCB(I);
						END;
					IF I = 4 THEN /* COMPLETE MATCH */
						DO; TYPE = PERIPH;
						/* SCAN PARAMETERS */
						IF GNC = LB THEN CALL SCANPAR;
						CBP = CBP - 1; CHAR = K;
						RETURN;
						END;
					/* OTHERWISE TRY NEXT DEVICE */ J = J + 3;
					END;
				
				/* ERROR: NO DEVICE NAME MATCH */ RETURN;
				END;
			IF CHAR = LB THEN /* PARAMETERS FOLLOW */
				CALL SCANPAR;
			END; ELSE
			
		/* CHAR IS NOT '.', SO FILE NAME IS SET SCAN REMAINDER */
		DO; IF FLEN = 0  THEN  /* ERROR: NO PRIMARY NAME */
				RETURN;
			FLEN = FNAM;
			IF CHAR = '.' THEN SCAN FILE TYPE  */
				DO WHILE NOT DELIMITER(CHAR := GNC);
				IF FLEN >= FNSIZE THEN
					/* ERROR: TYPE FIELD TOO LONG */ RETURN;
				IF CHAR = '*' THEN CALL FILLQ(FNSIZE);
				ELSE CALL PUTCHAR;
				END;
			IF CHAR = LB THEN
				CALL SCANPAR;
			/* RESCAN DELIMITER NEXT TIME AROUND */
			CBP = CBP - 1;
			TYPE - FILE;
			/* DISK IS THE SELECTED DISK (1 2 3 ... ) */
			IF DISK = 0 THEN DISK = CDISK + l; /* DEFAULT */
			FCB(0), FCB(32) = 0;
			RETURN;
			END;
		END;
	END SCAN;

NULLS: PROCEDURE;
	/* SEND 40 NULLS TO OUTPUT DEVICE */
	DECLARE 1 BYTE;
	DO I = 0 TO 39; CALL PUTDEST(0);
		END;
	END NULLS;

DECLARE FEXTH(FEXTL) BYTE,				/* HOLDS DESTINATION FILE TYPE */
	COPYING BYTE;						/* TRUE WHILE COPYING TO DEST FILE */
MOVEXT: PROCEDURE(A);
	DECLARE A ADDRESS;
	/* MOVE THREE CHARACTER EXTENT INTO DEST FCB */
	CALL MOVE(A,.DEST(FEXT),FEXTL);
	END MOVEXT;

EQUAL: PROCEDURE(A,B) BYTE;
	/* COMPARE THE STRINGS AT A AND B UNTIL EITHER A MISMATCH OR
	   A '$' IS ENCOUNTERED IN STRING B */
	DECLARE (A,B) ADDRESS,
		(SA BASED A, SB BASED B) BYTE;
	DO WHILE SB <> '$';
		IF SB <> SA THEN RETURN FALSE;
		A = A + 1; B = B + 1;
		END;
	RETURN TRUE;
	END EQUAL;

READ$EOF: PROCEDURE BYTE;
	/* RETURN TRUE IF END OF FILE */
	CHAR = GETSOURCE;
	IF SCOM THEN RETURN HARDEOF <= NSOURCE;
	RETURN CHAR = ENDFILE;
	END READ$EOF;

HEXRECORD: PROCEDURE BYTE;
	/* READ ONE RECORD INTO SBUFF AND CHECK FOR PROPER FORM
	   RETURNS 0 IF RECORD OK
	   RETURNS 1 IF END OF TAPE (:00800)
	   RETURNS 2 IF ERROR IN RECORD */
	
	DECLARE XOFFSET BYTE; /* TRUE IF XOFF RECVD */
	DECLARE NOERRS BYTE; /* TRUE IF NO ERRORS IN THIS RECORD */
	
	PRINTERR: PROCEDURE (A);
		/* PRINT ERROR MESSAGE IF NOERRS TRUE */
		DECLARE A ADDRESS;
		IF NOERRS THEN
			DO; NOERRS = FALSE;
			CALL PRINT(A);
			END;
		END PRINTERR;
	
	CHECKXOFF: PROCEDURE;
		IF XOFFSET THEN
			DO; XOFFSET = FALSE;
			CALL CLEARBUFF;
			END;
		END CHECKXOFF;
	
	SAVECHAR: PROCEDURE BYTE;
		/* READ CHARACTER AND SAVE IN BUFFER */
		DECLARE I BYTE;
		IF NOERRS THEN
			DO;
			DO WHILE (I := GETSOURCE) = XOFF; XOFFSET = TRUE;
				END ;
			NBUFF(NSOURCE) = I;
			IF (NSOURCE := NSOURCE + 1) >= LAST(KBUFF) THEN
				CALL PRINTERR(.('RECORD TOO LONG$'));
			RETURN I;
			END;
		RETURN ENDFILE; /* ON ERROR FLAG */
		END SAVECHAR;
	
	DECLARE (M, RL, CS, RT) BYTE;
	LDA ADDRESS; /* LOAD ADDRESS WHICH FOLLOWS : */
	
	READHEX: PROCEDURE BYTE;
		DECLARE H BYTE;
		IF (H := SAVECHAR) - '0' <= 9 THEN RETURN H-'0';
		IF H - 'A' > 5 THEN
			CALL PRINTERR(.('INVALID DIGIT$'));
		RETURN H - 'A' + 10;
		END READHEX;
	
	READBYTE PROCEDURE BYTE;
		/* READ TWO HEX DIGITS */
		RETURN SHL(READHEX,4) OR READHEX;
		END READBYTE;
	
	READCS: PROCEDURE BYTE;
		/* READ BYTE WITH CHECKSUM */
		RETURN CS := CS + READBYTE;
		END READCS;
	
	READADDR: PROCEDURE ADDRESS;
		/* READ DOUBLE BYTE WITH CHECKSUM */
		RETURN SHL(DOUBLE(READCS),8) OR READCS;
		END READADDR;
	
	NOERRS = TRUE; /* NO ERRORS DETECTED IN THIS RECORD */
	
	/* READ NEXT RECORD */
	/* SCAN FOR THE ':' */
	HSOURCE = 0;
	DO WHILE (CS := SAVECHAR) <> ':';
		HSOURCE = 0;
		IF CS = ENDFILE THEN
			DO; CALL PRINT(.('END OF FILE, CTL-Z', WHAT,'$'));
			IF READCHAR = ENDFILE THEN RETURN 1;
			ELSE HSOURCE = 0;
			END;
		CALL CHECKXOFF;
		END;
	
	/* ':' FOUND */
	CS = 0;
	IF (RL := READCS) = 0 THEN /* END OF TAPE */
		DO; DO WHILE (RL := SAVECHAR) <> ENDFILE;
		CALL CHECKXOFF;
		END;
	IF NOERRS THEN RETURN 1;
	RETURN 2;
	END;

/* RECORD LENGTH IS NOT ZERO */
LDA = READADDR; /* LOAD ADDRESS */

/* READ WORDS UNTIL RECORD LENGTH EXHAUSTED */
RT = READCS; /* RECORD TYPE */
DO WHILE RL <> 0 AND NOERRS; RL = RL - 1;
	M = READCS;
	/* INCREMENT LA HERE FOR EXACT ADDRESS */
	END;

/* CHECK SUM */
IF CS + READBYTE <> 0 THEN
	CALL PRINTERR(.('CHECKSUM ERROR$'));

CALL CHECKXOFF;
IF NOERRS THEN RETURN 0;
RETURN 2;
END HEXRECORD;

READTAPE: PROCEDURE;
	/* READ HEX FILE FROM HIGH SPEED READER TO 'HEX' FILE.
	   CHECK EACH RECORD FOR VALID DIGITS, AND PROPER CHECKSUM */
	DECLARE (I,A) BYTE;
	DO FOREVER;
		DO WHILE (I := HEXRECORD) <= 1;
			IF NOT (I = 1 AND IGNOR) THEN
				DO A = 1 TO HSOURCE;
				CALL PUTDEST(HBUFF(A-1));
				END;
			CALL PUTDEST(CR); CALL PUTDEST(LF);
			IF I = 1 THEN /* END OF TAPE ENCOUNTERED */
				RETURN;
			END;
		CALL CRLF; HBUFF(HSOURCE) = '$';
		CALL PRINT( .HBUFF);
		CALL PRINT( .('CORRECT ERROR, TYPE RETURN OR CTL-Z$'));
		CALL CRLF;
		IF READCHAR = ENDFILE THEN RETURN;
		END;
	END READTAPE;

FORMERR: PROCEDURE;
	CALL ERROR(.('INVALID FORMAT$'));
	END FORMERR;

SETUPDEST: PROCEDURE;
	CALL SELECT(DDISK);
	DHEX = AMBIG(.DEST(FEXT), ('HEX$'));
	CALL MOVE(.DEST(FEXT), .FEXTH,FEXTL); /* SAVE TYPE */
	CALL MOVEXT(.('$$$')); CALL DELETE(.DEST); /* REMOVE OLD $$$ FILE */
	CALL MAKE(.DEST); /* CREATE A NEW ONE */
	IF DCNT = 255 THEN CALL ERROR(.('NO DIRECTORY SPACE$'));
	DEST(32),NDEST = 0;
	END SETUPDEST;

SETUPSOURCE: PROCEDURE;
	HARDEOF = 0FFFFH;
	CALL SELECT(SDISK);
	CALL OPEN(.SOURCE);
	IF DCNT = 255 THEN CALL ERROR(.('NO FILE$'));
	SOURCE(32) = 0;
	/* CAUSE IMMEDIATE READ */
	SCOM = AMBIG(.SOURCE(FEXT), .('COM$')) OR
	EQUAL(.SOURCE(FEXT), .('CMI$'));
	NSOURCE = SBLEN;
	END SETUPSOURCE;

CHECK$STRINGS: PROCEDURE;
	IF STARTS > 0 THEN
		CALL ERROR(.('START NOT FOUND$'));
	IF QUITS > 0 THEN
		CALL ERROR(.('QUIT NOT FOUND$'));
	END CHECK$STRINGS;

CLOSEDEST: PROCEDURE;
	/* CLEAR BUFFER */
	DO WHILE (LOW(HDEST) AnD 7FH) <> 0;
		CALL PUTDEST(ENDFILE);
		END;
	CALL CHECK$STRINGS;
	CALL WRITEDEST;
	CALL SELECT(DDISK);
	CALL CLOSE(.DEST);
	IF DCNT = 255 THEN CALL ERROR(.('WRITE PROTECTED',WHAT,'$'));
	CALL MOVEXT(.FEXTH);				/* RECALL ORIGINAL TYPTE */
	CALL DELETE(.DEST);					/* REMOVE OLD FILE */
	CALL MOVE(.DEST,.DESK(16), 16);		/* READY FOR RENAME */
	CALL MOVEXT(.(' ***'));
	CALL RENAME(.DEST);
	END CLOSEDEST;

SIZE$NBUF: PROCEDURE;
	/* COMPUTE NUMBER OF BUFFERS - 1 FROM DBLEN */
	NBUF = (SHR(DBLEN,7) AND 0FFH) - 1;
	/* COMPUTED AS DBLEN/12B-1, WHERE DBLEN <= 32K (AND THUS
	   NBUF RESULTS IN A VALUE <= 2**15/2**7-1 = 2**8-1 = 255) */
	END SIZE$NBUF;

SET$DBLEN: PROCEDURE;
	/* ABSORB THE SOURCE BUFFER INTO THE DEST BUFFER */
	SBASE = .MEMORY;
	IF DBLEN >= 4000H THEN DBLEN = 7F80H; ELSE
	DBLEN = DBLEN + SBLEN;
	CALL SIZE$NBUF;
	END SET$DBLEN;

SIZE$MEMORY: PROCEDURE;
	/* SET UP SOURCE AND DESTINATION BUFFERS */
	SBASE = .MEMORY + SHR(MEMSIZE - .MEMORY, 1);
	SBLEN, DBLEN = SHR((MEMSIZE - .MEMORY) AND 0FF00H, 1);
	CALL SIZE$NBUF;
	END SIZE$MEMORY;

COPYCHAR: PROCEDURE;
	/* PERFORM THE ACTUAL COPY FUNCTION */
	DECLARE RESIZED BYTE; /* TRUE IF SBUFF AND DBUFF COMBINED */
	IF (RESIZED = (BLOCK AND PSOURCE <> 0)) THEN /* BLOCK NODE */
		CALL SET$DBLEN; /* ABSORB SOURCE BUFFER */
	IF NEXT OR IGNOR THEN /* HEX FILE */
		CALL READTAPE; ELSE
		DO WHILE NOT READ$EOF;
		CALL PUTDESK(CHAR);
		END;
	IF RESIZED THEN
		DO; CALL CLEARBUFF;
		CALL SIZE$MEMORY;
		END;
	END COPYCHAR;

SIMPLECOPY: PROCEDURE;
	DECLARE (FASTCOPY,I) BYTE;
	REAL$EOF: PROCEDURE BYTE;
		RETURN HARDEOF <> 0FFFFH;
		END REALEOF;
	CALL SIZE$MEMORY;
	TCBP = MCBP; /* FOR ERROR TRACING */
	CALL SETUPDEST;
	CALL SETUPSOURCE;
	/* FILES READY FOR DIRECT COPY */
	FASTCOPY = TRUE;
	/* LOOK FOR PARAMETERS */
	DO I = 0 TO 25;
		IF CONT(I) <> 0 THEN
			DO;
			IF NOT(I = 14 OR I = 21) THEN
				/* NOT OBJ OR VERIFY */
			FASTCOPY = FALSE;
			END;
		END;
	IF FASTCOPY THEN /* COPY DIRECTLY TO DBUFF */
		DO; CALL SET$DBLEN; /* EXTEND DBUFF */
		DO WHILE NOT REAL$EOF;
			CALL FILLSOURCE;
			IF REAL$EOF THEN
				NDEST = HARDEOF; ELSE NDEST = DBLEN;
			CALL WRITEDEST;
			END;
		END; ELSE
		CALL COPYCHAR;
	CALL CLOSEDEST;
	END SIMPLECOPY;

MULTCOPY: PROCEDURE;
	DECLARE (NEXTDIR, NCOPIED) BYTE;
	PRNAME: PROCEDURE;
		/* PRINT CURRENT FILE NAME */
		DECLARE (I,C) BYTE;
		CALL CRLF;
		DO I = 1 TO FNSIZE;
			IF (C := DEST(I)) <> ' ' THEN
				DO; IF I = FEXT THEN CALL PRINTCHAR('.');
				CALL PRINTCHAR(C);
				END;
			END;
		END PRNAME;
	
	NEXTDIR,NCOPIED = 0;
	DO FOREVER;
		/* FIND A MATCHING ENTRY */
		CALL SELECT(SDISK);
		CALL SETDMA(.BUFFER);
		CALL SEARCH(.SEARFCB);
		DO WHILE DCNT < NEXTDIR;
			CALL SEARCHN;
			END;
		/* FILE CONTROL BLOCK IN BUFFER */
		IF DCNT = 255 THEN
			DO; IF NCOPIED = 0 THEN
				CALL ERROR(.('NOT FOUND$')); CALL CRLF;
			RETURN;
			END;
		NEXTDIR = DCNT + 1;
		/* GET THE FILE CONTROL BLOCK NAME TO DEST */
		CALL MOVE(.BUFFER+SHL(DCNT AND 11B,5), .DEST,16);
		CALL MOVE(.DEST,.SOURCE,16); /* FILL BOTH FCB'S */
		IF (NCOPIED := NCOPIED + 1) = 1 THEN
			CALL PRINT(.('COPYING -$'));
		CALL PRNAME;
		CALL SIMPLECOPY;
		END;
	END MULTCOPY;

SET$SDISK: PROCEDURE;
	IF DISK > 0 THEN SDISK = DISK - 1; ELSE SDISK = CDISK;
	END SET$SDISK;

SET$DDISK: PROCEDURE;
	IF PARSET THEN /* PARAMETERS PRESENT */CALL FORMERR;
		IF DISK > 0 THEN DDISK = DISK - 1; ELSE DDISK = CDISK;
	END SET$DDISK;

CHECK$DISK: PROCEDURE;
	IF DDISK = SDISK THEN CALL FORMERR;
	END CHECK$DISK;

CHECK$EOL: PROCEDURE;
	CALL DEBLANK;
	IF CHAR <> CR THEN CALL FORMERR;
	END CHECK$EOL;

SCANDEST: PROCEDURE(COPYFCB);
	DECLARE COPYFCB ADDRESS;
	CALL SET$SDISK;
	CALL CHECK$EOL;
	CALL MOVE(.SOURCE,COPYFCB,33);
	CALL CHECK$DISK;
	END SCANDEST;

SCANEQL: PROCEDURE;
	CALL SCAN(.SOURCE);
	IF NOT (TYPE = SPECL AND CHAR = '=') THEN CALL FORMERR;
	MCBP = CBP; /* FOR ERROR PRINTING */
	END SCANEQL;

/* BUFFER AT 80H CONTAINS REMAINDER OF LINE TYPED
   FOLLOWING THE COWHAND 'PIP' - IF ZERO THEN PROMPT TIL CR */
CALL MOVE(80H,.COMLEN,80H);
MULTCOM = COMLEN = 0;

/* GET CURRENT DISK */
CDISK = MON2(25,0);

RETRY;
/* ENTER HERE ON ERROR EXIT FROM THE PROCEDURE 'ERROR' */
CALL SIZE$MEMORY;
/* MAIN PROCESSING LOOP. PROCESS UNTIL CR ONLY */
DO FOREVER;
	CALL LIFTHEAD;
	CONCNT,COLUMN = 0; /* PRINTER TABS */
	/* READ FROM CONSOLE IF NOT A ONELINER */
	IF MULTCOM THEN
		DO; CALL PRINTCHAR('+'); CALL READCOM;
		CALL CRLF;
		END;
	CBP = 255;
	IF COMLEN = 0 THEN /* SINGLE CARRIAGE RETURN */
		DO; CALL SELECT(CDISK);
		CALL EXIT;
		END;
	
	/* LOOK FOR SPECIAL CASES FIRST */
	DDISK,SDISK,PSOURCE,PDEST = 0;
	CALL SCAN( .DEST);
	IF TYPE = PERIPH THEN GO TO SIMPLECOM;
	IF TYPE = DISKNAME THEN
		DO; DDISK = DISK - 1;
		CALL SCANEQL;
		CALL SCAN( SOURCE);
		/* MAY BE MULTI COPY */
		IF TYPE <> FILE THEN CALL FORMERR;
		IF AMBIG THEN
			DO; CALL SCANDEST(.SEARFCB);
			CALL MULTCOPY;
			END; ELSE
			DO; CALL SCANDEST(.DEST);
			/* FORM IS A:=B: UFN */
			CALL SIMPLECOPY;
			END;
		GO TO ENDCOM;
		END;
	
	IF TYPE <> FILE OR AMBIG THEN CALL FORMERR;
	CALL SET$DDISK;
	CALL SCANEQL;
	CALL SCAN(.SOURCE);
	IF TYPE = DISKNAME THEN
		DO;
		CALL SET$SDISK; CALL CHECK$DISK;
		CALL MOVE(.DEST,.SOURCE,33);
		CALL CHECK$EOL;
		CALL SIMPLECOPY;
		GO TO ENDCOM;
		END;
	/* MAY BE POSSIBLE TO DO A FAST DISK COPY */
	IF TYPE = FILE THEN /* FILE TO FILE */
		DO; CALL DEBLANK; IF CHAR <> CR THEN GO TO SIMPLECOM;
		/* FILE TO FILE */
		CALL SET$SDISK;
		CALL SIMPLECOPY;
		GO TO ENDCOM;
		END;
	
	SIMPLECOM:
	CBP = 255; /* READY FOR RESCAN */
	/* OTHERWISE PROCESS SIMPLE REQEST */
	CALL SCAN(.DEST);
	IF (TYPE < FILE) OR AMBIG THEN /* DELIMITER OR ERROR */
		CALL ERROR(.('UNRECOGNIZED DESTINATION$'));
	
	DHEX = FALSE;
	IF TYPE = FILE THEN
		DO; /* DESTINATION IS A FILE, SAVE EXTENT NAME */
		CALL SET$DDISK;
		CALL SETUPDEST;
		CHAR = 255;
		END; ELSE
		/* PERIPHERAL NAME */
	IF CHAR >= NULP OR CHAR <= RDR THEN CALL ERROR(.('CANNOT WRITE$'));
	
	IF (PDEST .= CHAR + 1) = PUNP THEN CALL NULLS;
	
	/* NOW SCAN THE DELIMITER */
	CALL SCAN(.SOURCE);
	IF TYPE <> SPECL OR CHAR <> '=' THEN
		CALL ERROR(.('INVALID PIP FORMAT$'));
	
	/* OTHERWISE SCAN AND COPY UNTIL CR */
	C1,C2,C3 = 0; /* CLEAR LINE COUNTERS */
	COPYING = TRUE;
	DO WHILE COPYING;
		CALL SCAN(.SOURCE);
		SCOM = FALSE;
		IF TYPE = FILE AND NOT AMBIG THEN /* A SOURCE FILE */
			DO ;
			CALL SET$SDISK;
			CALL SETUPSOURCE;
			CHAR = 255;
			END; ELSE
			IF TYPE <> PERIPH OR (CHAR <= LST AND CHAR > RDR > THEN
			CALL ERROR(.('CANNOT READ$'));
		
		COLUMN = 0;
		PUTNUM = TRUE; /* CAUSES IMMEDIATE NEWLINE IF NUMB SET */
		SCOM = SCOM OR OBJ; /* MAY BE ABSOLUTE COPY */
		PSOURCE = CHAR + 1 ;
		IF CHAR = NULP THEN CALL NULLS; ELSE
		IF CHAR = EDFP THEN CALL PUTDEST(ENDFILE); ELSE
		DO; /* DISK COPY */
			IF (CHAR < HSRDR AND DHEX) THEN NEXT = 1;
			/* HEX FILE SET IF SOURCE IS RDR AND DEST IS HEX FILE */
			IF PDEST = PRNT THEN
				DO; TABS = 0; NUMB = 1;
				END;
			CALL COPYCHAR;
			END;
		
		CALL CHECK$STRINGS;
		/* READ ENDFILE, GO TO NEXT SOURCE */
		CALL SCAN(.SOURCE);
		IF TYPE <> SPECL OR (CHAR <> ',' AND CHAR <> CR) THEN
			CALL ERROR(.('INVALID SEPARATOR$'));
		COPYING = CHAR <> CR;
		END;
	
	/* IF NECESSARY, CLOSE FILE OR PUNCH TRAILER */
	IF PDEST = PUNP THEN
		DO; CALL PUTDEST(ENDFILE); CALL NULLS;
		END;
	IF PDEST = 0 THEN /* FILE HAS TO BE CLOSED AND RENAMED */
		CALL CLOSEDEST;
	
	/* COMLEN SET TO 0 IF NOT PROCESSING MULTIPLE COMMANDS */
	ENDCOM:
	COMLEN = MULTCOM;
	
	END; /* DO FOREVER */
END;
