TITLE MPOUT
	SUBTTL	11 JUL 69		P.M.MCLELLAN

;	THE FOLLOWING ROUTINE IS DESIGNED TO OUTPUT A MULTIPLE
;PRECISION NUMBER OF VARIABLE PRECISION IN FORTRAN F FORMAT, I.E.,
;AN INTEGER FOLLOWED BY A FRACTION. THE MAGNITUDE OF THE MP NUMBER MUST
;LIE BETWEEN 2**35-1 AND 2**-(2**34-1) FOR NUMBERS LESS THAN 1.0,
;LEADING ZEROS ARE NOT COUNTED AS SIGNIFICANT DIGITS. 
;
;	THE CALL IS
;
;			JSA 16, MPOUT
;			EXP ADDR
;			EXP PREC
;
;	ADDR IS THE ADDRESS OF THE EXPONENT OF THE MP NUMBER
;	PREC IS THE ADDRESS OF THE PRECISION.


	ENTRY MPOUT
	EXTERN DEPOT,DEVNO.,DYNDV.,MMULT,MSHIFT
	INTERN	OBUF

	A=	0
	B=	1
	C=	2
	D=	3
	E=	4
	F=	5
	G=	6
	N=	7
	Q=	16
	P=	17
	X=	17

MPOUT:	0
	MOVEM	N, SAVAC+7	;SAVE ACS.
	HRRZI	N, SAVAC
	BLT	N, SAVAC+6
	INIT	X, 0		;INIT FOR OUTPUT
	SIXBIT	/TTY/
	XWD	OBUF, 0
	JRST	.-3
	OUTBUF	X, 1
	OUTPUT	X,
	MOVE	B, (Q)		;GET ADDRESS OF EXPONENT
	MOVE	E, @B		;GET MP EXPONENT
	MOVE	N, @1(Q)	;GET PRECISION
	MOVS	B, B		;TRANSFER MP NUMBER TO WORK AREA
	HRRI	B, TEMP
	BLT	B, TEMP-1(N)
	MOVEI	D, 53		;PUT + SIGN IN D
	JUMPG	E, EXCESS	;IS EXPONENT WORD NEGATIVE?
	MOVEI	D, 55		;PUT - SIGN IN D
	MOVNS	E, TEMP		;MAKE POSITIVE
EXCESS:	MOVE	G, N		;GET PRECISION
	AOJ	G,		;INCREMENT BY 1 TO SHIFT WHOLE #
	SETZ	A,		;ZERO WORK AC
	HRLZI	F, 200000	;PUT ZERO EXPONENT IN F
	SUB	E, F		;GET TRUE EXPONENT
	JUMPL	E, SW		;IF EXPONENT NEGATIVE, JUMP
	SKIPG	A, E		;IF EXPONENT > 0, LOAD IN A AND SKIP
	JRST	ZERO		;OTHERWISE JUMP
	CAILE	E, 43		;IS IT < OR = 35
	JRST	ERROR1		;NO, STOP EXECUTION
	SETZM	TEMP		;ZERO FOR SHIFT
	MOVEM	E, .+4		;STORE FOR CALL TO MSHIFT
	JSA	Q, MSHIFT	;UNNORMALIZE NUMBER
	EXP	TEMP-1,G,0
	MOVE	A, TEMP		;GET INTEGER PART
ZERO:	MOVEM	F, TEMP		;ZERO EXPONENT
	JRST	.+2
SW:	SETZ	E,		;SET LEADING ZERO SWITCH
	MOVEI	C, 1		;SET CHARACTER COUNTER TO 1
	SKIPE	B, A		;IF INTEGER 0, SKIP DIVIDE
CONV:	IDIVI	A, 12		;CONVERT INTEGER TO DECIMAL
	ADDI	B, 60
	AOJ	C,
	PUSH	P, B
	JUMPG	A, CONV
	MOVEI	B, 16		;CALCULATE LEADING BLANKS
	SUB	B, C
	MOVEI	A, 40
	PUSHJ	P, DEPOT	;OUTPUT LEADING BLANKS
	SOJG	B, .-1
	PUSH	P, D		;PUT SIGN ON TOP OF STACK
	POP	P, A
	PUSHJ	P, DEPOT
	SOJG	C, .-2
	MOVEI	A, 56		;OUTPUT DECIMAL
	PUSHJ	P, DEPOT
	MOVE	D, N		;CALCULATE NUMBER OF DIGITS TO OUTPUT
	IMULI	D, 13
	MOVEI	B, 10		;SET UP GROUP COUNTER
	JRST	SPACE
TAB:	SOJG	B, SPACE	;INSERT TAB EVERY 40 DIGITS
	MOVEI	A, 12
	PUSHJ	P, DEPOT
	MOVEI	A, 15
	PUSHJ	P, DEPOT
	MOVEI	A, 11
	PUSHJ	P, DEPOT
	PUSHJ	P, DEPOT
	MOVEI	B, 10
SPACE:	MOVEI	A, 40		;OUTPUT BLANK EVERY 5 DIGITS
	PUSHJ	P, DEPOT
	MOVEI	C, 6
LOOP:	SOJE	C, TAB		;INSERT TABS EVERY 40 DIGITS
	MOVE	A, TEMP		;CHECK EXPONENT
	SETCA	A,
	TLNE	A, 177000
	MOVEM	F, TEMP		;SET UP ZERO MP EXPONENT
	JSA	Q, MMULT	;GRIND OUT FRACTION DIGITS
	EXP	TEMP,TEN,N,TEMP
	0
	MOVE	A, TEMP		;GET EXPONENT FROM MULTIPLY
	SUB	A, F		;GET TRUE EXPONENT FOR SHIFT
	JUMPGE	A, SHIFT	;IF TRUE EXPONENT POSITIVE, SHIFT
	MOVEI	A, 60		;OTHERWISE OUTPUT 0, AND RE-MULTIPLY
	PUSHJ	P, DEPOT
	JUMPG	E, OUTBOY+1	;LEADING ZERO?
	JRST	LOOP		;YES, DO NOT COUNT
SHIFT:	HRRZM	A, .+5		;PREPARE TO UNNORMALIZE TEMP
	SETZM	TEMP
	JSA	Q, MSHIFT	;CALL MSHIFT TO GET INTEGER PART
	EXP	TEMP-1,G,0
	MOVE	A, TEMP		;GET INTEGER PART
	AOJ	E,		;SET LEADING ZERO SWITCH
	ADDI	A, 60		;CONVERT TO ASCII DECIMAL
OUTBOY:	PUSHJ	P, DEPOT	;OUTPUT DIGIT
	SOJG	D, LOOP		;END OF NUMBER?
	MOVEI	A, 12		;LINE FEED
	PUSHJ	P, DEPOT
	MOVEI	A, 15
	PUSHJ	P, DEPOT
	HRLZI	N, SAVAC	;RESTORE ACS
	BLT	N, N
	CLOSE	X,
	JRA	Q, 2(Q)		;RETURN

ERROR1:	MOVEI	A, MSGE		;SET UP ERROR MESSAGE
	CALLI	A, 3
	CALLI	12		;STOP EXECUTION
MSGE:	ASCIZ/***** MP NUMBER > 2**35 *****/
OBUF:	BLOCK	3
SAVAC:	BLOCK	10
TEMP:	BLOCK	10
TEN:	200000000004
	240000000000
	BLOCK 8


	END