BLKCLI: DO;

$INCLUDE (:F1:COMMON.LIT)

$INCLUDE (:F1:ISS.COM)


/* DEFINITIONS OF BLOCK TYPE CHARACTERS */

DECL TYP$NAME  LIT '021H';
DECL TYP$DRECD LIT '023H';
DECL TYP$END   LIT '024H';
DECL TYP$ABORT LIT '025H';
DECL TYP$EXIT  LIT '026H';
DECL TYP$REV   LIT '027H';
DECL RECD$TYP  LIT 'BUFFER(0)';


DECL BLK$LNGTH LIT '0255';
DECL SIO$STAT  LIT '0F7H';
DECL SIO$DATA  LIT '0F6H';
DECL SIO$RXRDY LIT '02H';



/* RESPONSE CODES */

DECL ACK    LIT '01H';
DECL NACK   LIT '02H';
DECL ABO    LIT '03H';
DECL TM$OUT LIT '0FEH';
DECL CS$ERR LIT '0FFH';


/* TABLE OF RECOGNIZED COMMANDS AND CORRESPONDING MODES */

DECL COM$TABLE(*) BYTE DATA('SEND   ',01H,'RECEIVE',02H,
                            'CLEAR  ',03H,'EXIT   ',00H,
                            'DIRECT ',04H,'BAUD   ',05H,
                            'TERMIN ',06H,'QUIT   ',07H,
                            'S      ',01H,'R      ',02H,
                            'C      ',03H,'E      ',00H,
                            'D      ',04H,'B      ',05H,
                            'T      ',06H,'Q      ',07H);
DECL MAX$COM LIT '16';
DECL MAX$MODE LIT '8';
DECL LEN$COMMAND$ENTRY LIT '8';



CO: PROCEDURE (CHAR) EXTERNAL;
 DECL CHAR BYTE;
END CO;



BAUD: PROCEDURE (BPOINTER) BYTE EXTERNAL;
 DECL BPOINTER ADDRESS;
END BAUD;



BLK$XMT: PROCEDURE (BUFFER$ADDR,LNGTH,TYPE) BYTE EXTERNAL;
 DECL BUFFER$ADDR ADDRESS;
 DECL LNGTH BYTE;
 DECL TYPE BYTE;
END BLK$XMT;



BLOCK$INP: PROCEDURE(BUFFER$ADDRESS) BYTE EXTERNAL;
 DECL BUFFER$ADDRESS ADDRESS;
END BLOCK$INP;



ENQ: PROCEDURE BYTE EXTERNAL;
END ENQ;



REC$DATA: PROCEDURE BYTE EXTERNAL;
END REC$DATA;



REC$RDY: PROCEDURE BYTE EXTERNAL;
END REC$RDY;



SCHAR: PROCEDURE (CHAR) EXTERNAL;
 DECL CHAR BYTE;
END SCHAR;



DIRECT: PROCEDURE EXTERNAL;
END DIRECT;



