$ TITLE ('SUBMIT QUICK UTILITY')

SQ: DO;
/*
		INSITE ORDER NO. BG78

		TITLE/VERSION:   SUBMIT: ISIS COMMAND STRING, V1.0

		PERMITS EXECUTION OF MULTIPLE ISIS COMMANDS IN COMMAND TAIL,
		SEPARATED BY SEMICOLONS (;) WITHOUT HAVING TO EDIT (AND THEN
		DELETE) A SUBMIT FILE.

		ISIS INVOCATION:
		:F1:SQ 4 COMMAND1;COMMAND2;COMMAND3;COMMAND4...(CRLF)

		WHERE SQ MAY BE INVOKED FROM ANY DRIVE, THE NUMBER FOLLOWING THE
		COMMAND INVOCATION IS AN OPTIONAL DRIVE NUMBER FOR THE TEMPORARY
		SQ.CS FILE (THE DEFAULT DRIVE IS :F1:), AND ISIS COMMANDS FOLLOW,
		SEPARATED ONLY BY SEMICOLONS (;).  EACH COMMAND IS LIMITED TO 122
		CHARACTERS (LIKE ANY ISIS COMMAND) EXCLUDING LEADING SPACES.
		SEMICOLONS IN THE COMMAND STRING CAN BE LITERALIZED BY USING TWO
		CONSECUTIVE SEMICOLONS (;;).

		WILLIAM J. HINKLE
		COMTEC INC.
		27 SEP 1982

*/

/*	EXTERNAL PROCEDURES	*/

OPEN: PROCEDURE (AFTNPTR,FILE,ACCESS,MODE,STATUS) EXTERNAL;
DECLARE (AFTNPTR,FILE,ACCESS,MODE,STATUS) ADDRESS;
END OPEN;

CLOSE: PROCEDURE (AFTN,STATUS) EXTERNAL;
DECLARE (AFTN,STATUS) ADDRESS;
END CLOSE;

READ: PROCEDURE (AFTN,BUFFER,COUNT,ACTUAL,STATUS) EXTERNAL;
DECLARE (AFTN,BUFFER,COUNT,ACTUAL,STATUS) ADDRESS;
END READ;

WRITE: PROCEDURE (AFTN,BUFFER,COUNT,STATUS) EXTERNAL;
DECLARE (AFTN,BUFFER,COUNT,STATUS) ADDRESS;
END WRITE;

SEEK: PROCEDURE (AFTN,MODE,BLOCKNO,BYTENO,STATUS) EXTERNAL;
DECLARE (AFTN,MODE,BLOCKNO,BYTENO,STATUS) ADDRESS;
END SEEK;

RESCAN: PROCEDURE (AFTN,STATUS) EXTERNAL;
DECLARE (AFTN,STATUS) ADDRESS;
END RESCAN;

DELETE: PROCEDURE (FILE,STATUS) EXTERNAL;
DECLARE (FILE,STATUS) ADDRESS;
END DELETE;

CONSOL: PROCEDURE (INFILE,OUTFILE,STATUS) EXTERNAL;
DECLARE (INFILE,OUTFILE,STATUS) ADDRESS;
END CONSOL;

WHOCON: PROCEDURE (AFTN,BUFFER) EXTERNAL;
DECLARE (AFTN,BUFFER) ADDRESS;
END WHOCON;

ERROR: PROCEDURE (ERRNUM) EXTERNAL;
DECLARE ERRNUM ADDRESS;
END ERROR;

EXIT: PROCEDURE EXTERNAL;
END EXIT;

/*	DECLARATIONS	*/

DECLARE CR LITERALLY '0DH',LF LITERALLY '0AH',ESC LITERALLY '1BH';
DECLARE TRUE LITERALLY '0FFH', FALSE LITERALLY '0';

DECLARE (I,J) BYTE;				/* SCRATCH STORAGE */

