XMT800: DO;

$INCLUDE (:F1:COMMON.LIT)

$EJECT

$INCLUDE (:F1:ISS.COM)

$EJECT

$INCLUDE (:F1:DEFIO.800)

$EJECT


DECL AFT ADDRESS;
DECL CHAR BYTE;
DECL STAT ADDRESS;


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



CI: PROCEDURE BYTE EXTERNAL;
 END CI;



CSTS: PROCEDURE BYTE EXTERNAL;
 END CSTS;



MEMCK: PROCEDURE ADDRESS EXTERNAL;
 END MEMCK;



SIO$INIT: PROCEDURE EXTERNAL;
END SIO$INIT;



SCHAR: PROCEDURE (CHAR) PUBLIC;
  DECL CHAR BYTE;
	DO WHILE (INPUT (SIO$STAT) AND SIO$TXRDY) = 0;
	END;
  OUTPUT (SIO$DATA) = CHAR;
  RETURN;
 END;




ISCAN: PROCEDURE BYTE PUBLIC;

 ISC1: DO WHILE CSTS = 0;
	 IF (INPUT (SIO$STAT) AND SIO$RXRDY) = SIO$RXRDY THEN
		DO;
		 CHAR = (INPUT (SIO$DATA) AND 07FH);
		 IF CHAR <> NULL THEN CALL CO (CHAR);
		END;
	END;
  RETURN (CI AND 07FH);
 
 END;


SIO$SCAN: PROCEDURE BYTE PUBLIC;
  DECL CHAR BYTE;
 SIO$SCAN1: DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0;
	 IF CSTS <> 0 THEN
		DO;
		 CALL SCHAR (CI AND 07FH);
		END;
	END;
  CHAR = (INPUT (SIO$DATA) AND 07FH);
  IF CHAR < SPACE THEN
	DO;
	 IF (CHAR < BS) OR (CHAR > CR) THEN
	  GOTO SIO$SCAN1;
	END;
  RETURN (CHAR);
END SIO$SCAN;


TIM$OUT: PROCEDURE;
DECL REC$TIME BYTE;

  REC$TIME = 0;
	DO WHILE REC$TIME < 30;
	 IF (INPUT (SIO$STAT) AND SIO$RXRDY) > 0 THEN
		DO;
		 CALL CO (INPUT (SIO$DATA) AND 07FH);
		 REC$TIME = 0;
		END;
	 CALL TIME (10);
	 REC$TIME = REC$TIME + 1;
	END;
END TIM$OUT;


SEND$CHAR: PROCEDURE (BYT$OUT) PUBLIC;
 DECL BYT$OUT BYTE;
 DECL CHAR BYTE;


