.TITLE	FIOPS
/
/COPYRIGHT (C) 1975
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
/ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
/THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS
/SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PRO-
/VIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON
/EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO
/THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE
/WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COM-
/MITMENT BY DIGITAL EQUIPMENT CORPORATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
/OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
	.EJECT
/COPYRIGHT 1970,1973, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
/EDIT #035 7 NOV 73  T.A.MURRAY
/			M. HEBENSTREIT
/EDIT #036  18-APR-75  R. K. BLACKETT
/	PUT IN CODE IN THE RSX .FC SECTION TO SET BIT
/	3 OF THE CURRENT STAD ENTRY IF THE DEVICE IS FILE ORIENTED.
/	THIS IS REQUIRED IN BCDIO 050 AND LATER TO DETERMINE
/	IF BCDIO SHOULD USE THE CARRIAGE CONTROL CHARACTER OR NOT.
/	PUT SAME CODE IN DOS .DSK ROUTINE.
/	**NOTE** SEE ALSO EDIT 038 BELOW.
/
/EDIT #037  18-APR-75  R. K. BLACKETT
/	INSERT 'AND' AFTER 'FQ..4' TO ENABLE ERROR DETECTION
/	WHEN READING FROM A UNIT OTHER THAN ZERO.
/
/EDIT #038  12-JUN-75  R. K. BLACKETT
/	ADD TO CODE INSERTED IN EDIT 036 TO ALSO SET
/	BIT 03 OF THE STAD ENTRY IF THE DEVICE
/	HAS A BUFFER LENGTH OF 64 (FOR DOS) OR A
/	DEVICE CODE OF 10 (FOR RSX).  THESE
/	INDICATORS REPRESENT THE PAPER TAPE PUNCH
/	(OR POSSIBLY THE READER IN DOS).
/	THE SENSE OF BIT 03 HAS CHANGED FROM MEANING
/	"MASS-STORAGE DEVICE" TO MEANING "NON-PRINTER
/	TYPE DEVICE".
/
/EDIT #039  19-JUN-75  R. K. BLACKETT
/	REMOVE 'EOF ENCOUNTERED' CHECK FROM .FQ IN THE
/	DOUBLE BUFFERING CASE TO PREVENT .FQ FROM ALWAYS
/	RETURNING EOF INDICATOR.  THIS ALLOWS READING
/	'THRU' END OF FILES ON CARDS AND MAGTAPE.  SPR 15-968
/
/
/EDIT #040  29-JUL-75  R. K. BLACKETT
/	FIX DOUBLE BUFFERING I/O SECTION TO AND OFF DESCRIPTOR
/	BITS FROM 0:3 OF THE BUFFER ADDRESS POINTER ENTRIES.
/	ALSO, CHANGE NAME OF DOUBLE BUFFERING ADDRESS TABLE
/	FROM 'BTABLE' TO '.BTABL' TO AVOID CONFLICT
/	WITH USER SYMBOLS. THIS WAS DONE WITH THE CONVERT COMMAND, SO EDIT M
/	MARKERS WILL NOT APPEAR, AND SOME COMMENTS MAY HAVE BEEN MODIFIED.
/
/ EDIT #41	20-AUG-75	M. HEBENSTREIT	DISCLAIMER
/
/EDIT #042  24-NOV-75  R. K. BLACKETT
/	ADD A NEW ASSEMBLY PARAMETER, '%NODBL'  TO SUPPRESS
/	DOUBLE BUFFERING, AND MAKE DOUBLE BUFFER THE DEFAULT.
/
/EDIT #043  20-JAN-76  R. K. BLACKETT
/	FIX BUG IN .DSK ROUTINE WHICH CAUSED THE 'NON-PRINTER
/	DEVICE' BIT TO GET LOST IF A FILE WAS RE-OPENED FOR
/	OUTPUT.
/
/EDIT #044  23-FEB-76  R. K. BLACKETT
/	FIX .FC ROUTINE TO VERIFY THAT THE DAT SLOT (OR LUN)
/	BEING INITIALIZED IS NOT > THE NUMBER OF DAT SLOTS
/	(OR LUNS) IN THE SYSTEM.  THIS FIX INCLUDES CHANGES
/	TO BOTH THE DOS AND RSX PORTIONS OF FIOPS.
/
/EDIT #045  26-FEB-76  R. K. BLACKETT
/	FIX DOS .FC ROUTINE WHEN DOUBLE BUFFERING
/	AND A DAT SLOT IS BEING RE-INITIALIZED TO WAIT
/	FOR PREVIOUS WRITE REQUEST TO COMPLETE BEFORE
/	ISSUING .INIT, BUT DON'T WAIT FOR PREVIOUS READ
/	REQUEST, USE THE .INIT TO CANCEL THE .READ.
/
/EDIT #046   27-APR-76	G. A. REID
/	FIX DOS .FQ ROUTINE TO ALLOW THE USE OF
/	.DAT SLOT -1.  THIS IS NECESSARY TO ENABLE
/	DEFINE TO ADJUST RANDOM ACCESS FILES WHEN
/	SPECIFIED.
/
/EDIT #047	 4-MAY-76  G. A. REID
/	CHANGE THE RSX VERSION TO PASS THE LUN
/	AND THE EVENT VARIABLE TO OTSER WHEN
/	REPORTING AN OTS-20 ERROR.  THIS CHANGE
/	REQUIRES THE USE OF OTSER EDIT #016
/	OR LATER.
/
/
/
//
/
/
/OVERLAPPED IO MODIFICATIONS EDIT NO. 001
/
/DOUBLE BUFFERRING BY R. COOK, 10-10-71
/
/	OVERLAPPED IO IS IMPLEMENTED BY INTRODUCING A NEW TABLE --
/.BTABL, IN 1-1 CORRESPONDENCE WITH STAB. EACH ENTRY IN
/.BTABL CONTAINS AN INTEGER N, THE SIGNIFICANCE OF WHICH IS
/AS FOLLOWS:
/		N=0 -- THIS DAT SLOT UNUSED UP TO THIS POINT
/		N<0&N=-1 -- THIS DS HAS SYNCHRONOUS IO
/		N<0&N#-1 -- THIS DS IS DOUBLE BUFFERED WITH THE
/			FIOPS BUFFER (.FN) AND AN INIT HAS JUST BEEN DONE
/		N>0 -- THIS DS IS DOUBLE BUFFERED AND AT LEAST ONE 
/			IO TRANSFER HAS BEEN DONE SINCE THE LAST INIT.
//
//
//
/	THE ADDITIONAL BUFFER SPACE IS OBTAINED FROM THE SYSTEM VIA
/.GETBF (CAL-21) WITH THE CONVENTION THAT DISK IO IS NOT 
/DOUBLED BUFFERED SINCE THE CORE REQUIREMENTS COULD BECOME TOO
/GROSS FOR LITTLE RETURN. ONE (SYSTEM) BUFFER IS USED FOR ALL
/NON-MASS STORAGE DEVICES AND ONE EACH FOR EACH MASS STORAGE
/DEVICE (EG., MAG TAPE, DECTAPE) EXCEPT FOR DISK.
/
.SCOM=100
/
/**ASSEMBLY PARAMETERS
/DEFINE BF FOR BACKGROUND/FORGROUND SYSTEMS
/DEFINE RSX FOR RSX SYSTEMS.
	.IFUND RSX
	.IFDEF BF
%V5A=0
	.ENDC
/DEFINE %V5A FOR V5A SYSTEM
	.IFUND %V5A
%DOS15=0
	.ENDC
/DEFIN %DBL FOR DOUBLE BUFFERING UNDER DOS (DEFAULT)
/DEFINE %NODBL TO PREVENT DOUBLE BUFFERING MODE
	.IFUND	%NODBL		/(RKB-042)
%DBL=0				/(RKB-042)
	.ENDC			/(RKB-042)
	.IFDEF %DBL
%DOS15=0
SC.SLT=.SCOM+24			/(RKB-044) NUMBER OF POSITIVE .DATS
	.ENDC
/DSKTB --ONE WORD PER DAT SLOT
/IF ENTRY IS NON ZERO SLOT HAS BEEN .FSTAT 'D AND DSK WAS
/ASSIGNED.  ENTRY IS 777777 IF .FSTAT'D AND NOT THE DISK
/DEFAULT TABLE SIZE IS 20 (8)
/DEFINE DKTBSZ IF SIZE IS TO BE ADJUSTED
	.IFDEF %DOS15
	.GLOBL .SDSTB		/GLOBL IN STOP ROUTINE
	.IFUND DKTBSZ
DKTBSZ=20
	.ENDC
	.ENDC
       .GLOBL .FC,.FQ,.FH,.FM,.FN,.ER,.FP
	.GLOBL	.FC6		/** LINE BUFF SIZE
	.GLOBL FIOPS
	.GLOBL	.RN	/* RANDOM ACCESS FLG.:  =400000FOR
/			/* BCD R.A.;  =0 ELSE
	.GLOBL	.STADD	/* CONTAINS ADDR. OF CURRENT ENTRY IN ST. TAB.
	.GLOBL	.CHKDL	/* CHK. DELETE BIT AND DELETE IF NEC.
	.GLOBL	.ADDC	/* ADDR. OF DLCL IN DEFINE
	.GLOBL	.DTBL		/** TABLE FOR HDR. WD. 0
	.IFDEF %DOS15
	.GLOBL STAB,.DSK
	.ENDC
	.IFDEF %DBL
	.GLOBL .BTABL
	.ENDC
FIOPS=.
/*
/ASSEMBLY PARAMETERS
/  THE SIZE OF THE STATUS TABLE IN FIOPS (AT 'STAB') LIMITS
/    THE .DAT SLOTS THAT CAN BE USED IN FORTRAN.  THE STANDARD
/    ASSEMBLY OF FIOPS WILL ALLOW .DAT SLOTS FROM 1 TO 20(8)
/    TO BE USED.  TO INCREASE THIS NUMBER, IT IS NECESSARY
/    TO DEFINE AN ASSIGNED VARIABLE, 'STTBSZ' TO BE EQUAL TO
/    THE (OCTAL) NUMBER OF SLOTS DESIRED.
/
	.IFUND STTBSZ	/*
STTBSZ=20		/*
	.ENDC		/*
/INITIALIZE I/O DEVICE (.INIT)
/CALLING SEQUENCE--LAC  ADDRESS OF SLOT NUMBER.
/	         JMS* .FC
/EXIT WITH ACTUAL SLOT NUMBER IN AC.
.FC    CAL    0
	DAC SLOT  /EITHER ADR OF OR PTR TO ADR OF SLOT NO.
	.IFDEF %DBL
	SPA	  /IF PTR TO ADR, BIT 0 IS SET
	LAC* SLOT  /IN WHICH CASE ,RETRIEVE THE ACTUAL ADR
	DAC SLOT  /HARMLESS IF ABOVE SKP EXECUTED
	LAC* SLOT  /NOW GET THE VALUE OF SLOT
	.ENDC
	.IFUND %DBL
	SMA
	JMP .+3
	LAC* SLOT
	DAC SLOT
	LAC* SLOT
	.ENDC
/
       SMA!SZA	         /   FOR ZERO OR NEGATIVE.  IF SO,
       JMP    FC0	         /   GO TO ERROR EXIT.  IF OK, GO
FCERR  JMS*   .ER	         /   AHEAD. 
       .DSA   10
FC0	DAC	SLOT		/(RKB-044) SAVE WHOLE NUMBER
	TCA			/(RKB-044) MAKE IT NEGATIVE
	TAD*	(SC.SLT)	/(RKB-044) CHECK IT AGAINST # OF 
	SPA			/(RKB-044)   POSITIVE .DATS
	JMP	FCERR		/(RKB-044) ERROR, NOT THAT MANY SLOTS
	LAC	SLOT		/(RKB-044) RECALL DAT SLOT NUMBER
       TAD    (STAB-1)       /ADD STATUS TABLE ADDRESS TO
       DAC    .STADD          /   GET STATUS WORD ADDRESS.
       LAC    .FH	         /MOVE R/W FLAG TO BIT 0 AND SAVE.
	RCR;	RAR
       DAC    RWFLG
	LAC*	.STADD	/*
	AND	(377000	/* SAVE BITS #1 THRU #8
	DAC	OTBITS	/*
       LAC*   .STADD          /TEST STATUS WORD TO SEE IF THIS
       SNA	         /   SLOT HAS BEEN INITIALIZED.
	.IFDEF %DOS15
	JMP FC1	/GO INIT FIRST
	LAC SLOT	/TEST AND SET .DSKF FOR FUTURE TEST FOR DSK
	JMS .DSK
	LAC* .STADD
	XOR	OTBITS		/MASK OFF OTHER BITS
	JMP FC7
	.ENDC
       JMP    FC1	         /   NO--INITIALIZE IT.
/	IF BF MONITOR SYSTEM,FIOPS DOES NOT
/	WANT TO INIT ON CHANGE OF TRANSFER DIRECTION
/	ONLY WANTS TO INIT IF .DAT SLOT HAS NOT BEEN
/	PREVIOUSLY INITIALIZED.
	.IFDEF BF
	AND (777)		/MASK OFF BUFFER SIZE FOR .FM
	JMP FC2
	.ENDC
	.IFUND BF
/	WANT TO INIT ON CHANGE OF TRANSFER DIRECTION IN
/	CASE OF KEYBOARD OR I/O MONITOR SYSTEMS
FC7       XOR    RWFLG          /   YES--CHECK BIT 0.
       RAL	         /IF BIT 0 HAS CHANGED, INITIALIZE
       SNL!RCR	         /   THE SLOT IN ITS NEW MODE.	IF
       JMP    FC2	         /   NOT, RESTORE OLD STATUS WORD.
	.ENDC
	.IFDEF %DOS15
	DAC FC8	/TEMP DSTR
	LAC .DSKF	/IF DISK,DON'T REINIT ON I/O DIRECTION CHANGE
	SNA
	JMP	FC1	/NOT THE DISK
	LAC FC8	/RESTORE AND CONTINUE
	JMP FC2
	.ENDC
FC1    LAC    .FH	         /TEST FOR READ OF WRITE.
       SZA	         /   SLOT.OR.000000 FOR READ.
       LAC    (1000)         /   SLOT.OR.001000 FOR WRITE.
       XOR    SLOT
	DAC	FCINIT		/(RKB-045) STORE IN .INIT CAL
	CLC			/ENTER DAT SLOT INTO STOP TABLE
	TAD	SLOT
	TAD	.SDSTB
	DAC	T.1		/(RKB-045) SAVE .SDSTB ENTRY ADDRESS
	.IFDEF	%DBL		/(RKB-045)
	LAC*	T.1		/(RKB-045) IS THIS FIRST REFERENCE
	SNA			/(RKB-045) TO THIS SLOT?
	JMP	FC1.1		/(RKB-045) YES, DO INIT UNCONDITIONALLY
	LAC	.FH		/(RKB-045) NO, IS IT BEING OPENED FOR
	SZA			/(RKB-045) INPUT, THUS POSSIBLY
				/(RKB-045) LEAVING A .WRITE REQUEST
				/(RKB-045) IN PROGRESS?
	JMP	FCINIT		/(RKB-045) NO, THEN IT IS BEING OPENED
				/(RKB-045) FOR OUTPUT, THUS POSSIBLY
				/(RKB-045) LEAVING A .READ REQUEST
				/(RKB-045) IN PROGRESS, WHICH WE WANT
				/(RKB-045) TO CANCEL BY ISSUING A .INIT
	LAC	SLOT		/(RKB-045) YES, MAY HAVE A .WRITE GOING
				/(RKB-045) WHICH IS TO BE ALLOWED TO
				/(RKB-045) COMPLETE BY ISSUING A .WAIT
	DAC	FQ40		/(RKB-045) SET UP A .WAIT MACRO
	JMS	WAIT		/(RKB-045) AND LET THE .WRITE STOP
FC1.1=.				/(RKB-045) SET ENTRY IN .SDSTB
	.ENDC			/(RKB-045)
	CLC
	DAC*	T.1		/(RKB-045)
FCINIT	.INIT	0,0,FCERR	/(RKB-045) INITIALIZE THE HANDLER
.FC6=.-1			/(RKB-045) RETURNED MAX. BUFFER SIZE
	LAC	SLOT	/(RKB-043) RE-BUILD OTBITS
	JMS	.DSK	/(RKB-043) TO REFLECT 'NON-PRINTER' DEVICE
	.IFDEF %DBL
/************************************************************************
/
	STL
	LAC .FC6  /TEST FOR TTY
	SAD (42  /LINE BUFFER SIZE OF TTY
	LRS 1  /IF YES, SET BIT 1
	LRS 1  /SET BIT 0 TO INDICATE 1ST TIME
	AND (700000 
	DAC RW  /OR IN LATER
/
	LAC SLOT
	TAD (.BTABL-1
	DAC T.1
FC..5	LAC* T.1
	SAD (777777)
	JMP FC..4
	SZA
	JMP FC..2
	.ENDC
/(RKB-043)
/(RKB-043) THE FOLLOWING FOUR LINES WERE DELETED:
/	.IFDEF %DOS15
/	LAC SLOT
/	JMS .DSK	/IF DEVICE IS A DISK, AC = -1 ON RETURN
/	.ENDC
	.IFDEF %DBL
	LAC	.DSKF	/(RKB-043) GET INICATOR FROM .DSK
	SZA!CLC
	JMP FC..2	/IT'S  A DISK; INSTAL A -1
	LAW -375  /TEST FOR MS
	TAD .FC6
	SMA	/MS?
	JMP FC..6	/YES; TRY FOR A FULL BUFFER
	LAC BUFEND
	SZA	/IS THERE A NON-MS BUFFER YET?
	JMP FC..3	/YES; TRY TO PARTITION IT  (FURTHER)
	0		/NO; TRY TO GET ONE
	21
BUFEND	0
	DAC BUFPTR	/ADR OF NON-MS BUFFER (OR -1)
	TAD* (.SCOM+27
	DAC BUFEND	/LIMIT OF NON-MS BUFFER
FC..3	LAC BUFPTR
	SPA
	JMP FC..2	/BUFPTR = -1 => THERE IS NO PARTITIONABLE BUFFER
	TAD .FC6	/SEE IF ROOM FOR NON MS ALLOCATION
	TAD (1
	JMS COM
	TAD BUFEND
	SPA!CLC
	JMP FC..2	/INSTALL -1 ... NO ROOM!
	LAC BUFPTR
	DAC* T.1
	TAD .FC6
	DAC BUFPTR
	JMP FC..5
FC..6	LAC (100000	/THE MASS STORAGE BIT
	XOR RW
	DAC RW
	0	/TRY FOR A MS BUFFER
	21
	0
FC..2	JMS .OR	/OR IN THE DEVICE TYPE AND R/W CONTROL BITS
	DAC* T.1	/INSTALL IN THE .BTABL
	.ENDC
FC..4	LAC .FC6
	AND (776
FC2	DAC .FM
	XOR RWFLG
	XOR OTBITS
	DAC* .STADD
	.IFDEF %DBL
	AND (777
	JMS COM
	.ENDC
	.IFUND %DBL
	AND (777
	CMA
	TAD (1
	.ENDC
	DAC FQ3
	LAC SLOT
	JMP* .FC
	.IFDEF %DBL
/
/
T.1
T.2
/
/
.OR
	LMQ
	LAC RW
	OMQ
	JMP* .OR
/
/
/
/
BUFPTR	-1
	.ENDC
 
/CALLING SEQUENCE------LAC DSLOT
/----------------------JMS(*) .DSK
/-----------------------RETURN WITH DSK FLAG IN AC(NON-0 MEANS DISK
/ROUT. WILL .FSTAT ANY DAT SLOT .INIT'D ONLY ONCE
/WILL PUT 777777 IN DSKTBL IF NOT A DISK
/WILL PUT 200000 OR 300000 IN DSKTBL IF A DISK
	.IFDEF %DOS15
.DSK	0
	DAC FC9	/SAVE SLOT #
	TAD (3000)	/.FSTAT BUILD
	DAC FC4
	LAC (DSKTBL-1)
	TAD FC9
	DAC FC10
	LAC* FC10	/HAS .DAT SLOT BEEN .FSTAT'D?
	SZA
	JMP FC11	/YES.  BYPASS .FSTAT
	DZM .DSKF	/NO REINIT
FC4	0	/.FSTAT
	2
FC5	FC2	/DIR. ENTRY DOESN'T MATTER
	LAC FC5
	AND (700000)
	SAD	(500000)	/IF RK, SIMULATE RF CODE
	LAC	(200000)
	SAD (200000)	/TEST FOR RF DISK
	DAC .DSKF
	SAD	(300000)  /TEST FOR RP DISK
	DAC .DSKF
	SZA!CLA		/(RKB-036) SKP IF .DAT IS NON-FILE ORIENTED
	LAC	(40000)	/(RKB-036) SET 'DIRECTORIED' BIT IF DT,RF,RP,MT,RK
	DAC	OTBITS	/(RKB-036) SINCE I KNOW THIS IS FIRST TIME THRU
			/(RKB-036) FOR THIS FILE, AND ERGO 'OTBITS' IS
			/(RKB-036) ZERO, I'LL NOT BOTHER TO COMBINE BIT 3,
			/(RKB-036) I'LL JUST SET THE WHOLE WORD.
	LAC	.FC6	/(RKB-038) USE THE BUFFER SIZE TO CHECK FOR PAPER TAPE
	SAD	(64)	/(RKB-038) AS 'DIRECTORIED' BIT IS NOW THE
	SKP		/(RKB-038) 'NON-PRINTER' BIT.  I.E., THE DEVICE
	JMP	.+3	/(RKB-038) IS RP,RK,RF,DT,MT, OR PP OR PR.  THIS
	LAC	(40000)	/(RKB-038) MEANS THE DEVICE IS NOT LP,TT,VP,XY.
	DAC	OTBITS	/(RKB-038) WHERE EVER YOU SEE THE TERM 'DIRECTORIED' OR
			/(RKB-038) 'MASS-STORAGE' IN CONJUNCTION WITH THE
			/(RKB-038) CARRIAGE CONTROL CHARACTER, SUBSTITUTE THE
			/(RKB-038) 'NON-PRINTER TYPE DEVICE', OR ELSE BE READY
			/(RKB-038) TO CONSIDER THE PAPER TAPE UNIT AS A MASS
			/(RKB-038) STORAGE FACILITY.
	LAC FC5
	AND (77777)	/REZERO BITS 0-2
	DAC FC5
	LAC .DSKF	/FLAG IN AC FOR RETURN
	SNA		/IF 0, SET TABLE ENTRY TO 777777
	CLC
	DAC* FC10	/IF NOT 0,TABLE ENTRY 200000 OR 3000000
	LAC .DSKF	/FLAG TO AC
	JMP* .DSK
FC11	SAD (777777)	/CLEAR AC IF NOT A DSK
	CLA
	DAC	.DSKF
	LAC	FC9	/(RKB-043) GET THE DAT SLOT
	TAD	(STAB-1) /(RKB-043) FIND THE STAB ENTRY
	DAC	FC4	/(RKB-043) USE THIS WORD TEMORARILY
	LAC*	FC4	/(RKB-043) IS THIS SLOT BEING RE-OPENED?
	SZA		/(RKB-043) SKIP IF YES
	JMP	FC11.2	/(RKB-043) NO, ITS ALREADY OPEN
	LAW	-375	/(RKB-043) NEED TO RE-DETERMINE
	TAD	.FC6	/(RKB-043) DEVICE TYPE
	SMA		/(RKB-043) SKIP IF NOT DT, MT, RK, RP, DK
	JMP	FC11.1	/(RKB-043) ITS A DISK OR TAPE UNIT
	AAC	375-62	/(RKB-043) IF BUF SIZE IS 62, ITS PP OR PR
	SNA!CLA		/(RKB-043) SKIP IF NOT PP OR PR
FC11.1	LAC	(40000)	/(RKB-043) SET THE 'NON-PRINTER' BIT
	DAC	OTBITS	/(RKB-043) (I KNOW NO OTHER BITS ARE SET)
FC11.2	LAC	.DSKF	/(RKB-043) RECOVER OLD DISK FLAG
	JMP* .DSK
/DSK TABLE 200000 OR 300000 ENTRY INDICATES SLOT .FSTAT'D AND
/DISK PRESENT.  777777 ENTRY INDICATES SLOT .FSTAD'D AND NO
/DISK PRESENT
DSKTBL=.
	.REPT DKTBSZ
	0
	.ENDC
       .EJECT
/TRANSFER LINE BUFFER (.READ, .WRITE, AND .WAIT).
/CALLING SEQUENCE--LAC  SLOT(BITS 9-17) AND MODE(BITS 6-8).
/	         JMS* .FQ
.FQ    CAL    0
       AND    (7777)         /FORM CAL INSTRUCTION FOR .READ OR .WRITE
       DAC    FQ1	         /   AND .WAIT IOPS ROUTINE CALLS.
	.IFDEF %DBL
	DAC FQ10   /DOUBLE BUFFERING  CAL'S HAVE THEIR OWN CELLS.
	.ENDC
       AND    (777)
       DAC    FQ4
	.IFDEF %DBL
	DAC FQ40
	.ENDC
       LAC    .FH	         /SET UP WORD 2 OF .READ OR .WRITE.
       TAD    (10)	         /   10 FOR .READ.
       DAC    FQ2	         /   11 FOR .WRITE.
	.IFDEF %DBL
	DAC FQ20
/
/
/
/
/*************************************************************************
/
/
	LAC FQ3
	DAC FQ30
	LAC FQ4
	SAD	(000777)	/(GAR-046) ALLOW USE OF .DAT-1 BY DEFINE.
	JMP	FQ1		/(GAR-046) IT WAS -1, GO PERFORM I/O.
	TAD (.BTABL-1
	DAC T.1
	LAC* T.1
	SAD	(777777	/SYCHRONOUS I/O?
	JMP	FQ1	/YES; NORMAL ROUTE
	AND (77777  /DATA CHANNEL ADRESSES ARE FULL 18 BITS
		/THUS, THE DESCRIPTOR BITS MUST BE CLEARED.
	DAC FQ50  /BUFFER ADDRESS
	LAC FQ2
	SAD (10		/READ OR WRITE?
	JMP FQ..1		/READ
	JMS WAIT	/PROCESS THE WRITE
	JMS RSET	/TAKE ABS TABLE VALUE
	LAC	FQ50	/(RKB-040) USER ADDRESS W/O HIGH BITS
	DAC T.4  /DESTINATION ADR
	LAC (.FN
	DAC T.3  /SOURCE ADR
	JMS MOVE
	JMS RW
FQ..5	JMS RSET
	JMP* .FQ
/
FQ..1	LAC* T.1  /PROCESS THE READ
	RAL  /L = 1ST TIME FLAG; SIGN BIT = TTY IF TRUE
	SPA  /BIT 0 = 1, SYNCHRONOUS MODE
	JMP FQ1
	SZL  /1ST TIME?
	JMS RW	/SINCE 1ST TIME THROUGH
	JMS WAIT
	LAC* T.1
	AND	(77777)	/(RKB-040) REMOVE HIGH ORDER DESCRIPTOR BITS
	DAC T.3
	LAC (.FN
	DAC T.4
	JMS MOVE
/(RKB-039) REMOVED FOLLOWING 6 LINES TO ALLOW READING
/(RKB-039) THROUGH END OF FILES ON CARDS AND MAGTAPE.
/	LAC .FN
/	AND (17
/	SAD (5	/EOF?
/	JMP FQ..5	/YES...AVOID PROBLEMS
/	SAD (6  /EOM?
/	JMP FQ..5  /YES; DON'T ISSUE ANOTHER READ.
	JMS RSET
	JMS RW
	JMP FQ..4
/
	.ENDC
/*
/*********************************************************************
/
/
/
FQ1    CAL    0	         /.READ OR .WRITE IOPS CAL.
FQ2    .DSA   0
       .DSA   .FN
FQ3    XX
FQ4    CAL    0	         /.WAIT IOPS CAL.
	.DSA	12
FQ..4	LAC	FQ2		/CAL CODE
	AND	(777)	/(RKB-037) STRIP UNIT NUMBER SUPPLIED BY MONITOR
	SAD	(11		/SKP IF READ
	JMP*	.FQ		/RTN. IF WRITE
	LAC	FQ4		/SLOT NUM
	TAD	(.DTBL
	DAC	.DTBL		/ENTRY ADDR.
	LAC	.FN		/GET HDR. WD. 0
	DAC*	.DTBL		/MAKE ENTRY
       JMP*   .FQ	         /EXIT.
.DTBL	.BLOCK	STTBSZ+1
       .EJECT
	.IFDEF %DBL
COM
	CMA
	TAD (1
	JMP* COM
/
/
T.3
T.4
	.ENDC
/INITIALIZE I/O STATUS TABLE.
/CALLING SEQUENCE--JMS* .FP
.FP    CAL    0	         /STORE ZEROES IN ALL ENTRIES
       LAC    (STAB)         /   IN STATUS TABLE TO INDICATE
       DAC    .STADD          /   THAT NO SLOT NUMBERS HAVE
	LAW	-STTBSZ		/  BEEN INITIALIZED.
	DAC	CNT
FP1	DZM*	.STADD
	ISZ	.STADD
	ISZ	CNT
	JMP	FP1
	JMP*	.FP
	.EJECT
	.IFDEF %DBL
/
RSET	0
	LAC* T.1
	RCL
	RCR  /0 BIT 0
	DAC* T.1
	JMP* RSET
/
/
/
MOVE
	LAC .FM
	JMS COM  /EXTENT OF MOVE DETERMINED BY LINE BUFFER SIZE
	DAC T.2
MOV.1	LAC* T.3
	DAC* T.4
	ISZ T.3
	ISZ T.4
	ISZ T.2
	JMP MOV.1
	JMP* MOVE
/
	.EJECT
/*
RW	0
FQ10
FQ20
FQ50
FQ30
	JMP* RW
/
/
	.EJECT
/*
/
/
WAIT	0
FQ40
	12
	JMP* WAIT
	.ENDC
/
/
/
/*
/CHECK DELETE BIT AND DELETE IF NECESSARY
/CALLING SEQUENCE --
/	LAC	SLOT
/	JMS	.CHKDL
.CHKDL	0		/*
	DAC	SLOT	/*
	TAD	(STAB-1	/*
	DAC	.STADD	/*
	LAC*	.STADD	/* GET STATUS TAB. ENTRY FOR SLOT
	DZM*	.STADD	/*CLR. STATUS TAB. ENTRY
	RTL		/* R.A. BIT TO LINK
	SNL		/* SKP IF R.A.
	JMP*	.CHKDL	/* NOT R.A. - RTN.
	RAL		/* DELETE BIT TO LINK
	LAC	SLOT
	JMS*	.ADDC	/* ADDR. OF DLCL IN DEFINE
	JMP*	.CHKDL	/* RTN.
/  DEFINE LOADS THE ADDR. OF ITS DELETE AND CLEAR ROUTINE INTO
/    .ADDC IF R.A. OPERATIONS ARE USED IN A GIVEN CORE LOAD
.ADDC	XX		/*
	.EJECT
/*
/STATUS TABLE
/  THE SIZE IS REGULATED BY ASSEMBLY PARAMETER - DEFAULT SIZE
/    IS 20(8).
/  EACH WORD HOLDS INFORMATION FOR THE .DAT SLOT WHOSE NUMBER IS
/    EQUIVALENT TO THE RELATIVE POSITION OF THE WORD IN THE TABLE
/    (FIRST WORD FOR .DAT 1, ETC.)
/  FOR EACH WORD:
/    BIT #0   0=READ;   1=WRITE
/    BIT #1   1=R.A.;   0=NOT R.A.
/    BIT #2   1=DELETE DEFAULT-NAMED R.A. FILE;
/    BIT #3   0=NON-DIRECTORIED DEVICE
/	      1=DIRECTORIED DEVICE ASSIGNED TO THIS .DAT
/             0=NO DELETION
/    BITS #9 - #18  BUFFER SIZE OF DEVICE
/
/  THE 'CALL CLOSE' AND 'ENDFILE' COMMANDS IN FORTRAN CAUSE THE
/    ENTRY FOR THE .DAT SLOT REFERENCED TO BE CLEARED.
STAB	.BLOCK	STTBSZ
	.IFDEF %DBL
/
/ DOUBLE BUFFERING ADDRESS TABLE.
/	ONE ENTRY PER DAT SLOT, EACH ENTRY HAS THE FOLLOWING FORMAT:
/
/	BIT 0:  'FIRST TIME', MEANING THAT FOR INPUT OPERATIONS, THE
/		SYSTEM MUST START READ-AHEAD OVER.  THIS COULD BE BECAUSE
/		IT REALLY IS THE FIRST TIME, OR BECUASE IT FOLLOWS A
/		BACKSPACE OR REWIND OPERATION.
/
/	BIT 1:  'TELETYPE', THIS BIT IS SET IF THE DEVICE ASSOCIATED WITH
/		THIS .DAT SLOT IS  THE TELETYPE.  THIS IS DETERMINED BY
/		CHECK ING THE RETURNED MAX BUFFER SIZE FOR LENGTH 42(8).
/		WE MUST KNOW THIS, SO WE DON'T ATTEMPT TO READ-AHEAD ON THE
/		CONSOLE TERMINAL.
/
/	BIT 2:  'MASS STORAGE', THIS BIT IS SET IF THE ASSOCIATED DEVICE
/		IS DECTAPE OR MAGTAPE.  THIS IS DETERMINED BY CHECKING
/		THE BUFFER SIZE TO BE GREATER THAN 375(8), AFTER EXCLUDING
/		THE ENTRY IF ITS A DISK.  THE BIT IS USED BY
/		AUXIO TO RELEASE THE DOUBLE BUFFER FOR THIS DEVICE UPON
/		A 'CLOSE' REQUEST.  DOUBLE BUFFERING GETS A WHOLE SYSTEM
/		BUFFER FOR THESE TWO DEVICES, RATHER THAN PARTITIONING
/		A SINGLE BUFFER, AS IT DOES FOR NON-MASS STORAGE
/		DEVICES.
/
/	BITS 3-17:  CONTAINS THE BUFFER ADDRESS FOR THIS DEVICE.  IT COULD
/		    BE A WHOLE BUFFER, OR THE ADDRESS WITHIN THE
/		    PARTITIONED BUFFER.
/
.BTABL	.BLOCK STTBSZ	/THE DOUBLE BUFFERING ADDRESS TABLE
	.ENDC
.FH    .DSA   0	         /READ-WRITE FLAG (0=READ, 1=WRITE).
.FM    .DSA   0	         /LINE BUFFER SIZE
.FN    .BLOCK 400	         /* LINE BUFFER.
.RN	0	/* RANDOM ACCESS FLG.
OTBITS	0	/* OTHER BITS
	.IFDEF %DOS15
.DSKF	0		/DISK FLAG
FC8	0	/TEMP REGISTERS
FC9	0
FC10	0
	.ENDC
.STADD=.FQ 	         /STATUS WORD ADDRESS.
CNT=.FC		         /COUNTER.
RWFLG=.FP 	         /SHIFTED READ-WRITE FLAG.
SLOT=FQ1		         /SLOT NUMBER.
	.ENDC
	.IFDEF RSX
       .GLOBL .FC,.FQ,.FH,.FM,.FN,.ER,FIOPS,.SLOT
	.GLOBL	.RN	/RANDOM ACCESS FLAG (R.A. = 400000)
	.GLOBL	.STADD	/CONTAINS ADDR. OF CURRENT ENTRY IN ST. TAB.
	.GLOBL	.CHKDL	/CHK. DELETE BIT AND DELETE IF NEC.
	.GLOBL	.ADDC	/ADDR. OF DLCL IN DEFINE.
	.GLOBL	.XFLRA	/SUBR. ENTRY.
/
/ASSEMBLY PARAMETER FOR STATUS TABLE ADJUSTMENT.
/
	.IFUND STTBSZ
STTBSZ=77
	.ENDC
/
FIOPS=.
/INITIALIZE I/O DEVICE (.INIT)
/CALLING SEQUENCE--LAC  ADDRESS OF SLOT NUMBER.
/	         JMS* .FC
/EXIT WITH ACTUAL SLOT NUMBER IN AC.
.FC    CAL    0
       DAC    .SLOT	         /TEMP STORE SLOT NUMBER ADDRESS.
	SMA			/ *** DDS MAR69 ***
	JMP	.+3		/ *** DDS MAR69 ***
	LAC*	.SLOT		/ *** DDS MAR69 ***
	DAC	.SLOT		/ *** DDS MAR69 ***
       LAC*   .SLOT	         /GET ACTUAL SLOT NUMBER AND TEST
       SMA!SZA	         /   FOR ZERO OR NEGATIVE.  IF SO,
       JMP    FC0	         /   GO TO ERROR EXIT.  IF OK, GO
FCERR  JMS*   .ER	         /   AHEAD. DIR ASS TO GLOBL FIOPS
       .DSA   10
FC0	DAC	.SLOT		/(RKB-044) SAVE WHOLE LUN NUMBER
	AND	(777)		/(RKB-044) MODULO 511(10)
	SAD	.SLOT		/(RKB-044) CHECK FOR > 511
	SKP			/(RKB-044) IS THIS LEGAL LUN?
	JMP	FCERR		/(RKB-044) NO, DECLARE OTS 10
	LAC	.SLOT		/(RKB-044) RECALL LUN
	TAD	(STAB-1)	/ADD STATUS TABLE ADDR. TO GET
	DAC	.STADD		/ENTRY ADDR.
	LAC	.FH		/MOVE R/W FLAG TO BIT 0 AND SAVE.
	RCR
	RAR
	DAC	RWFLAG
	LAC*	.STADD		/SLOT INITIALIZED?
	SZA
	JMP	FC2		/YES.
	LAC	.SLOT	/(RKB-036) NO, DO A HINF TO TEST FOR DIRECTORIED DEV
	DAC	CHINF+2	/(RKB-036) SET LUN IN HINF CPB
	CAL	CHINF	/(RKB-036) DO THE HINF
	CAL	WFEV	/(RKB-036) WAIT FOR HINF
	LAC	EV	/(RKB-036) GET HINF INFO
/
	SAD	(100010) /(RKB-038) IS IT THE PAPER TAPE PUNCH
	LAC	(40000)  /(RKB-038) YES, IT IS TO BE CONSIDERED 'MASS STORAGE'
			 /(RKB-038) AT LEAST FOR CARRIAGE CONTROL CHARACTER
			 /(RKB-038) TRANSLATION PURPOSES.
/
	AND	(40000)	/(RKB-036) EXTRACT DIRECTORIED DEVICE BIT
	XOR	(376)	/(RKB-036) INCLUDE STD BUF SIZE (MOD. 'LAC' TO 'XOR')
	SKP
FC2	AND	(377777)	/MASK OFF R/W BIT.
	XOR	RWFLAG		/SET CURRENT R/W BIT.
	DAC*	.STADD		/UPDATE ENTRY.
       LAC    (376)	         /GET LINE BUFFER SIZE.
    DAC    .FM	         /SAVE BUFFER SIZE FOR I/O ROUTINES.
       LAC    .SLOT
       JMP*   .FC	         /EXIT WITH SLOT NUMBER IN AC.
/
.SLOT	0
/
       .EJECT
/TRANSFER LINE BUFFER (.READ, .WRITE, AND .WAIT).
/CALLING SEQUENCE--LAC  SLOT(BITS 9-17) AND MODE(BITS 6-8).
/	         JMS* .FQ
.FQ	0
	DAC	CPB+3	/SAVE MODE BITS TEMPORARILY
	AND	(777)
	DAC	CPB+2
	LAC	CPB+3	/PICK UP THE MODE
	SWHA
	AND	(7)	/MASK OFF THE MODE
	DAC	CPB+3	/STORE THE MODE INDICATOR
	LAC	.FH	/SET CAL PER .FH (CAL 26:READ::CAL 27:WRITE)
	AAC	26
	ALS	6
	AND	(7700)	/SET UP I/O REQUEST IN CPB
	DAC	CPB+0
/
	CAL	CPB	/READ OR WRITE REQUEST
/
WAIT	CAL	WFEV	/WAIT FOR I/O TO COMPLETE
	LAC	EV	/CHECK THE EVENT VARIABLE FOR AN ERROR
	SMA
	JMP	TPEV	/TEST POS. EV FOR +4.
	SAD	(-101)		/(RKB-044) IS LUN OUT OF RANGE?
	JMP	FCERR		/(RKB-044) YES, MAP IT TO OTS 10
XER20	LMQ		/(GAR-047) SAVE THE E.V.
	LAC	CPB+2	/(GAR-047) PICK UP THE LUN.
	JMS*	.ER	/(GAR-047) PRINT OTS-20 I/O ERROR.
	.DSA	20
/
CPB	XX	/FUNCTION CODE -- 26 FOR READ, 27 FOR WRITE
	EV	/EVENT VAR ADR
	XX	/LOGICAL UNIT NUMBER
	2	/MODE -- IOPS ASCII
	.FN	/LINE BUFFER ADDRESS
	376	/MAX TRANSFER LENGTH (READ ONLY)
/
WFEV	20	/WAIT FOR REQUEST
	EV
/
EV	0	/EVENT VARIABLE
.STADD	0	/CURRENT ST. TAB. ENTRY.
/
/
.FH    .DSA   0	         /READ-WRITE FLAG (0=READ, 1=WRITE).
.FM    .DSA   0	         /LINE BUFFER SIZE
.FN    .BLOCK 400	         /LINE BUFFER.
.RN	0		/R.A. FLAG.
/*
TPEV	SAD	(4)	/IF +4 , COULD BE MT END-OF-MEDIUM.
	JMP	PEOM
	JMP*	.FQ	/NOT +4.  EXIT.
PEOM	LAC	CPB+2	/GET LUN FOR HINF SETUP.
	DAC	CHINF+2
	CAL	CHINF	/GET HANDLER INFO FOR CHK FOR MT.
	CAL	WFEV	/WAITFOR EV. SETTING.
	LAC	EV
	SPA
	JMP	XER20	/I/O ERROR.  .OTS 20.
	AND	(7)	/MASK LOW ORDER 3 BITS.
	SAD	(5)	/MT?
	SKP		/YES.  SET DATA MODE 6 IN HEADER.
	JMP*	.FQ	/NOT MT.  EXIT.
	LAC	.FN	/GET BUFFER HEADER.
	AND	(777770)	/MASK OFF MODE.
	XOR	(6)		/FORCE DATA MODE TO 6 TO INDICATE EOM.
	DAC	.FN	/RESTORE.
	JMP*	.FQ	/EXIT
/
/HINF CPB
CHINF	3600		/FUNCT. CODE
	EV		/EV
	XX		/LUN.
/
	JMS*	.ER
/CHECK DELETE BIT AND DELETE IF NECESSARY
/CALLING SEQUENCE --
/	LAC	SLOT
/	JMS	.CHKDL
.CHKDL	0		/*
	DAC	SLOT	/*
	TAD	(STAB-1	/*
	DAC	.STADD	/*
	LAC*	.STADD	/* GET STATUS TAB. ENTRY FOR SLOT
	DZM*	.STADD	/*CLR. STATUS TAB. ENTRY
	RTL		/* R.A. BIT TO LINK
	SNL		/* SKP IF R.A.
	JMP*	.CHKDL	/* NOT R.A. - RTN.
	RAL		/* DELETE BIT TO LINK
	LAC	SLOT
	JMS*	.ADDC	/* ADDR. OF DLCL IN DEFINE
	JMP*	.CHKDL	/* RTN.
/  DEFINE LOADS THE ADDR. OF ITS DELETE AND CLEAR ROUTINE INTO
/    .ADDC IF R.A. OPERATIONS ARE USED IN A GIVEN CORE LOAD
.ADDC	XX		/*
	.EJECT
/*
/STATUS TABLE
/  THE SIZE IS REGULATED BY ASSEMBLY PARAMETER - DEFAULT SIZE
/    IS 20(8).
/  EACH WORD HOLDS INFORMATION FOR THE .DAT SLOT WHOSE NUMBER IS
/    EQUIVALENT TO THE RELATIVE POSITION OF THE WORD IN THE TABLE
/    (FIRST WORD FOR .DAT 1, ETC.)
/  FOR EACH WORD:
/    BIT #0   0=READ;   1=WRITE
/    BIT #1   1=R.A.;   0=NOT R.A.
/    BIT #2   1=DELETE DEFAULT-NAMED R.A. FILE;
/             0=NO DELETION
/    BIT #3   0=NON-DIRECTORIED DEVICE
/             1=DIRECTORIED DEVICE ASSIGNED TO THIS LUN
/    BITS #9 - #18  BUFFER SIZE OF DEVICE
/
/  THE 'CALL CLOSE' AND 'ENDFILE' COMMANDS IN FORTRAN CAUSE THE
/    ENTRY FOR THE .DAT SLOT REFERENCED TO BE CLEARED.
	.REPT	STTBSZ
STAB	0
/
	.EJECT
/SUBR. TO DETERM. IF DIRECT ACCESS FILE BEING PROCESSED ON INDICATED
/LUN.  LUN IN AC ON ENTRY.
/CALLING SEQ.:
/	LAC	SLOT		/LUN TO AC.
/	JMS(*)	.XFLRA
/	NEXT INSTR.		/RETS. HERE IF DIR. ACC. FILE BEING PROC.
/	NEXT INSTR.		/RETS. HERE IF NOT.
/
.XFLRA	0
	TAD	(STAB-1)
	DAC	XFLRA1		/SAVE.
	LAC*	XFLRA1
	AND	(200000)	/R.A. BEING PROCESSED?
	SNA
	ISZ	.XFLRA		/NO.  BUMP EXIT.
	JMP*	.XFLRA		/YES.
/
XFLRA1	0
SLOT	0
RWFLAG	0		/R/W FLAG.  BIT 0 =1 FOR WRITE.
/
       .ENDC
       .END