.SBTTL  DOCUMENTATION
;=======================================================================
;
	.TITLE UNFORM
	.IDENT  /081181/
;
;	SUBROUTINE FOR UNFORMATTED I/O FROM FORTRAN
;
;	OPERATING SYSTEM:  RSX-11/M
;
;	AUTHOR:	T G KELLY
;		T V ATKINSON
;		P A HOFFMAN
;		DEPARTMENT OF CHEMISTRY
;		MICHIGAN STATE UNIVERSITY
;		EAST LANSING, MI 48824
;
;	DATE:	DECEMBER 1,1981
;
;=======================================================================
;
;
;	ABSTRACT:
;
;		THIS PROGRAM ALLOWS UNFORMATTED I/O FROM FORTRAN.  A FILE
;	IS FIRST OPENED BY A CALL TO UNFORM WITH IMODE = 0.  THE FILE
;	CAN THEN BE READ FROM(WRITTEN TO) AS NECESSARY BY CALLING
;	UNFORM WITH IMODE =1.  THE FILE CAN BE CLOSED BY A CALL TO UNFORM
;	WITH IMODE = 2.  MULTILPLE FILES CAN BE OPEN AT ANY ONE TIME
;	SINCE ALL SYSTEM I/O TABLES FOR A FILE ARE MAINTAINED IN THE ARRAY
;	"ITABLE" ASSOCIATED WITH THAT FILE.  THE ARRAY "ITABLE" HAS THE
;	THE DIMENSION 96.  THE USER MUST PROVIDE SUCH AN
;	ARRAY FOR EACH FILE.  THE CONTENTS ARE MAINTAINED BY
;	UNFORM AND THE SYSTEM.  WHEN OPENING A FILE, THE FILE SPECIFICATION
;	IS PASSED IN A 32. BYTE ARRAY(ISTRNG).
;
;
;
;======================================================================
;
;	ERROR MESSAGES:
;
;		ERROR   UNFORM:MMMMMMMMMMMMMMMMJJJJJJKKKKKKLLLLLL
;
;		WHERE:
;			MMMMMMMMMMMMMMMM IS AN ERROR MESSAGE
;			JJJJJJ IS THE ERROR CODE
;			KKKKKK IS THE LUN
;			LLLLLL IS THE RSX-11M I/O ERROR CODE
;
;------------------------------------------------------------------------
;
;	CALLING SEQUENCES:
;
;	FORTRAN:
;
;	TO OPEN A FILE		CALL UNFORM (0,IERR,ITABLE,ISTRNG,IRW,IAB,LUN)
;	TO RD/WR TO A FILE	CALL UNFORM (1,IERR,ITABLE,IBUFF,IBYTE)
;	TO CLOSE A FILE		CALL UNFORM (2,IERR,ITABLE)
;
;------------------------------------------------------------------------
	.PAGE
;-----------------------------------------------------------------------
;
;	MACRO:
;
;		TO OPEN A FILE FOR READ/WRITE:
;
;
;		JSR	PC,UNFORM
;		BR	N$
;		.WORD	IMODE		; -> INTEGER: =0 FOR OPEN
;		.WORD	IERR		; -> INTEGER: ERROR FLAG
;		.WORD	ITABLE		; -> INTEGER ARRAY(96.): I/O TABLES
;		.WORD	ISTRNG		; -> BYTE ARRAY(32.): DATASET SPEC
;		.WORD	IRW		; -> INTEGER =0: OPEN FOR READ
;						     =1: OPEN FOR WRITE
;		.WORD	IAB		; -> INTEGER =0: UNFORMATTED ASCII
;					;            =1: UNFORMATTED BINARY
;					;            =2:   FORMATTED ASCII
;					;            =3:   FORMATTED BINARY
;		.WORD	LUN		; -> LOGICAL UNIT NUMBER FOR I/O
;					;    OPERATION
;	N$:				; CONTINUE
;
;	FORMAT FOR IFILE:  DEV:[UIC,UIC]FILENAME.TYP;VER    32 CHARACTERS
;
;-----------------------------------------------------------------------
;
;		TO DO I/O ON OPENED FILE
;
;
;		JSR	PC,UNFORM
;		BR	N$
;		.WORD	IMODE		; -> INTEGER: =1 FOR READ/WRITE
;		.WORD	IERR		; -> INTEGER: ERROR/EOF FLAG
;					;		 =1 ERROR
;					;                =0 NO ERRORS
;					;		 =-1 EOF
;		.WORD	ITABLE		; -> INTEGER ARRAY(96.): I/O TABLES
;		.WORD	IBUFF		; -> ARRAY TO BE TRANSFERRED
;		.WORD	IBYTE		; -> INTEGER:
;					; UPON ENTRY: MAXIMUM NUMBER OF BYTES
;					; MUST BE AN EVEN NUMBER OF UNFORMATTED
;					; I/O
;					; UPON RETURN: ACTUAL NUMBER TRANSFERRED
;	N$:				; CONTINUE
;
;-----------------------------------------------------------------------
;
;
;		TO CLOSE A FILE:
;		IF THE FILE IS OPEN, NO ACTION IS TAKEN
;
;
;		JSR	PC,UNFORM
;		BR	N$
;		.WORD	IMODE		; -> INTEGER: =2 FOR CLOSE
;		.WORD	IERR		; -> INTEGER: ERROR FLAG
;		.WORD	ITABLE		; -> INTEGER ARRAY(96.): I/O TABLES
;	N$:				; CONTINUE
;
;=======================================================================
;
	.PAGE
	.SBTTL	OFFSET DEFINITIONS
