.TITLE QMTSUB	WRITE MAGTAPES IN Q-TAPE FORMAT
	.IDENT	/14JUL7/	;10:10:00, NS
;	.ENTRY	QMTSUB - WRITE MAGTATES IN Q-TAPE FORMAT
	.SBTTL INTRODUCTION
;+
; Q M T S U B
;
; PURPOSE:	SUBROUTINES TO ENABLE THE USER TO WRITE MAGTAPES
;		IN Q-TAPE FORMAT. A DESCRIPTION OF PARAMETERS
;		IS PROVIDED AT THE ENTRY POINT OF EACH ROUTINE.
;
; INTERFACE:	CALLING SEQUENCE:  (FORTRAN-CALLABLE SUBROUTINES)
;			QMTBOT-	WRITE BEGINNING OF TAPE RECORD
;			QMTBOR-	WRITE BEGINNING OF RUN RECORD
;			QMTEVT- ACCUMULATE AND WRITE EVENT DATA
;			QMTDAT-	WRITE AN ENTIRE (USER COMPILED) DATA RECORD
;			QMTEOR-	WRITE AN END OF RUN RECORD
;			QMTEOT-	WRITE AN END OF TAPE RECORD
;			QMTCOM-	WRITE A COMMENT RECORD
;			QMTEOF- WRITE 5 FILE MARKS AND BACKUP OVER THEM
;
; METHOD:	A COMMENT ON THE "ERROR" PARAMETER
;
;		ALL SUBROUTINES HAVE AS THEIR LAST (IN SOME CASES THEIR
;		ONLY) PARAMETER AN ERROR RETURN WORD. THIS IS AN OPTIONAL
;		PARAMETER. IF INCLUDED, A STATUS RETURN CODE WILL BE
;		RETURNED TO THE USER PROGRAM UPON COMPLETION OF THE
;		SUBROUTINE. THE CODES RETURNED AND THEIR MEANINGS ARE
;		SUMMARIZED BELOW.
;
;		CODE					MEANING
;
;		  1				SUCCESSFUL OPERATION
;		  0				ILLEGAL PARAMETERS
;		NEGATIVE NUMBER			AN ERROR HAS BEEN DETECTED
;						   BY THE MAGTAPE HANDLER.
;
;		ALL ARGUMENTS ARE INTEGERS.  AN ARGUMENT ENCLOSED
;		IN SQUARE BRACKETS IS OPTIONAL.
;
;		EVENT FLAG 24. IS USED BY THESE ROUTINES TO DETECT I/O COMPLETION.
;
; LANGUAGE:	MACRO-11
;
; REFERENCES:	THE ERROR CODES AND THEIR ASSOCIATED MEANINGS ARE
;		LISTED IN APPENDIX A OF THE "DEVICE HANDLER REFERENCE
;		MANUAL".  (DEC-11-OIHRA-A-D OR SIMILAR)
;
; RESTRICTIONS:	SINCE THE SUBROUTINES CONTAIN INTERNAL POINTERS, IT
;		IS ASSUMED THAT ALL WRITING TO TAPE WILL BE DONE BY 
;		ONE OF THESE SUBROUTINES, ALL OF WHICH MUST BE
;		CALLED IN THE SAME TASK.
;
;-
; REVISIONS:
; SUMMER-76	ML	WRITTEN
; 21-JAN-77	NS	LEAVE PRIORITY BLANK IN QIO CALLS
;			FOR 11M COMPABILITY.
;			USE EVENT FLAG 24. (DECIMAL) NOT OCTAL.
;			ADD OPTIONAL RUN # TO QMTBOR TO ALLOW
;			MORE THAN 1 RUN # PER TAPE.
;			ALLOW FOR AN EVENT OF ZERO LENGTH (TAG ONLY).
; 23-JAN-77	NS	INC R5 BEFORE GETARG IN QMTEOR AND QMTEOT
;			TO AVOID AN ODD ADDRESS TRAP 
; 24-JAN-77	NS	CLEAR THE # OF EVENTS IN RUN WHEN WRITING 
;			START RUN RECORD. 
; 25-JAN-77	NS	WRITE EOF AFTER BEGINNING OF TAPE RECORD
;			AND AFTER END OF RUN RECORD RATHER THAN
;			BEFORE START RUN RECORD AND BEFORE END
;			TAPE RECORD.  THIS ENSURES THAT AN END
;			OF FILE WILL APPEAR AFTER THE END OF A RUN.
;			FIX BUG IN QMTEVT WHICH CREATES A RECORD
;			OF 1620. BYTES WHEN TAG IS LAST WORD IN BUFFER.
;			FIX BUG IN QMTEVT WHICH CREATES A TAG
;			IN THE WRAPOVER PORITON OF AN EVENT.
;			MAKE OFFSET IN HEADER BE BYTES NOT WORDS.
; 29-APR-77	NS	ADD ENTRY POINT QMTEOF TO ALLOW USER TO
;			WRITE 5 END-OF-FILES TO TAPE AND THEN TO
;			BACKUP CAREFULLY OVER THEM.
;			SET DEFAULT ERROR ADDRESS FOR QMTEOR AND QMTEOT.
;			CHECK FOR DIRECTIVE FAILURE AND RETURN DSW.
; 14-JUN-77	LV	UPDATED TO CONFORM TO STANDARDS.
; 23-JUN-77	NS	CHANGE FROM SIGNED CONDITIONAL
;			BRANCHES TO UNSIGNED CONDITIONAL
;			BRANCHES IN QMTEVT AND QMTBOR WHERE
;			ADDRESS COMPARISONS TAKE PLACE.
; 14-JUL-77	NS	EXPAND DOCUMENTATION
;


	.SBTTL MACRO CALLS AND DEFINITIONS
