Google
 

Trailing-Edge - PDP-10 Archives - LCG_Integration_Tools_Clearinghouse_T20_v7_30Apr86 - tools/compil/compil.for
There are 4 other files named compil.for in the archive. Click here to see a list.
C This is the COMPIL program, the program that does the functions of the
C DEC-10 COMPIL program, providing the user with the concise command
C language interface to the compilers and linker.

C Edit History:  Version 1(11)
C   1	 5-Apr-1983	Initial version
C   2	12-May-1983	When deleting the temp file, include a /NOCONFIRM
C			switch in case the user has DELETE defined as
C			DELETE/CONFIRM
C   3	19-May-1983	Add the capability to process MESSAGE files
C   4	29-Jun-1983	Define the SVC symbol as global in case COMPIL is run
C			from a command procedure
C   5	21-Jul-1983	Correct some problems with edit 3
C   6	21-Jul-1983	Pass correct file spec to link when recompiling is
C			not done, so path to file is passed on
C   7	21-Jul-1983	Allow 'TLB', 'MLB' and 'OLB' as valid library file types
C   8	22-Jul-1983	Add capability of having values for qualifiers; also add
C			the /LINK and /EXECUTE qualifiers
C   9	20-Oct-1983	If an /EXECUTE qualifier is specified on an execute
C			command, the right filename was not being given to
C			the RUN command
C  10	25-Jul-1984	Don't output the /CROSS_REFERENCE qualifier to Bliss;
C			it doesn't understand it.
C  11	 6-Aug-1984	Break up long commands to Link into multiple lines

	IMPLICIT NONE
	INCLUDE '($LIBCLIDEF)'

	INTEGER*4 GLOBAL_FLAGS		!Store the global flags here
	INTEGER*4 MAX_FILES
	PARAMETER (MAX_FILES=64)	!Define the maximum number of files
	CHARACTER*127 FILE_SPEC(MAX_FILES) !Store the entire filespecs here
	CHARACTER*9 FILE_NAME(MAX_FILES) !Store just the file name here
	CHARACTER*9 EXNAME		!Name of file to execute
	CHARACTER*4 EXTENSION		!Extension of the file being processed
	INTEGER*4 LOCAL_FLAGS(MAX_FILES) !Local flags go here
	INTEGER*4 FILE_POINTER		!Pointer to the current file being processed
	INTEGER*4 NUMBER_FILES		!Total number of files found
	INTEGER*4 FILE_TYPE		!Store type of compiler needed here
	INTEGER*4 RET_STATUS		!Store status of subroutine calls here
	LOGICAL*1 STAT			!Status of field scanner goes here
	LOGICAL*1 RECOMP		!Flag that the file needs to be compiled
	LOGICAL*1 TEST_SWITCH
	LOGICAL*1 GET_FIELD
	LOGICAL*1 GET_VALUE
	LOGICAL*1 VALUE_REQUIRED(13)	!True if value required on qualifier
	CHARACTER*128 QUAL_VALUE(13)	!Value of qualifier specified
	LOGICAL*1 NEW_COMMAND		!True if need to save command string
	INTEGER*4 SWITCH
	INTEGER*4 I, J, LIB$EXTZV, SCAN_FILE

	INTEGER*4 CMD_LENGTH
	CHARACTER*256 CMD_LINE
	INTEGER*4 LIB$GET_FOREIGN, LIB$LOOKUP_KEY, LIB$SET_SYMBOL
	INTEGER*4 LIB$GET_SYMBOL, STR$TRIM

	EXTERNAL CMD_TABLE, SWITCH_TABLE

