C*	KPSOP  - PROCESS COMMAND LINE AND OPEN FILES
C
	SUBROUTINE KPSOP
C
C	MODIFICATIONS	-
C	03/19/79 LEN	- CHANGED TYPE STATEMENTS TO WRITES TO REMOVE $LSTO
C			  FROM TASK IMAGE.
C	11/01/79 LEN	- CHANGED INPUT BUFFER SIZE TO 10 AND FORCED THE
C			  COPY FROM INPUT TO SCRATCH FILE 1 TO ALWAYS USE
C			  MXTMPB # OF BUFFERS.
C	11/02/79 LEN	- ADDED CALL FDBSET SO CALL X1LU FOR KPS1.TMP WILL
C			  PRE-ALLOCATE THE SPACE NEEDED TO SAVE EXTENTS.
C
C
C	OPEN INPUT FILE - CREATE SEQUENTIAL WORKING FILE WITH EACH 'LINE'
C		HAVING A CHARACTER COUNT AND FORWARD AND BACKWARD POINTERS
C		ASSOCIATED WITH IT.
C		THE PRIMARY SCRATCH FILE ALSO HAS A HEADER RECORD AS THE
C		FIRST RECORD, WHICH CONTAINS ZEROS FOR THE FWD AND BKWD
C		POINTERS AND A ZERO CHAR COUNT.
C	THERE CAN BE 2 POSSIBLE SCRATCH FILES.
C		THE FIRST ONE IS USED TO MAKE THE COPY OF THE INPUT FILE
C	INTO THE ABOVE FORMAT.
C		THE SECOND WILL THEN BE USED FOR INSERTED AND CHANGED LINES.
C	IF THE FILE TO EDIT DOES NOT EXIST ONLY THE FIRST SCRATCH FILE WILL
C	BE USED.
C
C	OPEN DRUM CARD FILE AND SET UP DRUM CARDS IF ANY EXIST.
C		THE DRUM CARD FILE CONTAINS UP TO 9 PROGRAM CONTROL CARDS
C	FOR USE BY KPS A'LA THE KEYPUNCH. SEE KPSMN FOR DESCRIPTION OF THE
C	PROGRAM CONTROL CHARACTERS.
C
C	COMMAND SYNTAX -
C		PDS> KPS INFILE[/DC=DRUMFILE]
C
C	IF KPS HAS NOTHING ON THE COMMAND LINE IT WILL PROMPT KPS> FOR
C	THE FILE SPECS.
C	DEFAULT FILE EXTENSION ON INFILE IS .DAT.
C	DEFAULT FILESPEC FOR DRUM CARD FILE IS DRUM.PRG
C
	INCLUDE 'KPSCM.COM/NOLIST'
C
	DIMENSION FBUFR(1280), DRUMID(3)
	DIMENSION NTMPLN(2), IHDR(5)
C
C	EQUIVALENCE BTMPID TO THE PRIMARY SCRATCH FILE SO THAT BTMPID(3)
C	IS THE NUMBER OF BUFFERS IN USER FOR TMPID(1,1). THIS WILL BE SET
C	TO MXTMPB FOR THE COPY TO THE SCRATCH FILE AND THEN SET BACK TO
C	NTMPB WHEN THE COPY IS FINISHED. CARE MUST BE TAKEN WHEN MODIFYING
C	THE ID BLOCK IN THIS CASE.
C
	DIMENSION BTMPID(12), ITMPID(6)
	EQUIVALENCE (TMPID(1,1),BTMPID, ITMPID)
C
C	DEFINE # BUFFERS TOTAL FOR TEMP FILES AND # BUFFERS AVAILABLE FOR
C	READING THE INPUT FILE.
C
	PARAMETER MXTMPB=10
	PARAMETER MXFBUF=10
C
C
	DATA NTMPLN/1,2/, IHDR/5*0/
C
C	GET COMMAND LINE, STRIP BLANKS
C
	NTMPB = MXTMPB
	BCRLF(1) = 13
	BCRLF(2) = 10
	ISTCH = 4
	CALL GETMCR (ITEMP,IDSW)
