/ROPEN.SB - CREATE AND OPEN FUNCTIONS FOR FORTRAN RANDOM
/ACCESS I/O.
/******* MUST NOT LOAD INTO 10000-11777 (USR AREA)
/LOADS HANDLER AT 01000. THIS AREA WILL BE RESERVED IF
/ /I OR /O IS SPECIFIED TO THE LINKING LOADER. /I OR /O
/ARE REQUIRED ONLY IF A NON CORE-RESIDENT HANDLER IS USED.
/
/MODIFIED FOR LESS CORE SPACE BY ED SMALLENBURG.
/+ERROR MESSAGE FOR BAD RECORD LENGTH
/+ERROR MESSAGE IF NOT ENOUGH ADD.INF. WORDS
/+A METHOD TO CHANGE THE DEFAULT .FR EXTENSION.
/+MINUS ID IS ALLOWED FOR ROPEN (ABS VALUE IS ASSUMED)
/MQ-REGISTER IS NOT LONGER USED.
/ERROR MESSAGES WILL ALWAYS WORK NOW.
/
	ENTRY	CREAT
	ENTRY	ROPEN
	OPDEF	TADI	1400
	OPDEF	DCAI	3400
	OPDEF	JMPI	5400
	OPDEF	JMSI	4400
	LAP
/
FNAM,	0; 0		/FILENAME WITH .FR EXTENSION
FNAM2,	0
IEXT,	0622		/.FR
CRERRI,	CRERR		/ERROR ROUTINE
USR,	200		/ENTRY USR
INF,	1404		/POINTER TO ADD.INF. WORDS
LPNT,	0017		/POINTER TO FILE LENGTH WORD IN DIRECTORY
C7,
KPNT,	0007		/POINTER TO DIRECTORY KEYWORD
ERR1,	TEXT "CREA"
ERRA,	BLOCK 2		/APPROPIATE MESS. COMES HERE
/
/FILE CREATE ROUTINE: CALL CREATE('DEV','FILE',LFILE,LREC)
/LFILE=FILE LENGTH IN BLOCKS.
/LREC =RECORD LENGTH IN WORDS.
/
CREAT,	BLOCK 2		/CREATE A FILE
	TAD ERR1	/MOVE RIGHT ERROR MESS.
	DCA ERRA
	TAD ERR1#
	DCA ERRA#
	JMS DEVFIL	/GET HANDLER,FILENAME
	CLA CLL
	JMS GETARG	/GET FILE LENGTH
	DCA CRE8	/FOR CLOSE
	JMS GETARG	/GET RECORD LENGTH
	DCA CRE7	/SAVE TEMP.
	TAD FPNT	/SET POINTER TO FILENA
	DCA CRE3
	TAD CRE8	/GET LENGTH
	AND (7400	/MUST BE .LE.377
	SNA CLA
	TAD CRE8	/.LE.377 FIND FITTING HOLE
	CLL RTL;CLL RTL	/MOVE TO BITS 0...7
	TAD CRE1#	/+DEVICE NUMBER
	6212		/CIF 10
	JMSI USR
	 3		/ENTER FILE
CRE3,	 0		/POINTER
	 0		/WILL BE STARTING BLOCK
	JMPI  CRERRI	/**ERROR**
	6211		/CDF 10
	CLA IAC
	TADI INF	/GET LOC. OF 2ND.ADD.INF. WORD
	SMA		/MIN. 2 ADD.INF.
	JMPI CRERRI	/1 OR 0: ERROR
	TADI LPNT
	DCA CRE3	/SAVE PONTER TEMP.
	TAD CRE7	/GET RECORD LENGTH
	DCAI CRE3	/SAVE RECORD LENGTH
	TADI KPNT
	AND C7		/BLOCK NUMBER OF SEGMENT
	DCA CRE7
	JMS MYCDF	/RESET DATAFIELD
	6202		/CIF 0
	JMSI CRE2	/USE HANDLER
	 4210		/WRITE 1 SEGMENT
	 1400
CRE7,	 0
	JMPI CRERRI	/WRITE ERROR
	TAD CRE1#	/GET DEVICE #
	6212		/CIF 10
	JMSI USR	/FORCE DATA FIELD
	 4		/CLOSE
FPNT,	 FNAM
CRE8,	 0		/LENGTH
	JMPI CRERRI	/***ERROR
	6212		/CIF 10
	JMSI USR
	 11		/SWAP USR OUT
	RETRN CREAT	/DONE
/ALL ERRORS ARE FATAL; SO NO RETURN AT ALL.
/
/
/GETTING THE ARGUMENTS
GETARG,	0
	SZL CLA	/IF LINK IS SET: GET NEXT WORD
	JMP GETCDF
	TAD I CREAT
	DCA GETCDF
	INC CREAT#
	TADI CREAT#
	DCA PNTR
	INC CREAT#	/FOR NEXT CALL
GETCDF,	0		/WILL BE CDF
	TADI PNTR	/GET ARG.
	INC PNTR	/FOR NEXT CALL WITH LINK=1
	JMP I GETARG	/RESTORE PGM DATAFIELD
/
/
PNTR,
MYCDF,	0
	JMP I  MYCDF	/FORCE CURRENT DATAFIELD
/
/
DEVFIL,	0		/FETCH HANDLER, GET FILENAME
	CLA CLL		/LINK MUST BE 0
	JMS GETARG	/CHAR. 1 AND 2 DEV. NAME
	DCA CRE1
	CLL CML
	JMS GETARG	/CHAR. 3 AND 4 DEV. NAME
	DCA CRE1#
	CLL
	JMS GETARG	/CHAR. 1 AND 2 FILENAME
	DCA FNAM
	CLL CML
	JMS GETARG	/CHAR. 3 AND 4 FILENAME
	DCA FNAM#
	JMS GETARG	/CHAR. 5 AND 6 FILENAME
	DCA FNAM2
	6212		/CIF 10
	JMS 7700
	 10		/LOCK USR
	TAD (1001	/LOAD HANDLER AT 01000
	DCA CRE2
	6212		/CIF 10
	JMSI USR
	 1		/FETCH HANDLER
CRE1,	 0;0
CRE2,	 0
	JMPI CRERRI	/GIVE ERROR MESS.
	JMPI DEVFIL	/RETURN

PAGE
/
/
/
/RANDOM FILE OPEN ROUTINE
/	CALL ROPEN(ID,'DEV','FILE')
/CAN ALSO BE USED TO CHANGE THE DEFAULT .FR
/EXTENSION:
/	CALL ROPEN(0,'XY')
/THE EXTENSION FOR ROPEN AND CREATE
/IS NOW .XY
/
GETARI,	GETARG
DEVFII,	DEVFIL
USR2,	200
MYCDFI,	MYCDF
ERPNT,	ERRA
DEVI,	CRE1#
IEXTI,	IEXT		/POINTS TO .FR EXTENSION
ID,	0		/FILE ID NUMBER
TEMP2,	0
INF2,	1404
LPNT2,	0017
FPNT2,	FNAM
ERR2,	TEXT "ROPN"
DEV,
ROPEN,	BLOCK 2		/OPEN ROUTINE
	CLA CLL CML CMA
	TAD ERPNT	/SET POINTER
	DCA 10		/TO MOVE ERR.
	TAD ERR2	/ MESSSAGE AND ENTRY
	DCAI 10
	TAD ERR2#
	DCAI 10
	TAD ROPEN
	DCAI 10
	TAD ROPEN#
	DCAI 10
	JMSI GETARI	/GET ID (LINK=0)
	SNA		/IF ID = 0  :
	JMP ROP8	/CHANGE DEFAULT EXTENSION
	SPA
	CIA		/MAKE ABSOLUTE
	DCA ID
	JMSI DEVFII	/GET HANDLER AND FILENAME
	TAD ID		/CHECK ID
	TAD (-5		/MUST BE .LE.5
	SMA SZA CLA
	JMP CRERR	/**ERROR: BAD ID
	TAD FPNT2	/SET POINTER TO FILENAME
	DCA ROP3
	TADI DEVI	/GET DEVICE NUMBER
	DCA DEV		/SAVE ON THIS PAGE
	TAD DEV
	6212		/CIF 10
	JMSI USR2
	 2		/LOOKUP
ROP3,	 0		/FILENA POINTER
ROP6,	 0		/WILL BE -FILE LENGTH
	JMP CRERR	/***NOT FOUND
	6211		/CDF 10
	CLA CLL IAC
	TADI INF2	/COMPUTE ADD INF WORD 2
	SMA		/# OF ADD.INF.WRDS MUST BE 2
	JMP CRERR	/ OR MORE
	TADI LPNT2
	DCA TEMP2
	TADI TEMP2	/RECORD LENGTH
	SPA SNA		/RECORD LENGTH MUST BE POS.
	JMP CRERR	/**BAD RECORD LENGTH
	DCA DEV#
	JMSI MYCDFI	/RESET DATAFIELD
	6212		/CIF 10
	JMSI USR2	/FORCE DATA FIELD
	 11		/SWAPOUT
	TAD ID		/COMMON LOC.=ID*4+174
	CLL RTL		/*4
	TAD (173
	DCA 10		/SET AUTO INDEX
	6211		/CDF 10
	TAD DEV#	/SET RECORD LENGTH
	DCAI 10
	TAD ROP6	/SET -FILE LENGTH
	DCAI 10
	TAD ROP3	/SET STARTBLOCK
	DCAI 10
	TAD DEV		/SET DEVICE #
	DCAI 10
	RETRN CREAT	/RETURN
CRERR,	JMSI MYCDFI	/RESET DATAFIELD
	6212		/CIF 10
	JMSI USR2
	 11		/RESTORE FORTRAN OPER. SYSTEM
	CALL 1,ERROR
	ARG ERRA	/NO RETURN: ALL FATAL
/
/
ROP8,	JMSI GETARI	/GET NEW EXTENSION
	DCAI IEXTI
	RETRN CREAT	/DONE
/
	END