DECL MSG1(*) BYTE DATA ('CAN NOT OPEN CONSOLE FOR INPUT');
DECL MSG2(*) BYTE DATA ('CAN NOT READ FROM CONSOLE');
DECL MSG3(*) BYTE DATA ('SYNTAX ERROR');
DECL MSG4(*) BYTE DATA ('ERROR RESPONSE RECD ON ATTEMPT TO TERMINATE LINK');
DECL MSG5(*) BYTE DATA ('NO RESPONSE ON ATTEMPT TO TERMINATE LINK');
DECL MSG6(*) BYTE DATA ('NEGATIVE RESPONSE ON NAME RECRD');
DECL MSG7(*) BYTE DATA ('NO RESPONSE ON NAME RECRD');
DECL MSG8(*) BYTE DATA ('NEGATIVE RESPONSE ON DATA RECRD');
DECL MSG9(*) BYTE DATA ('NO RESPONSE ON DATA RECRD');
DECL MSG10(*) BYTE DATA ('NEGATIVE RESPONSE ON EOF RECRD',CR,LF);
DECL MSG11(*) BYTE DATA ('NO RESPONSE ON EOF RECRD',CR,LF);
DECL MSG12(*) BYTE DATA ('NEG RESP ON ATTEMPT TO REVERSE LINE',CR,LF);
DECL MSG13(*) BYTE DATA ('NO RESP ON ATTEMPT TO REVERSE LINE',CR,LF);
DECL MSG14(*) BYTE DATA ('LINK ABORTED FROM PDP11',CR,LF);
DECL MSG15(*) BYTE DATA ('TIME$OUT IN RECV MODE',CR,LF);
DECL MSG16(*) BYTE DATA ('NON RECOVERABLE CHECK SUM ERROR',CR,LF);
DECL MSG17(*) BYTE DATA ('UNEXPECTED RECORD TYPE IN RECEIVE MODE',CR,LF);
DECL MSG18(*) BYTE DATA ('MDS FILENAME TOO LONG',CR,LF);
DECL MSG19(*) BYTE DATA ('NEG RESP ON ATTEMPT TO ABORT',CR,LF);
DECL MSG20(*) BYTE DATA ('TIME OUT ON ATTEMPT TO ABORT',CR,LF);
DECL MSG21(*) BYTE DATA ('PDP FILENAME TOO LONG',CR,LF);
DECL MSG22(*) BYTE DATA ('UNRECOGNIZABLE RESP',CR,LF);
DECL MSG23(*) BYTE DATA ('LINK TERMINATED',CR,LF);
DECL MSG24(*) BYTE DATA ('ABORT ACCEPTED BY PDP11',CR,LF);
DECL MSG25(*) BYTE DATA ('NOT A STANDARD BAUD RATE',CR,LF);
DECL MSG26(*) BYTE DATA ('LINK NOT ON LINE',CR,LF);


DECL ACTL ADDRESS;
DECL ACTUAL ADDRESS;
DECL AFT ADDRESS;
DECL AFT$IN ADDRESS;
DECL BUFFER(256) BYTE;
DECL COM$STAT BYTE;
DECL CONSL$INP(*) BYTE DATA (':CI:');
DECL DUMMY BYTE;
DECL INDX BYTE;
DECL KEY$BUFFER (122) BYTE;
DECL LNG$MDS BYTE;
DECL LNG$PDP BYTE;
DECL MDS$FILENAME(18) BYTE;
DECL MODE BYTE;
DECL PDP$FILENAME(18) BYTE;
DECL PRMTMSG(*) BYTE DATA (CR,LF,'@');
DECL RECD$LNGTH BYTE;
DECL SGN$ON(*) BYTE DATA('BLXMT V X.3',0DH,0AH);
DECL STATUS ADDRESS;









/* INDEX VARIABLES FOR COMMAND SEARCH ROUTINES */

DECL I BYTE; /* ENTRY IN SYMBOL TABLE BEING SCANNED FOR MATCH */
DECL J BYTE; /* CURRENT LETTER OF ENTRY BEING CHECKED */
DECL K BYTE; /* INDEX FOR COPY ROUTINES */


COPY$MDSNAME: PROCEDURE;
	K = 0;
		DO WHILE ((KEYBUFFER(J) <> SPACE)
		 AND (KEYBUFFER(J) <> CR)
		 AND (K < LENGTH(MDS$FILENAME)));
		 MDS$FILENAME(K) = KEY$BUFFER(J);
		 J = J + 1;
		 K = K + 1;
		END;
	LNG$MDS = K;
	MDS$FILENAME(K) = SPACE;
	IF K > 14 THEN
		DO;
		 MODE = MAX$MODE+1;
		 CALL WRITE(CO$AFT,.MSG18,LENGTH(MSG18),.STATUS);
		END;

END COPY$MDSNAME;



COPY$PDPNAME: PROCEDURE;
	K = 0;
		DO WHILE ((KEYBUFFER(J) <> SPACE)
		 AND (KEYBUFFER(J) <> CR)
		 AND(K < LENGTH(PDP$FILENAME)));
		 PDP$FILENAME(K) = KEY$BUFFER(J);
		 J = J + 1;
		 K = K + 1;
		END;
	LNG$PDP = K;
	PDP$FILENAME(K) = SPACE;
	IF K > 20 THEN
		DO;
		 MODE = MAX$MODE+1;
		 CALL WRITE(CO$AFT,.MSG21,LENGTH(MSG21),.STATUS);
		END;

END COPY$PDPNAME;



DEBLANK: PROCEDURE;
		DO WHILE KEYBUFFER(J) <> SPACE;
		 J = J + 1;
		END;
		DO WHILE KEYBUFFER(J) = SPACE;
		 J = J + 1;
		END;

