File: PHAMPL.MC of Tape: Various/ETH/eth11-2

(Source file text) 

---

.TITLE THE PHASE/AMPLITUDE SPECTRA SUBROUTINE(PHAMPL)
;LABORATORY SUBROUTINES
;DEC-11
;FILENAME PHAMPL.MAC
;FILE ID PHAMPL.1

.CSECT	FPHAMP









;			COPYRIGHT (C) 1976 BY
;	    DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
;COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;
;
;
;LDP SOFTWARE DEVELOPMENT GROUP   SEPTEMBER, 1977.
	.SBTTL CONDITIONALS

	;CONDITIONAL ASSEMBLY PARAMETERS
	;  DEFINE PARAMETERS BY REMOVING FIRST ";" IN LINE WHICH 
	;  PRECEEDS THE APPROPRIATE PARAMETER.

;EIS=1
;EAE=1
;F4P$=1
.IFDF	EAE
DIV=177300
AC=DIV+2
MQ=AC+2
MUL=MQ+2
EAESR=MUL+3
.ENDC



	;CONDITIONAL ASSEMBLY PARAMETER DESCRIPTIONS

;EIS	"EIS" SHOULD BE DEFINED IF EIS(KE11-E) HARDWARE IS AVAILABLE
;	ON THE SYSTEM WHERE THIS SOFTWARE IS TO BE USED. IF NOT DEFINED,
;	SUBROUTINES WHICH MIMIC THE REQUIRED FUNCTIONS OF THIS HARDWARE
;	ARE ASSEMBLED AND SUBSTITUTED.
;
;EAE	"EAE" SHOULD BE DEFINED IF EIS HARDWARE IS NOT AVAILABLE BUT
;	THE EAE IS.
;	NOTE: IF EAE HARDWARE IS AVAILABLE AND IS TO BE USED, THE 
;	      DEFAULT ADDRESSES ASSOCIATED WITH THE DEVICE ARE USED.
;	      IF YOUR "EAE" IS NOT INSTALLED AT THE NORMAL LOCATIONS
;	      THE DEFAULT ADDRESSES OF THE STATUS WORDS SHOULD BE
;	      MODIFIED TO REFLECT THIS DESCREPENCY BY REDEFINING "DIV"
;	      BY EDITING THIS FILE AND SETTING IT EQUAL TO THE STARTING
;	      ADDRESS OF THE STATUS WORDS ASSOCIATED WITH THE "EAE".
;F4P$	"F4P$" SHOULD BE DEFINED IF THIS SUBROUTINE WILL BE USED WITH
;	THE FORTRAN IV+ OBJECT TIME SYSTEM(OTS) LIBRARY.
;	SPECIFICALLY IT MUST BE DEFINED WHEN USED WITH ROUTINES
;	COMPILED WITH THE FORTRAN IV+ COMPILER.
;	ASK YOUR SYSTEM MANAGER WHICH FORTRAN IS BEING USED IN YOUR
;	INSTALLATION IF YOU ARE NOT SURE.


	;GLOBALS
	;	-INTERNAL

	.GLOBL	PHAMPL

	;	-EXTERNAL

.IIF NDF,F4P$	.GLOBL	FLOAT,SQRT,ATAN2
.IIF DF,F4P$	.GLOBL	$FLOAT,$SQRT,$ATAN2



	;REGISTER DEFINITIONS

	R0=%0
	R1=%1
	R2=%2
	R3=%3
	R4=%4
	R5=%5
	SP=%6
	PC=%7




	;MACROS

	;	-PROGRAM
	;MULTIPLY MACRO

.MACRO	$MUL	SRC,RX
	.IFDF	EIS
	MUL	SRC,RX
	.IFF
	.NTYPE .SYM,RX
	.IIF NE .SYM .ERROR ;REGISTER MUST BE R0
	.IF NB SRC
	.IIF DIF SRC,R1	MOV SRC,R1
	.ENDC
	JSR PC,MULR0
	.ENDC
.ENDM


.MACRO	MFLOAT
	.IIF	DF,F4P$		JSR	PC,$FLOAT
	.IIF	NDF,F4P$	JSR	PC,FLOAT
.ENDM

.MACRO	MATAN2
	.IIF	DF,F4P$		JSR	PC,$ATAN2
	.IIF	NDF,F4P$	JSR	PC,ATAN2
.ENDM