/* IF RECEIVING SYSTEM CANNOT TAKE CHARACTERS AT FULL SPEED */

  IF (INPUT (SIO$STAT) AND SIO$RXRDY) > 0 THEN
  CALL TIM$OUT;   /*CHAR RECEIVED WITHOUT SENDING ANYTHING*/
	DO WHILE (INPUT (SIO$STAT) AND SIO$TXRDY) = 0;
	END;
  IF BYT$OUT > SPACE THEN GOTO SEND;
  IF BYT$OUT < BS THEN RETURN;
  IF BYT$OUT = TAB THEN
	DO;
	 CR$FLG = FALSE;
	 OUTPUT (SIO$DATA) = BYT$OUT;
		DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0;
		END;
	 CALL TIM$OUT;
	 RETURN;
	END;
  IF BYT$OUT = CR THEN
	DO;
	 CR$FLG = TRUE;
	 GOTO SEND1;
	END;
  IF BYT$OUT = LF THEN
	DO;
	 IF CR$FLG = TRUE THEN
		DO;
		 CR$FLG = FALSE;
		 RETURN;
		END;
	END;
  IF BYT$OUT = VT THEN
	DO;
	 CR$FLG = FALSE;
	 OUTPUT (SIO$DATA) = BYT$OUT;
		DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0;
		END;
	 CALL TIM$OUT;
	 RETURN;
	END;
  IF BYT$OUT = FF THEN
	DO;
	 CR$FLG = FALSE;
	 OUTPUT (SIO$DATA) = BYT$OUT;
		DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0;
		END;
	 CALL TIM$OUT;
	 RETURN;
	END;

 SEND: CR$FLG = FALSE;
 SEND1: OUTPUT (SIO$DATA) = BYT$OUT;

	DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0;
	END;
  CHAR = (INPUT (SIO$DATA) AND 07FH);
  CALL CO (CHAR);
  IF CHAR = CR THEN
	DO WHILE CHAR <> LF;
		DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0;
		END;
	 CHAR = (INPUT (SIO$DATA) AND 07FH);
	 CALL CO (CHAR);
	END;
 IF CHAR = LF THEN CALL TIME (10);
 IF CHAR = CNTRL$S THEN
	DO;
	 CALL CO (UP$ARW);
	 CALL CO ('S');
		DO WHILE CHAR <> CNTRL$Q;
			DO WHILE (INPUT (SIO$STAT) AND SIO$RXRDY) = 0;
			END;
		 CHAR = (INPUT (SIO$DATA) AND 07FH);
		END;
	 CALL CO (UP$ARW);
	 CALL CO ('Q');
	END;
  RETURN;
END SEND$CHAR;


B$SEND$CHAR: PROCEDURE (CHAR);
 DECL IDATA BYTE;
 DECL CHAR BYTE;
	IF CR$FLG = TRUE THEN
		DO;
		 CR$FLG = FALSE;
		 IF CHAR = LF THEN
		 RETURN;
		END;
	IF CHAR < SPACE THEN
		DO;
		 IF ((CHAR = BS) OR (CHAR = TAB)
		  OR (CHAR = VT) OR (CHAR = FF)
		   OR (CHAR = LF)) THEN CHAR = (CHAR OR 080H);
		END;
	CALL SCHAR(CHAR);
	IDATA = 0;
	IF CHAR = CR THEN
		DO;
		 CR$FLG = TRUE;
			DO WHILE IDATA <> CNTRL$Q;
				DO WHILE (INPUT(SIO$STAT) AND SIO$RXRDY) = 0;
				END;
			 IDATA = (INPUT (SIO$DATA) AND 07FH);
			END;
		END;
	RETURN;
 END B$SEND$CHAR;


SIO$CHECK: PROCEDURE BYTE;
DECL FLAG BYTE;

IF (INPUT (SIO$STAT) AND SIO$RXRDY) <> 0 THEN
	FLAG = TRUE;
	ELSE FLAG = FALSE;
 RETURN (FLAG);
 END SIO$CHECK;



DECL ACTUAL ADDRESS;
DECL I ADDRESS;
DECL FLAG BYTE;
DECL COUNT BYTE;
DECL CR$FLG BYTE PUBLIC;

TEST: PROCEDURE BYTE;
  IF MEMORY(I - 1) <> LF THEN GOTO TST1;
  IF MEMORY(I - 2) <> CR THEN GOTO TST2;
  RETURN (TRUE);
 TST1: IF MEMORY(I-1) <> CR THEN RETURN (FALSE);
  IF MEMORY(I-2) <> LF THEN RETURN (FALSE);
  RETURN (TRUE);
 TST2: IF MEMORY(I-2) <> NULL THEN RETURN (FALSE);
  RETURN (TRUE);
 END TEST;

XMTCM: PROCEDURE PUBLIC;

/* WAIT FOR END OF COMMAND LINE */

DECL CHAR BYTE;


 CHAR = 0;

	/* WAIT FOR CR TO TERMINATE COMMAND THEN CR TO BE ECHOED */

	DO WHILE CHAR <> CR;
	CHAR = ISCAN;
	CALL SCHAR (CHAR);
	END;

  CHAR = 0;
	DO WHILE CHAR <> CR;
	CHAR = SIO$SCAN;
	CALL CO (CHAR);
	END;

