Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

C SUBROUTINE TO SCAN FILESPEC
C CALL WITH:
C DEFDEV	DEFAULT DEVICE (VARIABLE OR LITERAL, 0 = NONE)
C DEFNAM	DEFAULT FILENAME	"
C DEFEXT	DEFAULT EXTENSION	"
C DEFPRJ	DEFAULT PROJECT NUMBER (VARIABLE OR CONSTANT)
C DEFPRG	DEFAULT PROGRAMMER NUMBER	"
C RETURNS:
C DEVICE,FILE,PPN SUITABLE FOR OPEN CALL
C PPN IS INTEGER ARRAY OF SIZE 2
C NAME AND EXT ARE SEPERATE AND SUITABLE FOR DEFAULTS IN NEXT SCAN CALL

C ALTERNATE ENTRY "FSCAN" ALLOWS 2 ADDITIONAL ARGUMENTS:
C IDATA		ARRAY CONTAINING FILESPEC IN INTERNAL FORMAT
C ICNT		COUNT OF CHARACTERS IN IDATA
	SUBROUTINE SCAN(DEFDEV,DEFNAM,DEFEXT,DEFPRJ,DEFPRG,
	1DEVICE,FILE,PPN,NAME,EXT)
	PARAMETER NCHRS=200
	COMPLEX DEFDEV,DEFNAM,DEFEXT,DEVICE,FILE,NAME,EXT
	INTEGER DEFPRJ,DEFPRG,PPN(2)
	COMPLEX TDEV,TNAM,TEXT
	EQUIVALENCE (IDEV,TDEV),(INAM,TNAM),(IEXT,TEXT)
	INTEGER TPRJ,TPRG
	COMPLEX WORD
	INTEGER FLAG,TMP,IPTR,IBUF(NCHRS),TBUF(3),CHR,IDATA(1)
	COMMON/CHRBUF/IBUF,IPTR
	ISCNF = 0
	GOTO 9

	ENTRY FSCAN(IDATA,ICNT,DEFDEV,DEFNAM,DEFEXT,DEFPRJ,DEFPRG,
	1DEVICE,FILE,PPN,NAME,EXT)
	ISCNF = 1
	DO 101 I=1,NCHRS
101	IBUF(I) = ' '
	DECODE (ICNT,5,IDATA) IBUF
	ICNT = .TRUE.
9	TDEV=DEFDEV
	IF(IDEV.EQ.0)TDEV=0
	TNAM=DEFNAM
	IF(INAM.EQ.0)TNAM=0
	TEXT=DEFEXT
	IF(IEXT.EQ.0)TEXT=0
	TPRJ=DEFPRJ
	TPRG=DEFPRG
	FLAG=0
	IF (ISCNF.NE.0) GOTO 100
	TYPE 1
1	FORMAT('+filespec'$)
	CALL DEFPNT(TDEV,6,FLAG,0,':',0)
	IF(TDEV.EQ.0)TDEV='DSK'
	CALL DEFPNT(TNAM,6,FLAG,0,0,0)
	CALL DEFPNT(TEXT,3,FLAG,'.',0,0)
	IF(FLAG.NE.0) FLAG=-1
	CALL DEFPNT(TPRJ,0,FLAG,'[',0,0)
	CALL DEFPNT(TPRG,0,FLAG,',',']','[')
	IF (TPRG.EQ.0.AND.TPRJ.NE.0) TYPE 2
2	FORMAT('+,]',$)
	IF (FLAG.NE.0) TYPE 3
3	FORMAT('+)',$)
	TYPE 4
4	FORMAT('+: ',$)
	ACCEPT 5,IBUF
5	FORMAT(1000A1)
100	IPTR=0
	DO 6 I=1,NCHRS
	CHR=IBUF(I)
	IF(CHR.EQ.' ') GOTO 6
	IF(CHR.LT.0.AND.CHR.GT.']') CHR=CHR-"200000000000
	IPTR=IPTR+1
	IBUF(IPTR)=CHR
6	CONTINUE
	IF(IPTR.LT.NCHRS) GOTO 7
	IF (ISCNF.NE.0) RETURN
	TYPE 11
11	FORMAT(' ?Input line too long, please retype.',/)
	GOTO 9

7	DO 8 I=IPTR+1,NCHRS
8	IBUF(I)=0
	IPTR=0
	CALL GETWRD(WORD,FLAG,6)
	IF(FLAG.NE.':') GOTO 10
	TDEV=WORD
	CALL GETWRD(WORD,FLAG,6)
10	IF(WORD.NE.' ') TNAM=WORD
	IF(FLAG.NE.'.') GOTO 20
	CALL GETWRD(WORD,FLAG,3)
	TEXT=WORD