END DEBLANK;



COMDEC: PROCEDURE;


	I,J,K = 0;
	MODE = MAX$MODE+2;

		DO WHILE MODE = MAX$MODE+2;
			DO WHILE ((J < 3) AND (MODE = MAX$MODE+2));
			 IF KEYBUFFER(J) = COM$TABLE(I + J) THEN
				DO;
				 J = J + 1;
				 IF ((J = 3) OR (KEYBUFFER(J) = SPACE)
				  OR (KEYBUFFER(J) = CR))
				  THEN MODE = COM$TABLE(I + 7);
				END;
			 ELSE
				DO;
				 J = 0;
				 I = I + LEN$COMMAND$ENTRY;
				 IF (I = (MAX$COM * LEN$COMMAND$ENTRY))
				  THEN MODE = MAX$MODE;
				END;
			END;
		END;
	LNG$MDS,LNG$PDP = 0;
	IF ((MODE <> 2) AND (MODE <> 1)) THEN RETURN;
	IF MODE = 1 THEN
		DO;
		 CALL DEBLANK;
		 CALL COPY$MDSNAME;
		 IF MODE = MAX$MODE+1 THEN RETURN;
		 CALL DEBLANK;
		 CALL COPY$PDPNAME;
		END;
	ELSE
		DO;
		 CALL DEBLANK;
		 CALL COPY$PDPNAME;
		 IF MODE = MAX$MODE+1 THEN RETURN;
		 CALL DEBLANK;
		 CALL COPY$MDSNAME;
		END;
END COMDEC;


SEND$ROUTINE: PROCEDURE;

	CALL OPEN(.AFT,.MDS$FILENAME,READ$AC,0,.STATUS);
	IF STATUS > 0 THEN
		DO;
		 CALL ERROR(STATUS);
		 RETURN;
		END;
	IF REC$RDY > 0 THEN DUMMY = REC$DATA;
	IF ENQ = TRUE THEN
		DO;
		 IF REC$RDY > 0 THEN DUMMY = REC$DATA;
		 COM$STAT = BLK$XMT(.PDP$FILENAME,LNG$PDP,TYP$NAME);
		 IF ((COM$STAT = NACK) OR (COM$STAT = ABO)) THEN
			DO;
			 CALL WRITE(CO$AFT,.MSG6,LENGTH(MSG6),.STATUS);
			 GOTO ERRTN;
			END;
		 IF (COM$STAT = TM$OUT) THEN
			DO;
			 CALL WRITE(CO$AFT,.MSG7,LENGTH(MSG7),.STATUS);
			 GOTO ERRTN;
			END;
		IF COM$STAT <> ACK THEN
			DO;
			 CALL WRITE(CO$AFT,.MSG22,LENGTH(MSG22),.STATUS);
			 GOTO ERRTN;
			END;
		END;
	ELSE
		DO;
		 CALL WRITE(CO$AFT,.MSG26,LENGTH(MSG26),.STATUS);
		 GOTO ERRTN;
		END;
	ACTUAL = 1;
		DO WHILE ACTUAL > 0;
		 CALL READ (AFT,.BUFFER,BLK$LNGTH-3,.ACTUAL,.STATUS);
		 IF STATUS > 0 THEN
			DO;
			 CALL ERROR(STATUS);
			 ACTUAL = 0;
			END;
		 IF ACTUAL > 0 THEN
			DO;
			 COM$STAT = BLK$XMT(.BUFFER,ACTUAL,TYP$DRECD);
			 IF ((COM$STAT = NACK) OR (COM$STAT = ABO)) THEN
				DO;
				 CALL WRITE(CO$AFT,.MSG8,LENGTH(MSG8),.STATUS);
				 GOTO ERRTN;
				END;
			 IF COM$STAT = TM$OUT THEN
				DO;
				 CALL WRITE(CO$AFT,.MSG9,LENGTH(MSG9),.STATUS);
				 GOTO ERRTN;
				END;
			 IF COM$STAT <> ACK THEN
				DO;
				 CALL WRITE(CO$AFT,.MSG22,LENGTH(MSG22),.STATUS);
				 GOTO ERRTN;
				END;
			END;
		END;
	COM$STAT = BLK$XMT(.BUFFER,1,TYP$END);
	IF ((COM$STAT = NACK) OR (COM$STAT = ABO))
		THEN CALL WRITE(CO$AFT,.MSG10,LENGTH(MSG10),.STATUS);
	IF (COM$STAT = TM$OUT) THEN
	 CALL WRITE(CO$AFT,.MSG11,LENGTH(MSG11),.STATUS);
	IF (COM$STAT <> ACK) THEN
	 CALL WRITE(CO$AFT,.MSG22,LENGTH(MSG22),.STATUS);
