PROGRAM EXAMPLE
C
C  This program is a demonstration of the use of the command line package.
C  It uses the following routines:
C	INICMD	- Set up defaults for command line parsing
C	GETCMD	- Read a command line from the terminal or a command file
C	RESCMD	- Reset command line input to top-level
C	CSIDEF	- Establish default fields for command line parsing
C	CSISW	- Establish command switch parsing table entry
C	CSISV	- Establish switch value parsing table entry
C	CSI1	- Pre-process and compress command line
C	CSI2	- Parse a file specification
C	CSIFIL	- Compress a file specification for printing
C
C  The program prompts with the string:  EXA>
C  and will accept input from the terminal or an indirect command file.
C  The default extension for an indirect command file is:  .EXA
C
C  Command lines are parsed as follows:
C
C   [brackets indicate optional fields and are not part of syntax]
C
C	EXA> [object][/SW1] [,list][/SW2] = input[/SW3] [,inp2] [,...]
C
C  Where:
C	object	- object file spec   (default ext:  .OBJ)
C	list	- listing file spec  (default name: same as object name)
C		                     (default ext:  .LST)
C	input	- input file spec    (default ext:  .FTN)
C	inp2	- subsequent input file specs  (default ext:  same as input ext)
C
C	/SW1	- object switches....any combination of:
C		/CD:xxx		Where xxx is a 3 letter ASCII string
C		/I4
C		/RO
C		/SN
C		/VA
C
C	/SW2	- listing switches....any combination of:
C		/DI
C		/ID
C		/LI  or  /LI:#  or  /LI:#:#  or  /LI:#:#:#
C				Where  #  is an OCTAL number  (or DECIMAL if
C				terminated with a period).  All specified
C				numbers are or'ed and printed as an OCTAL value.
C		/SP
C
C	/SW3	- input switches....only valid on first input file:
C		/DE
C		/EX
C		/LO
C
C  All switches except /CD and /LI may be negated (e.g.:  /-SP  or  /NOSP ).
C
C  Try compiling, taskbuilding, and running this program.  It is a useful
C  exercise to read through the code and try to understand how all the
C  parsing works.  The file  TST.EXA  is a sample command file which may be
C  read as input by entering the command:  @TST  or  @TST.EXA
C

C  Declare command input buffer, filespec parsing buffer
	LOGICAL*1	IBUF(82),OUTFIL(34)
C
C  Declare GETCMD flags
	INTEGER		LENGTH
	LOGICAL*1	IERR,FERR,RCTL
C
C  Declare INICMD parameters
	INTEGER		IEXT
C
C  Declare CSI1 flags
	INTEGER		NEWLEN,IEFLG,IESIZ
C
C  Declare CSISW switch tables
	INTEGER		OBJSW(21),LSTSW(21),INPSW(13)
C
C  Declare CSISV switch value tables
	INTEGER		CDSWV(3),LISWV(7)
C
C  Declare CSISV switch value destination buffers
	LOGICAL*1	CDVAL(3)
	INTEGER		LIVAL(3)
C
C  Declare CSI2 flags
	INTEGER		LSTAT,MASK1,MASK2
C
C  Declare CSIFIL flags
	INTEGER		NEWSIZ
C
C  Declare output buffer
	LOGICAL*1	OUTBUF(80)
C
C  Initialize default command file extension (RAD50)
	DATA IEXT  /3REXA/
C
C  Assign initial command input stream to terminal  (same as TKB  ASG=TI:4)
	CALL ASSIGN (4,'TI:',3)
C
C  Declare command lun, default command file extension, and default prompt
	CALL INICMD (4,IEXT)
C

C  Declare /CD:xxx switch value
	CALL CSISV (CDSWV,'A',CDVAL,3)		! 3 character ASCII value