C Define the error message codes
	EXTERNAL CML_NOPRVCMD,CML_CNFQUAL,CML_INVQUAL,CML_INVSNTX
	EXTERNAL CML_MISFILSPC,CML_FNF,CML_INVCMD,CML_MISQUAL
	EXTERNAL CML_FILTBLOVF,CML_INTERR,CML_BADFILTYP
	EXTERNAL CML_NOVALU,CML_VALREQ

	INTEGER*4 COMP_FLAG, LIST_FLAG, CROSS_FLAG, DEB_FLAG
	INTEGER*4 NOCOMP_FLAG, NOLIST_FLAG, NOCROSS_FLAG, NODEB_FLAG
	INTEGER*4 RECOMP_FLAG, CONCAT_FLAG, LIBR_FLAG, LINK_FLAG
	INTEGER*4 EXE_FLAG

	PARAMETER (COMP_FLAG=32,LIST_FLAG=33,CROSS_FLAG=34)
	PARAMETER (DEB_FLAG=35,NOCOMP_FLAG=36,NOLIST_FLAG=37)
	PARAMETER (NOCROSS_FLAG=38,NODEB_FLAG=39,RECOMP_FLAG=40)
	PARAMETER (CONCAT_FLAG=41,LIBR_FLAG=42,LINK_FLAG=43)
	PARAMETER (EXE_FLAG=44)

	INTEGER BUFF_SIZE		!Size of the input command string
	PARAMETER (BUFF_SIZE = 255)

	CHARACTER*4 EXT_TABLE(10)	!Table of known file types
	DATA EXT_TABLE/'.FOR','.MAR','.BAS','.BLI','.PAS','.PLI','.MSG',
	1  '.TLB','.MLB','.OLB'/

	CHARACTER*7 COMMAND_TABLE(10), CMD
	DATA COMMAND_TABLE/'Fortran','Macro','Basic','Bliss','Pascal',
	1  'PLI','Message','TLB','MLB','OLB'/

	CHARACTER*255 FIELD
	CHARACTER*1 TERMINATOR
	CHARACTER*(BUFF_SIZE) BUFFER
	INTEGER*2 OFFSET, SIZE, COMMAND

	DATA VALUE_REQUIRED/.FALSE.,	!Compile
	1		    .FALSE.,	!List
	2		    .FALSE.,	!Cross
	3		    .FALSE.,	!Debug
	4		    .FALSE.,	!Nocompile
	5		    .FALSE.,	!Nolist
	6		    .FALSE.,	!Nocross
	7		    .FALSE.,	!Nodebug
	8		    .FALSE.,	!Recomp-flag
	9		    .FALSE.,	!Concat-flag
	1		    .FALSE.,	!Library
	2		    .TRUE., 	!Link
	3		    .TRUE./ 	!Execute

	COMMON /BUFF/ OFFSET, BUFFER	!Store the command line here

	FILE_POINTER = 1		!Initialize the file spec pointer
	FILE_SPEC(FILE_POINTER) = ' '	!Preset first file spec to spaces
	NEW_COMMAND = .TRUE.		!Assume this is a new command string

C Get the input command line
	OFFSET = 1			!Init the pointer to the buffer
	RET_STATUS = LIB$GET_FOREIGN(BUFFER)
	IF (.NOT. RET_STATUS) GOTO 10

C Decode the command
	STAT = GET_FIELD(FIELD, SIZE, TERMINATOR)
	IF (FIELD .EQ. ' ') THEN
10	   RET_STATUS = LIB$GET_SYMBOL('SVC',BUFFER,,)
	   IF (.NOT. RET_STATUS) CALL LIB$SIGNAL(CML_NOPRVCMD)
	   NEW_COMMAND = .FALSE.
	   OFFSET = 1
	   STAT = GET_FIELD(FIELD,SIZE,TERMINATOR)
	ENDIF
	RET_STATUS = LIB$LOOKUP_KEY(FIELD(1:SIZE), CMD_TABLE, COMMAND)
	IF (.NOT. RET_STATUS) CALL LIB$SIGNAL(CML_INVCMD,%VAL(1),
	1  FIELD(1:SIZE))	!Invalid command
	IF (.NOT. STAT) THEN	!If no files specified, get from the old symbol
C Come here if only the keyword is specified in the command string.  COMMAND
C has been decoded to tell us what to do.  See if the symbol SVC has been
C defined
	   RET_STATUS = LIB$GET_SYMBOL('SVC',BUFFER,,)
	   IF (.NOT. RET_STATUS) CALL LIB$SIGNAL(CML_NOPRVCMD)
	   NEW_COMMAND = .FALSE.	!Don't save the command
	   OFFSET = 1		!Start the buffer over again
	   STAT = GET_FIELD(FIELD,SIZE,TERMINATOR) !Discard the old command name
	ENDIF
	IF (TERMINATOR .NE. '/') GOTO 150	!Check for global switch
