Google
 

Trailing-Edge - PDP-10 Archives - cobol12c - pd.mac
There are 9 other files named pd.mac in the archive. Click here to see a list.
; UPD ID= 3273 on 12/10/80 at 4:01 PM by NIXON                          
TITLE	PD FOR LIBOL V12C
SUBTTL	CONVERT BINARY TO DISPLAY	/ACK



	SEARCH	COPYRT
	SALL

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE.

;REVISION HISTORY:
;V12B ****
;	13-JAN-82	/JEH	[1012] non-BIS display of low-values,
;				[100000,,000000], is wrong
;V10 *****
;	15-DEC-74	/ACK	CREATION.
;	5/15/75		/DBT	BIS
;	8/5/77		/DAW	BIS: EXTEND DONE INLINE, ADD CBDOV.
;	4/20/78		/DAW	BIS: SETO IN GENERATED CODE NOT NECESSARY
;*****
	SEARCH	LBLPRM		;DEFINE PARAMETERS.
	%%LBLP==:%%LBLP
	EBCMP.==:EBCMP.
	BIS==:BIS

	SALL
	EXTERN	EASTB.		;FORCE EASTBL TO BE LOADED.
	HISEG
	.COPYRIGHT		;Put COPYRIGHT statement in .REL file.

COMMENT	\
	THIS ROUTINE CONVERTS A ONE OR TWO WORD BINARY NUMBER TO A 
DISPLAY ITEM.
CALL:
	MOVE	16,[Z	AC,PARAMETER ADDRESS]
	PUSHJ	17,PD6./PD7./PD9.
PARAMETERS:
	THE ACCUMULATOR FIELD OF AC 16 CONTAINS THE AC WHICH CONTAINS THE
FIRST WORD OF THE NUMBER TO BE CONVERTED.  THE SECOND WORD, IF IT EXISTS,
IS IN THE FOLLOWING AC.
	THE RIGHT HALF OF AC 16 POINTS TO A WORD IN THE FOLLOWING
FORMAT:
	BITS	0-5	BYTE RESIDUE FOR OUTPUT FIELD.
	BIT	6	1 IF THE FIELD IS SIGNED.
	BIT	7	1 IF SEPARATE SIGN [ANS-74]
	BIT	8	1 IF LEADING SIGN [ANS-74]
	BITS	9-17	SIZE OF THE OUTPUT FIELD.
	BITS	18-35	ADDRESS OF THE FIRST CHARACTER OF THE OUTPUT FIELD.
RETURNS:
	CALL+1	ALWAYS.
REGISTERS USED:
	T1, CPTR, IPTR (CALLED OPTR), SW, CNT, T2, MASK, JAC, SAV10
\
	EXTERN	SET1.		;ROUTINE TO PICK UP THE PARAMETERS.
	EXTERN	PACFL.		;POINTER TO THE NUMBER OF THE AC INTO
				; WHICH WE ARE TO PLACE THE RESULT.

	ENTRY	PD6.		;IF THE INPUT IS SIXBIT.
	ENTRY	PD7.		;IF THE INPUT IS ASCII.
	ENTRY	PD9.		;IF THE INPUT IS EBCDIC.
	INTERN	CVBD.6		;TRANSLATE ROUTINES
	INTERN	CVBD.7
	INTERN	CVBD.9

IFE	BIS,<

;LOCAL AC DEFINITIONS:

	OPTR==IPTR
	CPTR==PARM
	SAV10==TAC5
	MASK==TAC4
	T1==TAC2
	T2==TAC3


PD6.:	JSP	CH,	PD		;ENTER HERE IF THE OUTPUT IS SIXBIT,
PD7.:	JSP	CH,	PD		; HERE IF IT IN ASCII AND
IFN EBCMP.,<
PD9.:	JSP	CH,	PD		; HERE IF IT IS IN EBCDIC.
>

PD:	SUBI	CH,	PD6.-5		;FIND OUT WHAT THE INPUT LOOKS LIKE.
	JSP	JAC,	SET1.		;GO SET UP THE PARAMETERS.
	LDB	T2,	PACFL.		;FIND OUT WHERE THE INPUT
					; OPERAND IS.
	HRRZ	MASK,	NCVTMS-6(SW)	;SELECT THE APPROPRIATE MASK.
	MOVE	CPTR,	SDDPTR-6(SW)	;SELECT THE APPROPRIATE POINTER
					; FOR THE SIGN CHAR.
