OpenVMS Source Code Demos

BASIC_DECIMAL_MOD_BUG

1000	!=============================================================================
	! title  : BASIC_DECIMAL_MOD_PROBLEM.BAS
	!	   (was: diffie_hellman_demo_100.bas)
	! author : Neil Rieck
	! history:
	! 101 NSR 120910 1. derived from BASIC_DECIMAL_MOD_PROBLEM.BAS
	!		 2. testing with: Alpha BASIC V1.7-000 (original compiler)
	! 102 NSR 120914 1. testing with: Alpha BASIC V1.7-001 (test compiler)
	!=============================================================================
	! Sample Output (production compiler - Alpha BASIC V1.7-000):
	!
	!	====================
	!	pow1:  31
	!	tmp0:  2147483648           <-- 2^31
	!	tmp1:  2147483649           <-- tmp0 + 1
	!	div1:  1073741824           <-- tmp1 / 2
	!	mod1:  1                    <-- tmp1 % 2
	!	====================
	!	pow1:  32                   fails at 32
	!	tmp0:  4294967296
	!	tmp1:  4294967297
	!	div1:  2147483648
	!	-e-error: 51 at stage 4
	!	%NONAME-E-NOMSG, Message number 00000002
	!=============================================================================
	! Sample Output (experimental compiler - Alpha BASIC V1.7-001):
	!
	!	====================
	!	pow1: 53                    works at 53 (no compile-time warning)
	!	tmp0: 9007199254740992 
	!	tmp1: 9007199254740993 
	!	div1: 4503599627370496 
	!	mod1: 1 
	!	====================
	!	pow1: 54                    appears to work at 54 (with compile-time warnings)
	!	tmp0: 18014398509481984 
	!	tmp1: 18014398509481985 
	!	div1: 9007199254740992 
	!	mod1: 1 
	!	...
	!	====================
	!	pow1:  63                   this test appears to work at 63
	!	tmp0:  9223372036854775808  <-- 2^63
	!	tmp1:  9223372036854775809  <-- tmp0 + 1 ("this test" appears to work)
	!	div1:  4611686018427387904  <-- tmp1 / 2 ("this test" appears to work)
	!	mod1:  1                    <-- tmp1 % 2 ("this test" appears to work)
	!	====================
	!	pow1:  64                   this test fails
	!	tmp0:  18446744073709551616 <-- 2^64
	!	tmp1:  1                    Oops (GFLOAT loss of precision)
	!	div1:  0                    Oops (GFLOAT loss of precision)
	!	mod1:  1                    Oops (GFLOAT loss of precision)
	!	====================
	!	note: this version of BASIC code was never meant to operate this high
	!=============================================================================
	option	type = explicit			,	!			&
		size = integer	quad		,	!			&
		size = real	xfloat		, 	!			&
		size = decimal	(31,0)			!
	declare long	rc%			,	! return code		&
			stage%			,	! stage register	&
			error%				! error register
!----------------------------------------------------------------------------------------------
!	notes:
!	1) 2^102 = 5070602400912917605986812821504 requires 31 decimal digits.
!	2) GFLOAT (which is used behind the scenes) only guarantees 15 digits of precision
!	3) BASIC would need to switch to XFLOAT to guarantee 33 digits of precision
!	4) testing with Alpha BASIC V1.7-001 (test compiler)
!
!	   declaration   max size compile warnings notes
!	   ------------- -------- ---------------- --------------------------------------------
!	   decimal(16,0) 2^53     n
!	   decimal(17,0) 2^56     y       safer to use quad
!	   decimal(18,0) 2^59     y       safer to use quad
!	   decimal(19,0) 2^62     y       safer to use quad
!	   decimal(31,0) 2^102    y       safer to use quad
!----------------------------------------------------------------------------------------------
	declare decimal(31,0)	tmp0		,	!			&
				tmp1		,	!			&
				div1		,	!			&
				mod1		,	!			&
				pow1
2000	main:						!
	on error goto trap				! old school trapping
	print "Basic version (decimal)"			!
	when error in					! new school trapping
	    for pow1 = 30 to 102			!
		print "===================="		!
		print "pow1: "; pow1	 		!
		!
		stage% = 1				!
		tmp0 = 2 ^ pow1				! raise 2 to the power of pow1
		print "tmp0: "; tmp0			!
		!
		stage% = 2				!
		tmp1 = tmp0 + 1				! add one to test modulus
		print "tmp1: "; tmp1			!
		!
		stage% = 3				!
		div1 = tmp1 / 2				! lets' try divide
		print "div1: "; div1			!
		!
		stage% = 4				!
		mod1 = mod(tmp1, 2)			! let's try modulus
		print "mod1: "; mod1			!
		!
	     next pow1					!
	     error% = 0					! cool
	use						!
	     error% = err				! oops
	end when					!
	!
	select error%					!
	    case 0					!
		goto fini				!
	    case else					!
		print "-e-error: "+str$(error%)+" at stage "+ str$(stage%)
		goto fini_error				!
	end select					!
	!
30000	trap:						!
	print "error: ";str$(err)			!
	print "line : ";str$(erl)			!
	print "text : ";ert$(err)			!
	resume fini_error				!
	!
	fini_error:					!
	rc% = 2						! VMS-E-
	goto fini_common				!
	!
32000	fini:						!
	rc% = 1						! VMS-S-
	!
	fini_common:					!
	end program rc%					!