100	IF (.NOT. STAT) GOTO 999	!Check for out of buffer
	STAT = GET_FIELD(FIELD, SIZE, TERMINATOR) !Get switch name
	IF (SIZE .EQ. 0) CALL LIB$SIGNAL(CML_MISQUAL)!No qualifier found
	RET_STATUS = LIB$LOOKUP_KEY(FIELD(1:SIZE),SWITCH_TABLE,SWITCH)
	IF (.NOT. RET_STATUS) CALL LIB$SIGNAL(CML_INVQUAL,%VAL(1),
	1  FIELD(1:SIZE))!Switch not found
	CALL SET_SWITCH(SWITCH, GLOBAL_FLAGS)
	IF (TERMINATOR .NE. '=') THEN		!Does this qualifier have a value?
	   IF (VALUE_REQUIRED(SWITCH-31))	!No - is a value required?
	1     CALL LIB$SIGNAL(CML_VALREQ,%VAL(1),FIELD(1:SIZE)) !Yes - error
	ELSE
	   IF (.NOT. VALUE_REQUIRED(SWITCH-31))	!Yes - is a value illegal?
	1     CALL LIB$SIGNAL(CML_NOVALU,%VAL(1),FIELD(1:SIZE))	!Yes - error
	   STAT = GET_VALUE(QUAL_VALUE(SWITCH-31),SIZE,TERMINATOR)!Get the value
	   IF (SIZE .EQ. 0) CALL LIB$SIGNAL(CML_VALREQ,%VAL(1),FIELD(1:SIZE))
	ENDIF

	IF (TERMINATOR .EQ. '/') GOTO 100 !Scan more global switches
	LOCAL_FLAGS(FILE_POINTER) = 0
C Check for conflicting global flags
120	IF (TEST_SWITCH(NOCOMP_FLAG,GLOBAL_FLAGS) .AND.
	1  TEST_SWITCH(COMP_FLAG,GLOBAL_FLAGS))
	2  CALL LIB$SIGNAL(CML_CNFQUAL)

150	IF (.NOT. STAT) GOTO 250
	IF (TERMINATOR .EQ. ',') GOTO 250
	IF (TERMINATOR .EQ. ' ') GOTO 300
	IF (TERMINATOR .EQ. '+') GOTO 200
	IF (TERMINATOR .NE. '/') CALL LIB$SIGNAL(CML_INVSNTX) !Invalid syntax
	STAT = GET_FIELD(FIELD, SIZE, TERMINATOR)
	IF (SIZE .EQ. 0) CALL LIB$SIGNAL(CML_MISQUAL)	!Error - no switch found
	RET_STATUS = LIB$LOOKUP_KEY(FIELD(1:SIZE),SWITCH_TABLE,SWITCH)
	IF (.NOT. RET_STATUS) CALL LIB$SIGNAL(CML_INVQUAL,%VAL(1),
	1  FIELD(1:SIZE))
	CALL SET_SWITCH(SWITCH,LOCAL_FLAGS(FILE_POINTER))
	IF (TERMINATOR .NE. '=') THEN		!Does this qualifier have a value?
	   IF (VALUE_REQUIRED(SWITCH-31))	!No - is a value required?
	1     CALL LIB$SIGNAL(CML_VALREQ,%VAL(1),FIELD(1:SIZE)) !Yes - error
	ELSE
	   IF (.NOT. VALUE_REQUIRED(SWITCH-31))	!Yes - is a value illegal?
	1     CALL LIB$SIGNAL(CML_NOVALU,%VAL(1),FIELD(1:SIZE))	!Yes - error
	   STAT = GET_VALUE(QUAL_VALUE(SWITCH-31),SIZE,TERMINATOR)!Get the value
	   IF (SIZE .EQ. 0) CALL LIB$SIGNAL(CML_VALREQ,%VAL(1),FIELD(1:SIZE))
	ENDIF
	GOTO 150			!Go process the next part