;
;
	.MCALL	DIR$,QIO$,WTSE$S,GTIM$,PUSH,POP
	.GLOBL	QMTBOT,QMTBOR,QMTEOR,QMTEOT,QMTCOM,QMTEVT,QMTDAT
	.GLOBL	QMTEOF
	.NLIST	BEX
;
;	MACRO DEFINITIONS
;
	.MACRO	GETARG	DFVAL,DESTIN,EXIT,ADR,?L1,?L2
	CMP	(R5),#-1		; CHECK FOR NULL ARGUMENT
	BNE	L1			; IF NOT USE SUPPLIED ARG.
	.IF	B	DFVAL
	JMP	CALLER			; IF NO DEFAULT--->ERROR
	.IFF
	MOV	DFVAL,DESTIN		; IF NULL, USE DEFAULT
	BR	L2
	.ENDC
	.IF	B	ADR
L1:	MOV	@(R5),DESTIN		; PUT IN ARGUMENT
	.IFF
L1:	MOV	(R5),DESTIN		; PUT IN ADDRESS OF ARGUMENT
	.ENDC
L2:	TST	(R5)+			; POINT TO NEXT ARGUMENT
	DEC	R0			; KEEP TRACK OF # ARGS FETCHED
	BEQ	EXIT			; QUIT WHEN WE HAVE THEM ALL
	.ENDM
;
;	DEFINE VARIABLES
;
IOST:	0,0				; QIO STATUS WORDS
TIMBUF:	.BLKW	8.			; TIME BUFFER
LUN:	0				; LOGICAL UNIT NUMBER STORAGE
ADRES:	0				; BUFFER ADDRESS STORAGE
EVENT:	0,0			; # OF EVENTS IN RUN (DOUBLE COUNTER)
TTYP:	0			; TEMPORARY TYPE HOLDER
LASTAD:	BUFFER			; LAST ADDRESS FILLED IN DATA BUFFER
OFFSET:	0			; OFFSET TO FIRST EVENT TAG
BYTEVT:	0			; BYTES IN AN EVENT
RECRUN:	0			; RECORD IN PARTICULAR RUN
NEVENT:	0			; EVENT NUMBER
ERAD:	0			; ERROR RETURN INFO ADDRESS
ERRWRD:	0			; ERROR RETURN INFO PUT HERE IF NOT
				; WANTED IN THE CALLING PROGRAM