D	TYPE *,IDSW
D	TYPE 2000,(BTEMP(I),I=1,IDSW)
D2000	FORMAT (' ',80A1)
 50	CONTINUE
	CALL UCASE (BTEMP, 80)			! SHIFT TO UPPER CASE
	BTEMP(80) = BCRLF(1)		! CR BYTE FOR IBLUF TERMINATION
 	CALL STBLK (BTEMP, BTEMP, 80)
	ICR = IBLUF (BCRLF(1), BTEMP)
	IF (ICR .GT. ISTCH) GO TO 100
C
C	IF CR IS FOURTH CHAR IN STRING, NO FILE SPEC PROVIDED, ASK FOR IT.
C
	WRITE (5, 510)
 510	FORMAT (' KPS> '$)
	READ (5, 520, END=980, ERR=980) BTEMP
 520	FORMAT (80A1)
	ISTCH = 1
	GO TO 50
C
C	CHECK FOR EXISTENCE OF DRUM CARD SPEC
C
 100	CONTINUE
	ISL = IBLUF ('/', BTEMP)	! SWITCH?
	IF (ISL .EQ. ISTCH) GO TO 900	! NO INPUT FILE, EXIT.
	IF (ISL .LE. 0) GO TO 150
C
C	SWITCH FOUND, CHECK FOR /DC=
C
	IF (BTEMP(ISL+1) .NE. 'D') GO TO 910
	IF (BTEMP(ISL+2) .NE. 'C') GO TO 910
	IF (BTEMP(ISL+3) .NE. '=') GO TO 910
	BTEMP(ISL) = ' '		! TERMINATOR FOR X1LU FILE PARSE.
	ISL = ISL + 4			! POINT TO DRUM CARD FILESPEC
C
C	OPEN INPUT FILE AND CREATE KPS.TMP FILE
C
 150	CONTINUE
	BTEMP(ICR) = ' '		! TERMINATOR FOR X1LU PARSE.
