BLKIO: DO;

$NOLIST
$INCLUDE (:F1:COMMON.LIT)
$INCLUDE (:F1:DEFIO)
$LIST


DECL
  MAX$RE$TRY LIT '010',
  ACK        LIT '01H',
  NACK       LIT '02H',
  ABO        LIT '03H',
  NAME       LIT '021H',
  DRECD      LIT '023H',
  END$REC    LIT '024H',
  ABORT      LIT '025H',
  EXIT       LIT '026H',
  RVINT      LIT '027H',
  TM$OUT     LIT '0FEH',
  CS$ERR     LIT '0FFH';




DECL BLK$LNGTH LIT '0255';
DECL CHKSM ADDRESS;
DECL LEN BYTE;
DECL RE$TRY BYTE;
DECL TIMER ADDRESS;
DECL TYPE BYTE;



REC$DATA: PROCEDURE BYTE PUBLIC;
	RETURN(INPUT(SIO$DATA) AND 07FH);
 END REC$DATA;



REC$RDY: PROCEDURE BYTE PUBLIC;
	RETURN(INPUT(SIO$STAT) AND SIO$RXRDY);
 END REC$RDY;



SCHAR: PROCEDURE (CHAR) PUBLIC;
 DECL CHAR BYTE;

		DO WHILE (INPUT(SIO$STAT) AND SIO$TXRDY) = 0;
		END;
	OUTPUT (SIO$DATA) = CHAR;
 END SCHAR;



BLOCK$SEND: PROCEDURE (BUFFER$ADD,LEN,TYPE)PUBLIC;
  DECL BUFFER$ADD ADDRESS;
  DECL (BUFFER BASED BUFFER$ADD) (BLK$LNGTH) BYTE;
  DECL I BYTE;
  DECL LEN BYTE;
  DECL TYPE BYTE;


/*  BLOCK$SEND TRANSMITS A RECORD.  RECORD FORMAT IS
		BYTE 1		RECORD TYPE
		BYTE 2 - 253		DATA
		BYTE 254		LSB OF CHECKSUM
		BYTE 255		MSB OF CHECKSUM

RECORDS ARE FIXED LENGTH 255 CHARS SO SHORT RECORDS ARE PADDED
WITH NULLS.  */



	CHKSM = 0;
	CALL SCHAR (TYPE);
	CHKSM = CHKSM + TYPE;
	IF LEN = 0 THEN GOTO PAD;
		DO I = 0 TO (LEN-1);
		 CALL SCHAR (BUFFER(I));
		 CHKSM = CHKSM + BUFFER(I);
		END;
PAD:	IF LEN < (BLK$LNGTH-3) THEN
		DO WHILE I < (BLK$LNGTH-3);
		 CALL SCHAR (NULL);
		 I = I + 1;
		END;
	CALL SCHAR (LOW(CHKSM));
	CALL SCHAR (HIGH(CHKSM));
	RETURN;
  END BLOCK$SEND;



BLOCK$RECV: PROCEDURE (BUFFER$ADD) BYTE PUBLIC;
 DECL BUFFER$ADD ADDRESS;
 DECL (BUFFER BASED BUFFER$ADD) (BLK$LNGTH) BYTE;
 DECL I BYTE;
 DECL CS$TEMP ADDRESS;


