Google
 

Trailing-Edge - PDP-10 Archives - ap-c800d-sb - stinfl.mac
There are 7 other files named stinfl.mac in the archive. Click here to see a list.
; UPD ID= 1598 on 12/29/78 at 9:36 AM by N:<NIXON>
TITLE	STINFL FOR COBOL V12
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, 1979 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	P
	%%P==:%%P

;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
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,1
	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
	CALLI	TA,$DEVCH	;GET CHARACTERISTICS

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

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

STINFA:	TLNN	TA,$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,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:	MOVE	TA,DEVSW(DA)	; NO EXTENSION IS IT THE LIBRARY? [256]
	TRNN	TA,1		; [256]
	TLOA	I2,'CBL'	;NO--USE "CBL"
	HRLZI	I2,'LIB'	;YES--USE "LIB" [256]
	XCT	I0		;TRY DEFAULT  EXTENSION--DO LOOKUP [256]
	  TRNA			;NOT FOUND [256]
	JRST	OPNIN3		; [256]

	TRNE	TA,1		;IS IT THE LIBRARY?
	JRST	OPNI1D		;YES, GO TRY NULL EXTENSION.
	HRLZI	I2,'COB'	;NO, TRY "COB".
	XCT	I0		;DO THE LOOKUP.
	  TRNA			;NOT FOUND TRY THE NULL EXTENSION.
	JRST	OPNIN3

OPNI1D:	SETZ	I2,		; TRY NULL EXTENSION [256]
	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,1		;LIBRARY?
	JRST	OPNIN4		;YES
	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
	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
	POPJ	PP,
;ERRORS WHILE INITIALIZING THE DEVICE

;DEVICE UNAVAILABLE
CANTOP:	MOVEI	TB,MESS3


TYPEIT:	MOVEI	CH,"?"
	TTCALL	1,CH

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

;LOOKUP FAILURE

NOLOOK:	TTCALL	3,[ASCIZ "?CANNOT FIND "]

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


;LIBRARY DEVICE NOT DSK

NOTDSK:	MOVEI	TB,MESS4
	JRST	TYPIT1

MESS3:	ASCIZ	": UNAVAILABLE"
MESS4:	ASCIZ	"?LIBRARY FILES MUST BE ON DISK"


	END