/ 
/ 
/                   FIRST PRINTING, FEBRUARY 1974
/ 
/ THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO 
/ CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
/ AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
/ DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPON-
/ SIBILITY FOR ANY ERRORS THAT MAY APPEAR IN THIS
/ DOCUMENT.
/ 
/ THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FUR-
/ NISHED TO THE PURCHASER UNDER A LICENSE FOR USE ON
/ A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH
/ INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR 
/ USE IN SUCH SYSTEM, EXCEPT AS MAY OTHERWISE BE PRO-
/ VIDED IN WRITING BY DIGITAL.
/ 
/ DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/ FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIP-
/ MENT THAT IS NOT SUPPLIED BY DIGITAL.
/ 
/ COPYRIGHT (C) 1974, BY DIGITAL EQUIPMENT CORPORATION
/ 
/ 
        .EJECT
/	TDVSUB SRC  EDIT #3 1/13/74  G. COLE
/	COPYRIGHT DIGITAL EQUIPMENT CORPORATION 1973
/	UTILITY ROUTINE FOR FORTRAN
/	WRITTTEN TDV PROGRAMS
	.IFUND	STKLUN
STKLUN=77	/LUN FOR ACCOUNT FILE
	.ENDC
/
XFC	0	/ROUTINE TO TRANSFER THE COMMAND LINE TO THE PROGRAM
	JMS*	.DA
	JMP	.+1+3
BUF	0
LEN	0
EV	0
	LAC	BUF
	DAC	XFCX+2
	LAC*	LEN
	DAC	XFCX+3
	LAC	EV
	DAC	XFCX+1
	CAL	XFCX
	JMP*	XFC
/
/
/
GETDV	0
	CAL	REQTDV
	JMP*	GETDV
/
REQMCR	0
	CAL	REQMC
	JMP*	REQMCR
GETDC	0
	CAL	REQTDC
	JMP*	GETDC
REQTDC	1
	0
	.SIXBT	/TDC/
	0
	0
/
/
RUNTLE	0
	JMS*	.DA
	JMP	.+1+1
LIM	0
	LAC*	LIM
	DAC	RUNTL+4
	CAL	RUNTL
	JMP*	RUNTLE
CANTLE	0
	CAL	CANTL
	JMP*	CANTLE
/
/DEFINE CAL PARAMETER BLOCKS
/
XFCX	37
	0
	0
	0
	0
REQTDV	1
	0
	.SIXBT	/TDV.../
	0
REQMC	1
	0
	.SIXBT	/...MCR/
	0
RUNTL	3
	0
	.SIXBT	/TLE.../
	0
	3
	0
	0
	0
/
CANTL	4
	0
	.SIXBT	/TLE.../
/
GETAF	0	/SUBROUTINE TO ACCESS THE ACCOUNT FILE
	JMS*	.DA		/THIS ROUTINE GETS THE ACCOUNTING FILE 
	JMP	.+1+2		/FROM THE DISK INTO THE USERS ARRAY
ADRS0	0
EVN0	0
	LAC	ADRS0
	DAC	ADR		/CORE ADDRESS FOR RECORD
	CAL	HINAF		/CHECK DEVICE FOR DISK AND SETUP
				/DISK TYPE FOR GET AND PUT
	CAL	WAIT
	LAC	EV2	/SHOULD BE POSITIVE
	SPA
	JMP	DEVER	/ASSIGNMENT ERROR
	AND	(77)	/TEST FOR DEVICE TYPE
	SAD	(2)
	JMP	DEVOK
	SAD	(3)
	JMP	DEVOK
	SAD	(24)
	JMP	DEVOK	/TEST FOR RF,RP AND RK DISKS.
DEVER	LAW	-6	/SEND ERROR TO USER
	DAC*	EVN0
	JMP*	GETAF	/RETURN TO CALLER WITH FATAL ERROR
DEVOK	DAC	RTYPE	/STORE DISK TYPE IN GET AND PUT CPS
	DAC	WTYPE
	CAL	OPEN		/OPEN FILE
	CAL	WAIT
	CAL	READ		/GET RECORD(ONE TRANSFER)
	CAL	WAIT		/WAIT TILL DONE
	LAC	EV2
	DAC*	EVN0	/SEND TO USER
	JMP*	GETAF
/
/
PUTAF	0
	CAL	WRITF
	CAL	WAIT
	JMP*	PUTAF
/
/
OPEN	1600
	EV2
	STKLUN
	.+1
	.SIXBT	/USERS RSX/
	4
	1
	2000
	1
DISKA	0
	0
ADR	0
	2000
/
/
READ	13000	/GET FUCNTION
	EV2
	1
	DISKA
RTYPE	0	/DISK TYPE STORED HERE
/
/
WRITF	13100	/MULTI DISK PUT FUNCTION
	EV2
	1
	DISKA
WTYPE	0
 
HINAF	3600	/TEST STATUS OF STKLUN
	EV2
	STKLUN
 
/
/
WAIT	20
	EV2
/
EV2	0
/
/
SIXBT	0	/CONVERT ASCII TO SIXBT
	JMS*	.DA
	JMP	.+1+2
ASCII	0
SIX	0
	LAC*	ASCII
	LMQ
	CLL!CLA
	LLS	7
	AND	(77)
	SAD	(40)
	CLA
	RTL; RTL; RTL
	DAC*	SIX
	LLS	7
	AND	(77)
	SAD	(40)
	CLA
	TAD*	SIX
	RTL; RTL; RTL
	DAC*	SIX
	LLS	4
	DAC	TEMP
	ISZ	ASCII
	LAC*	ASCII
	LMQ
	LAC	TEMP
	LLS	3
	AND	(77)
	SAD	(40)
	CLA
	TAD*	SIX
	DAC*	SIX
	ISZ	SIX
	LLS	7
	AND	(77)
	SAD	(40)
	CLA
	RTL; RTL; RTL
	DAC*	SIX
	LLS	7
	AND	(77)
	SAD	(40)
	CLA
	TAD*	SIX
	RTL; RTL; RTL
	DAC*	SIX
	ISZ	ASCII	/GET THIRD WORD
	LAC*	ASCII
	LMQ
	CLL!CLA
	LLS	7
	AND	(77)
	SAD	(40)
	CLA
	TAD*	SIX
	DAC*	SIX
	JMP*	SIXBT
TEMP	0
/
/
SUM	0
	JMS*	.DA
	JMP	.+1+2
CRR	0
SMM	0
	LAC*	CRR
	AND	(77)
	AAC	-60
	SPA
	JMP	ERRSMM
	DAC	TEMP
	AAC	-12
	SMA
	JMP	ERRSMM
	LAC*	SMM	/MULTIPLY PARTIAL RESULT BY 10
	MUL
	12
	LACQ
	TAD	TEMP
	DAC*	SMM
	JMP*	SUM
ERRSMM	LAW	-1
	DAC*	SMM
	JMP*	SUM
/
/
SPY	0
	JMS*	.DA
	JMP	.+1+3
ADSPS	0
VALSP	0
IEVSP	0
	LAC*	ADSPS
	DAC	CS+2
	LAC	IEVSP
	DAC	CS+1
	CAL	CS
	LAC	CS+3
	DAC*	VALSP
	JMP*	SPY
CS	31
	0
	0
	0
/
	.GLOBL	XFC,.DA,GETDV,RUNTLE,CANTLE,REQMCR,GETAF,PUTAF,SIXBT,SUM,SPY
	.GLOBL	GETDC
	.END