C ====================================================== C OPEN14 C SUBROUTINE USES A CALLER SUPPLIED BUFFER TO C INPUT AND ANALYSE AN INPUT STRING IN THE FORM C [NAM ]FNAM3,FNAM4=FNAM1 C IF NAM DOESNT OCCUR IN THE FIRST 3 CHARACTERS, C NAM IS USED A THE PROMPT TO GET A LINE C FNAM3 IS OPENED ON LUN 3 WITH TYPE .BIN C FNAM4 IS OPENED ON LUN 4 WITH TYPE .LST C FNAM1 IS OPENED ON LUN 1 WITH TYPE .LST C IF FNAM4 IS 'LP:' DEVICE IS SY: AND 'PRINT' C THE FNAM1 REMAINS LEFT JUSTIFIED IN THE USER C BUFFER AND IS PADDED WITH SPACES TO 20 CHARACTERS C PARAMETERS C BUFF 80 BYTE USER SUPPLIED BUFFER C PROMPT 4CHARACTERS PACKED IN 4 BYTE ARRAY C I3 A BINARY OUTPUT FILE IS OPEN IF A 1 C I3 A LISTING FILE IS OPEN IF A 1 C C ==================================================== C SUBROUTINE OPEN14 (BUFF,PROMPT,I3,I4) BYTE BUFF(80),PROMPT(4) I3=0 I4=0 CALL GETMCR (BUFF,J) J=J-4 IF (J.GE.1) GOTO 5 WRITE (5,1000) (PROMPT(I),I=1,3) 1000 FORMAT ('$',3A1,'>') 1010 FORMAT (Q,80A1) READ (5,1010) J,(BUFF(I),I=5,J+5) C ============== TRY THE FIRST FILENAME 5 I=0 K=4 L=0 10 I=I+1 K=K+1 IF (K.GT.J+4) STOP 'FATAL -- FILENAME ERROR' IF (BUFF(K).EQ.1H, .OR. BUFF(K).EQ.1H=) GOTO 20 IF (BUFF(K).EQ.1H.) L=1 BUFF(I)=BUFF(K) GOTO 10 20 IF (I.EQ.1) GOTO 40 IF (L.EQ.1) GOTO 30 BUFF(I)=1H. BUFF(I+1)=1HB BUFF(I+2)=1HI BUFF(I+3)=1HN I=I+4 30 CALL ASSIGN (3,BUFF,I-1) I3=1 40 IF (BUFF(K).EQ.1H=) GOTO 80 L=0 M=0 I=0 50 I=I+1 K=K+1 IF (K.GT.J+4) STOP 'FATAL -- FILENAME ERROR' IF (BUFF(K).EQ.1H=) GOTO 60 IF (BUFF(K).EQ.1H:) M=1 IF (BUFF(K).EQ.1H.) L=1 BUFF(I)=BUFF(K) GOTO 50 60 I4=1 IF (M.NE.1) GOTO 65 IF (I.NE.4) GOTO 65 IF (BUFF(1).NE.1HL .OR. BUFF(2).NE.1HP) GOTO 65 BUFF(1)=1HS BUFF(2)=1HY BUFF(I)=0 OPEN (UNIT=4,NAME=BUFF,DISPOSE='PRINT') GOTO 80 65 IF (I.EQ.1) GOTO 80 IF (L.EQ.1) GOTO 70 BUFF(I)=1H. BUFF(I+1)=1HL BUFF(I+2)=1HS BUFF(I+3)=1HT I=I+4 70 CALL ASSIGN (4,BUFF,I-1) 80 IF (I4.EQ.0) CALL ASSIGN (4,'TI:',3) I=0 L=0 90 I=I+1 K=K+1 IF (K.GT.J+4) GOTO 100 IF (BUFF(K).EQ.1H.) L=1 BUFF(I)=BUFF(K) GOTO 90 100 IF (I.EQ.1) STOP 'FATAL -- FILENAME ERROR' IF (L.EQ.1) GOTO 110 BUFF(I)=1H. BUFF(I+1)=1HS BUFF(I+2)=1HR BUFF(I+3)=1HC I=I+4 110 CALL ASSIGN (1,BUFF,I-1) RETURN END