<div id='wikitext'>
<pre><b> File: POWRSP.MC of Tape: Various/ETH/eth11-3</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
.TITLE THE POWER SPECTRUM SUBROUTINE(POWRSP)
;LABORTORY SUBROUTINES
;DEC-11
;FILENAME POWRSP.MAC
;FILE ID POWRSP.1

.CSECT	FPOWRS









;			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 &quot;;&quot; IN LINE WHICH 
	;  PRECEEDS THE APPROPRIATE PARAMETER.

;EIS=1
;EAE=1
.IFDF	EAE
DIV=177300
AC=DIV+2
MQ=AC+2
MUL=MQ+2
EAESR=MUL+3
.ENDC



	;CONDITIONAL ASSEMBLY PARAMETER DESCRIPTIONS

;EIS	&quot;EIS&quot; 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	&quot;EAE&quot; 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 &quot;EAE&quot; IS NOT INSTALLED AT THE NORMAL LOCATIONS
;	      THE DEFAULT ADDRESSES OF THE STATUS WORDS SHOULD BE
;	      MODIFIED TO REFLECT THIS DESCREPENCY BY REDEFINING &quot;DIV&quot;
;	      BY EDITING THIS FILE AND SETTING IT EQUAL TO THE STARTING
;	      ADDRESS OF THE STATUS WORDS ASSOCIATED WITH THE &quot;EAE&quot;.



	;GLOBALS
	;	-INTERNAL

	.GLOBL	POWRSP


	;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



	.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 &#039;EIS&#039; 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 POWER SPECTRUM SUBROUTINE SHOULD TAKE
; THE FOLLOWING FORM

; CALL POWRSP(N,IR,IM,P)

;WHERE
;	N IS AN INTEGER VALUE SPECIFYING THE NUMBER OF POINTS IN
;	  ARRAYS IR,IM, AND P
;	IR IS AN INTEGER ARRAY CONTAINING THE REAL PARTS OF THE
;	   COMPLEX FOURIER TRANSFORM RESULTS
;	IM IS AN INTEGER ARRAY CONTAINING THE IMAGINARY PARTS OF THE
;	   COMPLEX FOURIER TRANSFORM RESULTS
;	P IS A REAL ARRAY WHERE THE SUBROUTINE WILL RETURN THE 
;	  POWER SPECTRUM RESULTS
;  !!!NOTE!!
;	IF ANY ARGUMENT IN THE SUBROUTINE CALL IS OMITTED OR DEFAULTED
;	THE SUBROUTINE WILL CAUSE A FATAL ERROR. M-TRAP THRU 4.
	.SBTTL POWRSP ENTRY AND PROCESSING

POWRSP:	CMPB	#4,@R5		;CHECK FOR CORRECT NUMBER OF ARGUMENTS
	BLE	1$		;IF CORRECT, RETURN

;  !!! NOTE INTENTIONAL TRAP ON MISSING ARGUMENTS !!!
	MOV	R5,1		; MUST HAVE CORRECT NO. OF ARGUMENTS
;
1$:	TST	(R5)+		;GET FIRST ADDRESS
	MOV	@(R5)+,-(SP)	;GET TWO COPIES OF COUNT. NOTE, THIS
				; STATEMENT WILL TRAP IF COUNT DEFAULTED
	MOV	(SP),-(SP)	;SAVE COUNT ADDRESS
	MOV	(R5)+,R2	;SAVE THE ADDR OF THE REAL PART.
	MOV	(R5)+,R3	;SAVE THE ADDR OF THE IMAGINARY PART
	MOV	(R5)+,R4	;SAVE THE ADDRESS FOR THE RESULTS
2$:	MOV	(R2)+,R0	;GET THE NEXT REAL PART
				; NOTE: PREVIOUS STATEMENT WILL TRAP OUT
				;       IF ARGUMENT WAS DEFAULTED.
	$MUL	R0,R0		; SQUARE IT
	MOV	R0,(R4)+	; AND STASH THE HIGH PART OF THE RESULTS
				; NOTE: PREVIOUS STATEMENT WILL TRAP OUT
				;       IF ARGUMENT WAS DEFAULTED.
	MOV	R1,(R4)		; AND THEN THE LOW PART
	MOV	(R3)+,R0	;GET THE NEXT IMAGINARY PART
				; NOTE: PREVIOUS STATEMENT WILL TRAP OUT
				;       IF ARGUMENT WAS DEFAULTED.
	$MUL	R0,R0		; SQUARE IT
	ADD	R1,(R4)+	; AND ADD THE LOW
	ADC	R0		; AND THEN
	ADD	R0,-4(R4)	; THE HIGH PARTS TO THE REAL SQUARED
	DEC	(SP)		;LOOP UNTIL WHOLE ARRAY IS PROCESSED
	BNE	2$

; NOW CHANGE DOUBLE INTEGER RESULTS TO FLOATING POINT, 
;	BACKWARDS THROUGH THE ARRAY

	TST	(SP)+		;POINT STACK AT SECOND COPY OF COUNT
13$:	MOV	-(R4),R1	;TEST LOW PART
	BNE	11$		;BRANCH IF NOT 0
	MOV	-(R4),R2	;IS ENTIRE NUMBER 0
	BEQ	7$		;BRANCH IF YES
	BR	21$
11$:	MOV	-(R4),R2	;GET HIGH PART
21$:	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	(R4)		;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,(R4)		;STORE RESULTS
	MOV	R1,2(R4)		
	DEC	(SP)		;LOOP THROUGH ARRAY
	BNE	13$
	TST	(SP)+		;POP STACK
	RTS	PC		;RETURN
	.END</pre>
<hr/>
</div>