IFN ANS74,<
	TRZE	CNT,(1B7)		;SEPARATE SIGN?
	TLO	SW,SSF			;YES
	TRZE	CNT,(1B8)		;LEADING SIGN?
	TLO	SW,LSF			;YES
>
	SKIPGE	T1,	(T2)		;PICK UP THE FIRST WORD OF THE OPERAND.
	ADDI	CPTR,	^D10		;USE NEGATIVE SIGNS
	CAILE	CNT,	^D10		;ONE OR TWO WORDS?
	JRST		PD4		;TWO WORD OPERAND.
;HERE WE CONVERT A SINGLE PRECISION BINARY NUMBER TO DISPLAY.

	JUMPGE	T1,	PD1		;IS IT NEGATIVE?
	MOVM	T1,	T1		;YES, MAKE IT POSITIVE.
PD1:
IFN ANS68,<
	JUMPL	SW,	PD6		;IF WE HAVE TO WORRY ABOUT SIGNS,
					; GO DO SO.
>
IFN ANS74,<
	JUMPGE	SW,PD2			;UNSIGNED
	TLNE	SW,SSF			;SEPARATE SIGN?
	JRST	PD1A			;YES
	TLNN	SW,LSF			;LEADING NON-SEPARATE SIGN?
	JRST	PD6			;NO, MUST BE TRAILING
	PUSH	PP,OPTR			;SAVE OUTPUT PTR
	PUSHJ	PP,PD2			;CONVERT
	POP	PP,OPTR
	ILDB	T1,OPTR			;GET LEADING DIGIT
	JRST	PD6A			;OVERPUNCH IT

PD1A:	PUSHJ	PP,PD7			;RESET CPTR
	TLNN	SW,LSF			;LEADING SIGN?
	JRST	PD1B			;NO
	LDB	T2,CPTR			;GET SIGN
	IDPB	T2,OPTR			;STORE IT
	JRST	PD2			;NOW DO REST

PD1B:	PUSHJ	PP,PD2			;CONVERT
	IBP	OPTR			;ADVANCE TO NEXT BYTE
	JRST	PD6B			;STORE SIGN
>

;CONVERSION ROUTINE:

PD2:	IDIV	T1,	DECTAB(CNT)	;LEFT TRUNCATE IF THE OPERAND
					; IS TOO BIG.
PD3:	MOVE	T1,	T1+1		;GET THE REMAINING DIGITS.
PD3A:	IDIV	T1,	DECTAB-1(CNT)	;GET THE NEXT DIGIT.
	SKIPGE	T1			;[1012] IF RESULT IS NEGATIVE,
	MOVM	T1,	T1		;[1012]  TAKE THE MAGNITUDE
	IORI	T1,	(MASK)		;CONVERT IT.
	IDPB	T1,	OPTR		;STASH IT.
	SOJG	CNT,	PD3		;LOOP IF THERE ARE MORE DIGITS.
	POPJ	PP,			;OTHERWISE RETURN.

;COME HERE TO CONVERT A DOUBLE PRECISION BINARY NUMBER TO DISPLAY.

PD4:
IFN ANS74,<
	TLNE	SW,SSF			;SEPARATE SIGN?
	JRST	PD4A			;YES
	TLNN	SW,LSF			;LEADING NOT SEPARATE?
	JRST	PD4C			;NO, TRAILING SIGN
	TLZ	SW,(1B0)		;TURN OFF SIGN
	PUSH	PP,OPTR			;SAVE 1ST CHAR
	PUSHJ	PP,PD4C			;CONVERT
	POP	PP,OPTR
	ILDB	T1,OPTR			;GET IT BACK
	JRST	PD6A			;OVERPUNCH LEADING DIGIT

PD4A:	PUSHJ	PP,PD7			;RESET CPTR
	TLNN	SW,LSF			;LEADING SIGN?
	JRST	PD4B			;NO
	LDB	T1,CPTR			;GET SIGN
	IDPB	T1,OPTR			;STORE IT
	MOVE	T1,(T2)			;GET HIGH ORDER WORD AGAIN
	JRST	PD4C			;CONVERT REST