ERRTN:	CALL CLOSE(AFT,.STATUS);
	IF STATUS > 0 THEN CALL ERROR(STATUS);

END SEND$ROUTINE;



GET$ROUTINE: PROCEDURE;

	CALL OPEN(.AFT,.MDS$FILENAME,WRITE$AC,0,.STATUS);
	IF STATUS > 0 THEN
		DO;
		 CALL ERROR(STATUS);
		 RETURN;
		END;
	IF REC$RDY > 0 THEN DUMMY = REC$DATA;
	IF ENQ = TRUE THEN
		DO;
		 IF REC$RDY > 0 THEN DUMMY = REC$DATA;
		 COM$STAT = BLK$XMT(.PDP$FILENAME,LNG$PDP,TYP$REV);
		 IF ((COM$STAT = NACK) OR (COM$STAT = ABO)) THEN
			DO;
			 CALL WRITE(CO$AFT,.MSG6,LENGTH(MSG6),.STATUS);
			 GOTO ERRTN;
			END;
		 IF (COM$STAT = TM$OUT) THEN
			DO;
			 CALL WRITE(CO$AFT,.MSG7,LENGTH(MSG7),.STATUS);
			 GOTO ERRTN;
			END;
		 IF COM$STAT <> ACK THEN
			DO;
			 CALL WRITE(CO$AFT,.MSG22,LENGTH(MSG22),.STATUS);
			 GOTO ERRTN;
			END;
		END;
	ELSE
		DO;
		 CALL WRITE(CO$AFT,.MSG26,LENGTH(MSG26),.STATUS);
		 GOTO ERRTN;
		END;
	CALL TIME(200);
	RECD$TYP = TYP$DRECD;
		DO WHILE RECD$TYP = TYP$DRECD;
		 RECD$LNGTH = BLOCK$INP(.BUFFER);
		 IF ((RECD$LNGTH > 0) AND (RECD$TYP = TYP$DRECD)) THEN
			DO;
			 CALL WRITE (AFT,.BUFFER(1),RECD$LNGTH,.STATUS);
			 IF STATUS > 0 THEN
				DO;
				 CALL ERROR(STATUS);
				 CALL CLOSE(AFT,.STATUS);
				 IF STATUS > 0 THEN CALL ERROR(STATUS);
				 RETURN;
				END;
			END;
		 ELSE
			DO;
			 RECD$LNGTH = RECD$LNGTH;
			END;
		END;
	IF (RECD$TYP = TYP$END) THEN
		DO;
		 CALL CLOSE(AFT,.STATUS);
		 IF STATUS > 0 THEN CALL ERROR(STATUS);
		 RETURN;
		END;
	IF RECD$TYP = TYP$ABORT THEN
		DO;
		 CALL WRITE(CO$AFT,.MSG14,LENGTH(MSG14),.STATUS);
		 CALL CLOSE(AFT,.STATUS);
		 IF STATUS > 0 THEN CALL ERROR(STATUS);
		 RETURN;
		END;
	IF RECD$TYP = TM$OUT THEN
		DO;
		 CALL WRITE(CO$AFT,.MSG15,LENGTH(MSG15),.STATUS);
		 CALL CLOSE(AFT,.STATUS);
		 IF STATUS > 0 THEN CALL ERROR(STATUS);
		 RETURN;
		END;
	IF RECD$TYP = CS$ERR THEN
		DO;
		 CALL WRITE(CO$AFT,.MSG16,LENGTH(MSG16),.STATUS);
		 CALL CLOSE(AFT,.STATUS);
		 IF STATUS > 0 THEN CALL ERROR(STATUS);
		END;
	CALL WRITE(CO$AFT,.MSG17,LENGTH(MSG17),.STATUS);
ERRTN:	CALL CLOSE(AFT,.STATUS);
	IF STATUS > 0 THEN CALL ERROR(STATUS);
	RETURN;