.MACRO	MSQRT
	.IIF	DF,F4P$		JSR	PC,$SQRT
	.IIF	NDF,F4P$	JSR	PC,SQRT
.ENDM



	.SBTTL MULR0

.IFNDF EIS
;MULR0 SUBROUTINE TO SERVE $MUL SRC,REG MACRO
;USED TO SIMULATE THE INTEGER MULTIPLY INSTRUCTION WHEN THE USER 
;DOES NOT HAVE THE EXTENDED INSTRUCTION SET (EIS).
;CALLED BY THE FOLLOWING
;	MOV	SRC,R1
;	JSR	PC,MULR0
;	RETURNS HIGH PRODUCT IN R0, LOW IN R1
;ON RETURN ONLY C-BIT OF CONDITION CODES IS MEANINGFUL
;C=1 IMPLIES MORE THAN 16-BIT PRODUCT, C=0 IMPLIES SINGLE PREC. OK

;THE MACRO $MUL SRC,REG WILL ALSO GENERATE THIS CALLING SEQUENCE
;WHEN THE CONDITIONAL ASSEMBLY PARAMETER 'EIS' IS NOT DEFINED.

MULR0:	.IFDF	EAE
	MOV	R1,@#MQ		;PUT 1ST NUMBER IN MQ
	MOV	R0,@#MUL	;MULTIPLY BY SECOND NUMBER
	MOV	@#MQ,R1		;LOW ORDER PRODUCT
	MOV	@#AC,R0		;HIGH ORDER PRODUCT
	CLC
	BITB	#2,@#EAESR	;TEST FOR SINGLE PRECISION
	BNE	1$
	SEC			;C=0 IMPLIES 16-BIT PRODUCT OK
1$:	RTS	PC
	.ENDC
	.IFNDF	EAE
	MOV	R2,-(SP)	;PUSH TWO REGISTERS AND A FLAG
	MOV	R4,-(SP)
	CLR	-(SP)
	TST	R0		;CHECK SIGNS
	BPL	2$
	NEG	R0		;TAKE ABSOLUTE VALUES
	INC	@SP		;AND FLAG NEGATIONS
2$:	TST	R1
	BPL	4$
	NEG	R1
	DEC	@SP		;MINUS*MINUS=PLUS
4$:	MOV	#17.,R2		;COUNT ITERATIONS
	CLR	R4		;HIGH ORDER PRODUCT BUILT HERE
6$:	CLC			;CLEAR CARRY FOR ROTATES
	ROR	R4		;SHIFT MULTIPLIER AND PARTIAL PRODUCT
	ROR	R1
	BCC	8$		;NO ADD NEEDED
	ADD	R0,R4
8$:	DEC	R2		;COUNT ITERATION
	BGT	6$
	TST	R4		;WAS RESULT DOUBLE?
	BNE	10$		;YES
	CMP	R1,#100000	;MAYBE
	BLO	12$		;DEFINITELY NOT
	BHI	10$		;DEFINITELY
	TST	@SP		;SPECIAL CASE -2**15 OK
	BNE	12$		;YES
10$:	COM	R2		;USE THIS AS CARRY FLAG
12$:	TST	(SP)+		;IS RESULT TO BE NEGATED?
	BEQ	14$		;NO
	NEG	R4		;YES
	NEG	R1
	SBC	R4
14$:	MOV	R4,R0
	ASR	R2		;SET CARRY BIT FOR TWO WORD CASE
	MOV	(SP)+,R4	;RST REG
	MOV	(SP)+,R2
	RTS	PC
	.ENDC
.ENDC

	.SBTTL FORTRAN CALLING SEQUENCE

; THE FORTRAN CALL TO THE PHASE AND AMPLITUDE SPECTRUM SUBROUTINE
; SHOULD TAKE THE FOLLOWING FORM

;	CALL PHAMPL(N,IR,IM,PH,AM)