;
	I.MODE = 2		; CALLING MODE
	I.ERR  = 4		; ERROR ARGUMENT
	I.TBL  = 6		; FILE DESCRIPTOR BLOCK (FDB)
	I.STRNG = 10		; FILE NAME STRING
	I.BUF  = 10		; USER STORAGE BUFFER
	I.BYTE = 12		; # OF BYTES
	I.RW  = 12		; READ/WRITE FLAG
	I.AB  = 14		; FORMAT/UNFORMATTED FLAG
	I.LUN = 16		; LUN (LOGICAL UNIT NUMBER)
;
	.SBTTL	REGISTER USAGE
;
;	ALL REGISTERS RETURNED UNCHANGED ON RETURN
;	FROM UNFORM.
;
;		FOR LOCAL REGISTER USAGE SEE INDIVIDUAL SUBTITLES:
;		OPEN,RDWT,CLOSE
;
	.SBTTL	MACRO DEFININTIONS
;
	.MCALL	CSI$,CSI$1,CSI$2,FDAT$R
	.MCALL	OPEN$R,OPEN$W,WAIT$,PUT$,GET$
	.MCALL	READ$,WRITE$,CLOSE$
;
;
;	SAVE AND RESTORE A REGISTER
;
	.MACRO	PUSH	ARG
	.IRP	X,<ARG>
	MOV	X,-(SP)
	.ENDM
	.ENDM
;
	.MACRO	POP	ARGLST
	.IRP	X,<ARGLST>
	MOV	(SP)+,X
	.ENDM
	.ENDM
;
	.SBTTL	ENTRY
;
;================================================================
;
;	ENTRY POINT
;
;=================================================================
;
	.GLOBL	UNFORM
	.PSECT	UNFORM
	F.BFHD == 20		;AND ALLOW TKB>ACTFIL=N
UNFORM:	PUSH	<R0,R1,R2,R3,R4>; SAVE WORKING REGISTERS
	MOV	I.TBL(R5),R0	; ADDRESS OF FDB
	MOV	@I.MODE(R5),R1	; CALLING MODE TO R1
	CLR	@I.ERR(R5)	; INITIALIZE ERROR ARG
	CLR	ERR		; INITIALIZE LOCAL ERROR FLAG
	CMP	#2,R1		; LEGAL MODE?
	BGE	1$
	JMP	MODERR		; ILLEGAL CALLING MODE
1$:	ROL	R1		; CREATE BYTE OFFSET
	JMP	@JTBL(R1)	; JMP TO FUNCTION
;
;	JMP TABLE
;
JTBL:	.WORD	OPEN
	.WORD	RDWR
	.WORD	CLOSE
;
;=================================================================
;
;	OPEN FILE
;
;=================================================================
;
	.SBTTL	OPEN
;
;	REGISTER USAGE:
;
;		R0 -> FDB (FILE DESCRIPTOR BLICK) ADDRESS
;		R1 -> RECORD ATTRIBUTE
;		R2 -> READ/WRITE FLAG
;		R3 -> LUN
;		R4 -> FILE NAME STRING
;
OPEN:	MOV	I.STRN(R5),R4	; GET ADDRESS OF COMAND STRING
	CSI$1	#CSIBLK,R4,#32.	; CHECK SYNTAX
	BCC	1$
	JMP	SYNERR		; SYNTAX ERROR IF CARRY SET
1$:	CSI$2	#CSIBLK,OUTPUT
	BCC	2$
	JMP	SYNERR
2$:	CLR	R4		; INITIALIZE RECORD ACCESS BYTE
	CMP	#2,@I.AB(R5)	; DETERMINE FILE FORMAT
	BGT	UNFMT		; MODE 0 AND 1 ARE UNFORMATED
	BNE	CONT		; MODE 2 IS FORMATED ASCII
