C C C G E T F I L C C OPEN FILES FOR I/O C C THIS ROUTINE DETERMINS THE FILE NAMES , OPENS THE FILES FOR I/O AND C SETS UP THE UNIT NUMBERS.THIS ROUTINE WILL REQUIRE REWRITTING FOR C EACH SPECIFIC MACHINE. SPECIFIC FUNCTIONS OF THE ROUTINE ARE C C FOR FILE ORIENTED SYSTEMS: C DETERMIN THE FILE NAME OF THE SOURCE FILE AND OPEN THE FILE FOR C SEQUENTIAL INPUT C SET UP THE INTEGER ARRAY PRGNAM WITH THIS FILE NAME C IF A LISTING IS REQUIRED OPEN A LISTING FILE FOR SEQUENTIAL C OUTPUT AND SET LSTUNT TO THE LOGICAL UNIT ( CHANNEL ) NUMBER. C IF BINARY OUTPUT IS REQUIRED THEN OPEN A BINARY OUTPUT FILE FOR C SEQUENTIAL OUTPUT AND SET BINUNT TO THE LOGICAL UNIT(CHANNEL) C NUMBER C C NOTE THAT IF EITHER OUTPUT FILE IS NOT REQUIRED THE CORRESPONDING C UNIT NUMBER SHOULD BE SET TO 0 . C C THE PREFERED FILE NAMEING CONVENTION IS AS FOLLOWS:THE FILE NAME C MAY CONSIST OF ANY MEANINGFUL CHARACTERS CONFORMING TO THE HOST C SYSTEMS NAMING CONVENTIONS.THE FILE EXTENSION( TYPE ) SHOULD BE C "I80" FOR INTEL 8085 FOR THE SOURCE FILE, "LST" FOR THE C LISTING OUTPUT FILE , AND"BIN" OR "BINARY"FOR THE BINARY OUTPUT C FILE. C SUBROUTINE GETFIL(QUIT) INCLUDE 'IODEVS.CMN' INCLUDE 'LSTHDG.CMN' INTEGER BINSTR,BINEND,SRCSTR,SRCEND,OUT,QUIT,SRCLIM,BINLIM INTEGER RFNSTR LOGICAL BINEXT,LSTEXT,SRCEXT,LSTDEV,DFUIC,SRCVER LOGICAL CONTIN,COUNT,TYPO,LOG,DFDEV BYTE SRCNAM(14),LSTNAM(14),BINNAM(14), * BEXT(4),SEXT(4),LEXT(4),DEV(4),UIC(10), * FILENM(10),TYPE(4),VER(6) C C DEFAULT FILE TYPES OR EXTENSIONS C DATA BEXT/'.', 'B', 'I', 'N'/ DATA SEXT/'.', 'I', '8', '0'/ DATA LEXT/'.', 'L', 'S', 'T'/ SRCUNT = 0 LSTUNT = 0 BINUNT = 0 XRFUNT = 0 BINEXT = .FALSE. SRCEXT = .FALSE. LSTEXT = .FALSE. LSTDEV = .FALSE. SPL = .TRUE. XRF = .FALSE. SRCVER = .FALSE. DFUIC = .TRUE. DFDEV = .TRUE. CONTIN = .TRUE. !CONTINUE EXECUTION AFTER ERROR COUNT = .FALSE. !DON'T COUNT AGAINST ERROR COUNT TYPO = .TRUE. !USE ERR= ROUTE FOR CONTINUING LOG = .FALSE. !DON'T REPORT THE ERROR INP = 5 OUT = 5 C C SET ERR 29 (NO SUCH FILE) ERROR RECOVERY C CALL ERRSET(29,CONTIN,COUNT,TYPO,LOG) C C READ COMMAND LINE C CALL GETMCR(MCRBUF,MCRBLN) IF (MCRBLN.LT.0) GO TO 10 !BAD NEWS DO 5 I=1,MCRBLN !SKIP OVER THE TASK NAME IF (MCRBUF(I).EQ.' ') GO TO 15 5 CONTINUE C C NO COMMAND LINE SO GIVE A 1-SHOT PROMPT FOR C A SECOND CHANCE C 10 WRITE (OUT,11) 11 FORMAT ('$I80>') READ (INP,12,ERR=10,END=140) MCRBLN,MCRBUF 12 FORMAT (Q,80A1) IF (MCRBLN.EQ.0) GO TO 10 I = 0 C C START DECODING THE LINE C 15 I = I+1 !NOW LOOKING AT THE FIRST CHAR IF (MCRBUF(I).NE.',') GOTO 20 !COMMA MEANS NO BIN, YES LST. LSTUNT = 3 LSTSTR = I+1 !KEEP THE INDEX OF THE START GO TO 40 !AND LOOK FOR LIST NAME 20 IF (MCRBUF(I).NE.'=') GO TO 25 != MEANS NO BIN, NO LST, MAP? SRCUNT = 1 SRCSTR = I+1 GO TO 50 C C GET ALL THE INFOR ABOUT THE BINARY FILE C 25 BINUNT = 2 BINSTR = I DO 35 I=BINSTR,MCRBLN IF (MCRBUF(I).EQ.'.') BINEXT = .TRUE. !NO DEFAULT .EXT IF (MCRBUF(I).NE.',') GO TO 30 BINEND = I-1 !END OF BIN, LSTUNT = 3 !START OF LST LSTSTR = I+1 GO TO 40 30 IF (MCRBUF(I).NE.'=') GO TO 35 BINEND = I-1 !END OF BIN, SRCUNT = 1 !START OF SCR SRCSTR = I+1 GO TO 50 35 CONTINUE C C NOW WORK ON THE LISTING FILE C 40 DO 45 I=LSTSTR,MCRBLN IF (MCRBUF(I).EQ.'.') LSTEXT = .TRUE. !NO LST EXT DEFAULT IF (MCRBUF(I).EQ.'/') GO TO 46 !A SWITCH IF (MCRBUF(I).EQ.':') GO TO 42 IF (MCRBUF(I).NE.'=') GO TO 45 LSTEND = I-1 !END OF LST, IF (MCRBUF(LSTEND).EQ.':') LSTDEV = .TRUE. SRCUNT = 1 !START OF SCR SRCSTR = I+1 GO TO 50 42 LSTEND = I LSTDEV = .TRUE. IF (MCRBUF(I+1) .EQ. '=') GO TO 45 IF (MCRBUF(I+1) .EQ. '/') GO TO 45 GO TO 135 45 CONTINUE GO TO 50 C C DECODE THE SWITCH C 46 LSTEND = I-1 IF (MCRBUF(I+1).EQ.'-'.AND. $ MCRBUF(I+2).EQ.'S'.AND. $ MCRBUF(I+3).EQ.'P' ) SPL = .FALSE. IF (MCRBUF(I+1).EQ.'C'.AND. $ MCRBUF(I+2).EQ.'R' ) XRF = .TRUE. IF (SPL.AND..NOT.XRF) GO TO 130 !ILLEGAL SWITCH IF (.NOT.SPL.AND.MCRBUF(I+4).EQ.'=') GO TO 49 IF (XRF .AND.MCRBUF(I+3).EQ.'=') GO TO 49 IF (.NOT.SPL.AND.MCRBUF(I+4).EQ.'/') GO TO 47 !SYNTAX ERROR IF (XRF .AND.MCRBUF(I+3).EQ.'/') GO TO 48 GO TO 135 47 IF (MCRBUF(I+5).EQ.'C'.AND.MCRBUF(I+6).EQ.'R') XRF = .TRUE. GO TO 49 48 IF (MCRBUF(I+4).EQ.'-'.AND.MCRBUF(I+5).EQ.'S'.AND. $ MCRBUF(I+6).EQ.'P') SPL = .FALSE. 49 SRCUNT = 1 SRCSTR = I+1 IF (XRF) SRCSTR =SRCSTR+3 IF (.NOT.SPL) SRCSTR = SRCSTR+4 IF (XRF) XRFUNT = 4 C C NOW THE SOURCE FILE C 50 DO 55 I=SRCSTR,MCRBLN IF (MCRBUF(I).EQ.':') DFDEV = .FALSE. !NO DEFAULT DEV IF (MCRBUF(I).EQ.'.') SRCEXT = .TRUE. !NO DEFAULT EXT IF (MCRBUF(I).EQ.'[') DFUIC = .FALSE. !NO DEFAULT UIC IF (MCRBUF(I).EQ.';') SRCVER = .TRUE. !NO DEVAULT VERSION # 55 CONTINUE !TO THE END SRCEND = MCRBLN C C ATTACH THE DEFAULT EXTENSIONS IF ABLE, AND C OPEN THE FILES. ANY ERROR OPENING, GO TO C 10 AND REPROMPT. C IF (SRCUNT.EQ.0) GO TO 110 !NO SOURCE FILE? I = 1 RFNSTR = 1 !REAL FILENAME START IF (.NOT.DFDEV) GO TO 58 SRCNAM(1) = 'S' !ASSIGN SY: TO DEVICE SRCNAM(2) = 'Y' SRCNAM(3) = '0' SRCNAM(4) = ':' I = 5 RFNSTR = 5 !REAL FILENAME START 58 DO 60 J=SRCSTR,SRCEND SRCNAM(I) = MCRBUF(J) IF (SRCNAM(I).EQ.':') RFNSTR = I+1 !NO DEFAULT SY: I = I+1 60 CONTINUE IF (SRCEXT) GO TO 70 !ADD EXTENTION IF NEEDED K = I J = 1 DO 65 I=K,K+3 SRCNAM(I) = SEXT(J) J = J+1 65 CONTINUE 70 SRCLIM = I SRCNAM(I+1) = 0 !DELIMIT THE FILE NAME FOR OPEN OPEN(UNIT=SRCUNT,TYPE='OLD',READONLY,NAME=SRCNAM,ERR=115) CALL GETFNB(SRCUNT,IST,DEV,UIC,FILENM,TYPE,VER) !GET THE OTHER J = 1 !FILE STUFF DO 71 I=1,4 !GET THE DEVICE NAME IN PRGNAM(J) = DEV(I) J = J+1 71 CONTINUE IF (.NOT.DFUIC) GOTO 73 !NOT DEFAULT UIC? DO 72 I=1,9 IF (UIC(I).EQ.0.OR.UIC(I).EQ.' ') GO TO 73 PRGNAM(J) = UIC(I) J = J+1 72 CONTINUE 73 DO 74 I=RFNSTR,SRCLIM !GET REAL UIC,NAME,TYPE,VER IN PRGNAM(J) = SRCNAM(I) !IF SUPPLIED FROM USER J = J+1 74 CONTINUE IF (SRCVER) GO TO 76 !SPECIFIC VERSION # SUPPLIED? PRGNAM(J) = ';' !NO, ADD DEFAULT'S ON J = J+1 DO 75 I=1,5 IF (VER(I).EQ.0) GO TO 76 !PADDED WITH NUL'S PRGNAM(J) = VER(I) J = J+1 75 CONTINUE 76 IF (J.GE.32) GO TO 78 !PAD FIELD WITH SPACES DO 77 I=J,32 PRGNAM(I) = ' ' 77 CONTINUE C C DEFAULT THE LISTING FILE AND OPEN C 78 IF (LSTUNT.EQ.0) GO TO 90 I = 1 DO 79 J=LSTSTR,LSTEND LSTNAM(I) = MCRBUF(J) I = I+1 79 CONTINUE IF (LSTEXT) GO TO 85 !DEFAULT EXTENSION OF .LST IF (LSTDEV) GO TO 88 K = I J = 1 DO 80 I=K,K+3 LSTNAM(I) = LEXT(J) J = J+1 80 CONTINUE 85 LSTLIM = I LSTNAM(I+1) = 0 OPEN(UNIT=LSTUNT,TYPE='NEW',NAME=LSTNAM,DISP='SAVE',ERR=120) GO TO 90 C C LISTING FILE IS TO A DEVICE C 88 LSTNAM(I) = 0 SPL = .FALSE. CALL ASSIGN(LSTUNT,LSTNAM) C C THE BINARY FILE C 90 IF (BINUNT.EQ.0) GO TO 107 I = 1 DO 95 J=BINSTR,BINEND BINNAM(I) = MCRBUF(J) I = I+1 95 CONTINUE IF (BINEXT) GO TO 105 K = I J = 1 DO 100 I=K,K+3 BINNAM(I) = BEXT(J) J = J+1 100 CONTINUE 105 BINLIM = I BINNAM(I+1) = 0 OPEN (UNIT=BINUNT,TYPE='NEW',NAME=BINNAM,ERR=125) WRITE (BINUNT,106) PRGNAM,ATIME,ADATE 106 FORMAT (' BINARY ASSEMBLED FROM ',32A1,4A2,2X,4A2,A1) C C THE XREF FILE C 107 IF (XRFUNT.EQ.0) GO TO 150 OPEN (UNIT=XRFUNT,ACCESS='DIRECT',ERR=122,NAME='I80.XRF', $ RECORDSIZE=2,TYPE='SCRATCH') GO TO 150 C C ERRORS C 110 WRITE (OUT,111) 111 FORMAT (' I80 - NO SOURCE FILE SPECIFIED') GO TO 145 C C TROUBLE FINDING SOURCE FILE C 115 WRITE (OUT,116) (SRCNAM(I),I=1,SRCLIM) 116 FORMAT (' I80 - ERROR FINDING SOURCE FILE ',A1) GO TO 145 C C COULDN'T OPEN THE LISTING FILE C 120 WRITE (OUT,121) (LSTNAM(I),I=1,LSTLIM) 121 FORMAT (' I80 - ERROR OPENING LISTING FILE ',A1) GO TO 145 C C COULDN'T OPEN THE XREF FILE C 122 WRITE (OUT,123) 123 FORMAT (' I80 - ERROR OPENING THE I80.XRF FILE') GO TO 145 C C COULDN'T OPEN THE BINARY FILE C 125 WRITE (OUT,126) (BINNAM(I),I=1,BINLIM) 126 FORMAT (' I80 - ERROR OPENING BINARY OUTPUT FILE ', $ A1) GO TO 145 C C ILLEGAL SWITCH C 130 WRITE (OUT,131) 131 FORMAT (' I80 - ILLEGAL SWITCH') GO TO 145 C C SYNTAX ERROR C 135 WRITE (OUT,136) 136 FORMAT (' I80 - SYNTAX ERROR') GO TO 145 C C END OF FILE FOUND (Z) C 140 CLOSE (UNIT=INP) CALL ASSIGN(INP,'TI:',3) !REOPEN TO CLEAR EOF 145 QUIT = 1 !AND SAY NO MORE RETURN C C DONE CORRECTLY C 150 QUIT = 0 RETURN END