; WHERE
;	N IS AN INTEGER THAT DEFINES THE LENGTH OF THE INPUT AND OUTPUT
;	  ARRAYS
;	IR IS AN INTEGER ARRAY CONTAINING THE REAL PARTS OF THE COMPLEX
;	   VALUES TO BE CONVERTED
;	IM IS AN INTEGER ARRAY CONTAINING THE IMAGINARY PARTS OF THE
;	   COMPLEX VALUES TO BE CONVERTED
;	PH IS A REAL ARRAY IN WHICH THE SUBROUTINE STORES THE 
;	   PHASE ANGLE SPECTRUM, I.E.
;	   PH(I)= ATAN2(FLOAT(IM(I))/FLOAT(IR(I)))
;		WHERE "FLOAT" AND "ATAN2" ARE ROUTINES IN THE FORTRAN 
;		LIBRARY.
;	AM IS A REAL ARRAY IN WHICH THE SUBROUTINE STORES THE AMPLITUDE
;	   SPECTRUM, I.E.,
;	   AM(I)= SQRT(FLOAT(IR(I)*IR(I)+IM(I)*IM(I)))
;		WHERE "FLOAT" AND "SQRT" ARE ROUTINES IN THE FORTRAN
;		LIBRARY.
;  !!! NOTE !!!
;	IF ANY ARGUMENT IN THE CALL IS OMITTED, THE SUBROUTINE WILL 
;	CAUSE A TRAP THRU 4 ERROR. 


	.SBTTL PHASE/AMPLITUDE ENTRY POINT

	.SBTTL CALCULATE PHASE ANGLES

PHAMPL:	CMPB	#5,@R5		;CHECK FOR CORRECT NUMBER OF ARGUMENTS
	BLE	1$		;IF CORRECT, RETURN

; !!! NOTE INTENTIONAL TRAP OUT FOR NOT ENOUGH ARGUMENTS
	MOV	R5,1		;IF NOT ENOUGH ARGUMENTS, TRAP-OUT
;
1$:	TST	(R5)+		;GET FIRST ADDRESS
	MOV	@(R5)+,-(SP)	;GET TWO COPIES OF COUNT
				; NOTE: THE PREVIOUS STATEMENT WILL 
				;       CAUSE A TRAP ERROR IF THE 
				;       REQUIRED ARGUMENT WAS DEFAULTED.
	MOV	(SP),(PC)+	;SAVE ONE COPY OF THE COUNT
COUNT:	.WORD 0			; HERE.
	MOV	(R5)+,R2	;GET TWO COPIES OF REAL ARRAY ADDRESS
	MOV	R2,-(SP)	; SAVE ONE ON THE STACK
	MOV	(R5)+,R3	;DO THE SAME FOR THE IMAGINARY ARRAY
	MOV	R3,-(SP)
	MOV	(R5)+,R4	;GET THE ADDRESS FOR THE PHASE ANGLES
	MOV	(R5)+,-(SP)	;SAVE THE ADDRESS FOR THE AMPLITUDES
	MOV	COUNT,-(SP)	;POINT STACK AT A COPY OF THE COUNT

2$:	MOV	(R2)+,IRH	;GET THE NEXT REAL
				; NOTE: THE PREVIOUS STATEMENT WILL 
				;       CAUSE A TRAP ERROR IF THE 
				;       REQUIRED ARGUMENT WAS DEFAULTED.
	MOV	(R3)+,IMH	; AND IMAGINARY VALUE
				; NOTE: THE PREVIOUS STATEMENT WILL 
				;       CAUSE A TRAP ERROR IF THE 
				;       REQUIRED ARGUMENT WAS DEFAULTED.
	MOV	R2,-(SP)	;SAVE ALL ADDRESS POINTERS
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	MOV	#FLOT1,R5	;FLOAT THE REAL PART
	MFLOAT
	MOV	R1,IRL		;STORE THE FLOATED REAL RESULTS
	MOV	R0,IRH
	MOV	#FLOT2,R5	;FLOAT THE IMAGINARY PART
	MFLOAT
	MOV	R1,IML		;STORE THE FLOATED IMAGINARY RESULTS
	MOV	R0,IMH
	MOV	#ATAN2L,R5	;TAKE THE ARCTAN OF IMAGINARY/REAL
	MATAN2
	MOV	(SP)+,R4	;RESTORE THE ADDRESS POINTERS
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	R0,(R4)+	;STORE THE NEXT PHASE ANGLE RESULTS
				; NOTE: THE PREVIOUS STATEMENT WILL 
				;       CAUSE A TRAP ERROR IF THE 
				;       REQUIRED ARGUMENT WAS DEFAULTED.
	MOV	R1,(R4)+
	DEC	(SP)		;LOOP THROUGH THE ARRAY
	BNE	2$

	.SBTTL COMPUTE AMPLITUDES

	TST	(SP)+		;POP STACK
	MOV	(SP)+,R4	;GET COPY OF ADDRESS FOR AMPLITUDES
	MOV	(SP)+,R3	;GET COPY OF ADDRESS FOR IMAGINARY PART
	MOV	(SP)+,R2	;GET COPY OF ADDRESS FOR REAL PART
				;LEAVE STACK POINTING AT COPY OF COUNT