ASCII:	MOVB	#FD.CR,R1	; RECORD ATTRIBUTE
	BR	CDORS
CONT:	CLR	R1
	BR	CDORS
UNFMT:	MOVB	#FD.RWM,R4	; INDICATE BLOCK I/O
CDORS:	MOV	I.TBL(R5),R0	; MOVE FDB ADDRESS TO R0
	MOV	@I.LUN(R5),R3	; LUN FOR THIS FILE
	MOV	@I.RW(R5),R2	; IS THIS A READ OR WRITE
	BEQ	1$		; 0 = READ, 1 = WRITE
	CMPB	#FD.RWM,R4	; FD.RWM = BLOCK ACCESS
	BNE	WRTE		; BRANCH TO FORMATTED WRITE
	BR	UNWRTE		; BRANCH TO UNFORMATTED WRITE
;
;	OPEN FOR READ
;
1$:	OPEN$R	R0,R3,#C.DSDS+CSIBLK	; OPEN FILE TO READ
	BCC	2$		; RETURN IF NO ERROR
	JMP	ERR2		; ERROR ON OPEN$R IF CARRY SET
2$:	CMPB	#FD.RWM,R4	; IS THIS AN UNFORMATTED REQUEST?
	BNE	3$		; IF NOT, EXIT
	MOVB	R4,F.RACC(R0)	; MODIFY ATTRIBUTE
3$:	JMP	EXIT
;
;	OPEN FOR WRITE
;
WRTE:	FDAT$R	R0,#R.VAR,R1	; INITIALIZE ATTRIBUTE SECTION (FORMATTED)
	BR	OPNWTE		; OPEN FILE
UNWRTE:	FDAT$R	R0,#R.FIX,#FD.BLK,#512.	; INITIALIZE ATTRIBUTE SECTION
OPNWTE:	BIS	#FA.ENB!FA.DLK,F.ACTL(R0)	; SET FDB FOR NO LOCK ON ABORT
	OPEN$W	R0,R3,#C.DSDS+CSIBLK,R4	; OPEN FILE TO WRITE
	BCS	ERR3		; ERROR ON OPEN$W IF CARRY SET
	JMP	EXIT
;
	.SBTTL	RD/WR
;
;===============================================================
;
;	READ/WRITE FROM(INTO) A FILE
;
;===============================================================
;
;	REGISTER USAGE:
;
;		R0 -> FDB ADDRESS
;		R1 -> ADDRESS OF READ/WRITE BUFFER
;		R2 -> # OF BYTES TO TRANSFER
;		R3 -> NOT USED
;		R4 -> NOT USED
;
RDWR:	MOV	I.BUF(R5),R1	; R1<<<<ADDRESS OF READ/WRITE BUFFER
	MOV	@I.BYTE(R5),R2	; # OF BYTES TO TRANSFER
	CMPB	F.FACC(R0),#FO.RD ; TEST FOR READ
	BNE	WRT
	CMPB	#FD.RWM,F.RACC(R0) ; IS THIS BLOCK OR RECORD I/O?
	BEQ	1$		; 0 IS BLOCK I/O
	GET$	R0,R1,R2	; RECORD I/O
	TSTB	F.ERR(R0)	; TEST FOR ERROR ON READ
	BMI	RERR
	MOV	F.NRBD(R0),@I.BYTE(R5) ; NUMBER OF BYTES READ
	BR	EXIT
1$:	READ$	R0,R1,R2,,EVNTFL,#IOSTAT,#0 ; READ FROM FILE
	TSTB	F.ERR(R0)	; TEST FOR ERROR ON READ
	BMI	RERR		; IF STATUS MINUS, ERROR
	WAIT$	R0		; WAIT FOR I/O COMPLETE
	TSTB	F.ERR(R0)	; ERROR ON READ?
	BMI	RERR
	MOV	IOSTAT+2,@I.BYTE(R5)	; # OF BYTES ACTUALLY TRANSFERED
	BR	EXIT

WRT:	CMPB	#FD.RWM,F.RACC(R0) ; RECORD OR BLOCK I/O?
	BEQ	1$		; 0 IS BLOCK I/O
	PUT$	R0,R1,R2	; WRITE RECORD
	BR	WERR		; TEST FOR WRITE ERROR
1$:	WRITE$	R0,R1,R2,,EVNTFL,#IOSTAT ; WRITE TO FILE
	TSTB	F.ERR(R0)	; TEST FOR ERROR ON WRITE
	BMI	WERR
	WAIT$	R0		; WAIT FOR WRITE COMPLETE
