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

; UPD ID= 3289 on 12/19/80 at 11:09 AM by NIXON                         
TITLE	STINFL FOR COBOL V12B
SUBTTL	INITIALIZE AN INPUT FILE		AL BLACKINGTON/CAM



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974, 1981 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	P,UUOSYM
	%%P==:%%P
	IFE TOPS20,<SEARCH MACTEN>
	IFN TOPS20,<SEARCH MONSYM,MACSYM>

;EDITS
;V10*****************
;NAME	DATE		COMMENTS
; EHM	2-MAR-78	[530] FIX COBOL TO LOOK FOR FILE WITH NUL EXT IF USER TYPE =FILE.
;********************

;EDIT 302 FIX DATE 75 PROBLEM OF SOURCE FILE DATE IN LISTING
;EDIT 256 REVERSE ORDER OF LOOKUP FOR SOURCE AND LIBARY FILES
;	SO THAT .CBL (.LIB) IS LOOKED FOR FIRST

TWOSEG
RELOC	400000
SALL


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

EXTERNAL SIXOUT, RESTRT, ERATYP, FILOUT
EXTERNAL DEVDEV,DEVSW,DEVPP,DEVFIL,DEVEXT,DEVBH,DEVBUF,DEVBLK
EXTERNAL LOOKOP,OPENOP,INBOP,I0CHAN
EXTERNAL SRCEND,SRCDEV,LIBDEV,DEVSIZ

FL.LIB==1		;FILE IS A LIBRARY
FL.REW==2		;DEVICE MUST BE REWOUND

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

	MOVE	TA,DEVSW(DA)	;IS IT LIBRARY FILE?
	TRNN	TA,FL.LIB
	TLOA	DA,SRCDEV	;NO
	HRLI	DA,LIBDEV	;YES
	MOVS	TA,DA
	MOVEI	DA,(TA)
	PUSH	PP,DEVBUF(DA)
	BLT	TA,DEVSIZ-1(DA)
	POP	PP,DEVBUF(DA)

	MOVEI	TA,DEVSIZ
	ADDM	TA,SRCEND

	MOVE	TA,DEVDEV(DA)	;GET THE DEVICE
	DEVCHR	TA,		;GET CHARACTERISTICS

	MOVE	TB,DEVSW(DA)	;IS THIS THE LIBRARY?
	TRNE	TB,FL.LIB
	JRST	STINFA		;YES

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

STINFA:	TXNN	TA,DV.DSK	;IS DEVICE A DSK?
	JRST	NOTDSK		;NO--ERROR

	MOVEI	DC,LIB		;USE LIBRARY CHANNEL

	MOVE	TB,[SIXBIT /LIBARY/]	
	SKIPN	DEVFIL(DA)	;ANY FILE NAME?
	MOVEM	TB,DEVFIL(DA)	;NO--USE "LIBARY"

;INITIALIZE AN INPUT FILE

OPENIN:	MOVEI	I1,.IOASC	;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
	JUMPN	I2,OPNIN2	;ANY EXTENSION?

	MOVE	TA,DEVSW(DA)	;[256] NO EXTENSION IS IT THE LIBRARY?
	TRNN	TA,FL.LIB	;[256]
	TLOA	I2,'CBL'	;NO--USE "CBL"
	HRLZI	I2,'LIB'	;[256] YES--USE "LIB"
	XCT	I0		;[256] TRY DEFAULT  EXTENSION--DO LOOKUP
IFN ANS68,<
	  TRNA			;[256] NOT FOUND
>
IFN ANS74,<
	  TDZA	I2,I2		;NOT FOUND, TRY NUL EXTENSION
>
	JRST	OPNIN3		;[256]

IFN ANS68,<
	TRNE	TA,FL.LIB	;IS IT THE LIBRARY?
	JRST	OPNI1D		;YES, GO TRY NULL EXTENSION.
	HRLZI	I2,'COB'	;NO, TRY "COB".
	XCT	I0		;DO THE LOOKUP.
OPNI1D:	  TDZA	I2,I2		;[256] NOT FOUND TRY THE NULL EXTENSION.
	JRST	OPNIN3
>
	XCT	I0
	  JRST	NOLOOK		;DIDN'T FIND THAT EITHER--ERROR
	JRST	OPNIN3

OPNIN2:	HLLZS	I2,DEVEXT(DA)	;[530] GET RID OF FLAG SET TO INDICATE
				;[530] USER TYPED . (DOT) IN COMMAND STRING
	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
	HRRZ	TB,SRCFIL+1	; [302] GET HIGH ORDER DATE
	LSH	TB,-^D15	; [302] POSITON TO BYTE 6
	IOR	TA,TB		; [302] COMBINE WITH EXT
	MOVEM	TA,SRCFIL+1
	MOVE	TA,DEVSW(DA)	;GET SWITCHES
	TRNE	TA,FL.LIB	;LIBRARY?
	JRST	OPNIN4		;YES
	TRNE	TA,FL.REW	;NO--REWIND?
	MTREW.	SRC,		;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
	CAIN	DC,LIB		;IS THIS FOR LIBRARY?
	HRRI	I0,1		;YES--SINGLE BUFFERED

	DPB	DC,I0CHAN
	XCT	I0

	SETZM	DEVBLK(DA)

	CAIN	DC,LIB		;LIBRARY FILE?
	JRST	OPNIN6		;YES
	ADDI	TA,406		;NO--MAKE ROOM FOR TWO BUFFERS
	HRRM	TA,.JBFF
	POPJ	PP,

OPNIN6:	ADDI	TA,203		;MAKE ROOM FOR ONE BUFFER
	HRRM	TA,.JBFF
	JRST	STINFL

;NO MORE SOURCE FILES

OPNIN7:	SETZM	SRCDEV
	POPJ	PP,

;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
	MOVE	I4,DEVPP(DA)	;GET PROJ, PROG
	POPJ	PP,

;ERRORS WHILE INITIALIZING THE DEVICE

;DEVICE UNAVAILABLE
CANTOP:	OUTSTR	[ASCIZ/?CBLDVU Device is unavailable: /]

	MOVE	TA,DEVDEV(DA)
	PUSHJ	PP,SIXOUT
	OUTSTR	[ASCIZ/
/]				;END WITH CRLF

TYPIT2:	TSWT	FDSKC;
	SWOFF	FECOM;
	JRST	RESTRT

;LOOKUP FAILURE

NOLOOK:	OUTSTR	[ASCIZ "?CBLCFF Cannot find file: "]

	HRRZ	TA,I2
	JUMPN	TA,ERATYP
	PUSHJ	PP,FILOUT
	OUTSTR	[ASCIZ	/
/]					;FILOUT DOES NOT SUPPLY CR-LF ANYMORE
	JRST	TYPIT2


;LIBRARY DEVICE NOT DSK

NOTDSK:	OUTSTR	[ASCIZ/?CBLLFM Library files must be on disk
/]
	JRST	TYPIT2

	END