C
C  Declare object file switch table
C  (/CD is "100000 so that it will be the last switch printed)
C
	CALL CSISW (OBJSW( 1),'CD',"100000,,CDSWV)	! /CD:xxx
	CALL CSISW (OBJSW( 5),'I4',"002,'-')	! /I4
	CALL CSISW (OBJSW( 9),'RO',"004,'-')	! /RO
	CALL CSISW (OBJSW(13),'SN',"010,'-')	! /SN
	CALL CSISW (OBJSW(17),'VA',"020,'-')	! /VA
C
C  Declare /LI:#:#:# switch value table
	CALL CSISV (LISWV(1),'O',LIVAL(1),3)	! /LI:#
	CALL CSISV (LISWV(3),'O',LIVAL(2),3)	! /LI:#:#
	CALL CSISV (LISWV(5),'O',LIVAL(3),3)	! /LI:#:#:#
C
C  Declare list file switch table
C  (/LI is "100000 so that it will be printed last)
C
	CALL CSISW (LSTSW( 1),'LI',"100000,,LISWV)	! /LI  or  /LI:#:#:#
	CALL CSISW (LSTSW( 5),'DI',"002,'-')	! /DI
	CALL CSISW (LSTSW( 9),'ID',"004,'-')	! /ID
	CALL CSISW (LSTSW(13),'SP',"010,'-')	! /SP
	CALL CSISW (LSTSW(17),'WR',"020,'-')	! /WR
C
C  Declare input file switch table
	CALL CSISW (INPSW(1),'DE',"02000,'-')	! /DE
	CALL CSISW (INPSW(5),'EX',"04000,'-')	! /EX
	CALL CSISW (INPSW(9),'LO',"10000,'-')	! /LO

C  Main command input loop  --  read the next command line
10	CALL GETCMD (IBUF,82,LENGTH,,,IERR,FERR,RCTL)	! Use default prompt
C
C  If top-level input is ^Z or EOF,  IERR = "366  --- exit program, if so
	IF (IERR .EQ. "366) GOTO 999
C
C  If IERR is not zero, GETCMD returned an error  (e.g., input line too long)
	IF (IERR .NE. 0) GOTO 500
C
C  Compress command and check for syntax errors
	CALL CSI1 (IBUF,LENGTH,NEWLEN,IEFLG,IESIZ)
C
C  If IEFLG > 0, CSI1 returned an error
	IF (IEFLG .GT. 0) GOTO 520
C
C  If NEWLEN = 0, blank line....get another
	IF (NEWLEN .EQ. 0) GOTO 10
C
C  If RCTL = 7, command came from TI:
C  If not, then command came from command file.....echo it on the terminal
	IF (RCTL .NE. 7) WRITE(5,20) (IBUF(I),I=1,NEWLEN)
20	FORMAT(1X,'...>',82A1)
C
C  Get ready to parse the object filespec -- establish default extension
C  and clear other defaults (possibly left over from last time through)
	CALL CSIDEF ('O',0,0,0,'OBJ')
	CDVAL(1) = ' '
	CDVAL(2) = ' '
	CDVAL(3) = ' '
C
C  Parse first output filespec
	CALL CSI2 ('O',OUTFIL,LSTAT,OBJSW,MASK1,MASK2)
C
C  If OUTFIL(1) is null (zero), CSI2 error  (probably bad switch or value)
	IF (OUTFIL(1) .EQ. 0) GOTO 560
C

C  If CS.NMF bit ("001) of LSTAT is set, filename was parsed
	NEWSIZ = 0			! Assume no output filespec
	IF ((LSTAT .AND. 1) .EQ. 0) GOTO 30
C
C  Although OPEN statement would accept OUTFIL as is, it looks nicer with
C  the spaces removed.  CSIFIL does this....compress the name into OUTBUF
	CALL CSIFIL (OUTFIL,OUTBUF,NEWSIZ)
30	NEWSIZ = NEWSIZ + 1		! Point to next free space in array
C
C  Call special subroutine (below) to copy the rest of the specified switches
C  into OUTBUF after the filespec  (/CD last)
	CALL PRTSW(OBJSW,"002,MASK1,MASK2,OUTBUF,NEWSIZ)
C
C If /CD:xxx specified, add the :xxx to OUTBUF
	IF ((MASK1 .AND. "100000) .EQ. 0) GOTO 35
	OUTBUF(NEWSIZ) = ':'
	OUTBUF(NEWSIZ+1) = CDVAL(1)
	OUTBUF(NEWSIZ+2) = CDVAL(2)
	OUTBUF(NEWSIZ+3) = CDVAL(3)
	NEWSIZ = NEWSIZ + 4
C
C  Write out the filespec  (depending on whether it was explicit)
35	NEWSIZ = NEWSIZ - 1			! Get accurate count
	IF ((LSTAT .AND. 1) .EQ. 0) GOTO 40	! Skip if no explicit name
	WRITE(5,37) (OUTBUF(I), I=1,NEWSIZ)
37	FORMAT('0','    Object Filespec:  ',80A1)
	GOTO 50
C
40	IF (NEWSIZ .NE. 0) WRITE(5,42) (OUTBUF(I), I=1,NEWSIZ)
	IF (NEWSIZ .EQ. 0) WRITE(5,42)
42	FORMAT('0','    Object Filespec: (*** NONE ***) ',56A1)
C

C  If CS.MOR ("020) bit not set in LSTAT, no comma in filename
50	NEWSIZ = 0				! Assume no list file
	IF ((LSTAT .AND. "020) .EQ. 0) GOTO 80
C
C  Set defaults for list file....device, ufd, filename default to obj filespec
C  and extension defaults to  .LST  --  version # defaults to ;0  (new version)
	CALL CSIDEF ('O',,,,'LST',0)
	LIVAL(1) = 0
	LIVAL(2) = 0
	LIVAL(3) = 0
C
C  Parse the list file specification
	CALL CSI2 ('O',OUTFIL,LSTAT,LSTSW,MASK1,MASK2)
C
C  Check for parsing error
	IF (OUTFIL(1) .EQ. 0) GOTO 580
C
C  Since there was a comma, the object filename would propagate to the
C  list file name by default.  Therefore, if there was an object file name,
C  then the first filename character will not be a space, indicating a valid
C  listing file spec, even if CS.NMF of LSTAT is clear!
	IF (OUTFIL(15) .EQ. ' ') GOTO 60	! Branch if no object or list
	LSTAT = LSTAT .OR. 1			! Got a name...set CS.NMF
C
C  Compress the name into OUTBUF
	CALL CSIFIL (OUTFIL,OUTBUF,NEWSIZ)
60	NEWSIZ = NEWSIZ + 1		! Point to next free space in array
C
C  Call special subroutine (below) to copy the rest of the specified switches
C  into OUTBUF after the filespec  (/LI last)
	CALL PRTSW(LSTSW,"002,MASK1,MASK2,OUTBUF,NEWSIZ)
C
C If /LI:#:#:# specified, add the :# (octal sum) to OUTBUF
	IF ((MASK1 .AND. "100000) .EQ. 0) GOTO 70
	I = LIVAL(1)
	I = I .OR. LIVAL(2)
	I = I .OR. LIVAL(3)
	ENCODE (7,65,OUTBUF(NEWSIZ)) I
65	FORMAT(':',O6)
	OUTBUF(NEWSIZ+7) = 0		! Set null terminator for CSIFIL
	CALL CSIFIL (OUTBUF(NEWSIZ+1),OUTBUF(NEWSIZ+1),I)	!Remove spaces
	NEWSIZ = NEWSIZ + I + 1
C
C  Write out the filespec  (depending on whether it was explicit)
70	NEWSIZ = NEWSIZ - 1			! Get accurate count
	IF ((LSTAT .AND. 1) .EQ. 0) GOTO 80	! Skip if no list filespec
	WRITE(5,75) (OUTBUF(I), I=1,NEWSIZ)
75	FORMAT(1X,'      List Filespec:  ',80A1)
	GOTO 90
C
80	IF (NEWSIZ .NE. 0) WRITE(5,85) (OUTBUF(I), I=1,NEWSIZ)
	IF (NEWSIZ .EQ. 0) WRITE(5,85)
85	FORMAT(1X,'      List Filespec: (*** NONE ***) ',56A1)
C
C  If CS.MOR ("020) bit set in LSTAT, more output files!
90	IF ((LSTAT .AND. "20) .EQ. 0) GOTO 95
	WRITE(5,92)
92	FORMAT(1X,'    Extra Filespecs: (** IGNORED **)')
95	WRITE(5,97)
97	FORMAT(1X)
C

C  Now decode input filespec(s)
C
C  If CS.EQU ("040) bit is clear, there was no equal sign
100	IF ((LSTAT .AND. "40) .EQ. 0) GOTO 540
C
C  Establish input file defaults  (none, except extension)
	CALL CSIDEF ('I',0,0,0,'FTN')
C
C  Get first input filespec, if any
	CALL CSI2 ('I',OUTFIL,LSTAT,INPSW,MASK1,MASK2)
C
C  If switch errors, OUTFIL(1) = 0
	IF (OUTFIL(1) .EQ. 0) GOTO 600
C
C  If CS.NMF clear, no input filespec at all
	IF ((LSTAT .AND. 1) .EQ. 0) GOTO 540
C
C Compress filespec, add switches and print it
	CALL CSIFIL (OUTFIL,OUTBUF,NEWSIZ)
	NEWSIZ = NEWSIZ + 1
	CALL PRTSW (INPSW,1,MASK1,MASK2,OUTBUF,NEWSIZ)
	J = 1					! Count the input files
	WRITE(5,110) J,(OUTBUF(I), I=1,NEWSIZ-1)
110	FORMAT(1X,'   Input Filespec',I2,':  ',80A1)
C
C  Now loop through all the rest of the input files in the command.
125	IF ((LSTAT .AND. "20) .EQ. 0) GOTO 200		!Skip if CS.MOR clear
	J = J + 1					! Keep count
C
C  Set up defaults (device, ufd, and ext propagate...filename does not)
	CALL CSIDEF ('I',,,0)
C
C  Parse another filespec  (no switches allowed)
	CALL CSI2 ('I',OUTFIL,LSTAT)
	IF (OUTFIL(1) .EQ. 0) GOTO 620
	IF ((LSTAT .AND. 1) .EQ. 0) GOTO 140		!Skip if no filespec
	CALL CSIFIL (OUTFIL,OUTBUF,NEWSIZ)		!Compress filespec
	WRITE(5,110) J,(OUTBUF(I), I=1,NEWSIZ)		!Write it out
	GOTO 125					!And loop for next one
C
C  Skip to 140 if blank input filespec
140	WRITE(5,145) J
	GOTO 125
145	FORMAT(1X,'   Input Filespec',I2,': (*** NONE ***)')
C
C  Skip to 200 when there are no more commas in input side
200	WRITE(5,205)
205	FORMAT(1X)
C
C  Now go back and get the next command
	GOTO 10
C

C  Error handling routines:
C
C  GETCMD error
500	WRITE(5,505) IERR,FERR,RCTL
505	FORMAT(1X,'*** GETCMD Error -- ',
     1	'IERR =',I4,'   FERR =',I4,'   RCTL =',O4)
	GOTO 800
C
C  CSI1 error -- NEWLEN = 0  if line is not fully compressed
520	WRITE (5,522)
522	FORMAT(1X,'*** CSI1 Syntax Error')
	IF (NEWLEN .EQ. 0) GOTO 800
C
C  CSI1 error -- write out compressed command line
525	WRITE(5,527) (IBUF(I), I=1,NEWLEN)
527	FORMAT(1X,'*** ',82A1)
	JJ = IEFLG + IESIZ		! Calculate offset to end of error
	DO 530  I=1,JJ
530		IBUF(I) = ' '		! Clear out buffer for printing
	IBUF(IEFLG+1) = '^'		! Put a marker at the start of error
	IBUF(JJ-1) = '^'		! and at the end of the error
	WRITE(5,527) (IBUF(I), I=1,JJ)	! Print markers showing error
	GOTO 800
C
C  No equal sign in command
540	WRITE(5,545)
545	FORMAT(1X,'*** Missing input file(s)')
	GOTO 800
C
C  Object file parsing error
560	WRITE(5,565)
565	FORMAT(1X,'*** Error in object file switch(es) (CSI2)')
	GOTO 800
C
C  List file parsing error
580	WRITE(5,585)
585	FORMAT('0','*** Error in listing file switch(es) (CSI2)')
	GOTO 800
C
C  Switch error in first input file parse (CSI2)
600	WRITE(5,605)
605	FORMAT(1X,'*** Error in input file switch(es) (CSI2)')
	GOTO 800
C
C  Error in subsequent input files (CSI2)...probably because switch specified
620	WRITE(5,625) J
625	FORMAT('0','*** Error in input file',I2,' -- no switches allowed')
	GOTO 800
C
C
C  Error in command line....reset command input to top-level (start-up)
800	CALL RESCMD
	GOTO 10		!Get next command line
C
C
999	CALL EXIT
	END

	SUBROUTINE PRTSW(SWTBL,START,MASK1,MASK2,OUTBUF,OUTPTR)
C
C  SUBROUTINE TO PRINT SWITCH VALUES FROM SWTBL ACCORDING TO MASKS FROM CSI2
C
C  ONLY BITS GREATER THAN OR EQUAL TO (START) ARE CHECKED
C
	INTEGER		SWTBL(5)	! AT LEAST 5 LONG...MAYBE LONGER
	INTEGER		START,MASK1,MASK2,OUTPTR
	LOGICAL*1	OUTBUF(82)
C
	INTEGER		INT
	LOGICAL*1	CHR(2)
	EQUIVALENCE	(INT,CHR(1))
C
	I = START
10	IF (I .EQ. 0) RETURN
	IF ((MASK1 .AND. I) .EQ. 0) GOTO 50	!THIS MASK BIT NOT SET
C
C  This mask bit is set....look in SWTBL for corresponding entry(s)
	J = 1
15	IF (SWTBL(J) .EQ. 0) GOTO 50		!END OF SWITCH TABLE
	IF ((SWTBL(J+1) .AND. I) .EQ. 0)GOTO 30	!THIS SWITCH ISN'T IT
C
C  This switch is specified....put in /[-]SW
	OUTBUF(OUTPTR) = '/'
	IF ((MASK2 .AND. I) .NE. 0) GOTO 20	!THIS IS IT...NOT NEGATED
	OUTPTR = OUTPTR + 1
	OUTBUF(OUTPTR) = '-'			! SHOW NEGATION
C
20	INT = SWTBL(J)				! GET SWITCH CHARS
	OUTBUF(OUTPTR+1) = CHR(1)		! MOVE FIRST ONE
	OUTBUF(OUTPTR+2) = CHR(2)		! AND SECOND ONE
	OUTPTR = OUTPTR + 3			! AND UPDATE PTR
C
30	J = J + 4
	GOTO 15					!TRY NEXT SWITCH
C
50	I = ISHFT(I,1)				!SHIFT LEFT ONCE
	GOTO 10					!AND TRY THIS
	END