;
;
;	INITIALIZE FOR QIO CALLS
;
QWLB:	QIO$	IO.WLB,,24.,,IOST,,<0,0>
QEOF:	QIO$	IO.EOF,,24.,,IOST,
QSPB:	QIO$	IO.SPB,,24.,,IOST,,<0>
TIMEQ:	GTIM$	TIMBUF			; GET TIME PARAMETERS
;
;	DEFINE OFFSET VALUES
;
RUN=10.
TAPE=12.
CCT=12.
DATE=2
TIME=4
TYPE=8.
BED=16.
FSET=14.

	.SBTTL QMTBOT
;+
;
; Q M T B O T
;
; PURPOSE:	WRITE BEGINNING OF TAPE RECORD
;
; INTERFACE:	CALLING SEQUENCE: (FORTRAN-CALLABLE SUBROUTINE)
;			CALL QMTBOT([RUN #],[TAPE #],[LUN],[ERROR])
;
;		OPTIONAL ARGUMENT DEFAULTS:
;			RUN # 	= 1
;			TAPE # 	= 1
;			LUN 	= 1
; 			ERROR--NO ERROR STATUS RETURNED TO USER PROGRAM
;
;	NOTE:	LUN IS THE LOGICAL UNIT NUMBER.  IT IS ASSUMED THAT
;		THIS HAS BEEN ASSIGNED TO A MAGTAPE UNIT THAT HAS BEEN
;		MOUNTED AS FOLLOWS:
;
;			MCR>MOU MTN:/CHA=[FOR]
;
;-
QMTBOT:	MOVB	(R5)+,R0		; GET # OF ARGUMENTS
	BEQ	ADFTBT			; IF NONE, INSERT DEFAULTS
	INC	R5			; NEXT WORD
	GETARG	#1,HEAD+RUN,DF2BT	; GET FIRST ARG (RUN #)
	GETARG	#1,HEAD+TAPE,DF3BT	; GET NEXT ARG	(TAPE #)
	GETARG	#1,LUN,DF4BT		; AND LAST (LUN)
	GETARG	#ERRWRD,ERAD,HARGBT,AD	; ERROR INFO
ADFTBT:	MOV	#1,HEAD+RUN
DF2BT:	MOV	#1,HEAD+TAPE
DF3BT:	MOV	#1,LUN			; SUPPLY DEFAULT ARGS
DF4BT:	MOV	#ERRWRD,ERAD		; NO ERROR REPORT
HARGBT:	CALL	MAKHDR			; GO MAKE UP THE HEADER
	MOV	#1,HEAD+TYPE		; THIS IS TYPE ONE
	MOV	#1,HEAD			; FIRST RECORD ON TAPE
	MOV	#14.,QWLB+Q.IOPL+2	; # OF BYTES
	CALL	QIOWLB			; WRITE THE ASSEMBLED RECORD
	CALL	QIOEOF			; WRITE END OF FILE AFTER BOT
	JMP	SUCCES			; DONE

	.SBTTL QMTBOR AND QMTCOM
;+
;
; Q M T B O R / Q M T C O M
;
; PURPOSE:	QMTBOR - WRITE BEGINNING OF RUN RECORD
;		QMTCOM - WRITE COMMENT RECORD
;
; INTERFACE:	CALLING SEQUENCE: (FORTRAN-CALLABLE SUBROUTINE)
;			CALL QMTBOR(MESAG ADDR,CHARACTER COUNT,[RUN#],[ERROR])
;			CALL QMTCOM(MESAG ADDR,CHARACTER COUNT,[RUN#],[ERROR])
;
;		INPUT:	THE MESSAGE ADDRESS AND CHARACTER COUNT MUST
;			BE SPECIFIED.  IF RUN # IS OMITTED IN THE CALL
;			TO QMTBOR IT WILL REMAIN UNCHANGED.
;
;-
;
QMTBOR:	MOV	#2,TTYP			; BOR IS TYPE 2
	CLR	EVENT			; CLEAR # OF EVENTS IN RUN
	CLR	EVENT+2			; CLEAR 2ND HALF OF # OF EVENTS IN RUN
	CLR	RECRUN			; CLEAR RECORD # FOR THIS RUN
BORCOM:	MOVB	(R5)+,R0		; GET # OF ARGUMENTS
	INC	R5			; POINT TO NEXT WORD
	CMP	R0,#2			; MUST HAVE EXACTLY 2
	BGE	.+6
	JMP	CALLER			; IF MORE OR LESS --> ERROR
	GETARG	,R1,DF1BR,ADR		; GET BUFFER ADDRESS
	GETARG	,R2,DF1BR		; GET CHARACTER COUNT
	GETARG	HEAD+RUN,HEAD+RUN,DF1BR	; GET RUN # IF THERE
	GETARG	#ERRWRD,ERAD,HARGBR,AD	; GET ADDR OF ERROR IF THERE
DF1BR:	MOV	#ERRWRD,ERAD		; DEFAULT
HARGBR:	CALL	MAKHDR			; PUT IN HEADER
	MOV	R2,HEAD+CCT		; PUT IN CHARACTER COUNT
	MOV	TTYP,HEAD+TYPE		; THIS IS TYPE 2
	INC	HEAD			; NEXT RECORD
	MOV	#BUFAS,R3		; GET COMMENT IN BUFFER
BLKMOV:	MOVB	(R1)+,(R3)+		; ONE BYTE AT A TIME
	DEC	R2			; ONE LESS
	BNE	BLKMOV			; CONTINUE TILL DONE
BLKCLR:	CLRB	(R3)+			; FILL WITH ZEROES
	CMP	R3,#BUFAS+80.		; TILL COMMENT IS 80. BYTES
	BLOS	BLKCLR	
	MOV	#47.*2,QWLB+Q.IOPL+2	; #OF BYTES IN THIS RECORD
	CALL	QIOWLB			; WRITE THE RECORD
	JMP	SUCCES			; DONE
;
;	WRITE COMMENT RECORD
;
QMTCOM:	MOV	#6,TTYP			; TYPE 6
	JMP	BORCOM			; THE REST IS COMMON WITH BOR
.PAGE
	.SBTTL QMTEOF
;
;
;+
; Q M T E O F
;
; PURPOSE:	WRITE 5 FILE MARKS AND THEN BACKUP "CAREFULLY" OVER THEM
;
; INTERFACE:	CALLING SEQUENCE: (FORTRAN-CALLABLE SUBROUTINE)
;			CALL QMTEOF ([ERROR])
;
;	NOTE:	THIS CALL WILL ALLOW THE USER TO EFFECTIVELY CLOSE
;		OUT A TAPE IN CASE IT SHOULD BE REMOVED; HOWEVER,
;		IF ANY FURTHER TAPE WRITING OCCURS AFTER THIS CALL,
;		THE FILE MARKS WILL BE WRITTEN OVER AS IF THE CALL
;		TO QMTEOF HAD NEVER OCCURRED.
;
;
;-
QMTEOF:	MOVB	(R5)+,R0		;ARGS?
	BEQ	DF1EF
	INC	R5
	GETARG	#ERRWRD,ERAD,HARGEF,AD	;GET ADDRESS OF ERROR RETURN
DF1EF:	MOV	#ERRWRD,ERAD		;DEFAULT ERROR ADDRESS
HARGEF:	MOV	#5,R1			;COUNT FOR 5 FILE MARKS
10$:	CALL	QIOEOF			;WRITE END-OF-FILE
	SOB	R1,10$			;LOOP FOR ALL FILE MARKS
;
; 	WE WANT TO LEAVE THE TAPE POSITIONED SO THAT WE CAN CONTINUE TO
;	WRITE ON IT; THEREFORE, WE WANT TO BACK UP OVER THE FILE MARKS
;	WE'VE JUST WRITTEN. DUE TO POSITIONING PROBLEMS ON SOME UNITS, WE
;	WE WANT TO PERFORM THIS OPERATION "CAREFULLY". WE WILL BACKSPACE
;	1 RECORD AT A TIME CHECKING FOR AN END-OF-FILE ERROR.
;	IF WE DO NOT GET AN END-OF-FILE ERROR WE SPACE FORWARD ONE RECORD
;	AND SHOULD HAVE THE TAPE POSITIONED PROPERLY. WE WILL BACKSPACE A
;	TAPE WHICH WE WISH TO PRESERVE JUST PRIOR TO THE 5 FILE MARKS
;	WE WROTE.
;
	MOV	#6,R1		;MAX. # OF RECORDS TO BACKSPACE
	MOV	#-1,QSPB+Q.IOPL	;# OF RECORDS TO SKIP
20$:	CALL	QIOSPB		;SPACE A RECORD
	BCC	40$		;BRANCH IF SUCCESS
	SOB	R1,20$		;WE GET EOF-TRY AGAIN TO BACKSPACE
;
;	WE HAVE EITHER ENCOUNTERED A VALID RECORD DURING A BACKSPACE
;	OPERATION OR WE HAVE BACKSPACED THE MAXIMUM # OF TIMES ALLOWABLE.
;	NOW SPACE FORWARD 1 RECORD.
;
40$:	MOV	#1,QSPB+Q.IOPL	;# OF RECORDS TO SKIP
	CALL	QIOSPB		;SPACE A RECORD
	JMP	SUCCES

	.SBTTL QMTEOR
;+
;
; Q M T E O R
;
; PURPOSE:	WRITE END OF RUN RECORD
;
; INTERFACE:	CALLING SEQUENCE: (FORTRAN-CALLABLE SUBROUTINE)
;			CALL QMTEOR([ERROR])
;
;
;-
QMTEOR:	MOVB	(R5)+,R0		; ARGS?
	BEQ	DF1ER
	INC	R5			; POINT TO NEXT WORD
	GETARG	#ERRWRD,ERAD,HARGER,AD	; GET ADDRESS OF ERROR RETURN
DF1ER:	MOV	#ERRWRD,ERAD		; DEFAULT ERROR ADDRESS
HARGER:
	INC	HEAD			; NEXT RECORD
	CALL	MAKHDR			; PUT IN HEADER
	MOV	#4,HEAD+TYPE		; TYPE 4
	MOV	EVENT,HEAD+CCT		; HIGH WORD OF EVENT COUNT
	MOV	EVENT+2,HEAD+CCT+2	; LOW WORD OF EVENT COUNT
	MOV	#8.*2,QWLB+Q.IOPL+2	; SUPPLY BYTE COUNT
	CALL	QIOWLB			; WRITE IT
	CALL	QIOEOF			; WRITE END OF FILE AFTER EOR RECORD
	JMP	SUCCES

	.SBTTL QMTEOT
;
;+
;
;
; Q M T E O T
;
; PURPOSE:	WRITE END OF TAPE RECORD
;
; INTERFACE:	CALLING SEQUENCE: (FORTRAN-CALLABLE SUBROUTINE)
;			CALL QMTEOT([ERROR])
;
;
;-
QMTEOT:	MOVB	(R5)+,R0		; ARGS?
	BEQ	DF1EO			; NO
	INC	R5			; POINT TO NEXT WORD
	GETARG	#ERRWRD,ERAD,HARGEO,AD	; GET IT
DF1EO:	MOV	#ERRWRD,ERAD		; DEFAULT ERROR ADDRESS
HARGEO:
	INC	HEAD			; NEXT RECORD
	CALL	MAKHDR			; PUT IN HEADER
	MOV	#5,HEAD+TYPE		; TYPE 5
	CLR	HEAD+CCT		; UNUSED
	MOV	#7*2,QWLB+Q.IOPL+2	; BYTE COUNT
	CALL	QIOWLB			; WRITE IT
	MOV	#5,R3			; NOW WRITE 5 EOF'S
EOTWFM:	CALL	QIOEOF			; WRITE A FILE MARK
	DEC	R3			; COUNT
	BNE	EOTWFM
	JMP	SUCCES			; RETURN WHEN FINISHED

	.SBTTL QMTEVT
;+
;
;
; Q M T E V T
;
; PURPOSE:
; PURPOSE:	ACCUMULATE AND WRITE EVENT DATA
;
; INTERFACE:	CALLING SEQUENCE: (FORTRAN-CALLABLE SUBROUTINE)
;			CALL QMTEVT(EVENT #,WRD COUNT,ARRAY NAME,[ERROR])
;				OR
;			CALL QMTEVT ([ERROR])
;
;	NOTE:	THIS SUBROUTINE CAN BE CALLED IN TWO WAYS.  IF THE FORM
;
;		1)	CALL QMTEVT(EVENT#,WORD COUNT,ARRAY OF DATA,[ERROR])
;
;		IS USED, EVENT DATA WILL BE ACCUMULATED IN AN INTERNAL
;		BUFFER.  WHEN THE BUFFER IS FULL (800 WORDS OF EVENT
;		DATA ARE ACCUMULATED), IT IS WRITTEN ONTO TAPE IN
;		Q-TAPE DATA RECORD FORMAT.  THE WORD COUNT SHOULD NOT
;		EXCEED 255 WICH IS THE MAXIMUM NUMBER OF DATA WORDS
;		IN AN EVENT.
;
;		IF THE FORM
;
;		2)	CALL QMTEVT([ERROR])
;
;		IS USED, THE INTERNAL BUFFER WILL BE EMPTIED.
;		ANY EVENT DATA WHICH HAS BEEN ACCUMULATED BUT NOT YET
;		WRITTEN WILL BE WRITTEN ON TAPE.  THIS TYPE OF
;		CALL SHOULD, THEREFORE, BE MADE AFTER ALL EVENTS HAVE
;		BEEN STORED WITH A CALL OF TYPE 1.
;
;
;
;-
QMTEVT:	MOVB	(R5)+,R0		; # OF ARGS
	CMP	R0,#1
	BLE	FLUSH			; 0 OR 1 ARGS MEANS FLUSH
	ADD	#1,EVENT+2		; # OF EVENTS / RUN
	ADC	EVENT			; DOUBLE PRECISION
	INC	R5			; POINT TO NEXT WORD
	CMP	R0,#3			; 3 ARGS MUST BE PRESENT
	BGE	.+6
	JMP	CALLER			; REPORT CALL ERROR
	GETARG	,R4,DF1ET		; GET EVENT NUMBER
	GETARG	,R2,DF1ET		; GET WORD COUNT
	GETARG	,R1,DF1ET,ADR		; GET EVENT BUFFER ADDR
	GETARG	#ERRWRD,ERAD,HARGET,AD;	; ERROR ADDRESS
DF1ET:	MOV	#ERRWRD,ERAD
HARGET:	MOV	LASTAD,R3		; ADDR TO START SAVING DATA
	MOVB	R2,(R3)+		; FILL IN TAGWORRD
	MOVB	R4,(R3)+		; (WORD COUNT & EVENT #)
	MOV	R2,BYTEVT		; SAVE BYTE COUNT
	BEQ	EVTDON			; BRANCH IF ZERO LENGTH EVENT
	ASL	BYTEVT			; WORDS TO BYTES
EVTBLK:	CMP	R3,#BUFFER+1600.	; AT BUFFER END?
	BHIS	EVTDMP			; IF SO --> GO WRITE BUFFER
EVTMOV:	MOV	(R1)+,(R3)+		; MOVE A WORD
	DEC	R2			; ONE LESS WORD
	BGT	EVTBLK			; KEEP MOVING TILL DONE
EVTDON:	CMP	R3,#BUFFER+1600.	; AT BUFFER END?
	BHIS	EVTDMP			; IF SO --> GO WRITE BUFFER
	MOV	R3,LASTAD		; SAVE ADDR FOR NEXT TIME
	JMP	SUCCES			; DONE WITH THIS EVENT
EVTDMP:	INC	HEAD			; NEXT RECORD
	PUSH	R3			; SAVE ADDR
	CALL	MAKHDR			; PUT IN HEADER
	POP	R3			; ADDR IS BACK
	MOV	#3,HEAD+TYPE		; TYPE 3
	INC	RECRUN			; BUMP COUNTER
	MOV	RECRUN,HEAD+CCT		; NEXT RECORD THIS RUN
	MOV	OFFSET,HEAD+FSET	; OFFSET TO TAG
	SUB	#BUFFER,R3		; GET #BYTES EVENT DATA
	MOV	R3,HEAD+BED		; SAVE IT
	ADD	#9.*2,R3		; COMPUTE #BYTES TO WRITE
	MOV	R3,QWLB+Q.IOPL+2
	CALL	QIOWLB			; GO WRITE
	MOV	#BUFFER,LASTAD		; START OVER AT TOP
	MOV	LASTAD,R3		; ADDR TO START SAVING DATA
	MOV	R2,OFFSET		; SAVE OFFSET
	ASL	OFFSET			; WORDS TO BYTES
	BNE	EVTMOV
	JMP	SUCCES			; RETURN IF AT END OF EVENT DATA
FLUSH:	BLT	DF1FU			; PUT IN DEFAULT
	INC	R5			; POINT TO WORD
	GETARG	#ERRWRD,ERAD,HARGFU,AD	; GET ERROR ADDRESS
DF1FU:	MOV	#ERRWRD,ERAD		; PUT DEFAULT
HARGFU:	CLR	R2			; DONE AFTER WRITE
	MOV	LASTAD,R3		; LAST ADDR
	CMP	R3,#BUFFER		; MAYBE EVERYTHING IS O.K.
	BNE	EVTDMP			; GO WRITE THE REMAINDER
	JMP	SUCCES			; NO NEED TO WRITE ANYTHING

	.SBTTL QMTDAT
;+
;
;
; Q M T D A T
;
; PURPOSE:	WRITE ENTIRE RECORD COMPILED BY THE USER
;
; INTERFACE:	CALLING SEQUENCE: (FORTRAN-CALLABLE SUBROUTINE)
;			CALL QMTDAT (WORD COUNT,ARRAY NAME,[# OF EVENTS],
;				[OFFSET],[ERROR])
;
;		DEFAULTS FOR OPTIONAL PARAMETERS
;
;			# OF EVENTS	= 1
;			OFFSET		= 0
;			ERROR		DO NOT RETURN ERROR CODE TO USER
;
;	THIS SUBROUTINE ENABLES THE USER TO COMPILE THE DATA BUFFER.
;	IT IS ASSUMED THAT THE DATA INCLUDES TAG WORDS AND THAT
;	THEY ARE INCLUDED IN THE WORD COUNT.  (A TAG WORD CONSISTS
;	OF THE EVENT # IN THE HIGH BYTE AND THE NUMBER OF DATA
;	WORDS IN THE EVENT (NOT INCLUDING THE TAG) IN THE LOW BYTE.)
;	THE USER IS RESPONSIBLE FOR SUPPLYING THE OFFSET AND NUMBER 
;	OF EVENTS OR MAKING SURE THAT THE DEFAULT VALUES ARE
;	APPROPRIATE.
;
;
;-
QMTDAT:	MOVB	(R5)+,R0		; # OF ARGS
	INC	R5			; NEXT WORD
	CMP	R0,#2			; NEED AT LEAST 2
	BGE	.+6			; O.K.
	JMP	CALLER			; SORRY
	GETARG	,R2,DF1DA		; GET WORD COUNT
	GETARG	,R1,DF1DA,ARG		; GET DDRESS
	GETARG	#1,R4,DF2DA		; GET # OF EVENTS
	GETARG	#0,OFFSET,DF3DA		; GET OFFSET
	GETARG	#ERRWRD,ERAD,HARGDA,DA	; ERROR ADDR ARG
DF1DA:	MOV	#1,R4			; DEFAULT EVENTS=1
DF2DA:	CLR	OFFSET			; PROVIDE DEFAULT ARG
DF3DA:	MOV	#ERRWRD,ERAD		; ERROR ADDR DEFAULT
HARGDA:	ADD	R4,EVENT+2		; ADD # OF EVENTS
	ADC	EVENT			; DOUBLE
	MOV	#BUFFER,R3		; MOVE DATA
DATBLK:	MOV	(R1)+,(R3)+		; WORD AT A TIME
	DEC	R2			; TILL DONE
	BGT	DATBLK
	CLR	R2			; RETURN AFTER WRITE FLAG
	JMP	EVTDMP			; WRITE IT LIKE FULL EVENT

	.SBTTL INTERNAL SUBROUTINES
;
;	SUBROUTINES
;
SUCCES:	MOV	#1,@ERAD		; SUCCESSFUL OPERATION FLAG
DONE:	RETURN
CALLER:	CLR	@ERAD			; CALL ERROR FOUND
	BR	DONE
;
HARD:	MOVB	IOST,R0			; GET ERROR CODE
	BIS	#177400,R0
ERREX:	MOV	R0,@ERAD		; SAVE ERROR CODE
	TST	(SP)+			; KEEP STACK PURE
	BR	DONE
;
;	DIRECTIVE FAILURE
;
DRFAIL:	MOV	$DSW,R0
	BR	ERREX
;
;
MAKHDR:	MOV	#HEAD,R3		; SAVE START OF RECORD
	DIR$	#TIMEQ			; GET TIME
	MOV	TIMBUF+G.TIDA,R0	; GET DAY
	ASH	#4,R0			; MAKE ROOM FOR MONTH
	ADD	TIMBUF+G.TIMO,R0	; PUT IN MONTH
	ASH	#7,R0			; MAKE ROOM FOR YEAR
	ADD	TIMBUF+G.TIYR,R0	; DATE READY
	MOV	R0,DATE(R3)		; SAVE IT
	MOVB	TIMBUF+G.TIHR,TIME(R3)	; SAVE HOUR
	MOVB	TIMBUF+G.TIMI,TIME+1(R3)	; SAVE MINUTES
	MOVB	TIMBUF+G.TISC,TIME+2(R3)	; SAVE SECONDS
	MOVB	TIMBUF+G.TICT,TIME+3(R3)	; SAVE TICKS
	RETURN				; ALL DONE
;
;
;	WRITE LOGICAL BLOCK SUBROUTINE
;
QIOWLB:	MOV	LUN,QWLB+Q.IOLU		; INSERT LUN
	MOV	#HEAD,QWLB+Q.IOPL	; STARTING ADDR
	DIR$	#QWLB
	BCS	DRFAIL			; BRANCH IF DIRECTIVE FAILED
	WTSE$S	#24.			; WAIT TILL DONE
	CMPB	#1,IOST
	BNE	HARD			; DONE IF NO ERROR
WLBRET:	RETURN
;
;	WRITE END OF FILE SUBROUTINE
;
QIOEOF:	MOV	LUN,QEOF+Q.IOLU
	DIR$	#QEOF			; WRITE AN END OF FILE
	BCS	DRFAIL			; BRANCH IF DIRECTIVE FAILED
	WTSE$S	#24.			; WAIT
	CMPB	#1,IOST
	BNE	HARD			; DONE IF NO ERROR
	RETURN
;
;
;	SPACE RECORD SUBROUTINE
;
; ENTRY CONDITIONS:
;	# OF RECORDS TO SKIP HAVE ALREADY BEEN STORED IN QIO PARAMETER
;	BLOCK
; EXIT CONDITIONS:
;	DIRECTIVE STATUS IS RETURNED TO USER AND ROUTINE DOES NOT RETURN
;	TO WHERE IT WAS CALLED IF DIRECTIVE FAILS.
;	IF THERE IS ANY ERROR EXCEPT IE.EOF, ROUTINE DOES NOT RETURN WHERE
;	IT WAS CALLED, BUT RETURNS ERROR CODE TO USER.
;	C CLEAR IF DIRECTIVE SUCCESSFULL.
;	C SET IF IE.EOF SET
;
QIOSPB:	MOV	LUN,QSPB+Q.IOLU		;INSERT LUN
	DIR$	#QSPB			;ISSUE SPACE RECORD DIRECTIVE
	BCS	DRFAIL			;BRANCH IF DIRECTIVE FAILED
	WTSE$S	#24.			;WAIT FOR COMPLETION
	TSTB	IOST			;CHECK FOR ERROR CONDITION
	BGT	SPBRET			;BRANCH IF NO ERROR
					;TSTB CLEARS C
	CMPB	#IE.EOF,IOST		;WAS IT EOF
	BNE	HARD			;WE GOT AN ERROR WE WEREN'T EXPECTING
	SEC				;INDICATE EOF
SPBRET:	RETURN
;
;
;
;
;
;	MAIN BUFFER
;
HEAD:	.BLKW	7			; INITIAL INFO FOR RECORDS
BUFAS:	.BLKW	2
BUFFER:	.BLKW	800.			; DATA AREA
	.END