.TITLE	AR	ARCHIVE HANDLER
.IDENT	/V04.00/
.SBTTL	RT-11 ARCHIVE HANDLER

;                      Copyright (c) 1981 by
;	Berez Associates, 64 Jacqueline Road, Waltham, MA 02154
;		May be used freely, but not sold
.MCALL	.DRDEF,.MTPS
;MMG$T	=1			;MUST BE DEFINED FOR TSX+

;For additional handlers, change AR to AS, AT, AU, etc.
;and change 300 to 301, 302, 303, etc.
	.DRDEF	AR,300,FILST$!SPFUN$,20,0,0

; CONSTANTS

D.HAND=	0			;OFFSET INTO DEVTAB ENTRY FOR HANDLER ADDRESS
D.UNIT=	2			;UNIT NUMBER
D.FBEG=	4			;BEGINNING OF FILE
D.FLEN=	6			;LENGTH OF FILE
D.NEXT=	10			;OFFSET TO NEXT ENTRY

SIZ$FN=	373			;GET DEVICE SIZE
DEF$FN=	300			;DEFINE DEVICE
MAP$FN=	301			;GET MAP OF DEFINED DEVICES (USED BY DSKLIB)

; START OF HANDLER

	.DRBEG	AR

	MOV	ARCQE,R4	;GET POINTER TO Q ELEMENT 3RD WORD.
	MOVB	Q$UNIT(R4),R0	;GET UNIT NUMBER
	BIC	#^C7,R0		;CLEAR UNWANTED BITS
	JSR	PC,TABPOS	;CALCULATE DEVTAB OFFSET
	MOVB	Q$FUNC(R4),R1	;GET SPECIAL FUNCTION CODE
	BNE	SPFUN		;NON-ZERO MEANS SPECIAL FUNCTION
	MOV	D.HAND(R0),R1	;POINTER TO HANDLER
	BEQ	ERROR		;NO SUCH UNIT DEFINED?
	MOV	Q$WCNT(R4),R2	;WORDS TO TRANSFER
	BPL	2$
	NEG	R2		;TAKE ABSOLUTE VALUE
2$:	ADD	#377,R2		;CONVERT TO BLOCKS
	BIC	#377,R2
	SWAB	R2
	ADD	Q$BLKN(R4),R2	;CALCULATE NUMBER OF BLOCKS NEEDED IN FILE
	CMP	R2,D.FLEN(R0)	;GREATER THAN LENGTH OF FILE?
	BHI	ERROR		;IF SO, LOSE
	ADD	D.FBEG(R0),Q$BLKN(R4)   ;ABSOLUTIZE BLOCK NUM FOR REAL HANDLER
	MOVB	Q$UNIT(R4),R2	;AND INSERT REAL UNIT NUMBER
	BIC	#7,R2
	ADD	D.UNIT(R0),R2
	MOVB	R2,Q$UNIT(R4)
	MOV	Q$LINK(R4),ARCQE ;REMOVE CURRENT ELEMENT FROM AR QUEUE
	BNE	3$
	CLR	ARLQE		;IF LAST ELEMENT, CLEAR LAST ELEMENT POINTER
3$:	CLR	Q$LINK(R4)	;CLEAR LINK POINTER FOR OUR ELEMENT
	.MTPS	#340		;DISABLE INTERRUPTS
	MOV	(R1),R2		;;; GET LQE POINTER TO SEE IF CHAIN IS PRESENT
	BNE	4$		;;; CHAIN EXISTS
	MOV	R4,(R1)+	;;; NO CHAIN, MAKE THIS THE ONLY ELEMENT
	MOV	R4,(R1)+	;;; ALSO CQE ELEMENT
	.MTPS	#0		;;; ENABLE INTERRUPTS
	JMP	@R1		;AND JUMP TO REAL HANDLER

4$:	MOV	R4,Q$LINK(R2)	;;; ADD OUR ELEMENT TO CHAIN
	MOV	R4,(R1)		;;;
	.MTPS	#0		;;; ENABLE INTERRUPTS
	RTS	PC		;AND RETURN

ERROR:	BIS	#HDERR$,@Q$CSW(R4) ;ON ERROR, SIGNAL HARD ERROR
	BR	AREXIT		;AND GO TO COMPLETION

TABPOS:	ASL	R0		;CALCULATE DEVTAB OFFSET
	ASL	R0
	ASL	R0
	ADD	#<DEVTAB-1$>,R0	;MUST BE POSITION-INDEPENDENT
	ADD	PC,R0
1$:	RTS	PC		;RETURN VALUE IN R0

SPFUN:	CMPB	R1,#SIZ$FN	;SIZE FUNCTION?
	BNE	1$		;NO
	TST	(R0)		;ENSURE THAT DEVICE IS DEFINED
	BEQ	ERROR
.IF EQ MMG$T
	MOV	D.FLEN(R0),@Q$BUFF(R4) ;RETURN FILE LENGTH
.IFF
	MOV	D.FLEN(R0),-(SP)
	JSR	PC,@$PTWRD
.IFTF
	BR	AREXIT
1$:	CMPB	R1,#DEF$FN	;DEFINE FUNCTION?
	BNE	3$		;NO
.IFT
	MOV	Q$BUFF(R4),R1	;YES, GET BUFFER ADDRESS
.REPT	4			;TRANSFER NEW DEVTAB ENTRY
	MOV	(R1)+,(R0)+
.ENDR
.IFF
	MOV	#10,R1
2$:	JSR	PC,@$GTBYT
	MOVB	(SP)+,(R0)+
	DEC	R1
	BNE	2$
.ENDC
	BR	AREXIT		;DONE
3$:	CMPB	R1,#MAP$FN	;MAP FUNCTION?
	BNE	ERROR		;NO, LOSE
	CLR	R0		;YES, POINT TO BEGINNING OF DEVTAB
	JSR	PC,TABPOS
	CLR	R1		;MAP BYTE
	MOV	#10,R2		;8 ENTRIES IN TABLE
4$:	ASL	R1		;SHIFT TO NEXT BIT POSITION
	TST	(R0)		;ENTRY DEFINED?
	BEQ	5$		;NO
	BIS	#1,R1		;YES, SET BIT IN MAP
5$:	ADD	#D.NEXT,R0	;SKIP TO NEXT ENTRY
	DEC	R2
	BNE	4$		;LOOP THROUGH TABLE
.IF EQ MMG$T
	MOV	R1,@Q$BUFF(R4)	;RETURN MAP WORD
.IFF
	MOV	R1,-(SP)
	JSR	PC,@$PTWRD
.ENDC
	BR	AREXIT		;DONE

DEVTAB:	.REPT	40		;DEVICE TRANSLATION TABLE (8 ENTRIES)
		.WORD	0
	.ENDR

	RTS	PC		;ABORT ENTRY
ARINT::
AREXIT::.DRFIN	AR		;EXIT

	.DREND	AR

.END
            