DECLARE DEFAULT$DRIVE LITERALLY '''1''';	/* DEFAULT DRIVE FOR SQ.CS FILE */
DECLARE CSNAME (*) BYTE INITIAL (':F',DEFAULT$DRIVE,':SQ.CS$');
/* COMMAND FILE NAME */
DECLARE DRIVE BYTE INITIAL (DEFAULT$DRIVE);
/* DISK DRIVE OF CS FILE (ASCII DIGIT) */

DECLARE CBUFF (123) BYTE, CINDEX BYTE;
DECLARE (BLOCKNO,BYTENO) ADDRESS;	/* INITIAL CONSOLE RETURN MARKER */
DECLARE AFTN$F ADDRESS;				/* CONTROL FILE AFTN */
DECLARE STATUS ADDRESS;				/* ISIS STATUS RETURN STORAGE */
DECLARE SQLEN BYTE;					/* LENGTH OF SQ COMMAND INVOCATION */
DECLARE LAST$EOF BYTE;				/* END OF FILE FLAG */
DECLARE IN$INIT BYTE INITIAL (TRUE);	/* INPUT INITIALIZE FLAG */

DECLARE RESTORE (*) BYTE DATA ('RESTORE');
DECLARE RFLAG BYTE INITIAL (TRUE);	/* RESTORE FUNCTION FLAG */
DECLARE RBUFF (*) BYTE INITIAL (':Fx:123456.123 ');

/*	LOCAL PROCEDURES */

/*
	FILE$CHAR: TESTS INPUT CHARACTER FOR INCLUSION IN FILE NAME CHARACTER
	SET OF A-Z, 0-9, : OR . CHARACTERS.  RETURNS TRUE IF IN THIS SET, FALSE
	OTHERWISE.
	PARAMETER:	CHARACTER (BYTE VALUE)
	RETURNED:	TRUE IF FILE CHARACTER, FALSE OTHERWISE (BYTE VALUE)
*/
FILE$CHAR: PROCEDURE (CHAR) BYTE;
DECLARE CHAR BYTE;

RETURN ((CHAR - 'A') <= ('Z' - 'A')) OR ((CHAR - '0') <= ('9' - '0'))
	OR (CHAR = ':') OR (CHAR = '.');
END FILE$CHAR;

/*
	END$OF$FILE: RETURNS TRUE IF CHARACTER IS END-OF-FILE, FALSE OTHERWISE.
	ALSO ECHOES A CRLF AFTER AN ESCAPE ENTRY.
	PARAMETERS:	CHARACTER (BYTE VALUE)
	RETURNED:	TRUE IF EOF CHARACTER, FALSE OTHERWISE (BYTE VALUE)
*/
END$OF$FILE: PROCEDURE (CHAR) BYTE;
DECLARE CHAR BYTE;

IF (CHAR=CR) THEN RETURN TRUE;			/* RETURN TRUE IF CR */
IF (CHAR=ESC) THEN DO;
	CALL WRITE (0,.(CR,LF),2,.STATUS);	/* ECHO A CRLF AFTER ESCAPE */
	RETURN TRUE;						/* AND RETURN TRUE */
END;
RETURN FALSE;						/* ELSE FALSE */
END END$OF$FILE;

/*
	GET$CMD: LOADS CBUFF WITH NEXT COMMAND LINE.  TERMINATES EACH COMMAND LINE
	WITH CRLF, AND RETURNS TRUE IF COMMAND WAS TERMINATED WITH AN EOF CHARACTER
	(CRLF OR ESC) OR FALSE IF TERMINATED WITH SEMICOLON (;).
	THE CBUFF INDEX CINDEX IS RESET TO 0.  MULTIPLE LINE READS ARE PERFORMED
	TRANSPARENTLY.  TWO (2) CONSECUTIVE ;; ARE CONSIDERED A LITERAL SEMICOLON.
	RETURNED:	TRUE IF COMMAND ENDS WITH CRLF OR ESC, FALSE IF ; (BYTE VALUE)
	CHANGED:	CBUFF, CINDEX
*/
GET$CMD: PROCEDURE BYTE;
DECLARE LBUFF (122) BYTE, LINDEX BYTE;
DECLARE ACTUAL ADDRESS;
DECLARE SC2 BYTE;
DECLARE CSTART BYTE;

