*
*
*
*    MATRIX FORMAT:
*
*      a11  a12
*
*      a21  a22
*
*    a11-a22 are single precision float variables (2 word).
*
*
*    IN MEMORY LAYOUT:
*
*    a11
*    a11
*    a12
*    a12
*    a21
*    a21
*    a22
*    a22
*
*
*    JST M$INIT                   INITIALIZE MATRIX TO IDENTITY
*    DAC MATRIX      ADDRESS
*
*
********************************************************************************
*
	SUBR	M$INIT,INIT	INITIALIZE MATRIX
	SUBR	M$MUL,MUL	MATRIX MULTIPLICATION
	SUBR	M$APLI,APLI	APPLY MATRIX TO INTEGER VECTOR
	SUBR	M$APII,APII	APPLY MATRIX TO PAIR OF INTEGERS
	SUBR	M$ROT,XXX	ADD ROTATION TO MATRIX ARGUMENT
	SUBR	M$SCLE,SCLE	SCALE MATRIX
*
	REL
	ORG	'0
*
*
*
*
*
********************************************************************************
*
*
INIT	DAC	**
	LDX*	INIT
*	
	LDA*	INIT	GET MATRIX BASE ADDRESS
	STA	IM11
	ADD	=6
	STA	IM22
	IRS	INIT
*
	CRA
	STA	2,1
	STA	3,1
	STA	4,1
	STA	5,1
	CALL	FLOAT
	DAC	ONE
	CALL	H$22
IM11	DEC	0
	CALL	H$22
IM22	DEC	0
*
	JMP*	INIT
ONE	DEC	1
*
*
********************************************************************************
*
*  C=A*B
*
*  a11 a12  b11 b12   a11*b11 a21*b12
*  a21 a22  b21 b22   a12*b21 a22*b22
*
*  JST MUL
*  DAC MC
*  DAC MA
*  DAC MB
*
MUL	DAC	**
	LDX*	MUL
*
	LDA*	MUL
	STA	PC11
	ADD	=2
	STA	PC12
	ADD	=2
	STA	PC21
	ADD	=2
	STA	PC22
	IRS	MUL
*
	LDA*	MUL
	STA	PA11
	ADD	=2
	STA	PA12
	ADD	=2
	STA	PA21
	ADD	=2
	STA	PA22
	ADD	=2
*
	IRS	MUL
*
	LDA*	MUL
	STA	PB11
	ADD	=2
	STA	PB12
	ADD	=2
	STA	PB21
	ADD	=2
	STA	PB22
	ADD	=2
*
	IRS	MUL
	IRS	MUL
*
*
*  a11 a12  b11 b12   a11*b11 a21*b12
*  a21 a22  b21 b22   a12*b21 a22*b22
*
	CALL	L$22	LOAD REAL
PA11	DAC	0
	CALL	M$22	MULTIPLY
PB11	DAC	0
	CALL	H$22	STORE
PC11	DEC	0
*
	CALL	L$22
PA21	DEC	0
	CALL	M$22
PB12	DEC	0
	CALL	H$22
PC12	DEC	0
*
	CALL	L$22
PA12	DEC	0
	CALL	M$22
PB21	DEC	0
	CALL	H$22
PC21	DEC	0
*
	CALL	L$22
PA22	DEC	0
	CALL	M$22
PB22	DEC	0
	CALL	H$22
PC22	DEC	0
*
*
	JMP*	MUL
*
********************************************************************************
*
*
SCLE	DAC	**	SCALE MATRIX
	LDX*	SCLE
*	
	LDA*	SCLE	GET MATRIX BASE ADDRESS
	STA	SM11
	STA	TM11
	ADD	=6
	STA	SM22
	STA	TM22
	IRS	SCLE
	LDA*	SCLE
	STA	SX
	STA	SY
	IRS	SCLE	TALLY RETURN ADDRESS
*
	CALL	L$22
SM11	DAC	0
	CALL	M$22
SX	DAC	0
	CALL	H$22
TM11	DAC	0
*
	CALL	L$22
SM22	DAC	0
	CALL	M$22
SY	DAC	0
	CALL	H$22
TM22	DAC	0
*
	JMP*	SCLE
*
*
*
*
********************************************************************************
*
*
* Apply Pair of integers and round
*
*	JST	M$APII
*	DAC	MATRIX
*	DAC	X	
*	DAC	Y
*       DAC	0	
*
APII	DAC	**
*
	LDA*	APII
	STA	MP11
	ADD	=2
	STA	MP12
	ADD	=2
	STA	MP21
	ADD	=2
	STA	MP22
	IRS	APII
*
	LDA*	APII
	STA	XP1
	STA	XP2
	IRS	APII
	LDA*	APII
	STA	YP1
	STA	YP2
	IRS	APII
	IRS	APII
	JST	APL	CALL REAL ROUTINE
	JMP*	APII
*	
********************************************************************************
*
*
* Apply to integer vector and round
*
*	JST	M$APLI
*	DAC	MATRIX
*	DAC	X	Y MUST FOLLOW IN NEXT LOCATION!
*
APLI	DAC	**
*
	LDA*	APLI
	STA	MP11
	ADD	=2
	STA	MP12
	ADD	=2
	STA	MP21
	ADD	=2
	STA	MP22
	IRS	APLI
*
	LDA*	APLI
	STA	XP1
	STA	XP2
	AOA
	STA	YP1
	STA	YP2
	IRS	APLI
	IRS	APLI
	JST	APL
	JMP*	APLI
*
*
****************************************
*
*
APL	DAC	**	REAL APPLY ROUTINE
*
	CALL	FLOAT	LOAD SINGLE PRECISION FLOAT FROM 1-WORD INTEGER
XP1	DAC	0
	CALL	M$22	MULTIPLY FLOAT*FLOAT
MP11	DAC	0
	CALL	H$22	STORE FLOAT
	DAC	TMP
	CALL	FLOAT
YP1	DAC	0
	CALL	M$22
MP12	DAC	0
	CALL	A$22
	DAC	TMP
	JST	RND	ROUND AND CONVERT TO INTEGER
	STA	PA21	STORE NEW X VALUE INTO TEMPORARY LOCATION
****
	CALL	FLOAT
XP2	DAC	0
	CALL	M$22
MP21	DAC	0
	CALL	H$22
	DAC	TMP
*
	CALL	FLOAT
YP2	DAC	0
	CALL	M$22
MP22	DAC	0
	CALL	A$22
	DAC	TMP
	JST	RND	NOW INTEGER IN AC
	STA*	YP1	STORE NEW Y VALUE
*
	LDA	PA21
	STA*	XP1
	JMP*	APL	RETURN TO CALLER.
*
****************************************
*
RND	DAC	**	ROUND A/B AND RETURN WITH INTEGER IN A
	CALL	A$22	ADD 0.5
	DAC	HLF
	CALL	C$21	CONVERT TO INTEGER
	NOP
	JMP*	RND
HLF	OCT	'040100	CONSTANT 0.5	
	OCT	'000000
*
****************************************
*
TMP	BSS	2
*
*
********************************************************************************
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
********************************************************************************
*
	END
*
********************************************************************************