/*  WAIT ONE MORE CHARACTER FOR LINE FEED  */
/* NOT NEEDED IN ALL SYSTEMS               */
/*
 CHAR = SIO$SCAN;
 CALL CO (CHAR);
*/
/*  BEGIN TRANSMISSION  */

	DO CASE TRANSFER$MODE;
	 RETURN;
	 GOTO SEND$LOOP;
	 GOTO RECEIVE$LOOP;
	 GOTO BLOCK$SEND$LOOP;
	END;


RECEIVE$LOOP: I = 0;
   FLAG = FALSE;
   COUNT = 0;
   MEMORY(I) = SIO$SCAN;
   IF MEMORY(I) <> LF THEN GOTO REC$NXT1;

 REC$NXT: MEMORY(I) = SIO$SCAN;
 REC$NXT1: IF MEMORY(I) = PROMPT THEN FLAG = TEST;
	IF FLAG = TRUE THEN GOTO REC$END;
 NEXT: IF MEMORY(I) < SPACE THEN
	DO;
	 IF (MEMORY(I) < BS) OR (MEMORY(I) > CR) THEN GOTO REC$NXT;
	END;
I = I+1;
IF I >= MAX$MEM THEN
	DO;
	 CALL SCHAR (CNTRL$S);
		DO WHILE COUNT < 100;
		 IF SIO$CHECK = TRUE THEN
			DO;
			 MEMORY(I) = INPUT (SIO$DATA);
			 IF MEMORY(I) < SPACE THEN
				DO;
				 IF MEMORY(I) <> CR THEN GOTO RESTIME;
				 I = I+1;
				 MEMORY(I) = LF;
				END;
			 IF MEMORY(I) = PROMPT THEN FLAG = TEST;
			 IF FLAG = TRUE THEN GOTO REC$END;
			 I = I+1;
			RESTIME: COUNT = 0;
			 IF I >= MEM$LIMIT THEN COUNT = 100;
			END;
		 CALL TIME (2);
		 COUNT = COUNT+1;
		END;
	 CALL WRITE (AFT,.MEMORY,I,.STAT);
	 I = 0;
	 CALL SCHAR (CNTRL$Q);
	 GOTO RECEIVE$LOOP;
	END;
   GOTO REC$NXT;

/*  TRANSMISSION DONE WRITE INFO AND RESET BUFFER  */

REC$END:
  CALL WRITE (AFT,.MEMORY,I,.STAT);
  IF STAT > 0 THEN CALL ERROR (STAT);
  CALL CO (CR);
  CALL CO (LF);
  CALL CO (PROMPT);
  I = 0;
  RETURN;


BLOCK$SEND$LOOP: DO WHILE CHAR <> LF;
		 CHAR = SIO$SCAN;
		 CALL CO(CHAR);
		END;
	CR$FLG = FALSE;
	CALL B$SEND$CHAR(CR);
B$SEND$LOOP1: CALL READ (AFT,.MEMORY,MAX$MEM,.ACTUAL,.STAT);
	IF STAT > 0 THEN
		DO;
		 CALL ERROR(STAT);
		 RETURN;
		END;
	IF ACTUAL < 1 THEN
		DO;
		 CALL SCHAR(END$O$FILE);
		 RETURN;
		END;
	I = 0;
		DO WHILE I < ACTUAL;
		 CALL B$SEND$CHAR (MEMORY(I));
		 IF MEMORY(I) = CR THEN
			DO;
			 IF CSTS <> 0 THEN
				DO;
				 IF (CI AND 07FH) = ESC THEN
				 RETURN;
				END;
			END;
		 I = I + 1;
		END;
	 GOTO B$SEND$LOOP1;