WERR:	TSTB	F.ERR(R0)	; ERROR ON WRITE?
	BPL	EXIT		; NO NEED TO UPDATE # BYTES TRANSFERED
	CMPB	F.ERR(R0),#IE.BYT ;ODD BYTE COUNT?
	BEQ	ODDERR		; HANDLE THE ERROR
	BR	WRTERR
RERR:	CMPB	F.ERR(R0),#IE.BYT ;ODD BYTE COUNT?
	BEQ	ODDERR		; HANDLE THE ERROR
	CMPB	F.ERR(R0),#IE.EOF ; END OF FILE?
	BNE	ERR1
	MOV	#-1,@I.ERR(R5)	; SIGNAL EOF
	BR	EXIT		; AND RETURN
IOSTAT:	.BLKW	2		; I/O STATUS BLOCK (2 WORDS)
;
;======================================================================
;
;	CLOSE FILE
;
;======================================================================
;
CLOSE:	CLOSE$	R0		; CLOSE FILE
	BCC	EXIT
	BR	CLSERR
;
;------------------------------------------------------------------------
;
;	ERROR HANDLER
;
;------------------------------------------------------------------------
;
ODDERR:	INC	ERRARG		;ODD BYTE COUNT FOR BLOCK I/O 
WRTERR:	INC	ERRARG		; ERROR ON WRITE
CLSERR:	INC	ERRARG		; ERROR ON CLOSE
MODERR:	INC	ERRARG		; ILLEGAL CALLING MODE
SYNERR:	INC	ERRARG		; SYNTAX ERROR
ERR3:	INC	ERRARG		; OPEN$W
ERR2:	INC	ERRARG		; OPEN$R
ERR1:	INC	ERRARG		; ERROR ON READ/WRITE
	MOV	ERRARG,R2		; R2 <<<< ERROR CODE
	MOV	R2,@I.ERR(R5)	; REPORT ERROR
	DEC	R2			; CONVERT TO "0" BASED ADDRESS
	ASL 	R2			; CONVERT TO BYTE ADDRESS
	MOV	MSGTAB(R2),ERRMSG	; UPDATE ERR MSG POINTER
	MOV	#NARTAB,NUMARG		; CHOOSE NUMBER OF ARGUMENTS
	MOVB	F.LUN(R0),ERRARG+2
	MOVB	F.ERR(R0),ERRARG+4
	MOV	R5,-(SP)
	MOV	#ARGLIS,R5		; SET UP CALL TO FORTRN
	JSR	PC,ERRPRT		; GO PRINT IT
	MOV	(SP)+,R5
;
;
;
EXIT:	POP	<R4,R3,R2,R1,R0>
	RETURN
EVNTFL:	32			; EVENT FLAG USED FOR ASYNCHRONOUS I/O
ERR:	.WORD	0		; LOCAL ERROR STORAGE
;
;----------------------------------------------------------------------
;
;	FORTRAN IV ARGUMENT LIST
;
;----------------------------------------------------------------------
;
ARGLIS:	.BYTE	4,0
	.WORD	MODNAM
	.WORD	ERRARG
	.WORD	NUMARG
ERRMSG:	.WORD	0			; POINTER TO ERROR MESSAGE
	.PAGE
;
;----------------------------------------------------------------------
;
;	ERROR REPORTING STORAGE
;
;----------------------------------------------------------------------
;
MSGTAB:	.WORD	MSG1		; TABLE OF MESSAGE POINTERS
	.WORD	MSG2
	.WORD	MSG3
	.WORD	MSG4
	.WORD	MSG5
	.WORD	MSG6
	.WORD	MSG7
	.WORD	MSG8
NARTAB=3
NUMARG:	.WORD	0		; NUMBER OF ARGUMENTS
ERRARG:	.BLKW	3		; ARGUMENTS TO BE PRINTED WITH ERROR MSG
;
;	MESSAGES
;
MODNAM:	.ASCII	/  UNFORM/
MSG1:	.ASCII	/DURING READ     /
MSG2:	.ASCII	/OPENING FOR RD  /
MSG3:	.ASCII	/OPENING FOR WRIT/
MSG4:	.ASCII	/SYNTAX ERROR    /
MSG5:	.ASCII	/ILLEGAL MODE    /
MSG6:	.ASCII	/CLOSING         /
MSG7:	.ASCII	/DURING WRITE    /
MSG8:	.ASCII	/ODD BYTE COUNT  /
	.EVEN
;
	CSI$			; DEFINE CSI BLOCK
	.EVEN
CSIBLK:	.BLKB	C.SIZE
	.END