200	CALL SET_SWITCH(CONCAT_FLAG,LOCAL_FLAGS(FILE_POINTER))!Set concat flag
250	IF (FILE_SPEC(FILE_POINTER) .EQ. ' ')
	1  CALL LIB$SIGNAL(CML_MISFILSPC)
	IF (LIB$EXTZV(0,5,LOCAL_FLAGS(FILE_POINTER)) .EQ. 0) THEN
	   IF (LIB$EXTZV(0,5,GLOBAL_FLAGS) .EQ. 0) THEN
	      FILE_TYPE = 0
	      DO I=1,10
		 IF (EXTENSION .EQ. EXT_TABLE(I)) FILE_TYPE = I
	      ENDDO
	   ELSE
	      FILE_TYPE = LIB$EXTZV(0,5,GLOBAL_FLAGS)
	   ENDIF
	   IF (FILE_TYPE .EQ. 0) FILE_TYPE = 1 !Default to Fortran
	   CALL SET_SWITCH(FILE_TYPE,LOCAL_FLAGS(FILE_POINTER))
	ENDIF
C Check for conflicting local flags
	IF (TEST_SWITCH(NOCOMP_FLAG,LOCAL_FLAGS(FILE_POINTER)) .AND.
	1  TEST_SWITCH(COMP_FLAG,LOCAL_FLAGS(FILE_POINTER)))
	2  CALL LIB$SIGNAL(CML_CNFQUAL)

C Set or clear the recomp flag depending on the local and global comp flags
	IF (TEST_SWITCH(COMP_FLAG,LOCAL_FLAGS(FILE_POINTER)) .OR.
	1  (.NOT. (TEST_SWITCH(COMP_FLAG,LOCAL_FLAGS(FILE_POINTER))
	2  .OR. TEST_SWITCH(NOCOMP_FLAG,LOCAL_FLAGS(FILE_POINTER)))
	3  .AND. TEST_SWITCH(COMP_FLAG,GLOBAL_FLAGS))) THEN
	   CALL SET_SWITCH(RECOMP_FLAG,LOCAL_FLAGS(FILE_POINTER))
	ELSE IF (TEST_SWITCH(NOCOMP_FLAG,LOCAL_FLAGS(FILE_POINTER))
	1  .OR. (.NOT. (TEST_SWITCH(NOCOMP_FLAG,LOCAL_FLAGS(
	2  FILE_POINTER)) .OR. TEST_SWITCH(COMP_FLAG,LOCAL_FLAGS(
	3  FILE_POINTER))) .AND. TEST_SWITCH(NOCOMP_FLAG,GLOBAL_FLAGS)))
	4  THEN
	   CALL CLEAR_SWITCH(RECOMP_FLAG,LOCAL_FLAGS(FILE_POINTER))
	ENDIF
C Don't allow recompile if this is a library file
	IF (TEST_SWITCH(LIBR_FLAG,LOCAL_FLAGS(FILE_POINTER))) THEN
	   CALL CLEAR_SWITCH(RECOMP_FLAG,LOCAL_FLAGS(FILE_POINTER))
	ELSE
C Don't allow library extensions without the library switch
	   IF (FILE_TYPE .EQ. 8 .OR. FILE_TYPE .EQ. 9)
	1     CALL LIB$SIGNAL(CML_BADFILTYP,%VAL(1),EXTENSION)
	ENDIF
	IF (.NOT. STAT) GOTO 999
	FILE_POINTER = FILE_POINTER + 1	!Step to the next slot
	IF (FILE_POINTER .GT. MAX_FILES) CALL LIB$SIGNAL(CML_FILTBLOVF)
	FILE_SPEC(FILE_POINTER) = ' '
	LOCAL_FLAGS(FILE_POINTER) = 0