SEND$LOOP: DO WHILE CHAR <> LF;
	 CHAR = SIO$SCAN;
	 CALL CO (CHAR);
	END;
  CR$FLG = FALSE;
 SEND$LOOP1: CALL READ (AFT,.MEMORY,MAX$MEM,.ACTUAL,.STAT);
  IF STAT > 0 THEN
	DO;
	 CALL ERROR (STAT);
	 RETURN;
	END;
  IF ACTUAL < 1 THEN
	DO;
	 CALL SCHAR (END$O$FILE);
	 RETURN;
	END;
  I = 0;
	DO WHILE I < ACTUAL;
	 CALL SEND$CHAR (MEMORY (I));
	 IF MEMORY(I) = CR THEN
		DO;
		 IF CSTS <> 0 THEN
			DO;
			 IF (CI AND 07FH) = ESC THEN RETURN;
			END;
		END;

	 I = I+1;
	END;
  GOTO SEND$LOOP1;
 END;



   COM$DEC: PROCEDURE (CHAR,ADR$COM$ARRAY,COUNT) BYTE PUBLIC;
          DECL (CHAR,I,TEST,COUNT) BYTE;
          DECL ADR$COM$ARRAY ADDRESS;
          DECL (COM$ARRAY BASED ADR$COM$ARRAY) (128) BYTE;

          I=0;
          TEST=FALSE;

          DO WHILE TEST=FALSE;

             IF CHAR = COM$ARRAY(I) THEN
                TEST = TRUE;

              ELSE DO;
                   I = I+1;
                   IF I > COUNT THEN
                    TEST = TRUE;
                   END;

          END;
          RETURN (I);
        END;

DECL KEY$BUFFER(122) BYTE PUBLIC;
DECL AFT$IN ADDRESS PUBLIC;
DECL CONSL$INP(*) BYTE PUBLIC INITIAL(':CI:');
DECL ACTL ADDRESS PUBLIC;
DECL STATUS ADDRESS PUBLIC;
DECL INDEX BYTE;
DECL FILE$COMMANDS(*) BYTE INITIAL ('RWTCPEX');


READ$SETUP: PROCEDURE PUBLIC;
	IF TRANSFER$MODE > 0 THEN
		DO;
		CALL CLOSE (AFT,.STAT);
		IF STAT > 0 THEN CALL ERROR (STAT);
		END;
	CALL OPEN (.AFT,.KEY$BUFFER(2),READ$AC,0,.STAT);
	IF STAT > 0 THEN CALL ERROR (STAT);
	IF STAT > 0 THEN TRANSFER$MODE = 0;
		ELSE TRANSFER$MODE = 1;
	CALL CO(PROMPT);
	RETURN;
 END READ$SETUP;


BLOCK$READ$SETUP: PROCEDURE PUBLIC;
	IF TRANSFER$MODE > 0 THEN
		DO;
		 CALL CLOSE (AFT,.STAT);
		 IF STAT > 0 THEN CALL ERROR (STAT);
		END;
	CALL OPEN (.AFT,.KEYBUFFER(2),READ$AC,0,.STAT);
	IF STAT > 0 THEN CALL ERROR (STAT);
	IF STAT > 0 THEN TRANSFER$MODE = 0;
		ELSE TRANSFER$MODE = 3;
	CALL CO(PROMPT);
	RETURN;
 END BLOCK$READ$SETUP;


WRITE$SETUP: PROCEDURE PUBLIC;
	IF TRANSFER$MODE > 0 THEN
		DO;
		CALL CLOSE (AFT,.STAT);
		IF STAT > 0 THEN CALL ERROR (STAT);
		END;
	CALL OPEN (.AFT,.KEY$BUFFER(2),WRITE$AC,0,.STAT);
	IF STAT > 0 THEN CALL ERROR (STAT);
	IF STAT > 0 THEN TRANSFER$MODE = 0;
		ELSE TRANSFER$MODE = 2;
	CALL CO (PROMPT);
	RETURN;
END WRITE$SETUP;