PD4B:	PUSHJ	PP,PD4C			;CONVERT FIRST
	IBP	OPTR
	JRST	PD6B			;STORE SIGN IN LASR BYTE

PD4C:>
	MOVE	T2,	1(T2)		;PICK UP THE SECOND WORD OF THE
					; OPERAND.
	JUMPGE	T1,	PD5		;IS IT NEGATIVE?
	SETCA	T1,	T1		;NEGATE THE HIGH ORDER WORD.
	MOVNS		T2		;NEGATE THE LOW ORDER WORD.
	TLZ	T2,	(1B0)		;CLEAR THE SIGN BIT OF THE LOW ORDER WORD.
	SKIPN		T2		;IF THE LOW ORDER WORD IS ZERO.
	ADDI	T1,	1		;BUMP THE HIGH ORDER WORD.

PD5:	DIV	T1,	DEC10		;BREAK OFF THE LAST TEN DIGITS.
	MOVE	SAV10,	T2		;SAVE THEM.
	MOVEI	CNT,	-^D10(CNT)	;REDUCE THE COUNT BY 10.
	PUSHJ	PP,	PD2		;CONVERT THE FIRST N DIGITS.
	MOVE	T1,	SAV10		;GET BACK THE LAST TEN DIGITS.
	MOVEI	CNT,	^D10		;SET UP CNT.
	JUMPGE	SW,	PD3A		;IF WE DON'T HAVE TO WORRY ABOUT
					; SIGNS, GO CONVERT THE DIGITS
					; AND RETURN TO CALLER.

;COME HERE IF WE HAVE TO WORRY ABOUT SIGNS.

PD6:	PUSHJ	PP,	PD2		;CONVERT THE REMAINING N DIGITS.
PD6A:	ANDI	T1,	17		;RESTORE THE NUMBER.
PD6B:	LDB	T1,	CPTR		;PICK UP THE APPROPRIATE SIGNED DIGIT.
	DPB	T1,	IPTR		;STASH IT.
	POPJ	PP,			;AND RETURN.

IFN ANS74,<
PD7:	TLZ	SW,(1B0)		;TURN OFF SIGN REQUIRED
	SUBI	CPTR,SDDTBL
	TRZN	CPTR,-1			;NEGATIVE?
	TROA	CPTR,SDDTBL-1		;+
	HRRI	CPTR,SDDTBL-2		;-
	TLZ	CPTR,17			;TURN OFF INDEX
	POPJ	PP,
>
	SUBTTL	TABLES.

;MASKS TO MAKE A BINARY DIGIT INTO A DISPLAY DIGIT.

NCVTMS:	EXP	20		;SIXBIT.
	EXP	60		;ASCII.
IFN EBCMP.,<
	EXP	360		;EBCDIC.
>

>	;END OF NON-BIS

DC.TB1::
DECTAB::
	DEC	1
	DEC	10
	DEC	100
	DEC	1000
	DEC	10000
	DEC	100000
	DEC	1000000
	DEC	10000000
	DEC	100000000
	DEC	1000000000
DEC10:	DEC	10000000000

DC.TB2::
	OCT	2			;11
	OCT	351035564000
	OCT	35			;12
	OCT	032451210000
	OCT	443			;13
	OCT	011634520000
	OCT	5536			;14
	OCT	142036440000
	OCT	70657			;15
	OCT	324461500000
	OCT	1070336			;16
	OCT	115760200000
	OCT	13064257		;17
	OCT	013542400000
	OCT	157013326		;18
	OCT	164731000000
;TABLE OF SIGNED DISPLAY DIGITS:

IFE	BIS,<

	DEFINE	SDD(A, B, C, D)<	BYTE	(6)B(7)C(8)D>
>

IFN	BIS,<

; PRODUCE TRANSLATION TABLES FOR BIS WITH NEGATIVE OVERPUNCH IN LEFT
;	AND POSITIVE IN RIGHT
	DEFINE	IMAGE(A,B)<A'B>
%IDXX==0

