TITLE	STINFL for RPGII %2
SUBTTL	Initialize input files

;
;STINFL			Routine to set up input files
;
;This routine is called upon end-of-file on the source file to open the
;next file. Note that for the SCAN/WILD version, only one file is
;supported.
;
;Copyright (C) 1975, 1976, 1977  Bob Currier and Cerritos College
;All Rights Reserved
;
;

TWOSEG
RELOC	400000


	ENTRY	STINFL		;SET UP AN INPUT FILE
	ENTRY	OPENIT		;DO "OPEN"--SET UP FOR "LOOKUP" & "ENTER"

	EXTERNAL SIXOUT, RESTRT, ERATYP, FILOUT

IFE	FTSCAN,<
STINFL:	HRRZ	DA,SRCEND	;GET ADDRESS OF NEXT SOURCE FILE DATA
	CAIE	DA,SRCEND	;ANY MORE ENTRIES?
	SKIPN	0(DA)		;YES--EMPTY?
	JRST	OPNIN7		;YES--NO MORE SOURCE FILES

	HRLI	DA,SRCDEV
	MOVS	TA,DA
	MOVEI	DA,(TA)
	PUSH	PP,DEVBUF(DA)
	BLT	TA,DEVSZ-1(DA)		; [316]
	POP	PP,DEVBUF(DA)

	MOVEI	TA,DEVSZ		; [316]
	ADDM	TA,SRCEND

	MOVEI	DC,SRC		;NO--USE SOURCE CHANNEL
	JRST	OPENIN

;INITIALIZE AN INPUT FILE

OPENIN:	MOVEI	I1,0		;ASCII MODE
	MOVEI	I3,DEVBH(DA)	;CREATE AN XWD
	PUSHJ	PP,OPENIT	;DO "OPEN", SET UP FOR "LOOKUP"

	MOVE	I0,LOOKOP	;CREATE A LOOKUP
	DPB	DC,I0CHAN
	MOVE	I4,DEVPP(DA)	;GET PROJ, PROG
	JUMPN	I2,OPNIN2	;ANY EXTENSION?

OPNIN1:	XCT	I0		;NO EXTENSION--DO LOOKUP
	SKIPA			;NOT FOUND
	JRST	OPNIN3

	HRLZI	I2,(SIXBIT "RPG")	;NO--USE "RPG"
	XCT	I0
	JRST	NOLOOK		;DIDN'T FIND THAT EITHER--ERROR
	JRST	OPNIN3

OPNIN2:	XCT	I0		;DO LOOKUP
	JRST	NOLOOK		;ERROR

OPNIN3:	MOVSI	TA,I1		;SAVE SOURCE FILE INFO FOR LISTING
	HRRI	TA,SRCFIL##
	BLT	TA,SRCFIL+2
	HLLZ	TA,SRCFIL+1	;PUT EXT IN BYTES 2, 3, 4
	LSH	TA,-6		;  SO SIXIT OF COBOLF WORKS
	MOVEM	TA,SRCFIL+1
	MOVE	TA,DEVSW(DA)	;GET SWITCHES
	TRNE	TA,2		;NO--REWIND?
	MTAPE	SRC,$REW	;YES--REWIND MTA
;SET UP A BUFFER

OPNIN4:	SKIPN	TA,DEVBUF(DA)
	MOVE	TA,.JBFF##

	MOVEM	TA,.JBFF
	MOVEM	TA,DEVBUF(DA)

	MOVE	I0,INBOP

	DPB	DC,I0CHAN
	XCT	I0

	SETZM	DEVBLK(DA)

	ADDI	TA,406		;NO--MAKE ROOM FOR TWO BUFFERS
	HRRM	TA,.JBFF
	POPJ	PP,


;NO MORE SOURCE FILES

OPNIN7:	SETZM	SRCDEV
	POPJ	PP,

	>		; end of IFE FTSCAN


IFN	FTSCAN,<

;The SCAN/WILD version of STINFL
;
;
;

STINFL:	SETZM	SRCDEV			; say no more files
	POPJ	PP,			; and exit
	>		; end of IFN FTSCAN
;OPENIT		Open the file and set up parameters for ENTER or LOOKUP
;
;
;

OPENIT:	MOVE	I2,DEVDEV(DA)	;GET DEVICE NAME
	MOVE	I0,OPENOP	;CREATE AN OPEN
	DPB	DC,I0CHAN
	XCT	I0		;OPEN
	  JRST	CANTOP		;CANNOT--ERROR
	MOVE	I1,DEVFIL(DA)	;GET FILE NAME
	MOVE	I2,DEVEXT(DA)	;GET EXTENSION
	MOVEI	I3,0		;ZERO IN THIRD WORD
	POPJ	PP,
;ERRORS WHILE INITIALIZING THE DEVICE

;DEVICE UNAVAILABLE
CANTOP:	MOVEI	TB,MESS3


TYPEIT:	MOVEI	CH,"?"
	CHROUT	CH

	MOVE	TA,DEVDEV(DA)
	PUSHJ	PP,SIXOUT
TYPIT1:	TTCALL	3,(TB)
TYPIT2:	TSWT	FDSKC;
	SWOFF	FECOM;
	JRST	RESTRT

;LOOKUP FAILURE

NOLOOK:	MSG	<?RPGFNF File not found >

	HRRZ	TA,I2
	JUMPN	TA,ERATYP
	PUSHJ	PP,FILOUT
	JRST	TYPIT2


;ERROR MESSAGES

MESS3:	ASCIZ	": unavailable"

EXTERNAL DEVDEV,DEVSW,DEVPP,DEVFIL,DEVEXT,DEVBH,DEVBUF,DEVBLK
EXTERNAL LOOKOP,OPENOP,INBOP,I0CHAN
EXTERNAL SRCEND,SRCDEV,DEVSZ


	END