300	IF (.NOT. STAT) GOTO 999
	STAT = GET_FIELD(FIELD, SIZE, TERMINATOR)
	IF (SIZE .EQ. 0) GOTO 150
	FILE_SPEC(FILE_POINTER) = FIELD
	RET_STATUS = SCAN_FILE(FIELD,EXTENSION,FILE_NAME(FILE_POINTER),
	1  RECOMP)	!Check the file
	IF (.NOT. RET_STATUS)THEN	! If file was not found, issue error message
	   RET_STATUS = STR$TRIM(FIELD,FILE_SPEC(FILE_POINTER),I)
	   CALL LIB$SIGNAL(CML_FNF,%VAL(1),FIELD(1:I))
	ENDIF
	IF (RECOMP) CALL SET_SWITCH(RECOMP_FLAG,LOCAL_FLAGS(FILE_POINTER))
	GOTO 150

999	NUMBER_FILES = FILE_POINTER	!Save the number of files found
	FILE_POINTER = 1		!Reset the file pointer

C Now step through the list of files and set all concatenated files
C to use the same processor and show the same name on output, namely
C the name of the last file in the concatenated list
1000	IF (TEST_SWITCH(CONCAT_FLAG,LOCAL_FLAGS(FILE_POINTER))) THEN
	   I = FILE_POINTER + 1
	   DO WHILE (I .LE. NUMBER_FILES .AND. TEST_SWITCH(
	1     CONCAT_FLAG,LOCAL_FLAGS(I)))
	      I = I + 1
	   ENDDO
   	   IF (I .GT. NUMBER_FILES) CALL LIB$SIGNAL(CML_INVSNTX) !No nonconcatenated files found
	   CALL LIB$INSV(0,0,5,LOCAL_FLAGS(FILE_POINTER))
	   CALL SET_SWITCH(LIB$EXTZV(0,5,LOCAL_FLAGS(I)),
	1     LOCAL_FLAGS(FILE_POINTER))
	   FILE_NAME(FILE_POINTER) = FILE_NAME(I)
	   CALL CLEAR_SWITCH(RECOMP_FLAG,LOCAL_FLAGS(FILE_POINTER))
	   IF (TEST_SWITCH(RECOMP_FLAG,LOCAL_FLAGS(I)))
	1     CALL SET_SWITCH(RECOMP_FLAG,LOCAL_FLAGS(FILE_POINTER))
	ENDIF
	FILE_POINTER = FILE_POINTER + 1
	IF (FILE_POINTER .LE. NUMBER_FILES) GOTO 1000

C Now transfer the local /LINK and /EXECUTE qualifiers to global qualifiers
	DO I=1,NUMBER_FILES
	   IF (TEST_SWITCH(LINK_FLAG,LOCAL_FLAGS(I))) THEN
	      IF (TEST_SWITCH(LINK_FLAG,GLOBAL_FLAGS))
	1	 CALL LIB$SIGNAL(CML_CNFQUAL)
	      CALL SET_SWITCH(LINK_FLAG,GLOBAL_FLAGS)
	   ENDIF
	   IF (TEST_SWITCH(EXE_FLAG,LOCAL_FLAGS(I))) THEN
	      IF (TEST_SWITCH(EXE_FLAG,GLOBAL_FLAGS))
	1	 CALL LIB$SIGNAL(CML_CNFQUAL)
	      CALL SET_SWITCH(EXE_FLAG,GLOBAL_FLAGS)
	   ENDIF
	END DO

C Now generate the command file
C	OPEN(UNIT=1,NAME='SYS$OUTPUT:',STATUS='NEW',
C	1 CARRIAGECONTROL='LIST')
	OPEN(UNIT=1,NAME='COMPTMP.COM',STATUS='NEW',
	1 CARRIAGECONTROL='LIST')
	WRITE(1,1090)
1090	FORMAT('$ DELETE/NOLOG/NOCONFIRM COMPTMP.COM.')

	FILE_POINTER = 1		!Start at the beginning

C First compile all necessary modules
1100	IF (.NOT. TEST_SWITCH(RECOMP_FLAG,LOCAL_FLAGS(FILE_POINTER)))
	1  GOTO 1999		!Should this be recompiled?  No
	CMD = COMMAND_TABLE(LIB$EXTZV(0,5,LOCAL_FLAGS(
	1  FILE_POINTER)))
	I = INDEX(CMD,' ')
	IF (I .EQ. 0) I = 8
	CMD_LINE = '$ '//CMD	!Put the command in the command line
	CMD_LENGTH = I + 2	!Set the length of the command line