DEFINE	SDD(A,B,C,D)<
IFN ANS74,<
	BYTE	(6)B(7)C(8)D
>
	.XCREF
	IFL	%IDXX-^D10,<	IMAGE(SP,\%IDXX)==B	;;SIXBIT POS
				IMAGE(AP,\%IDXX)==C	;;ASCII POS
				IMAGE(EP,\%IDXX)==D+60	;;EBCDIC POS
			   >
	IFGE	%IDXX-^D10,<	%IDXXX==%IDXX-^D10
				IMAGE(SM,\%IDXXX)==B	;;NEG SIXBIT
				IMAGE(AM,\%IDXXX)==C	;;NEG ASCII
				IMAGE(EM,\%IDXXX)==D	;;NEG EBCDIC
			 >
	IFGE	%IDXX-^D20,<%IDXX==-1>		;;REINITIALIZE
	%IDXX==%IDXX+1				;;INCREMENT
	.CREF
>

; TABLE BUILDING MACRO

DEFINE	CVBDTB(SRC)
<	.XCREF
	%IDX==0
	REPEAT	^D10,<
	XWD	IMAGE(SRC'M,\%IDX),	IMAGE(SRC'P,\%IDX)	
	%IDX==%IDX+1
	>
	.CREF
>


>	;END BIS TABLES


	BYTE	(6)'-'(7)"-"(8)140	;NEGATIVE SIGN
	BYTE	(6)'+'(7)"+"(8)116	;POSITIVE SIGN

SDDTBL:	SDD	+0,20,60,300
	SDD	+1,21,61,301
	SDD	+2,22,62,302
	SDD	+3,23,63,303
	SDD	+4,24,64,304
	SDD	+5,25,65,305
	SDD	+6,26,66,306
	SDD	+7,27,67,307
	SDD	+8,30,70,310
	SDD	+9,31,71,311
	SDD	-0,75,135,320
	SDD	-1,52,112,321
	SDD	-2,53,113,322
	SDD	-3,54,114,323
	SDD	-4,55,115,324
	SDD	-5,56,116,325
	SDD	-6,57,117,326
	SDD	-7,60,120,327
	SDD	-8,61,121,330
	SDD	-9,62,122,331

IFN	BIS,<

;NOW DEFINE THE TABLES

CVBD.6:	CVBDTB(S)		;SIXBIT
CVBD.7:	CVBDTB(A)		;ASCII
CVBD.9:	CVBDTB(E)		;EBCDIC
>

IFE	BIS,<
CVBD.6: CVBD.7: CVBD.9: HALT		;DUMMY ENTRIES FOR NON-BIS

;POINTERS TO THE SIGNED DISPLAY DIGITS:
SDDPTR:	POINT	6,SDDTBL(T1),5
	POINT	7,SDDTBL(T1),12
IFN EBCMP.,<
	POINT	8,SDDTBL(T1),20
>
>

IFN ANS74&BIS,<
SDDPTR:	POINT	6,SDDTBL(SRCHI),5
	POINT	7,SDDTBL(SRCHI),12
	0
	POINT	8,SDDTBL(SRCHI),20

	POINT	6,SDDTBL+^D10(SRCHI),5
	POINT	7,SDDTBL+^D10(SRCHI),12
	0
	POINT	8,SDDTBL+^D10(SRCHI),20
>
IFN	BIS,<

PD6.:	JSP	BISCH,	PD	;SIXBIT
PD7.:	JSP	BISCH,	PD	;ASCII
	BLOCK	1
PD9.:	JSP	BISCH,	PD	;EBCDIC

PD:	SUBI	BISCH,	PD6.-5		;CONVERT TO BYTE SIZE
	LDB	BIST0,	PACFL.##		;GET SOURCE AC FOR LATER
	MOVE	DSTPT,	(PARM)		;GET DESTINATION POINTER
	LDB	DSTCNT,	BSLPT2##	;GET COUNT
	TLZN	DSTPT,3777		;CLEAR BYTE POINTER
	POPJ	PP,			;RETURN IF ZERO