IF IN$INIT THEN DO;
	ACTUAL=DOUBLE(LINDEX);		/* FORCE INITIAL COMMAND LINE READ */
	CALL RESCAN (1,.STATUS);	/* BACK UP TO START OF INVOCATION */
	IN$INIT=FALSE;				/* PERFORM FIRST CALL INITIALIZATION */
END;
CINDEX=0;						/* START OF NEW COMMAND */
SC2=FALSE;						/* RESET SEMICOLON 2 FLAG */
CSTART=TRUE;
DO WHILE TRUE;
	IF (LINDEX = ACTUAL) THEN DO;	/* READ MORE DATA AS REQUIRED */
		LINDEX, ACTUAL=0;
		DO WHILE (ACTUAL = 0);		/* INSURE THAT SOME CHARACTERS ARE READ */
			CALL READ (1,.LBUFF,LENGTH(LBUFF),.ACTUAL,.STATUS);
		END;
	END;
	IF (CINDEX = LAST(CBUFF)) THEN DO;
		/* EXIT WITH ERROR IF ANY LINE IS TOO LONG */
		DECLARE TOO$LONG (*) BYTE DATA (CR,LF,'COMMAND TOO LONG.',CR,LF);
		CALL WRITE (0,.TOO$LONG,LENGTH(TOO$LONG),.STATUS);
		CALL EXIT;
	END;
	IF END$OF$FILE (LBUFF(LINDEX)) THEN DO;
		/* LOAD CRLF IF END OF FILE CHARACTER FOUND */
		CBUFF(CINDEX)=CR; CBUFF(CINDEX+1)=LF;
		CINDEX=0;
		RETURN TRUE;
	END;
	IF LBUFF(LINDEX)=';' THEN DO;
		IF SC2 THEN DO;		/* SECOND (LITERAL) SEMICOLON */
			CBUFF(CINDEX)=';';
			LINDEX=LINDEX+1;
			CINDEX=CINDEX+1;
			SC2=FALSE;
		END;
		ELSE DO;
			LINDEX=LINDEX+1;
			SC2=TRUE;		/* FIRST SEMICOLON...WAIT AND SEE IF ANOTHER */
		END;
	END;
	ELSE DO;
		IF SC2 THEN DO;		/* ONLY ONE SEMICOLON: END OF COMMAND */
			CBUFF(CINDEX)=CR; CBUFF(CINDEX+1)=LF;
			CINDEX=0;
			RETURN FALSE;
		END;
		ELSE DO;
			IF NOT (CSTART AND (LBUFF(LINDEX) = ' ')) THEN DO;
				CBUFF(CINDEX)=LBUFF(LINDEX);	/* ELSE, LOAD CHARACTER */
				CINDEX=CINDEX+1;
				CSTART=FALSE;
			END;
			LINDEX=LINDEX+1;	/* DON'T LOAD LEADING BLANKS */
		END;
	END;
END;
END GET$CMD;

/*
	EDITH2: EDITS A WORD-LENGTH INTEGER TO A FOUR CHARACTER HEX STRING.
	PARAMETERS:	(1) INPUT INTEGER (ADDRESS VALUE)
				(2) LOCATION OF DESTINATION BUFFER (ADDRESS VALUE)
	CHANGED:	DESTINATION BUFFER
*/

EDITH2: PROCEDURE (N,LOC);
DECLARE (N,LOC) ADDRESS;
DECLARE D BASED LOC BYTE;
DECLARE HL (2) BYTE AT (.N);
DECLARE K BYTE;

	HEXASCII: PROCEDURE (NIBBLE) BYTE;
	DECLARE NIBBLE BYTE;
	IF NIBBLE > 9
	THEN RETURN NIBBLE-10+'A';
	ELSE RETURN NIBBLE+'0';
	END HEXASCII;