20	IF(FLAG.NE.'[') GOTO 30
	CALL GETOCT(TMP,FLAG)
	TPRJ=TMP
	IF(FLAG.NE.',') GOTO 30
	CALL GETOCT(TMP,FLAG)
	TPRG=TMP
	IF(FLAG.NE.']') GOTO 30
	IPTR=IPTR+1
	FLAG=IBUF(IPTR)
30	IF(FLAG.EQ.0) GOTO 40
	IF (ISCNF.NE.0) RETURN
	TYPE 31
31	FORMAT(' ?Illegal filespec, please retype.',/)
	GO TO 9

40	DEVICE=TDEV
	NAME=TNAM
	EXT=TEXT
	PPN(1)=TPRJ
	PPN(2)=TPRG
	DECODE(6,41,TNAM)(IBUF(I),I=1,6)
41	FORMAT(6A1)
	DO 42 J=1,6
	I=J
	IF(IBUF(I).EQ.' ') GOTO 43
42	CONTINUE
	I=7
43	IBUF(I)='.'
	DECODE(3,44,TEXT)(IBUF(J),J=I+1,I+3)
44	FORMAT(3A1)
	DO 45 J=I+4,10
45	IBUF(J)=' '
	ENCODE(10,46,FILE)(IBUF(I),I=1,10)
46	FORMAT(10A1)
	IF(TNAM.EQ.0)FILE=0
	IF(ISCNF.NE.0) ICNT = .FALSE.
	RETURN
	END

	SUBROUTINE GETWRD(WORD,CHR,MAX)
	PARAMETER NCHRS=200
	COMPLEX WORD
	INTEGER CHR,MAX,CNT,TBUF(6)
	INTEGER IPTR,IBUF(NCHRS)
	COMMON/CHRBUF/IBUF,IPTR
	CNT=0
	DO 2 I=1,6
2	TBUF(I)=' '
1	IPTR=IPTR+1
	CHR=IBUF(IPTR)
	IF(CHR.LT.'A'.OR.CHR.GT.'9') GOTO 99
	IF(CHR.GT.'Z'.AND.CHR.LT.'0') GOTO 99
	IF(CNT.GE.MAX) GOTO 98
	CNT=CNT+1
	TBUF(CNT)=CHR
	GOTO 1

99	ENCODE(10,97,WORD)(TBUF(I),I=1,6)
97	FORMAT(6A1,'    ')
	RETURN

98	CHR=-1
	RETURN
	END

	SUBROUTINE GETOCT(VAL,CHR)
	PARAMETER NCHRS=200
	INTEGER VAL,CHR
	INTEGER IPTR,IBUF(NCHRS)
	COMMON/CHRBUF/IBUF,IPTR
	VAL=0
1	IPTR=IPTR+1
	CHR=IBUF(IPTR)
	IF(CHR.LT.'0'.OR.CHR.GT.'9') RETURN
	VAL=VAL*8+((CHR/"4000000000)-"60)
	IF(VAL.LT."1000000) GOTO 1
	CHR=-1
	RETURN
	END

	SUBROUTINE DEFPNT(IVAL,ICNT,IFLAG,IDEL1,IDEL2,IDEL3)
	INTEGER IVAL(2),ICNT,IFLAG,IDEL1,IDEL2,IDEL3,TBUF(6),TMP(2)
	IF (IVAL(1).EQ.0) RETURN
	IF (IFLAG.EQ.0) TYPE 4
4	FORMAT('+(',$)
	IF (IFLAG.LT.0.AND.IDEL3.NE.0) TYPE 1,IDEL3
1	FORMAT('+',A1,$)
	IF (IDEL1.NE.0) TYPE 1,IDEL1
	IF (ICNT.EQ.0) GOTO 10
	DECODE(6,20,IVAL)(TBUF(I),I=1,6)
20	FORMAT(6A1)
	DO 3 I=ICNT,1,-1
	K=I
3	IF(TBUF(I).NE.' ') GOTO 5
5	J=1
	GOTO 60

10	ENCODE(6,30,TMP)IVAL(1)
30	FORMAT(O6)
	DECODE(6,20,TMP)(TBUF(I),I=1,6)
	DO 40 I=1,6
	J=I
	IF(TBUF(J).NE.'0') GOTO 50
40	CONTINUE
50	K=6
60	DO 70 I=J,K
	TYPE 71,TBUF(I)
71	FORMAT('+',A1,$)
70	CONTINUE
11	IF (IDEL2.NE.0) TYPE 1,IDEL2
	IFLAG=1
	END