IFN ANS74,<
	TRNN	DSTCNT,(1B7!1B8)	;SPECIAL SIGN?
	JRST	PD1WD			;NO, NORMAL TRAILING OVERPUNCH
	TLZ	DSTPT,4000		;CLEAR SIGN
	DPB	BISCH,BPTOBS		;BUILD BYTE PTR
	PUSH	PP,SRCHI		;GET A FREE ACC
	TRZE	DSTCNT,(1B7)		;SEPARATE SIGN?
	JRST	PD1			;YES
	TRZ	DSTCNT,(1B8)		;NO, LEADING OVERPUNCH
	SKIPGE	(BIST0)
	SKIPA	SRCHI,SDDPTR-2(BISCH)	;NEGATIVE 
	MOVE	SRCHI,SDDPTR-6(BISCH)	;POSITIVE
	EXCH	SRCHI,0(PP)		;SAVE SIGN PTR
	PUSH	PP,[EXP 20,60,0,360]-6(BISCH)	;SAVE MASK
	PUSH	PP,DSTPT		;SAVE INITIAL PTR
	PUSHJ	PP,PD1WD		;CONVERT
	POP	PP,DSTPT		;GET BYTE PTR
	POP	PP,BIST0		;GET MASK
	ILDB	SRCHI,DSTPT		;GET 1ST BYTE
	SUBI	SRCHI,(BIST0)		;GET DIGIT
	POP	PP,BIST0		;GET SIGN PTR
	LDB	SRCHI,BIST0		;CONVERT
	DPB	SRCHI,DSTPT		;STORE BACK
	POPJ	PP,

PD1:	SKIPGE	(BIST0)			;POSITIVE?
	SKIPA	SRCHI,[EXP '-',"-",0,140]-6(BISCH)	;NEGATIVE
	MOVE	SRCHI,[EXP '+',"+",0,116]-6(BISCH)	;POSITIVE
	TRZN	DSTCNT,(1B8)		;LEADING SIGN?
	JRST	PD2			;NO
	IDPB	SRCHI,DSTPT		;YES, STORE SIGN
	POP	PP,SRCHI		;RESTORE
	JRST	PD1WD			;CONTINUE

PD2:	EXCH	SRCHI,0(PP)		;SAVE SIGN
	PUSHJ	PP,PD1WD		;CONVERT
	POP	PP,SRCHI
	IDPB	SRCHI,DSTPT		;STORE IT
	POPJ	PP,

PD1WD:>
	;ONE OR TWO WORDS??
	CAILE	DSTCNT,	^D10
	JRST	PD2WD			;TWO

	;ONE WORD
	TLZE	DSTPT,4000		;SIGNED??
	SKIPA	SRCHI,(BIST0)		;YES - TAKE IT AS IS
	MOVM	SRCHI,(BIST0)		;NO - GET MAGNITUDE
	ASHC	SRCHI,-^D35		;EXTEND SIGN
	JRST	PDGO			;GO

PD2WD:	;TWO WORDS
	TLZN	DSTPT,4000		;SIGNED FIELD??
	JRST	PD2NS			;NO
	DMOVE	SRCHI,(BIST0)		;YES
	JRST	PDGO		;GO

PD2NS:	;UNSIGNED FIELD - TAKE MAGNITUDE
	SKIPL	SRCHI,(BIST0)		;NEGATIVE
	SKIPA	SRCLO,1(BIST0)	;NO
	DMOVN	SRCHI,(BIST0)		;YES - NEGATE AGAIN

PDGO:	;NOW WE ARE READY
	DPB	BISCH,BPTOBS##		;STORE BYTE SIZE IN OUTPUT POINTER

	LSH	BISCH,1			;MULTIPLY INDEX BY 2
PDGOO:	HRLI	BD.FLG,BFLG.S		;TURN ON FOR RIGHT JUSTIFY.
	EXTEND	B.FLAG,	CVBD.T-14(BISCH)	;CONVERT
	JRST	OVFLO			;OVERFLOW
	TLNE	BISCH,-1
	CAIE	BISCH,22		;IF IT ISN'T EBCDIC,
	POPJ	PP,			; RETURN.
	MOVE	BISCH,(PARM)		;GET THE PARAMETER.
	TLNN	BISCH,4000		;IF THE RESULT IS UNSIGNED,
	POPJ	PP,			; RETURN.
	LDB	BISCH,DSTPT		;REGET THE LAST CHAR.
	TRNE	BISCH,40		;IF THE NUMBER IS POSITVE,
	TRZ	BISCH,60		; OVERPUNCH A "+".
	DPB	BISCH,DSTPT		;STASH THE CHAR.
	POPJ	PP,			;RETURN.

