PROGRAM USE PARAMETER LINE_LEN=600 PARAMETER FILENAME_LEN=80 CHARACTER*(LINE_LEN) LINE CHARACTER*(FILENAME_LEN) FNAME CHARACTER*3 COMND CHARACTER*4 INPUT_TYPE,OUTPUT_TYPE D CHARACTER*25 ASCII_TIME LOGICAL COMMAND LOGICAL SKIPLINE INTEGER*4 IDATE(2),ODATE(2),SDATE(2) COMMON/USEL/LOUTS EXTERNAL RMS$_FNF DATA SKIPLINE/.FALSE./ C get file name CALL IFERR(LIB$GET_FOREIGN(FNAME,CHAR(13)//CHAR(10)// . 'Which file do you wish to use ? ',LF), . 'USE unable to read user input') LF = NBLANK(FNAME(1:LF)) C LF will be the logical end of string for us FNAME = FNAME(1:LF) C IEB is the location of a ] if present IEB = INDEX(FNAME,']') C IVR is the location of a possible version number IVR = INDEX(FNAME,';') C ITP is the location of a possible file type field ITP = INDEX(FNAME(IEB+1:),'.') + IEB C open use file if extant IF(ITP.NE.0)THEN OPEN(UNIT=1,NAME=FNAME(1:LF),TYPE='OLD',READONLY,ERR=5) ELSE OPEN(UNIT=1,NAME=FNAME(1:LF)//'.USE',TYPE='OLD', . READONLY,ERR=5) END IF GO TO 10 5 CONTINUE C Explicit USE file doesn't exist. IF(ITP.NE.0)THEN TYPE *,'No explicit USE file named '//FNAME(1:LF) ELSE TYPE *,'No explicit USE file named '//FNAME(1:LF)// . '.USE' END IF C Try for a logically named default USE file. OPEN(UNIT=1,NAME='USE_DEFAULT',TYPE='OLD',READONLY,ERR=6) C Found one. TYPE *,'Using default USE file' GOTO 10 6 CONTINUE TYPE *,'FATAL ERROR ** unable to find default USE file' CALL SYS$EXIT(RMS$_FNF) 10 CONTINUE C logically truncate file name to exclude version & type IF(IVR.NE.0)LF = IVR - 1 IF(ITP.NE.0)LF = ITP - 1 C open output file OPEN(UNIT=2,NAME='DF:'//FNAME(IEB+1:LF)//'.USF', . CARRIAGECONTROL='LIST') 15 CONTINUE LINE = ' ' L0 = 1 20 CONTINUE READ(1,102,END=80)LENGTH,LINE(L0:) 102 FORMAT(Q,A) C If this is first part of line, check whether COMMAND or not IF(L0.EQ.1)THEN L = INDEX(LINE(1:LENGTH),'$') COMMAND = L.GT.0 C COMMAND implies a $ possibly preceded by blanks IF(L.GT.1)COMMAND = LINE(1:L-1).EQ.' ' IF(COMMAND)THEN C On DCL commands, strip off the $ and subsequent blanks LINE(1:LENGTH) = LINE(L+1:LENGTH) DO 25 L = 1 , NBLANK(LINE(1:LENGTH)) LN = L IF(LINE(L:L).NE.' ')GOTO 28 25 CONTINUE 28 LINE(1:LENGTH) = LINE(LN:LENGTH) END IF END IF C If its a data line, just copy it out and loop on next line IF(.NOT.COMMAND)THEN IF(.NOT.SKIPLINE)CALL WRITE(LINE(1:LENGTH)) GOTO 15 END IF C For command lines prepare in case of continuation lines L0 = NBLANK(LINE(1:L0-1+LENGTH)) C Yes, the next line is a continuation IF(LINE(L0:L0).EQ.'-')GOTO 20 C No, it isn't. LENGTH = L0 C C assume we will not execute this line C SKIPLINE = .TRUE. C C now look for occurrences of !? C 30 CONTINUE IS = INDEX(LINE,'!?') IF(IS.NE.0)THEN IF(LENGTH + LF - 2 .GT.LINE_LEN)STOP 'LINE TOO LONG' IF(IS.EQ.1)THEN LINE = FNAME(1:LF)//LINE(IS+2:) ELSE LINE = LINE(1:IS-1)//FNAME(1:LF)//LINE(IS+2:) END IF LENGTH = LENGTH + LF - 2 GOTO 30 END IF D TYPE *,' INPUT LINE IS ',LINE(1:LENGTH) COMND = LINE(1:3) C convert the command to upper case CALL CUPPER(COMND) INPUT_TYPE = '.'//COMND OUTPUT_TYPE = '.OBJ' IF(COMND.EQ.'MAC')THEN INPUT_TYPE = '.MAR' ELSE IF(COMND.EQ.'IFT')THEN OUTPUT_TYPE = '.FOR' ELSE IF(COMND.EQ.'LIB')THEN INPUT_TYPE = '.OBJ' OUTPUT_TYPE = '.OLB' ELSE IF(COMND.EQ.'LIN')THEN INPUT_TYPE = '.OBJ' OUTPUT_TYPE = '.EXE' END IF C initialize input date to very old IDATE(1) = 0 IDATE(2) = 0 C initialize output date to very new ODATE(1) = 'FFFFFFFF'X ODATE(2) = '7FFFFFFF'X C zero the count of potential output files for this command line LOUTS = 0 C search for input and output files C this could be speeded up considerably !!!!! CALL FINDFIL('I','!I',LINE(1:LENGTH),LENGTH,INPUT_TYPE,IDATE) CALL FINDFIL('I','!i',LINE(1:LENGTH),LENGTH,INPUT_TYPE,IDATE) CALL FINDFIL('I','!M',LINE(1:LENGTH),LENGTH,'.MLB',IDATE) CALL FINDFIL('I','!m',LINE(1:LENGTH),LENGTH,'.MLB',IDATE) CALL FINDFIL('I','!L',LINE(1:LENGTH),LENGTH,'.OLB',IDATE) CALL FINDFIL('I','!l',LINE(1:LENGTH),LENGTH,'.OLB',IDATE) CALL FINDFIL('O','!O',LINE(1:LENGTH),LENGTH,OUTPUT_TYPE,ODATE) CALL FINDFIL('O','!o',LINE(1:LENGTH),LENGTH,OUTPUT_TYPE,ODATE) D CALL SYS$ASCTIM(,ASCII_TIME,IDATE,) D TYPE *,' FINAL IDATE = ',ASCII_TIME D CALL SYS$ASCTIM(,ASCII_TIME,ODATE,) D TYPE *,' FINAL ODATE = ',ASCII_TIME D TYPE 101,IDATE(2),IDATE(1),ODATE(2),ODATE(1) 101 FORMAT(' IDATE & ODATE OF 2 & 1 ',4Z10) C If no input tests specified, then execute the line IF(IDATE(1).EQ.0 .AND. IDATE(2).EQ.0)THEN SKIPLINE = .FALSE. CALL WRITE('$ '//LINE(1:LENGTH)) CALL UPDATE D TYPE *,'WROTE LINE' GOTO 15 END IF C If we found no output files then set output to be very old IF(ODATE(2).EQ.'7FFFFFFF'X .AND. ODATE(1).EQ.'FFFFFFFF'X)THEN ODATE(2) = 0 ODATE(1) = 0 END IF C compare most recent input date with oldest output date CALL SUBQUAD(ODATE,IDATE,SDATE) C if input is newer than output then execute the line IF(SDATE(2).LT.0)THEN SKIPLINE = .FALSE. CALL WRITE('$ '//LINE(1:LENGTH)) CALL UPDATE D TYPE *,'WROTE LINE' END IF GO TO 15 80 CONTINUE CLOSE(UNIT=1) CLOSE(UNIT=2) CALL IFERR(LIB$DO_COMMAND('@DT:[SYSMGR.USE]USE '// . 'DF:'//FNAME(IEB+1:LF)//'.USF'), . 'USE unable to execute command procedure') END SUBROUTINE WRITE(LINE) C NWRIT is how long to make output lines PARAMETER NWRIT = 60 CHARACTER*(*) LINE LOGICAL COMMENT 100 FORMAT(A) IF(LINE(1:1).NE.'$')THEN WRITE(2,100)LINE RETURN END IF LENGTH = NBLANK(LINE) L0 = 1 COMMENT = .FALSE. 10 CONTINUE IF(COMMENT)THEN IF(LENGTH+1-L0.GT.NWRIT)THEN WRITE(2,100)'$!'//LINE(L0:L0+NWRIT-1)//'-' L0 = L0 + NWRIT GOTO 10 ELSE WRITE(2,100)'$!'//LINE(L0:LENGTH) END IF ELSE IF(LENGTH+1-L0.GT.NWRIT)THEN WRITE(2,100)LINE(L0:L0+NWRIT-1)//'-' COMMENT = INDEX(LINE(L0:L0+NWRIT-1),'!').NE.0 L0 = L0 + NWRIT GOTO 10 ELSE WRITE(2,100)LINE(L0:LENGTH) END IF END IF RETURN END