DO K=0 TO 1;
	D=HEXASCII(SHR(HL(1-K),4));
	LOC=LOC+1;
	D=HEXASCII(0FH AND HL(1-K));
	LOC=LOC+1;
END;
END EDITH2;
/*
	GETH2: GETS A WORD-LENGTH INTEGER FROM A 4 CHARACTER HEX STRING.
	PARAMETER:	LOCATION OF SOURCE BUFFER (ADDRESS VALUE)
	RETURNED: INTEGER (ADDRESS VALUE)
*/

GETH2: PROCEDURE (LOC) ADDRESS;
DECLARE (N,LOC) ADDRESS;
DECLARE D BASED LOC BYTE;
DECLARE K BYTE;

N=0;
DO K = 0 TO 3;
	N=SHL(N,4);
	IF D > '9'
		THEN N=N+(D-'A'+10);
		ELSE N=N+(D-'0');
	LOC=LOC+1;
END;
RETURN N;
END GETH2;

/*
	SKIP: REPOSITIONS CBUFF POINTER CINDEX TO NEXT CHARACTER AFTER STRING OF
	BLANKS (ASCII SPACE CHARACTERS).
	CHANGED:	CINDEX
*/
SKIP: PROCEDURE;

DO WHILE CBUFF(CINDEX) = ' ';
	CINDEX=CINDEX+1;
END;
END SKIP;
/*****************************************************************************/
/* MAIN */

LAST$EOF=GET$CMD;		/* GET INITIAL COMMAND STRING, W/ INVOCATION */
CALL SKIP;
SQLEN=0;
DO WHILE FILE$CHAR (RBUFF(SQLEN):=CBUFF(CINDEX));
	/* FIND END OF SQ INVOCATION AND SAVE INVOCATION FOR USE IN RESTORE CMD */
	SQLEN=SQLEN+1;				/* GET LENGTH OF SQ COMMAND */
	CINDEX=CINDEX+1;
END;
CALL SKIP;
IF END$OF$FILE (CBUFF(CINDEX)) THEN CALL EXIT;	/* EXIT IF NO INPUT TO SQ */
J=CINDEX;						/* DON'T CHANGE COMMAND BUFFER POINTER YET */
DO I = 0 TO LAST(RESTORE);		/* CHECK FOR RESTORE FUNCTION */
	IF (CBUFF(J) <> RESTORE(I)) THEN RFLAG=FALSE;
	J=J+1;
END;
IF RFLAG THEN CINDEX=J;				/* CONTINUE LINE SCAN AFTER "RESTORE" */
CALL SKIP;
IF ((CBUFF(CINDEX)-'0') < 10) AND NOT FILE$CHAR (CBUFF(CINDEX+1)) THEN DO;
	DRIVE,CSNAME(2)=CBUFF(CINDEX);	/* LOAD DRIVE NUMBER FOR CS FILE */
	CINDEX=CINDEX+1;				/* SKIP OVER DRIVE NUMBER */
END;
CALL SKIP;
IF RFLAG THEN DO;					/* COMPLETE THE RESTORE FUNCTION IF ANY */
	CALL CONSOL (.CBUFF(CINDEX),.(':CO: '),.STATUS);	/* RESTORE CONSOLE */
	DO WHILE FILE$CHAR (CBUFF(CINDEX));
		CINDEX=CINDEX+1;			/* SKIP OVER OLD CONSOLE NAME */
	END;
	IF CBUFF(CINDEX) = ','		/* IF , IS AFTER NAME THEN MARKER IS AFTER , */
	THEN DO;
		BLOCKNO=GETH2(.CBUFF(CINDEX+1));	/* GET MARKER BLOCK */
		BYTENO=GETH2(.CBUFF(CINDEX+6));		/* GET MARKER BYTE */
		CALL SEEK (1,2,.BLOCKNO,.BYTENO,.STATUS);	/* SET MARKER */
	END;
	CALL DELETE (.CSNAME,.STATUS);		/* DELETE THE SQ.CS FILE */
	CALL EXIT;							/* RETURN TO ISIS UNDER OLD CONSOLE */
