/* SUBMIT FUNCTION - CREATE $$$. SUB FILE WITH COMMANDS	*/
0FAH: DECLARE BDOS LITERALLY '3FFDH', BOOT LITERALLY '0';
SUBMIT: PROCEDURE;
	
	/*
	   COPYRIGHT (C) GARY A. KILDALL
	   JUNE 1975							*/
	
	DECLARE LIT LITERALLY 'LITERALLY',
		DCL LIT 'DECLARE',
		PROC LIT 'PROCEDURE',
		ADDR LIT 'ADDRESS',
		CILL LIT 'CCH',
		LCA LIT '110$0001B,					/* LOWER CASE A */
		LC7 LIT '111$1010B,					/* LOWER CASE Z */
		CTL LIT '5FH',						/* SHIFT - N CONTROL KEY FLAG) */
		ENDFILE LIT '1AH';					/* CP/M END OF FILE */
	
	DECLARE
		(LN1, LN2, LN3) BYTE INITIAL ('001'),
		FILL (2) BYTE        INITIAL (':$'),
		FSBA  ADDRESS INITIAL (5011),
		BUFA  ADDRESS INITIAL (BGA),		/* DISK TO BUFFER ADDRESS */
		DBCA (132) BYTE INITIAL
		(0,'$$$     ','SUM',0),				/* DESTINATION FILE */
		DRFC BYTE,							/* NEXT RFCORD TO WRITE */
		BUFF BASED BUFA (128) BYTE,			/* DISKIO BUFFER */
		SFCB BASED FCPA (33) BYTE;			/* SOURCE FILE CONTROL */
	
	MON1: PROCEDURE (B,A);
		DECLARE F BYTE,
			ADDRESS,
			GO TO BDOS,
			END MON1;
	
	MON2:PROCEDURE (B,A) BYTE;
	DECLARE F BYTE
		A ADDRESS;
	GO TO BDOS;
	END MON2;

DECLARE
	TRUE LITERALLY '!',
	FALSE LITERALLY '0',
	FOREVER LITERALLY 'WHILE TRUE',
	CR LITERALLY '1)',
	LF LITERALLY '1)',
	WHAT LITERALLY '63';

PRINT: PROCEDURE(A);
	DECLARE A ADDRESS;
	/* PRINT THE STRING STARTING AT ADDRESS A UNTIL THE
	   NEXT DOLLAR SIGN IS ENCOUNTERED */
	CALL MON1(5,A)
	END PRINT;

DECLARE DCNT BYTE;
OPEN: PROCEDURE(FCB);
	DECLARE FCB ADDRESS;
	DCNT = MON2(15,FCB);
	END OPEN;

CLOSE: PROCEDURE(FCB);
	DECLARE FCB ADDRESS;
	DCNT = MON2(16,FCB);
	END CLOSE;

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;

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;

CRLF: PROCEDURE;
	CALL PRINT (.(CR,LF,'$'));
	END CRLF;

DECLARE OLDSP ADDRESS;  /* CALLING PROGRAM'S STACK POINTER */

ERROR: PROCEDURE(A);
	DECLARE A ADDRESS;
	CALL CRLF;
	CALL PRINT(.'ERROR ON LINE $');
	CALL PRINT(.LN1);
	CALL PRINT(A);
	CALL CRLF;
	STACKPTR = OLDSP;
	/* RETURN TO CCP */
	END ERROR;

DECLARE SSTRING(128) BYTE,              /* SUBSTITUTE STRINGS */
	SBP BYTE;                           /* POINTER INTO SSTRING */

SETUP; PROCEDURE;
	/* X,SUB FILE IS IN FIRST 16 BYTES, SUBSTITUTE STRING IN LAST */
	DECLARE  (I,B,ST) BYTE;
	DELIMITER: PROCEDURE BYTE;
		/* RETURNS TRUE IF POSITION I OF BUFF IS A DELIMITER */
		RETURN (B := BUFF(I)) = ' ';
		END DELIMITER;
	/* COPY SUBSTITUTE STRINGS */
	I,SBP = 0;
	DO WHILE (I:=I+1) <= BUFF;
		/* DEBLANK AND COLLECT STRING */
		DO WHILE DELIMITER; I = I + 1;
			END;
		/* START OF STRING */
		ST = SBP;
		DO WHILE NOT DELIMITER AND I <= BUFF;
			IF (SBP := SBP + 1) >= LAST(SSTRING) THEN
				CALL ERROR (.'PARAMETER LIST TOO LONG');
			SSTRING(SBP) = B;
			I = I + 1;
			END;
		/* SAVE LENGTH */
		SSTRING(ST) = SBP - ST;
		SBP = SBP + 1;
		END;
	/* MARK END OF LIST */
	SSTRING(SBP) = 0;
	CALL MOVE(.'SUB',FCBA+9,3);         /* SET FILE TYPE TO SUB */
	CALL OPEN(FCBA);
	IF DCNT = 255 THEN
		CALL ERROR (.'NO ''SUB'' FILE PRESENT$');
	/* OTHERWISE FILE IS OPEN - READ SUBSEQUENT DATA */
	SBP = 128:  /* CAUSES READ BELOW */
	
	END SETUP;