CLOSE$SETUP: PROCEDURE PUBLIC;
	CALL CLOSE (AFT,.STAT);
	IF STAT > 0 THEN CALL ERROR (STAT);
	TRANSFER$MODE = 0;
	CALL CO (PROMPT);
	RETURN;
 END CLOSE$SETUP;


SET$NEW$PROMPT: PROCEDURE PUBLIC;

/*  ALLOW ALL PRINTING ASCII CHARACTERS TO BE PROMPT  */

	IF SPACE < KEY$BUFFER(2)  THEN PROMPT = KEY$BUFFER(2);
	ELSE PROMPT = DASH;
	CALL CO (PROMPT);
	RETURN;
 END SET$NEW$PROMPT;

SET$NEW$EOF: PROCEDURE PUBLIC;
	IF KEY$BUFFER(2) < EXCLM$PT THEN END$O$FILE = KEY$BUFFER(2);
	ELSE END$O$FILE = CNTRL$Z;
	CALL CO(PROMPT);
 END SET$NEW$EOF;


FLCMD: PROCEDURE PUBLIC;

COM$BEGIN: CALL READ (AFTIN,.KEY$BUFFER,122,.ACTL,.STATUS);
	IF STATUS > 0 THEN GOTO REPORT$ERROR;


	INDEX = COMDEC (KEY$BUFFER(0),.FILE$COMMANDS,LENGTH(FILE$COMMANDS));
	IF INDEX > LENGTH(FILE$COMMANDS) THEN
		DO;
		 STATUS=203; /* SET UP STATUS SO ERROR ROUTINE WILL PRINT 
				         'INVALID COMMAND SYNTAX'     */
		 CALL ERROR (STATUS);
		 RETURN;
		END;
		DO CASE INDEX;
		CALL READ$SETUP;
		CALL WRITE$SETUP;
		 CALL BLOCK$READ$SETUP;
		CALL CLOSE$SETUP;
		CALL SET$NEW$PROMPT;
		CALL SET$NEW$EOF;
		CALL EXIT;
		END;
	RETURN;


	REPORT$ERROR: CALL ERROR (STATUS);
		GOTO COM$BEGIN;


END;


DECL PROMPT BYTE PUBLIC INITIAL (GR$THAN);
DECL END$O$FILE BYTE PUBLIC INITIAL (CNTRL$Z);
DECL TRANSFER$MODE BYTE PUBLIC INITIAL (0H);
DECL MAX$MEM ADDRESS PUBLIC;
DECL MEM$LIMIT ADDRESS PUBLIC;
DECL SGN$ON(*) BYTE DATA ('800XMT V1.5',CR,LF);



MEM$LIMIT = (MEMCK-.MEMORY);
MAX$MEM = (MEM$LIMIT-200);
CALL SIO$INIT;
CALL OPEN (.AFT$IN,.CONSL$INP,READ$AC,LN$EDT$CO,.STATUS);
  IF STATUS > 0 THEN CALL ERROR (STATUS);
CALL READ (AFT$IN,.KEY$BUFFER,122,.ACTL,.STATUS);
  IF STATUS > 0 THEN CALL ERROR (STATUS);
	DO I = 0 TO (LENGTH (SGN$ON) - 1);
	 CALL CO (SGN$ON(I));
	END;
  CALL SCHAR (CR);

STRT$XMT: CHAR=ISCAN;
  IF CHAR=PRCNT THEN
	DO;
	 CALL CO (CHAR);
	 CALL XMTCM;
	 GOTO STRT$XMT;
	END;
  IF CHAR=AMPRSAND THEN
	DO;
	 CALL CO (CHAR);
	 CALL FLCMD;
	 GOTO STRT$XMT;
	END;
  CALL SCHAR (CHAR);
	DO WHILE CHAR <> CR;
	 CHAR = ISCAN;
	 CALL SCHAR (CHAR) ;
	END;
  GOTO STRT$XMT;
END;
EOF;