13$:	MOV	(R3)+,R0	;GET NEXT IMAGINARY VALUE
	$MUL	R0,R0		; SQUARE IT
	MOV	R0,-(SP)	; STORE THE HIGH
	MOV	R1,-(SP)	; AND THEN THE LOW PARTS
	MOV	(R2)+,R0	;GET NEXT REAL VALUE
	$MUL	R0,R0		; SQUARE IT
	ADD	(SP)+,R1	;ADD LOW OF SQUARED IMAG. TO LOW OF REAL
	ADC	R0		; AND THEN
	ADD	(SP)+,R0	;ADD HIGHS OF THE SQUARES
	MOV	R2,-(SP)	;SAVE ADDRESS POINTERS
	MOV	R3,-(SP)
	MOV	R4,-(SP)
				;DO A DOUBLE INTEGER FLOAT
	TST	R1		;TEST LOW PART
	BNE	11$		;BRANCH IF NOT 0
	MOV	R0,R2		;IS ENTIRE NUMBER 0
	BEQ	7$		;BRANCH IF YES
11$:	MOV	R0,R2		;GET HIGH PART
	BPL	12$		;BRANCH IF POSITIVE
	NEG	R2		;NEGATE HIGH PART, C=1
	NEG	R1		;NEGATE LOW PART
	SBC	R2
12$:	MOV	#237,R3		;SET MAXIMUM EXP+1
3$:	BIT	#177400,R2	;LOOK FOR A STRING OF 8 0 BITS
	BNE	5$		;BRANCH IF NOT FOUND
	SWAB	R2		;LEFT JUSTIFY THEM
	SUB	#8.,R3		;PERFORM A SHIFT BY 8
	SWAB	R1
	BISB	R1,R2		;INSERT NEW BITS
	CLRB	R1		;REMOVE THEM
	BR	3$		;TRY AGAIN
4$:	DEC	R3		;FIX EXP COUNT
	ROL	R1		;NORMALIZE R2:R1
	ROL	R2
5$:	BPL	4$		;LOOP TILL IMPLIED NORM BIT IN SIGN
	CLRB	R1		;REMOVE THE BITS FROM 2ND WORD
	BISB	R2,R1		;MOVE THE NEW ONES IN FROM R2
	SWAB	R1		;JUSTIFY IT
	CLRB	R2		;REMOVE THEM FROM HIGH WORD
	SWAB	R2		;JUSTIFY IT
	SWAB	R3		;GET EXP INTO HIGH BYTE
	TST	R0		;WAS ORIGINAL NUMBER + OR -
	BPL	6$		;BRANCH IF POSITIVE, C=0
	SEC
6$:	ROR	R3		;INSERT WITH EXP
	ADD	R3,R2		;CREATE RESULT
7$:	MOV	R2,IRH		;STORE RESULTS
	MOV	R1,IRL		
	MOV	#FLOT1,R5	;TAKE THE SQUARE ROOT
	MSQRT
	MOV	(SP)+,R4	;RESTORE ADDRESSES
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	R0,(R4)+	;STORE THE RESULTING AMPLITUDE
				; NOTE: THE PREVIOUS STATEMENT WILL 
				;       CAUSE A TRAP ERROR IF THE 
				;       REQUIRED ARGUMENT WAS DEFAULTED.
	MOV	R1,(R4)+
	DEC	(SP)		;LOOP TILL DONE
	BNE	13$
	TST	(SP)+		;POP STACK
	RTS	PC		;RETURN
FLOT1:	1			;ADDRESS AREA FOR CALL TO FLOAT AND SQRT
	IRH
FLOT2:	1			;SECOND ADDRESS AREA FOR CALLS TO FLOAT
	IMH
ATAN2L:	2			;ADDRESS AREA FOR CALL TO ATAN2
	IMH
	IRH
IRH:	.WORD 0			;SCRATCH SPACE FOR FORTRAN LIBRARY CALLS
IRL:	.WORD 0
IMH:	.WORD 0
IML:	.WORD 0
	.END

---