.TITLE	UNIV
	.IDENT	/V03.0/

;+
;
;	FORTRAN routine to extract a 1-byte element from a data common in
;	memory.  If the correct segment of the common is not currently mapped,
;	then the remapping is done first.  The original mapping context is not
;	restored.
;
;	The calling sequence is:
;
;		CALL UNIV(IX,IY,CHAR,IUNIV)
;
;	CHAR is assumed to be a 1-byte variable, and IX and IY must be integer.
;
;		D. O'Reilly		20-Dec-82
;
;	Modification history:
;
;		D. O'Reilly		24-Jan-83
;
;		Added ability to have multiple universes
;
;		D. Carroll		09-Feb-83
;
;		Convert signed multiply/divide to unsigned
;
;-

	.MCALL	MAP$,DIR$

	.PSECT	MAPPNG,RW,D,GBL,OVR

RDB:	.BLKW	8.
WDB:	.BLKW	8.
MAPS:	.BLKW	2
CURBAS:	.WORD	0
CURTOP:	.WORD	0
UNIBAS:	.BLKW	5

	.PSECT	TRKCOM,RW,D,GBL,OVR

MAXX:	.BLKW	1
MAXY:	.BLKW	1
IUNIV:	.BLKW	8.
IUNIMX:	.BLKW	1

	.PSECT	DATA,RW,D

X:	.WORD	0
Y:	.WORD	0
HLDBAS:	.WORD	0
MAP:	MAP$	WDB

	.PSECT	INSTR,RO,I

UNIVIN::
	CLR	R0			;SHOW WE'RE INSERTING
	BR	DOIT			;DO OUR STUFF
UNIV::	MOV	#-1,R0			;HERE, WE'RE EXTRACTING
DOIT:	MOV	@2(R5),X		;GET THE X-COORDINATE
	DEC	X			;SUBTRACT 1 FROM IT
	MOV	@4(R5),Y		;AND THE Y-COORDINATE
	DEC	Y			;DROP Y
	MOV	MAXX,R1			;THE MAXIMUM X-COORDINATE
	MOV	R0,-(SP)		; save our flag
	MOV	X,R0			; get the coord ...
	CALL	$MUL			; multiply it out
	ADD	Y,R1			;FINISH OFFSETTING

;
;	SEE IF WE NEED TO REMAP
;

	MOV	@10(R5),R4		;GET THE UNIVERSE NUMBER
	DEC	R4			;SUBTRACT BY ONE
	ASL	R4			;MAKE IT BYTES

	MOV	#UNIBAS,R3		;GET THE UNIVERSE BASE ADDRESS
	ADD	R4,R3			;BIAS TO THE CORRECT BASE
	MOV	(R3),HLDBAS		;SAVE IT

	ADD	R1,HLDBAS		;OFFSET TO THE PROPER PLACE
	CMP	HLDBAS,CURBAS		;CURRENTLY MAPPED THERE?
	BLO	30$			;IF LT, NO
	CMP	HLDBAS,CURTOP		;HOW ABOUT GT CURRENT MAPPING
	BHIS	30$			;IF GT, NO
10$:	MOV	HLDBAS,R3		;MAKE SURE R3 CONTAINS THE LOCATION
	SUB	CURBAS,R3		;GET THE ACTUAL OFFSET

;
;	MAPPING IS FINE.  AT THIS POINT, R3 MUST CONTAIN THE BYTE OFFSET INTO
;	THE MAPPING WINDOW.
;

	ADD	WDB+W.NBAS,R3		;GET THE VIRTUAL ADDRESS OF WINDOW
	CMP	(R5),#5			; five arguments specified ?
	BNE	15$			; nope, dont give VA
	MOV	HLDBAS,@12(R5)		; copy in the VA given
15$:	TST	(SP)+			;IN OR OUT
	BEQ	20$			;IN
	MOVB	(R3),@6(R5)		;PUT THE CHARACTER INTO RETURN LOCATION
	RETURN				;AND GO AWAY
20$:	MOVB	@6(R5),(R3)		;EXTRACT THE CHARACTER
	RETURN				;AND GO AWAY

;
;	REMAP THE WINDOW.  NOTE THAT R3 AFTER THIS ROUTINE WILL CONTAIN THE
;	BYTE OFFSET INTO THE WINDOW.
;

30$:	ADD	#1,MAPS			; bump mapping count
	ADC	MAPS+2			; I*4 WORD
	MOV	HLDBAS,R2		; get the base value
	CLR	R3			; clear out the low word
	ASHC	#-12,R2			; shift to get the correct offset
	BIC	#177700,R2		; clean up the extraneous stuff
	ASH	#4,R2			; shift to 32W block
	MOV	R2,WDB+W.NOFF		;STUFF INTO THE WDB
	DIR$	#MAP			;REMAP THE WINDOW

;
;	THIS SECTION OF CODE CALCULATES THE NEW MAPPING OF THE WINDOW.
;	R1 AT THIS POINT STILL CONTAINS THE BYTE OFFSET INTO THE COMMON.
;

	MOV	WDB+W.NOFF,R3		;THE CURRENT OFFSET
	ASH	#6,R3			;CALCULATE THE BASE ADDRESS IN BYTES
	MOV	R3,CURBAS		;HOLD IT
	MOV	WDB+W.NLEN,R3		;THE WINDOW LENGTH
	ASH	#6,R3			;MAKE IT BYTES
	MOV	CURBAS,CURTOP		;SAVE MAPPING BASE
	ADD	R3,CURTOP		;GET THE TOP OF THE WINDOW MAPPING
	BR	10$			;AND NOW ACCESS THE DATA

	.END