END;

CALL OPEN (.AFTN$F,.CSNAME,2,0,.STATUS);	/* OPEN SQ.CS FILE */
DO WHILE TRUE;								/* FORMAT COMMANDS TO FILE */
	CALL SKIP;
	J=CINDEX;
	DO WHILE (CBUFF(CINDEX) <> LF);
		CINDEX=CINDEX+1;					/* FIND NEXT CRLF */
	END;
	CALL WRITE (AFTN$F,.CBUFF(J),CINDEX+1-J,.STATUS);	/* WRITE COMMAND */
	IF LAST$EOF THEN DO;			/* END OF SQ COMMAND STRING, LAST COMMAND */
/*
	NOTE: LAST RECORD IN SQ.CS COMMAND SEQUENCE FILE WILL BE AN SQ RESTORE
	COMMAND SIMILAR TO ONE OF THE FOLLOWING FORMS:
		:F1:SQ RESTORE 1 :VI:(CRLF)
		SQ RESTORE 4 :F0:LINK.CS,0043,0032(CRLF)
	THE DRIVE OF THE ORIGINAL SQ INVOCATION WILL BE USED FOR THE SQ RESTORE
	INVOCATION, THE NUMBER FOLLOWING "RESTORE" WILL, AS IN AN ORDINARY SQ
	COMMAND, INDICATE THE DRIVE NUMBER OF SQ.CS, AND THE NEXT FIELD INDICATES
	THE DEVICE TO WHICH CONSOLE INPUT MUST BE RETURNED.  IF THAT DEVICE IS A
	DISK FILE, THEN THE NAME IS FOLLOWED BY A COMMA AND A FILE MARKER
	VALUE WRITTEN AS TWO 4-CHARACTER HEX INTEGERS: BLOCK,BYTE.
*/
		CALL MOVE (SQLEN,.RBUFF(0),.CBUFF(0));	/* LOAD INVOCATION */
		CINDEX=SQLEN;
		CALL MOVE (11,.(' RESTORE 1 '),.CBUFF(CINDEX));
		CBUFF(CINDEX+9)=DRIVE;		/* LOAD DRIVE NUMBER */
		CINDEX=CINDEX+11;
		J=CINDEX+1;				/* SAVE POSITION OF DEVICE INDICATION "F" */
		CALL WHOCON (1,.CBUFF(CINDEX));		/* GET CURRENT CONSOLE DEVICE */
		DO WHILE FILE$CHAR (CBUFF(CINDEX));
			CINDEX=CINDEX+1;				/* GET LENGTH OF CONSOLE NAME */
		END;
		IF CBUFF(J) = 'F'
		THEN DO;
			CBUFF(CINDEX),CBUFF(CINDEX+5)=',';	/* APPEND MARKER FOR DISK */
			CINDEX=CINDEX+1;
			CALL SEEK (1,0,.BLOCKNO,.BYTENO,.STATUS);
										/* GET NEW MARKER */
			CALL EDITH2 (BLOCKNO,.CBUFF(CINDEX));	/* LOAD MARKER BLOCK */
			CINDEX=CINDEX+5;
			CALL EDITH2 (BYTENO,.CBUFF(CINDEX));		/* LOAD MARKER BYTE */
			CINDEX=CINDEX+4;
		END;
		CBUFF(CINDEX)=CR; CBUFF(CINDEX:=CINDEX+1)=LF;
		CALL WRITE (AFTN$F,.CBUFF,CINDEX+1,.STATUS);	/* SAVE RESTORE CMD */
		CALL CLOSE (AFTN$F,.STATUS);
		CALL CONSOL (.CSNAME,.(':CO: '),.STATUS);	/* SQ.CS IS CONSOLE */
		CALL EXIT;									/* RETURN TO ISIS */
	END;
	LAST$EOF=GET$CMD;			/* GET THE NEXT COMMAND FROM THE SQ STRING */
END;

END SQ;