CVBD.T:	CVTBDT		CVBD.6		;SIXBIT
	XWD	Z,	SP0
	CVTBDT		CVBD.7		;ASCII
	XWD	Z,	AP0
	XWD	0,	0
	XWD	0,	0
	CVTBDT		CVBD.9		;EBCDIC
	XWD	Z,	EP0

	;THERE WAS AN OVERFLO SO WE MUST GO THROUGH A VARIETY
	; OF MASCENATIONS TO GET COBOLS VERSION OF OVERFLOW WHICH
	; THROWS AWAY THE EXCESS HIGH ORDER DIGITS AND KEEPS THE REST

	T1==SRCCNT-2
	T2==SRCCNT-1
OVFLO:

	JUMPE	PARM,ERROR		;ERROR IF WE HAVE BEEN HERE BEFORE

	SETZ	PARM,

	PUSH	PP,T1			;SAVE REGS
	PUSH	PP,T2

	LSH	DSTCNT,1		;MULTIPLY COUNT BY 2
					;SO IT WILL INDEX INTO THE
					;DOUBLE WORD CONSTANT TABLE
	SKIPL	SRCHI			;NEGATIVE??
	TDZA	T1,T1			;NO ZERO SIGN EXTEND
	SETOI	T1,			;YES
	MOVE	T2,T1
	DDIV	T1,DTAB(DSTCNT)		;DIVIDE BY LARGEST NUMBER THAT
					;WILL FIT AND KEEP THE REMAINDER
	LSH	DSTCNT,-1		;RESTORE COUNTER
	POP	PP,T2
	POP	PP,T1
	JRST	PDGOO			;TRY AGAIN


