<div id='wikitext'>
<pre><b> File: BCDBIN.RA of Disk: Disks/MyPDP/m8-backup-rka1-rkb1</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
/BCD TO BINARY CONVERSION - 6-DIGIT
/BINARY TO BCD CONVERSION - 6-DIGIT
/
/
/ VERSION 40A 12-SEP-80 WVDM
/
/
/
/	IVAL=KBCD2B(24-BIT BCD MANTISSA)
/
/	24-BIT BCD MANTISSA=KB2BCD(IVAL)
/
	SECT8 KBCD2B
	ENTRY KB2BCD
/
	BSW=7002
	MQL=7421
	MQA=7501
/
	BASE	0
	INDEX 	0
	JSA	SETUP	/USUAL STUFF
	FSTA#	XR1	/STORE ARG HERE
	TRAP4	SBCD2B	/CONVERT LOW ORDER
	XTA	1	/LOW ORDER BINARY RESULT
	FSTA	3
	FLDA#	XR1
	FSTA#	XR2	/PUT HIGH ORDER IN PLACE
	TRAP4	SBCD2B	/CONVERT HIGH ORDER
	XTA	1
	FMUL	P1000	/HIGH ORDER * 1000
	FADD	3	/ + LOW ORDER IN FAC
GOBAK,	JA	.	/RTN TO CALLER

KB2BCD,	JSA	SETUP	/BINARY TO BCD ENTRY
	JLT	ERROR	/ONLY POSITIVE NUMBERS
	FDIV	P1000	/ISOLATE HIGH ORDER
	FSUB	P1000	/TOO LARGE ?
	JGE	ERROR	/YES
	FADD	P1000	/RESTORE HIGH ORDER
	ATX	4	/TO SCRATCH XR
	TRAP4	SB2BCD	/SINGLE PREC BINARY TO BCD
	XTA	4	/HI AGAIN
	FMUL	P1000
	FNEG
SMALL,	FADD%	3	/THAT&#039;S LOW ORDER
	ATX	4	/INTEGERIZE
	TRAP4	SB2BCD	/CONVERT LOW ORDER
	FLDA#	XR0	/LOAD UNNORMALIZED BCD VALUE
	JA	GOBAK

	EXTERN	#ARGER
ERROR,	TRAP4	#ARGER
TEMP,
SBCD2B,	0
	TAD	XR3	/GET ARG: A*400+B*20+C
	AND	P7400	/A*400
	CLL RAR		/A*200
	DCA	XR4
	TAD	XR4
	CLL RTR		/A*40
	TAD	XR4	/A*240
	TAD	XR3	/A*640+B*20+C
	AND	P7760	/A*640+B*20
	CLL RTR		/A*150+B*4
	DCA	XR4
	TAD	XR4
	CLL RAR		/A*64+B*2
	TAD	XR4	/A*234+B*6
	CIA		/-A*234-B*6
	TAD	XR3	/A*144+B*12+C	RIGHT ?
	DCA	XR1	/STORE RESULT
	CIF CDF 0
	JMP%	SBCD2B

SB2BCD,	0
	TAD	XR2	/SAVE OLD RESULT
	DCA	XR1	/IN HORD
	TAD	XR4
	DCA	XR3	/SET INITIAL VALUE
	TAD	BINCON
	DCA	BINLUP	/SET PNT TO TABLE
	CLA CLL IAC RTL	/MAKE 4 AND CLEAR LINK
	RTL		/MAKE 20 AND
	DCA	TEMP	/SET COUNT MASK
	TAD	XR3
BINLUP,	TAD	BINTAB	/SUBTRACT
	SZL
	DCA	XR3	/UPDATE IF OVERFLOW
	CLA
	TAD	TEMP	/SHIFT DIV BIT INTO MASK
	RAL
	ISZ	BINLUP	/TO NEW DIVISOR
	SNL		/DID MASK FINISH ?
	JMP	BINLUP-2 /NO, UPDATE IT
	CLL RTL		/YES, THE END
	RTL		/SHIFT 1 BCD LEFT
	TAD	XR3	/AND ADD REMAINS
	DCA	XR2
	CIF CDF 0
	JMP%	SB2BCD
SETUP,	JA	.
	STARTD
	SETX	XR0
	FLDA	30	/GET RETURN
	FSTA#	GOBAK
	FLDA%	0,5	/GET PTR TO ARG1
	FSTA	3
	STARTF
	FLDA%	3	/USER ARG TO FAC
	JA	SETUP

	DECIMAL
BINTAB,	-800
	-400
	-200
	-100
	-80
	-40
	-20
	-10
	OCTAL

BINCON,	TAD	BINTAB
P7400,	7400
P7760,	7760
P1000,	F 1000.
	ORG	.-1
XR0,	0		/TRACEBACK AND BCD EXP OVERLAPPED WITH P1000
XR1,	0		/HI MANTISSA BCD	EXP	BCD2B TEMP
XR2,	0		/LOW MANTISSA BCD	HI	EXP
XR3,	0		/TEMP B2BCD		LO	HI
XR4,	0		/TEMP B2BCD			LO
XR5,	1		/CONSTANT INDEX
	END
</pre>
<hr/>
</div>