Directory of image this file is from
This file as a plain text file

/	BCD(FVAL)
/
/	RETURN TEXT STRING REPRESENTING BCD VAL.

	ENTRY BCD

ERRM,	4203;0443	/"BDC#"
BCD,	0	/***** ENTRY *****
BCDARG,	0
	JMS	FETCH
	SPA
	JMP	OUTRNG	/NEGATIVE ARG!
	RTR
	RAR
	AND	(377	/EXPONENT
	TAD	(-220
	SMA
	JMP	OUTRNG
	DCA	CTR
	JMS	TADARG
	AND	(7
	DCA	NUMHI
	INC	FET1
	JMS	TADARG
	DCA	NUMLO
	JMP	ROTAC2
ROTAC1,	TAD	NUMHI	/JUSTIFY UPPER 15 BITS.
	CLL RAR
	DCA	NUMHI
	TAD	NUMLO
	RAR
	DCA	NUMLO
ROTAC2,	ISZ	CTR
	JMP	ROTAC1
	JMS	BCDSUB
	TAD	ANSLO
	AND	(7400
	CLL RAR
	TAD	ANSHI
	RTL
	RTL
	RTL
	TAD	(6060
	DCA	ACH
	TAD	ANSLO
	RTL
	AND	(1700
	DCA	7
	TAD	ANSLO
	AND	(17
	TAD	7
	TAD	(6060
BCDX,	DCA	ACM
	TAD	(4040
	DCA	ACL
	RETRN 	BCD

OUTRNG,	CALL	1,ERROR
	ARG	ERRM
	CLA CLL CMA RAR
	AND	ERRM
	DCA	ACH
	TAD	ERRM#
	JMP	BCDX

CTR,
FETCH,	0	/FETCH NEXT ARGUMENT
	TAD	BCD
	DCA	FET1
FET1,	TAD I	BCDARG	/** CDF **
	DCA	TAD1
	INC	BCDARG
	TAD I	BCDARG
	DCA	FET1
	INC	BCDARG
	JMS	TADARG
	JMP I	FETCH

TADARG,	0	/TAD CURRENT ARGUMENT.
TAD1,	TAD I	FET1	/** CDF **
TAD2,	JMP I	TADARG	/** CDF **

	PAGE

TMPLO,	0
ANSLO,	0
ANSHI,	0
NUMLO,	0
NUMHI,	0

BCDSUB,	0	/CONVERT NUMHI/NUMLO TO BCD IN ANSHI/ANSLO.
	TAD	(400	/CONVERT 4 DIGITS WORTH
/	IAC		/CONVERT 6 DIGITS WORTH.
	DCA	ANSLO
	JMS	TABLE
/			/START HERE FOR 6 DIGITS.
/	-2400	/800,000 (MINUS LO ORDER)
/	-304	/        (MINUS HI ORDER)
/	-5200	/400,000
/	-142
/	-6500	/200,000
/	-61
/	-3240	/100,000
/	-31
/	-4200	/ 80,000
/	-24
/	-6100	/ 40,000
/	-12
/	-7040	/ 20,000
/	-5
/	-3420	/ 10,000
/	-3
	-7500	/  8,000	/START HERE FOR ONLY 4 DIGITS.
	-2
	-7640	/  4,000
	-1
	-3720	/  2,000
	-1
	-1750	/  1,000
	-1
	-1440	/    800
	-1
	-620	/    400
	-1
	-310	/    200
	-1
	-144	/    100
	-1
	-120	/     80
	-1
	-50	/     40
	-1
	-24	/     20
	-1
	-12	/     10
	-1
	0	/END OF TABLE
TABLE,	0	/BECOMES POINTER.
BCD1,	CLL
	TAD I	TABLE
	INC	TABLE
	SNA
	JMP	BCDSBX
	TAD	NUMLO
	DCA	TMPLO
	RAL
	TAD I	TABLE
	INC	TABLE
	TAD	NUMHI
	SNL
	JMP	BCD5	/CURRENT NUMLO/NUMHI TOO SMALL.
	DCA	NUMHI	/O.K. KEEP SUBTRACTED VALUE.
	TAD	TMPLO
	DCA	NUMLO
BCD5,	CLA
	TAD	ANSLO	/LINK CONTAINS 1 IF SUBTRACTION O.K.
	RAL
	SZL		/ROTATED ENOUGH DATA?
	DCA	ANSHI	/YES.  JAM INTO HI-ORDER.
	DCA	ANSLO	/REPLACE OR CLEAR.
	JMP	BCD1	/CONTINUE

BCDSBX,	TAD	ANSLO	/PUT IN LAST DIGIT.
	CLL RTL
	RTL
	TAD	NUMLO
	DCA	ANSLO
	JMP I	BCDSUB

	END