ERROR:	OUTSTR	[ASCIZ	'?LIBOL PD.N error
']
	POPJ	PP,
; HERE IS ROUTINE TO HANDLE OVERFLOW IF EXTEND DONE INLINE
	ENTRY	CBDOV.		;FOR BIS OVERFLOW
;CALL:
;	MOVEI	AC7,DEST.SIZE
;	MOVEI	AC10,DEST.BYTE.PTR
;	EXTEND	AC4,[CVTBDT @ CVBD.6
;			XWD 0, FILL.CHR]
;	 PUSHJ	PP,CBDOV.##
;	<END CODE>
;

CBDOV.:	PUSH	PP,T1
	PUSH	PP,T2

	LSH	DSTCNT,1
	SKIPL	SRCHI
	TDZA	T1,T1
	SETOI	T1,

	MOVE	T2,T1
	DDIV	T1,DTAB(DSTCNT)
	LSH	DSTCNT,-1

	POP	PP,T2
	HRRZ	T1,-1(PP)	;POINT TO RETURN ADDRESS
	MOVE	T1,-2(T1)	;FETCH EXTEND INSTRUCTION
	EXCH	T1,(PP)		;RESTORE OLD T1, "PUSH" INSTRUCTION
	POP	PP,(PP)		;FIX STACK
	HRLI	BD.FLG,BFLG.S

	XCT	1(PP)		;TRY THE EXTEND AGAIN
	 JRST	ERROR		;? NO GOOD
	POPJ	PP,		;OK THIS TIME, RETURN

SUBTTL	double	macro to generate double-word integers

define shift(a,b)<
;macro to simulate ashc a,1.   treats b as low part.
%s==a_-43			;;%s contains sign of number
a==a_1				;;shift high part
b==b_1				;;shift low part
ifl b,<a==a!1			;;high order bit of low part goes into
>
			;;low order bit of high part
ifn %s-<a_-43>,< printx shift overflowed !!	;;sign change means overflow
>
b==b&<1b0-1>			;;clear low order sign bit
>

define dmul10(a,b)<
;;macro to multiply double word integer in a and b by ten.

%a==a
%b==b			;;make copy of number
shift(%a,%b)		;;multiply number by 2
%%a==%a
%%b==%b			;;make copy of 2*n
shift(%a,%b)
shift(%a,%b)		;;produce 8*n in %a and %b
b==%b+%%b		;;add low order parts
a==%a+%%a		;;add high order parts
ifl b,<a==a+1		;;carry...  we just added 2n + 8n to get 10n.
b==b&<1b0-1>		;;turn off high order bit
>
>



define .dbl(number)		;;generates double word decimal number
<
%high==<%low==0>
irpc number<
dmul10 (%high,%low)		;;multiply by ten
%low==%low+number		;;add in next digit
ifl %low,<%high==%high+1		;;maybe carry
>
ifl %high,<	printx decimal quantity too large. !!
		stopi
	  >
%low==%low&<1b0-1>		;;clear carry bit
>				;;end of irpc
%high
%low				;;store number in core
>				;;end of definition


DTAB:	.dbl	1
	.dbl	10
	.dbl	100
	.dbl	1000
	.dbl	10000
	.dbl	100000
	.dbl	1000000
	.dbl	10000000
	.dbl	100000000
	.dbl	1000000000
	.dbl	10000000000
	.dbl	100000000000
	.dbl	1000000000000
	.dbl	10000000000000
	.dbl	100000000000000
	.dbl	1000000000000000
	.dbl	10000000000000000
	.dbl	100000000000000000
	.dbl	1000000000000000000
	.dbl	10000000000000000000
	.dbl	100000000000000000000
	.dbl	1000000000000000000000


>;END IFN BIS
SUBTTL	D.P. INTEGER POWER OF TEN TABLE		T.W.EGGERS/DMN	6-APR-77

INTERN	HITEN$,	LOTEN$,	EXP10$,	PTLEN$

	;POWER OF TEN TABLE IN DOUBLE PRECISION
	;INTEGER FORMAT. EACH ENTRY CONSISTS OF TWO WORDS,
	;EACH WITH 35 BITS OF FRACTION (SIGNS ARE EXCLUDED).
	;THE BINARY POINT IS BETWEEN BITS 0 AND 1 OF THE
	;HI ORDER WORD. THE EXPONENT (EXCESS 200) FOR THE 70 BIT
	;FRACTION IS STORED IN THE SHORT TABLE CALLED "EXPTEN".
DEFINE .TAB. (A)<
	REPEAT 0,<
	NUMBER 732,357347511265,056017357445	;D-50
	NUMBER 736,225520615661,074611525567
	NUMBER 741,273044761235,213754053125
	NUMBER 744,351656155504,356747065752
	NUMBER 750,222114704413,025260341562
	NUMBER 753,266540065515,332534432117
	NUMBER 756,344270103041,121263540543
	NUMBER 762,216563051724,322660234335
	NUMBER 765,262317664312,007434303425
	NUMBER 770,337003641374,211343364332
	NUMBER 774,213302304735,325716130610	;D-40
	NUMBER 777,256162766125,113301556752
	NUMBER 002,331617563552,236162112545	;D-38
	NUMBER 006,210071650242,242707256537
	NUMBER 011,252110222313,113471132267
	NUMBER 014,324532266776,036407360745
	NUMBER 020,204730362276,323044526457
	NUMBER 023,246116456756,207655654173
	NUMBER 026,317542172552,051631227231
	NUMBER 032,201635314542,132077636440
	NUMBER 035,242204577672,360517606150	;D-30
	NUMBER 040,312645737651,254643547602
	NUMBER 043,375417327624,030014501542
	NUMBER 047,236351506674,217007711035
	NUMBER 052,306044030453,262611673245
	NUMBER 055,367455036566,237354252116
	NUMBER 061,232574123152,043523552261
	NUMBER 064,301333150004,254450504735
	NUMBER 067,361622002005,327562626124
	NUMBER 073,227073201203,246647575664
	>
	NUMBER 076,274712041444,220421535242	;D-20
	NUMBER 101,354074451755,264526064512
	NUMBER 105,223445672164,220725640716
	NUMBER 110,270357250621,265113211102
	NUMBER 113,346453122766,042336053323
	NUMBER 117,220072763671,325412633103
	NUMBER 122,264111560650,112715401724
	NUMBER 125,341134115022,135500702312
	NUMBER 131,214571460113,172410431376
	NUMBER 134,257727774136,131112537675
	NUMBER 137,333715773165,357335267655	;D-10
	NUMBER 143,211340575011,265512262714
	NUMBER 146,253630734214,043034737477
	NUMBER 151,326577123257,053644127417
	NUMBER 155,206157364055,173306466551
	NUMBER 160,247613261070,332170204303
	NUMBER 163,321556135307,020626245364
	NUMBER 167,203044672274,152375747331
	NUMBER 172,243656050753,205075341217
	NUMBER 175,314631463146,146314631463	;D-01
A:	NUMBER 201,200000000000,0	;D00
	NUMBER 204,240000000000,0
	NUMBER 207,310000000000,0
	NUMBER 212,372000000000,0
	NUMBER 216,234200000000,0
	NUMBER 221,303240000000,0
	NUMBER 224,364110000000,0
	NUMBER 230,230455000000,0
	NUMBER 233,276570200000,0
	NUMBER 236,356326240000,0
	NUMBER 242,225005744000,0	;D+10
	NUMBER 245,272207335000,0
	NUMBER 250,350651224200,0
	NUMBER 254,221411634520,0
	NUMBER 257,265714203644,0
	NUMBER 262,343277244615,0
	NUMBER 266,216067446770,040000000000
	NUMBER 271,261505360566,050000000000
	NUMBER 274,336026654723,262000000000
	NUMBER 300,212616214044,117200000000
	NUMBER 303,255361657055,143040000000	;D+20
	REPEAT 0,<
	NUMBER 306,330656232670,273650000000
	NUMBER 312,207414740623,165311000000
	NUMBER 315,251320130770,122573200000
	NUMBER 320,323604157166,147332040000
	NUMBER 324,204262505412,000510224000
	NUMBER 327,245337226714,200632271000
	NUMBER 332,316627074477,241000747200
	NUMBER 336,201176345707,304500460420
	NUMBER 341,241436037271,265620574524
	NUMBER 344,311745447150,043164733651	;D+30
	NUMBER 347,374336761002,054022122623
	NUMBER 353,235613266501,133413263573
	NUMBER 356,305156144221,262316140531
	NUMBER 361,366411575266,037001570657
	NUMBER 365,232046056261,323301053415
	NUMBER 370,300457471736,110161266320
	NUMBER 373,360573410325,332215544004
	NUMBER 377,226355145205,250330436402	;D+38
	NUMBER 402,274050376447,022416546102
	NUMBER 405,353062476160,327122277522	;D+40
	NUMBER 411,222737506706,206363367623
	NUMBER 414,267527430470,050060265567
	NUMBER 417,345455336606,062074343124
	NUMBER 423,217374313163,337245615764
	NUMBER 426,263273376020,327117161361
	NUMBER 431,340152275425,014743015655
	NUMBER 435,214102366355,050055710514
	NUMBER 440,257123064050,162071272637
	NUMBER 443,332747701062,216507551406
	NUMBER 447,210660730537,231114641743	;D+50
	NUMBER 452,253035116667,177340012333
	>
>
DEFINE NUMBER (A,B,C)<	B>

TENTAB:	.TAB. HITEN$

DEFINE NUMBER (A,B,C)<	C>

	.TAB. LOTEN$
PTLEN$==HITEN$-TENTAB	;CALCULATE NUMBER OF TABLE ENTRIES BEFORE "TENS"
XX=PTLEN$
XX=XX-XX/4*4		;CALC XX=XX MOD 4

BINR1=<BINR2=<BINR3=0>>	;INIT THE BINARY

DEFINE NUMBER (A,B,C)<
IFE XX-1,<	BYTE (9) BINR1,BINR2,BINR3,<A>
	BINR1=<BINR2=<BINR3=0>> >
IFE XX-2,<BINR3=A>
IFE XX-3,<BINR2=A>
IFE XX,<BINR1=A
	XX=4>
XX=XX-1>

	.TAB. EXP10$
	IFN BINR1!BINR2!BINR3,<	BYTE (9) BINR1,BINR2,BINR3,0>


	END