/*  BLOCK$RECV  INPUTS A RECORD FROM THE USART.
	INPUT REQUIRED IS A BUFFER ADDRESS FOR A 255
		CHARACTER BUFFER
	RECORD TYPE IS RETURNED AS THE FIRST CHARACTER IN THE BUFFER
	TYPES ARE:
		!   NAME RECORD
		#   DATA RECORD
		$   END OF FILE
		%   ABORT
		&   TERMINATE LINK
		'   REVERSE INTERUPT
		RUB OUT(0FFH)   CHECKSUM ERROR
		 (0FEH)         TIMEOUT ERROR
	ACTUAL RECORD LENGTH IS RETURNED AS PARAMETER
	A ONE SECOND TIME OUT IS USED TO DETERMINE POSSIBLE LINE FAILURE*/



	CHKSM = 0;
	CS$TEMP = 0;
	I = 0;
	LEN = 0;
	TIMER = 01FFFH;

		DO FOREVER;
		 	DO WHILE ((REC$RDY = 0) AND (TIMER > 0));
			 CALL TIME (1);
			 TIMER = TIMER - 1;

			END;
		 IF TIMER = 0 THEN
			DO;
			 BUFFER(0) = TM$OUT;
			 RETURN (LEN-1);
			END;

		 TIMER = 01FFFH;
		 IF I < (BLK$LNGTH-6) THEN
			DO;
			 BUFFER(LEN) = REC$DATA;
			 IF (((BUFFER(LEN) > 0) AND (BUFFER(LEN) < 8))
			  OR ((BUFFER(LEN) > LF) AND (BUFFER(LEN) < SPACE)))
			  THEN
				DO;
				 BUFFER(LEN) = BUFFER(LEN);
				END;
			 IF BUFFER(LEN) > 0 THEN
				DO;
				 CHKSM = CHKSM + BUFFER(LEN);
				 LEN = LEN + 1;
				END;
			END;
		 ELSE
			DO;
			 BUFFER(I) = REC$DATA;
			 IF ((BUFFER(I) < '0') OR (BUFFER(I) > '7')) THEN
			 	DO;
				 BUFFER(0) = CS$ERR;
				END;
			 BUFFER(I) = (BUFFER(I) AND 07H);
			 IF I = (BLK$LNGTH-1) THEN
				DO;
				 CS$TEMP = ((SHL(BUFFER(BLK$LNGTH-1),3))
				  OR (BUFFER(BLK$LNGTH-2)));
				 CS$TEMP = (SHL(CS$TEMP,3))
				  OR (BUFFER(BLK$LNGTH-3));
				 CS$TEMP = (SHL(CS$TEMP,3))
				  OR (BUFFER(BLK$LNGTH-4));
				 CS$TEMP = (SHL(CS$TEMP,3))
				  OR (BUFFER(BLK$LNGTH-5));
				 CS$TEMP = (SHL(CS$TEMP,3))
				  OR (BUFFER(BLK$LNGTH-6));
				 IF CS$TEMP - CHKSM <> 0 THEN BUFFER(0) = CS$ERR;
				 RETURN(LEN-1);
				END;
			END;
		I = I + 1;
		END;
END BLOCK$RECV;


DECL ENQ$CODE LIT '03H';
DECL ENQ$POS  LIT '03H';

ENQ: PROCEDURE BYTE PUBLIC;
 DECL RESP$CHAR BYTE;

 RE$TRY = MAX$RE$TRY;
	DO WHILE RE$TRY > 0;
	 TIMER = 1FFFH;
	 CALL SCHAR(ENQ$CODE);
		DO WHILE (TIMER > 0) AND (REC$RDY = 0);
		 CALL TIME(1);
		 TIMER = TIMER - 1;
		END;
	 IF TIMER > 0 THEN
		DO;
		 RESP$CHAR = REC$DATA;
		 IF RESP$CHAR = ENQ$POS THEN RETURN(TRUE);
		END;
	 RE$TRY = RE$TRY - 1;
	END;
 CALL SCHAR(CR);
 RETURN(FALSE);
END ENQ;


BLK$XMT: PROCEDURE (BUFFER$ADD,LEN,TYPE) BYTE PUBLIC;
 DECL BUFFER$ADD ADDRESS;
 DECL LEN BYTE;
 DECL RESP BYTE;
 DECL TYPE BYTE;

	RE$TRY = MAX$RE$TRY;

		DO WHILE RE$TRY > 0;
		 TIMER = 1FFFH;
		 CALL BLOCK$SEND(BUFFER$ADD,LEN,TYPE);
			DO WHILE (TIMER > 0) AND (REC$RDY = 0);
			 CALL TIME(1);
			 TIMER = TIMER - 1;

			END;
		 IF TIMER > 0 THEN
			DO;
			 RESP = REC$DATA;
			 IF ((RESP = ACK) OR (RESP = ABO))
			  THEN RETURN (RESP);
			END;
		 RE$TRY = RE$TRY - 1;
		END;
	IF TIMER = 0 THEN RETURN (TM$OUT);
	RETURN (RESP);
END BLK$XMT;


BLOCK$INP: PROCEDURE (BUFFER$ADD) BYTE PUBLIC;
 DECL BUFFER$ADD ADDRESS;
 DECL (BUFFER BASED BUFFER$ADD) (BLK$LNGTH) BYTE;
 DECL DUMMY BYTE;
 DECL RTYPE LIT 'BUFFER(0)';

	RE$TRY = MAX$RE$TRY;
	CALL SCHAR(ACK);
	RTYPE = 0;
	IF REC$RDY > 0 THEN DUMMY = REC$DATA;

		DO WHILE RE$TRY > 0;
		 LEN = BLOCK$RECV(BUFFER$ADD);
		 IF ((RTYPE = NAME) OR (RTYPE = DRECD) OR
		  (RTYPE = END$REC) OR (RTYPE = EXIT) OR
		   (RTYPE = RVINT)) THEN
			DO;
			 RETURN(LEN);
			END;
		 ELSE
			DO;
			 CALL SCHAR(NACK);
			 IF RTYPE = ABORT THEN
			  RE$TRY = 0;
			 ELSE
			  RE$TRY = RE$TRY - 1;
			END;
		END;
	RETURN(LEN);
END BLOCK$INP;


END;
EOF