C
C	TRY TO OPEN OLD FILE. IF NON-EX CREATE NEW
C		NOTE THAT X1LU (AJB'S FPARS STUFF) FILL'S THE FDB WITH
C	THE FILE-SPEC WHETHER OR NOT THE FILE IS SUCCESSFULY OPENED.
C	THE FDB IS USED UPON TERMINATION IN KPSEXT TO RE-CONSTRUCT THE
C	FILE NAME KPS WAS ENTERED WITH.  HENCE, THE LUN FOR THE INPUT
C	FILE (LUN=3) MUST NOT BE USED BEYOND THIS POINT OR RESULTS ARE
C	UNPREDICTABLE.
C
D	TYPE *,'ISL,ICR,ISTCH',ISL,ICR,ISTCH
	CALL X1LU (FIDIN, FBUFR, MXFBUF, 1, 1,
	1	3, 'O', BTEMP(ISTCH), -1, 'X.DAT', NER)
	LIMODE = NER .EQ. -26
D	TYPE *,'HERE'
	IF (NER.NE.0 .AND. .NOT.LIMODE) GO TO 920
C
C	OPEN PRIMARY SCRATCH FILE REGARDLESS OF EXISTENT EDIT FILE
C
C	FIND SIZE OF INPUT FILE AND CALL FDBSET TO INITIALIZE THE
C	PRIMARY TEMP FILE SIZE.
C
	CALL X1LRN (FIDIN, KNRLST)
	NBINIT = (KNRLST+KNRLST/5)/256 + 10
	CALL FDBSET (NTMPLN(1),,,,NBINIT)
	IF (.NOT.LIMODE) NTMPB = NTMPB/2
	CALL X1LU (TMPID(1,1), TMPBUF(1,1), MXTMPB, 1, 1,
	1	NTMPLN(1), 'N', 'KPS1.TMP', -1, '.TMP', NER)
	IF (NER .NE. 0) GO TO 930		! CAN'T OPEN SCRATCH FILE
C
C	CREATE HEADER RECORD AND SET UP POINTERS
C	NOTE THAT ONLY 5 WORDS ARE WRITTEN HERE TO THE SCRATCH FILE SO
C	THE BUFFER SIZE DOES NOT MATTER AS YET
C
	KT1 = 1
	CALL X1DW (TMPID(1,1), KT1, 5, IHDR)
	KPTR = 1
	KNEXT = KT1
C
C	CHECK TO OPEN SECONDARY SCRATCH FILE
C
	IF (LIMODE) GO TO 400
	CALL X1LU (TMPID(1,2), TMPBUF(1,NTMPB+1), NTMPB, 1, 1,
	1	NTMPLN(2), 'N', 'KPS2.TMP', -1, '.TMP', NER)
	IF (NER .NE. 0) GO TO 930
C
C	COPY INPUT FILE TO SCRATCH FILE
C	NOTE MODIFICATION OF BTMPID(3) (# OF BUFFERS TO MXTMPB) WHILE
C	THE TRANSFER FOR SOURCE FILE TO SCRATCH FILE TAKES PLACE
C
C
	KNR = 1
	LSTUP = .TRUE.			! SET IN START-UP MODE FOR KPSINS
 200	CONTINUE
	IF (KNR .GT. KNRLST) GO TO 250
	CALL X1DR (FIDIN, KNR, 1, ICP)
	IF (ICP .GT. 134) GO TO 935
	ICPOLD = ICP			! FOR DEBUG
	IF (ICP) 935, 240, 235
 235	CALL X1DR (FIDIN, KNR, (ICP+1)/2, IDUP)
 240	CONTINUE
	CALL KPSINS
	GO TO 200
C
C	COPY COMPLETE - CLEAR THE BUFFER AND RESTORE THE BUFFER COUNT
C
 250	CONTINUE
	LSTUP = .FALSE.			! NOT START-UP MODE FOR KPSINS
	KNEXT = -1			! SECONDARY FOR SCRATCH IF OLD FILE
 400	CONTINUE
C
C	FLUSH TEMP BUFFER INITIALLY SO THAT IF RECOVERY MEASURES ARE TAKEN
C	WE WON'T GET GARBAGE IN OUR POINTER AREAS.
C
	CALL X1CL (TMPID(1,1))
	BTMPID(3) = NTMPB
	ITMPID(4) = -NTMPB
	ITMPID(6) = 0
C
C
C..........................................................................
C	OPEN DRUM CARD FILE
C
	NPRG = 1
	CALL SFCHR (BPRG, 1, 80, ' ')
	IF (ISL .LE. 0) ISL = ICR		! DEFAULT FILESPEC = ' '
	CALL X1LU (DRUMID, FBUFR, 1, 1, 1,
	1	4, 'R', BTEMP(ISL), -1, 'DRUM.PRG', NER)
	IF (NER .EQ. -26) GO TO 450
	IF (NER .NE. 0) GO TO 925
C
C	CHECK PROGRAM CARDS FOR VALIDITY OR COMMENT
C
	KNR = 1
	CALL X1LRN (DRUMID, KNRLST)
 410	CONTINUE
	IF (KNR .GT. KNRLST) GO TO 440
	CALL X1DR (DRUMID, KNR, 1, NBYTES)
	IF (NBYTES .EQ. 0) GO TO 420
	CALL X1DR (DRUMID, KNR, (MIN0(NBYTES,80)+1)/2, MPRG(1,NPRG+1))
C
C	CHECK FOR COMMENT ';' IN COL 1
C
	IF (BPRG(1,NPRG+1) .NE. ';') GO TO 412
	NBYTES = 0			! FILL BPRG WITH BLANKS
	GO TO 420
C
 412	CONTINUE
	IF (NBYTES .GT. 80) GO TO 940
	DO 415 I=1, NBYTES
	IF (IBLUF(BPRG(I,NPRG+1),BPRGV) .LE. 0) GO TO 950
 415	CONTINUE
 420	CONTINUE
	CALL SFCHR (MPRG(1,NPRG+1), NBYTES+1, 80-NBYTES, ' ')
	NPRG = NPRG + 1
	IF (NPRG .GT. MXPRG) GO TO 960
	GO TO 410
C
 440	CONTINUE
	CALL X1EF (DRUMID)
C...........................................................................
C
C
 450	CONTINUE
C
	CALL SFCHR (BDUP, 1, 132, ' ')
	KPTR = 1			! SET TO TOF TO START
C
	GO TO 990
C
C	ERROR MESSAGES
C
 900	CONTINUE
	WRITE (5, 530)
 530	FORMAT (' ** ERROR ** KPSOP - INPUT FILE NOT SPECIFIED')
	GO TO 980
 910	CONTINUE
	WRITE (5, 540)
 540	FORMAT (' ** ERROR ** KPSOP - ILLEGAL SWITCH')
	GO TO 980
 920	CONTINUE
	WRITE (5, 550) NER
 550	FORMAT (' ** ERROR ** KPSOP - ERROR OPENING INPUT FILE, NER=', I5)
	GO TO 980
 925	CONTINUE
	WRITE (5, 555) NER
 555	FORMAT (' ** ERROR ** KPSOP - ERROR OPENING DRUM.PRG FILE, NER=',
	1	I5)
	GO TO 980
 930	CONTINUE
	WRITE (5, 560) NER
 560	FORMAT (' ** ERROR ** KPSOP - UNABLE TO OPEN SCRATCH FILE, NER=',
	1	I5)
	GO TO 980
 935	CONTINUE
	WRITE (5, 565)ICP, ICPOLD, KNR
 565	FORMAT (' ** ERROR ** KPSOP - INPUT FILE HAS ILLEGAL FORMAT',
	1	/' ICP,ICPOLD,KNR',3I7,' PREVIOUS RECORD FOLLOWS -')
	WRITE (5, 566) IDUP
 566	FORMAT (' ',70A2)
	GO TO 980
 940	CONTINUE
	WRITE (5, 570) NPRG
 570	FORMAT (' ** ERROR ** KPSOP - >80 COLUMNS ON DRUM CARD NO. ',I5)
	GO TO 980
 950	CONTINUE
	WRITE (5, 575) NPRG
 575	FORMAT (' ** ERROR ** KPSOP - ILLEGAL DRUM CONTROL CHARACTER, ',
	1	'DRUM CARD NO. ', I5)
	GO TO 980
 960	CONTINUE
	WRITE (5, 580) MXPRG
 580	FORMAT (' ** ERROR ** KPSOP - TOO MANY PROGRAM CARDS, LIMIT =',
	1	I5)
	GO TO 980
C
C	DELETE TEMP FILES AND CLOSE INPUT FILE ON ERROR
C
 980	CONTINUE
	CALL X1DE (TMPID(1,1), 1)
	CALL X1DE (TMPID(1,2), 2)
	CALL X1EF (FIDIN)
	CALL EXIT
C
 990	CONTINUE
C
D	TYPE *,'TYPE 1 TO PRINT DRUM AND EDIT FILES '
D	ACCEPT *,BQ
D	DO 9999 I=1,NPRG
D	TYPE 9991,(BPRG(J,I),J=1,80)
D9991	FORMAT (' ',80A1)
D9999	CONTINUE
D	IF (BQ .EQ. 0) GO TO 999
D	KPTR = 1
D	CALL KPSNEX (1, ISTAT)
D	TYPE *,ISTAT
D	IF (ISTAT .NE. 0) CALL EXIT
D1000	CONTINUE
D	CALL KPSFR
D	WRITE (5, 1010) (BDUP(I),I=1,ICP)
D1010	FORMAT (' ',132A1)
D	CALL KPSNEX (1, ISTAT)
D	IF (ISTAT .LT. 0) CALL EXIT
D	GO TO 1000
C
D999	CONTINUE
	RETURN
	END