END GET$ROUTINE;



TERMINATE: PROCEDURE;
 IF REC$RDY > 0 THEN DUMMY = REC$DATA;
 IF ENQ = TRUE THEN
	DO;
	 IF REC$RDY > 0 THEN DUMMY = REC$DATA;
	 COM$STAT = BLK$XMT (.BUFFER,1,TYP$EXIT);
	 IF COM$STAT = ACK THEN RETURN;
	 IF COM$STAT = ABO THEN
	  CALL WRITE(CO$AFT,.MSG23,LENGTH(MSG23),.STATUS);
	 IF COM$STAT = NACK THEN
	  CALL WRITE(CO$AFT,.MSG4,LENGTH(MSG4),.STATUS);
	 IF (COM$STAT = TM$OUT) THEN
	  CALL WRITE(CO$AFT,.MSG5,LENGTH(MSG5),.STATUS);
	 IF (COM$STAT <> TM$OUT AND COM$STAT <> NACK
	  AND COM$STAT <> ABO) THEN
	   CALL WRITE(CO$AFT,.MSG22,LENGTH(MSG22),.STATUS);
	 RETURN;
	END;
 ELSE
	DO;
	 CALL WRITE(CO$AFT,.MSG26,LENGTH(MSG26),.STATUS);
	 RETURN;
	END;
END TERMINATE;





SETUP$CLI: CALL WRITE(CO$AFT,.SGN$ON,LENGTH(SGN$ON),.STATUS);


	CALL OPEN (.AFT$IN,.CONSL$INP,READAC,LN$EDT$CO,.STATUS);
	IF STATUS > 0 THEN
		DO;
		 CALL WRITE(CO$AFT,.MSG1,LENGTH(MSG1),.STATUS);
		 CALL EXIT;
		END;
	CALL READ(AFT$IN,.KEY$BUFFER,122,.ACTL,.STATUS);
	IF STATUS > 0 THEN
		DO;
		 CALL WRITE(CO$AFT,.MSG2,LENGTH(MSG2),.STATUS);
		 CALL EXIT;
		END;
COMMAND$LEVEL: DO FOREVER;
		 CALL WRITE(CO$AFT,.PRMTMSG,LENGTH(PRMTMSG),.STATUS);
		 CALL READ(AFT$IN,.KEY$BUFFER,122,.ACTL,.STATUS);
		 CALL COMDEC;
			DO CASE MODE;
				DO;
				 CALL TERMINATE;

				 CALL EXIT;
				END;
			 CALL SEND$ROUTINE;
			 CALL GET$ROUTINE;

			DO;
			 IF REC$RDY > 0	THEN DUMMY = REC$DATA;
			 IF ENQ = TRUE THEN
				DO;
				 IF REC$RDY > 0 THEN DUMMY = REC$DATA;
				 COM$STAT = BLK$XMT (.BUFFER,1,TYP$ABORT);
				 IF COM$STAT = ABO THEN
				  CALL WRITE(CO$AFT,.MSG24,LENGTH(MSG24),.STATUS);
				 IF COM$STAT = NACK THEN
				  CALL WRITE(CO$AFT,.MSG19,LENGTH(MSG19),.STATUS);
				 IF (COM$STAT = TM$OUT) THEN
				  CALL WRITE(CO$AFT,.MSG20,LENGTH(MSG20),.STATUS);
				 IF (COM$STAT <> ACK OR COM$STAT <> ABO OR
				  COM$STAT <> NACK OR COM$STAT <> TM$OUT) THEN
				  CALL WRITE(CO$AFT,.MSG22,LENGTH(MSG22),.STATUS);
				END;
			ELSE
				DO;
				 CALL WRITE(CO$AFT,.MSG26,LENGTH(MSG26),.STATUS);
				END;
			END;


			 CALL DIRECT;


				DO;
				 CALL DEBLANK;
				 MODE = BAUD(.KEYBUFFER(J));
				 IF MODE > 0 THEN
				  CALL WRITE(CO$AFT,.MSG25,LENGTH(MSG25),.STATUS);
				END;


			 CALL TERMINATE;
			 CALL EXIT;
			 CALL WRITE(CO$AFT,.MSG3,LENGTH(MSG3),.STATUS);
			 MODE = MODE;
		 	END;
		END;
END;
EOF