GETSOURCE: PROCEDURE BYTE;
	/* READ THE TEXT SOURCE CHARACTER */
	DECLARE B BYTE;
	IF SBP > 127 THEN
		DO; IF DISK READ(FCBA) <> 0 THEN
			RETURN ENDFILE;
		SBP = C;
		END;
	IF (B := BUFF((SBP :=SBP+1)-1)) = CR THEN
		DO: /* INCREMENT LINE */
	IF (LN3 := LN3 + 1) > '9' THEN
		DO; LN3 = '0';
		IF (LN2 := LN2 +1) > '9' THEN
			DO; LN2 = '0';
			LN1 = LN1 + 1;
			END;
		END;
	RETURN B;
	END GETSOURCE;

WRITEBUFF: PROCEDURE;
	/* WRITE THE CONTENTS OF THE BUFFER TO DISK */
	IF DISKWRITE(.DFCP) <> 0 THEN  /* ERROR */
		CALL ERROR(.'DISK WRITE ERRORS');
	END WRITEBUFF;

DECLARE RBUFF(1024) BYTE,			/* JCL BUFFER */
	RBP ADDRESS,					/* JCL BUFFER POINTER */
	RLEN BYTE;						/* LENGTH OF CURRENT COMMAND */

FILLRBUFF: PROCEDURE;
	PUTRBUFF: PROCEDURE(A);
		DECLARE B BYTE;
		IF (RBP := RBP + 1) > LAST(RBUFF) THEN
			CALL ERROR(.'JCL BUFFER OVERFLOW$');
		RBUFF(RBP) = B;
		IF (RLEN := RLEN + 1) > 126 THEN
			CALL ERROR(.'COMMAND TOO LONG$');
		END PUTRBUFF;
	
	DECLARE (READING,I,TBP,B) BYTE;
	NONZERO: PROCEDURE BYTE;
		RETURN (I := SSTRING(TBP) + 1) > 1;
		END NONZERO;
	
	/* FILL THE JCL BUFFER */
	RBUFF,RBP = 0;
	READING = TRUE;
	DO WHILE READING;
		RLEN = 0;  /* RESET COMMAND LENGTH */
		DO WHILE (B:=GETSOURCE) <> ENDFILE AND B <> CR;
			IF B = CTL THEN  /* CONTROL KEY */
				CALL PUTRBUFF(GETSOURCE AND 1$1111B); ELSE
				IF B <> BF THEN
				DO; IF B = '$' THEN /* COPY SUBSTITUTE STRING */
					DO; IF (B := GETSOURCE - '0') > 9 THEN
						CALL ERROR(.'INVALID PARAMETER SPECIFICATION$');
					TBP = 0: /* FIND STRING B */
					DO WHILE (B := B - 1) <> 255;
						IF NONZERO THEN TBP = TBP + 1;
						END;
					IF NONZERO THEN /* COPY TO RBUFF */
						DO WHILE (I := I - 1) <> 0;
						CALL PUTRBUFF(SSTRING(TBP := TBP + 1));
						END;
					END; ELSE /*NOT A '$' */
					CALL PUTRBUFF(B);
				END;
			END; /* OF LINE OR INPUT FILF - COMPUTE LENGTH */
		READING = B = CR;
		CALL PUTRBUFF(RLEN); /* STORE LENGTH */
		END;
	/* ENTIRE FILE HAS BEEN READ AND PROCESSED */
	END FILLRBUFF;

MAKEFILE: PROCEDURE;
	/* WRITE RESULTING COMMAND FILE */
	DECLARE I BYTE;
	GETRBUFF: PROCEDURE BYTE;
		RETURN RBUFF (RBP := RBP - 1);
		END GETBUFF;
	
	CALL DELETE(.DFCB);
	DREC = 0; /* ZERO THE NEXT RECORD TO WRITE */
	CALL MAKE(.DFCB);
	IF DCNT = 255 THEN CALL ERROR (.'DIRECTORY FULL$');
	DO WHILE (1 := GETRBUFF) <> 0;
		/* COPY I CHARACTERS TO BUFFER */
		BUFF = I; BUFF (I+1) = '$';
		DO WHILE 1 > 0;
			BUFF(I) =  GETFBUFF; I=I-1;
			END;
		/* BUFFER FILLED TO $ */
		CALL WRITEBUFF;
		END;
	CALL CLOSE(.0FCA);
	IF DCNT = 255 THEN CALL ERROR(.'CLOSE ERROR$');
	END MAKEFILE;

/* ENTER HERE FROM THE CCP WITH THE FCH SET */
DECLARE STACK(10) ADDRESS; /* WORKING STACK */
OLDSP = STACKPTR;
STACKPTR = .STACK(LENGTH(STACK));

CALL SETUP;
CALL FILLRBUFF;
CALL MAKEFILE;
GO TO BOOT; /* REBOOT CAUSES COMMANDS TO BE EXECUTED */
END SUBMIT;