C Output /LIST if needed
	IF (TEST_SWITCH(LIST_FLAG,LOCAL_FLAGS(FILE_POINTER)) .OR.
	1  (.NOT. TEST_SWITCH(NOLIST_FLAG,LOCAL_FLAGS(FILE_POINTER))
	1  .AND. TEST_SWITCH(LIST_FLAG,GLOBAL_FLAGS))) THEN
	   CMD_LINE(CMD_LENGTH+1:CMD_LENGTH+6) = '/LIST'
	   CMD_LENGTH = CMD_LENGTH + 5
	ENDIF

C Output /CROSS if needed
	IF (CMD .NE. 'Message' .AND. CMD .NE. 'Bliss') THEN
	   IF (TEST_SWITCH(CROSS_FLAG,LOCAL_FLAGS(FILE_POINTER)) .OR.
	1     (.NOT. TEST_SWITCH(NOCROSS_FLAG,LOCAL_FLAGS(FILE_POINTER))
	1     .AND. TEST_SWITCH(CROSS_FLAG,GLOBAL_FLAGS))) THEN
	      CMD_LINE(CMD_LENGTH+1:CMD_LENGTH+7) = '/CROSS'
	      CMD_LENGTH = CMD_LENGTH + 6
	   ENDIF
	ENDIF
C Output /DEBUG switch if needed
	IF (CMD .NE. 'Message') THEN
	   IF (TEST_SWITCH(DEB_FLAG,LOCAL_FLAGS(FILE_POINTER)) .OR.
	1     (.NOT. TEST_SWITCH(NODEB_FLAG,LOCAL_FLAGS(FILE_POINTER))
	1     .AND. TEST_SWITCH(DEB_FLAG,GLOBAL_FLAGS))) THEN
	      IF (CMD .EQ. 'Macro') THEN
	         CMD_LINE(CMD_LENGTH+1:CMD_LENGTH+14) = '/ENABLE=DEBUG'
	         CMD_LENGTH = CMD_LENGTH + 13
	      ELSE
	         CMD_LINE(CMD_LENGTH+1:CMD_LENGTH+7) = '/DEBUG'
	         CMD_LENGTH = CMD_LENGTH + 6
	      ENDIF
	   ENDIF
	ENDIF

C Output the object file name here
	J = INDEX(FILE_NAME(FILE_POINTER),' ')
	IF (J .EQ. 0) J = 10
	CMD_LINE(CMD_LENGTH+1:CMD_LENGTH+J+9) =	'/OBJECT='//
	1  FILE_NAME(FILE_POINTER)(1:J-1)
	CMD_LENGTH = CMD_LENGTH + J + 8

1200	J = INDEX(FILE_SPEC(FILE_POINTER),' ')
	CMD_LINE(CMD_LENGTH+1:CMD_LENGTH+J+1) =
	1  FILE_SPEC(FILE_POINTER)(1:J-1)
	CMD_LENGTH = CMD_LENGTH + J - 1
C Output the /LIBRARY switch if needed
	IF (TEST_SWITCH(LIBR_FLAG,LOCAL_FLAGS(FILE_POINTER))) THEN
	   CMD_LINE(CMD_LENGTH+1:CMD_LENGTH+8) = '/LIBRARY'
	   CMD_LENGTH = CMD_LENGTH + 8
	ENDIF
	IF (TEST_SWITCH(CONCAT_FLAG,LOCAL_FLAGS(FILE_POINTER))) THEN
	   CMD_LINE(CMD_LENGTH+1:CMD_LENGTH+1) = '+'
	   CMD_LENGTH = CMD_LENGTH + 1
	   FILE_POINTER = FILE_POINTER + 1
	   IF (FILE_POINTER .GT. NUMBER_FILES) CALL LIB$SIGNAL(CML_INTERR)
	   GOTO 1200		!Get the next concatenated file
	ENDIF

	WRITE(1,1110) CMD(1:I-1),FILE_NAME(FILE_POINTER)
1110	FORMAT('$ WRITE SYS$OUTPUT "',A<I-1>,':	',A9,'"')
	WRITE(1,1250) CMD_LINE(1:CMD_LENGTH)
1250	FORMAT(A<CMD_LENGTH>)

1999	FILE_POINTER = FILE_POINTER + 1
	IF (FILE_POINTER .LE. NUMBER_FILES) GOTO 1100

C Is the command 'COMPILE'?
	IF (COMMAND .EQ. 1) GOTO 9999	!Don't link if not requested

C Need to link the modules together
	WRITE (1,2000)
2000	FORMAT('$ WRITE SYS$OUTPUT "Link:	Loading"')

	FILE_POINTER = 1	!Start at the beginning
	CMD_LINE = '$ LINK '	!Start the command line
	CMD_LENGTH = 7
	EXNAME = ' '

	IF (COMMAND .EQ. 4) THEN	!If command was 'DEBUG'
	   CMD_LINE(7:13) = '/DEBUG '
	   CMD_LENGTH = 13
	ENDIF

C See if an executable qualifier was given
	IF (TEST_SWITCH(EXE_FLAG,GLOBAL_FLAGS)) THEN
	   RET_STATUS = STR$TRIM(QUAL_VALUE(EXE_FLAG-31),
	1     QUAL_VALUE(EXE_FLAG-31),I)	!Find length of the exe string
	   CMD_LINE(CMD_LENGTH:CMD_LENGTH+12) = '/EXECUTABLE='
	   CMD_LENGTH = CMD_LENGTH + 12
	   CMD_LINE(CMD_LENGTH:CMD_LENGTH+I) =
	1     QUAL_VALUE(EXE_FLAG-31)(1:I)
	   EXNAME = QUAL_VALUE(EXE_FLAG-31)(1:I)
	   CMD_LENGTH = CMD_LENGTH + I
	ENDIF

C Now see if the /LINK qualifier was given
	IF (TEST_SWITCH(LINK_FLAG,GLOBAL_FLAGS)) THEN
	   RET_STATUS = STR$TRIM(FIELD,QUAL_VALUE(LINK_FLAG-31),I)
	   IF (FIELD(1:1) .NE. '(' .OR. (FIELD(1:1) .EQ. '(' .AND.
	1     FIELD(2:2) .NE. '/')) THEN
	      CMD_LINE(CMD_LENGTH:CMD_LENGTH) = '/' !Output the leading slash
	      CMD_LENGTH = CMD_LENGTH + 1
	   ENDIF
	   J = 1
	   IF (FIELD(1:1) .EQ. '(') THEN
	      J = 2
	      I = I - 1
	   ENDIF
	   CMD_LINE(CMD_LENGTH:CMD_LENGTH + I) = FIELD(J:I)
	   CMD_LENGTH = CMD_LENGTH + I
	   IF (J .EQ. 2) CMD_LENGTH = CMD_LENGTH - 1
	ENDIF

2100	IF (.NOT. TEST_SWITCH(CONCAT_FLAG,LOCAL_FLAGS(FILE_POINTER)))
	1  THEN
	   IF (TEST_SWITCH(RECOMP_FLAG,LOCAL_FLAGS(FILE_POINTER))) THEN
	      FIELD = FILE_NAME(FILE_POINTER)
	   ELSE
	      FIELD = FILE_SPEC(FILE_POINTER)
	   ENDIF
	   J = INDEX(FIELD,' ')
	   IF (J .EQ. 0) J = 10
	   CMD_LINE(CMD_LENGTH+1:CMD_LENGTH+J+1) =
	1     FIELD(1:J-1)
	   CMD_LENGTH = CMD_LENGTH + J - 1

C	   If this is a library file, output the /LIBRARY switch to LINK
C	   If not, set the executable file name if necessary

	   IF (TEST_SWITCH(LIBR_FLAG,LOCAL_FLAGS(FILE_POINTER))) THEN
	      CMD_LINE(CMD_LENGTH+1:CMD_LENGTH+8) = '/LIBRARY'
	      CMD_LENGTH = CMD_LENGTH + 8
	   ELSE
	      IF (EXNAME .EQ. ' ') EXNAME = FILE_NAME(FILE_POINTER)
	   ENDIF

	   IF (FILE_POINTER .LT. NUMBER_FILES) THEN
	      CMD_LINE(CMD_LENGTH+1:CMD_LENGTH+1) = ','
	      CMD_LENGTH = CMD_LENGTH + 1
	      IF (CMD_LENGTH .GE. 70) THEN
		 CMD_LINE(CMD_LENGTH+1:CMD_LENGTH+1) = '-' !Request continuation
		 CMD_LENGTH = CMD_LENGTH + 1
		 WRITE(1,1250) CMD_LINE(1:CMD_LENGTH)	!Write the record
		 CMD_LINE = ' '			!Clear the command line
		 CMD_LENGTH = 0
	      ENDIF
	   ENDIF
	ENDIF
	FILE_POINTER = FILE_POINTER + 1	!Step to the next file
	IF (FILE_POINTER .LE. NUMBER_FILES) GOTO 2100
	WRITE(1,1250) CMD_LINE(1:CMD_LENGTH) !No more files; output the command

	J = INDEX(EXNAME,' ')
	IF (J .EQ. 0) J = 10

	IF (COMMAND .EQ. 3) WRITE(1,2200) EXNAME(1:J-1)
2200	FORMAT('$ WRITE SYS$OUTPUT "[',A<J-1>,' execution]"')
	IF (COMMAND .EQ. 4) WRITE(1,2210)
2210	FORMAT('$ WRITE SYS$OUTPUT "[DEBUG execution]"')

9999	IF (COMMAND .GE. 3) WRITE(1,10005)
10005	FORMAT('$ ASSIGN/USER TT: SYS$INPUT')
	IF (COMMAND .GE. 3) WRITE(1,10010) EXNAME(1:J-1)
10010	FORMAT('$ RUN ',A<J-1>)
	CLOSE(UNIT=1)
	RET_STATUS = STR$TRIM(FIELD,BUFFER,J)
	IF (NEW_COMMAND) STAT = LIB$SET_SYMBOL('SVC',FIELD(1:J),
	1  LIB$K_CLI_GLOBAL_SYM)
	CALL LIB$DO_COMMAND('@COMPTMP')
	CALL EXIT
	END
	SUBROUTINE SET_SWITCH(SWITCH,FLAGS)
	IMPLICIT NONE
	INTEGER*4 SWITCH, FLAGS
	INTEGER*4 LIB$EXTZV
	EXTERNAL CML_CNFQUAL

C This subroutine sets the appropriate bits in the flags word as
C determined by the value in SWITCH.  The values are determined in
C the keyword tables in GETFILE.MAR.

C First handle the language switches
	IF (SWITCH .LT. 32) THEN !See if more than one switch given,
	   IF (LIB$EXTZV(0,5,FLAGS) .NE. 0) CALL LIB$SIGNAL(CML_CNFQUAL)
	   CALL LIB$INSV(SWITCH,0,5,FLAGS) !and set the switch
	   RETURN
	ENDIF

C Now set bits needing to be set
	IF (SWITCH .LT. 64) THEN
	   CALL LIB$INSV(1,SWITCH-16,1,FLAGS)
	   RETURN
	ENDIF

C Now clear the bits needing to be cleared
	CALL LIB$INSV(0,SWITCH-48,1,FLAGS)
	RETURN

	ENTRY CLEAR_SWITCH(SWITCH,FLAGS)
	IF (SWITCH .GE. 32 .AND. SWITCH .LT. 64)
	1  CALL LIB$INSV(0,SWITCH-16,1,FLAGS)
	RETURN
	END
	LOGICAL*1 FUNCTION TEST_SWITCH(SWITCH,FLAGS)
	IMPLICIT NONE
	INTEGER*4 SWITCH, FLAGS, LIB$EXTZV

C This subroutine extracts a binary flag from the FLAGS longword.  The
C number of the flag is in argument SWITCH

	TEST_SWITCH = LIB$EXTZV(SWITCH-16,1,FLAGS)
	RETURN
	END