'begin the teatest.tea program begun on 06-SEP-2001
'written in Teapro which uses the OpenTea technology
'In today's world, we need computer software that actually works.
vari dg_pass1, dg_pass2, dg_pass3, dg_pass4
vari sg_pass1, sg_pass2, sg_pass3, sg_pass4
vari dg_xvalue, dg_yvalue, dg_zvalue, sg_xyzmath
vari sg_nothing, sg_build
sub_main
endp
subr sub_main
'main subroutine
'updated 2007/09/10, 2004/04/17
vari d_any, s_any, d_dot, s_dot
vari d_loop, s_pick, d_pick
$trb sg_nothing, " "
d_loop = 1
dwhi d_loop = 1
s_dot = "Program: teatest.tea, build=56, 2007/09/12"
$cut sg_build, s_dot, 23, 8
$out s_dot
$out "Copyright (c) 2001-2006 D La Pierre Ballard"
$out "Written in Teapro which uses the OpenTea technology"
$out "Copyright (c) 1997-2006 D La Pierre Ballard"
s_any = "In today's world, we need computer software"
$app s_any, " that actually works."
$out s_any
$sys s_any, 1
$out s_any
$dat s_any
dsec d_any
$out "date=" + s_any + ", seconds=" + d_any
$out " "
sub_floating_point_test
$out "1. min for bad add one to a number"
$out "2. min and max for \ 1 to make an integer"
$out "3. non-integer numbers"
$out "4. sub_random_test"
$out "5. sub_floating_point_test"
$out "6. sub_test_various_commands1"
$out "7. sub_next_test_code"
$out "8. sub_word_to_number"
$out "9. sub_command_speed_test"
$out "10. file append test"
$out "11. sub_mod_arithmetic_test"
$out "96. sub_xyzmath"
$out "98. sub_teaquad_prime_speed_test"
$out "99. sub_speed_test"
s_dot = "pick a number *=end " + sg_build
$app s_dot, " x=" + dg_xvalue
$inp s_pick, s_dot
$ift s_pick = "*": dinc d_loop
d_pick = 0
$isd d_any, s_pick
dift d_any = 1: $tod d_pick, s_pick
dift d_pick = 1: sub_bad_add_one_to_large_number
dift d_pick = 2: sub_make_an_integer
dift d_pick = 3: sub_non_integers
dift d_pick = 4: sub_random_test
dift d_pick = 5: sub_floating_point_test
dift d_pick = 6: sub_test_various_commands1
dift d_pick = 7: sub_next_test_code
dift d_pick = 8: sub_word_to_number
dift d_pick = 9: sub_command_speed
dift d_pick = 10
$inp s_any, "1=new"
$ift s_any = "1"
sub_file_append_new
else
sub_file_append_old
endi
endi
dift d_pick = 11: sub_mod_arithmetic_test
dift d_pick = 96
sg_pass1 = "x=x"
sub_xyzmath
endi
dift d_pick = 98: sub_teaquad_prime_speed_test
dift d_pick = 99: sub_speed_test
sg_pass1 = s_pick
sub_xyzmath
endw
ends sub_main
subr sub_file_append_old
'updated 2004/10/21
vari d_any, s_any, d_dot, s_dot, s_out
vari s_file, s_number, d_count, d_loop, d_bytes
s_file = "zappend.txt"
dran d_any
d_any = 1000 * 100 * d_any
dto$ s_number, d_any, 0, 0
d_count = 0
d_loop = 1
dwhi d_loop = 1
dinc d_count
s_out = d_count + ". " + s_number
fapp d_bytes, s_file, s_out
dbad d_bytes = 0
d_dot = 0
dwhi d_bytes = 0
dinc d_dot
s_any = s_out + " extra " + d_dot
fapp d_bytes, s_file, s_any
dbad d_bytes = 0
endw
endw
ends sub_file_append_old
subr sub_file_append_new
'updated 2003/05/05
vari d_any, s_any, d_dot, s_dot, s_out
vari s_file, s_number, d_count, d_loop, d_bytes
s_file = "zappend.txt"
dran d_any
d_any = 1000 * d_any
dto$ s_number, d_any, 0, 0
d_count = 0
d_loop = 1
dwhi d_loop = 1
dinc d_count
s_out = d_count + ". " + s_number
fapp d_bytes, s_file, s_out
dift d_bytes = 0: $out s_out
endw
ends sub_file_append_new
subr sub_command_speed
'updated 2003/03/11
vari d_any, s_any, d_dot, s_dot, s_out
vari d_sec0, d_sec1, d_sec2, d_count, d_total
d_count = 0
dpow d_total, 10, 6
dsec d_sec1
dwhi d_count < d_total
dinc d_count
endw
dsec d_sec2
d_sec0 = d_sec2 - d_sec1
d_count = 0
dsec d_sec1
dwhi d_count < d_total
s_any = "hello"
dinc d_count
endw
dsec d_sec2
d_any = d_sec2 - d_sec1 - d_sec0
$out "P2.26, d_dot=d_dot+1, 1.15sec"
$out "P2.26, , 0.281sec"
$out "P2.26, s_dot='hello', 1.27sec"
$out "seconds=" + d_any
$inp s_any, "return"
ends sub_command_speed
subr sub_word_to_number
'updated 2002/08/02
vari d_any, s_any, d_dot, s_dot, s_out
vari s_alpha, d_loop, d_number1, d_number2
vari d_big1, d_big2, d_small, d_method
vari d_long, d_byte, s_word
d_method = 1
$inp s_any, "which method 1,2"
$isd d_any, s_any
dift d_any = 1: $tod d_method, s_any
s_alpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
$tod d_big1, "700000001"
$tod d_big2, "612345857"
$tod d_any, "2147483647"
d_small = d_any \ 36 - 1
ded$ s_any, d_small, 0, 0
$out "d_small=" + s_any
d_loop = 1
dwhi d_loop = 1
$inp s_word, "enter a word, * to end"
$ift s_word = "*": dinc d_loop
$cup s_word, s_word
$trb s_word, s_word
$cut s_word, s_word, 1, 12
$len d_long, s_word
d_number1 = 0
d_number2 = 0
d_byte = 1
dift d_loop <> 1: d_byte = 99999
dwhi d_byte <= d_long
$cut s_dot, s_word, d_byte, 1
$lok d_dot, s_alpha, 1, s_dot
dift d_method = 1
d_any = d_dot * d_dot * d_byte
d_number1 = d_number1 * 3 + d_any % d_big1
d_any = d_dot * d_dot * d_dot
d_number2 = d_number2 * 3 + d_any % d_big2
endi
dift d_method = 2
d_any = d_long \ 2
dift d_byte <= d_any
d_number1 = d_number1 % d_small
d_number1 = d_number1 * 36 + d_dot % d_big1
else
d_number2 = d_number2 % d_small
d_number2 = d_number2 * 36 + d_dot % d_big2
endi
endi
ded$ s_any, d_number1, 15, 0
s_out = s_dot + "1=" + s_any
ded$ s_any, d_number2, 15, 0
$app s_out, ", 2=" + s_any
$out s_out
dinc d_byte
endw
$out "method=" + d_method
$out "word=" + s_word
ded$ s_any, d_number1, 15, 0
$out "number1=" + s_any
ded$ s_any, d_number2, 15, 0
$out "number2=" + s_any
endw
ends sub_word_to_number
subr sub_next_test_code
'updated 2002/07/28
vari d_any, s_any, d_dot, s_dot, s_out
vari d_big1, d_number1, d_divisor1
vari d_big2, d_number2, d_divisor2
vari d_maxcount, d_count, d_diff, d_holdprevious
vari d_index, d_value, d_shift, d_previous, d_kicker
'best 50,19,23,100000=61
d_holdprevious = 50
$inp s_any, "1 through 95 shift to look at next"
$isd d_any, s_any
dift d_any = 1: $tod d_holdprevious, s_any
d_divisor1 = 19
$inp s_any, "1 through 10000 first divisor, 19"
$isd d_any, s_any
dift d_any = 1: $tod d_divisor1, s_any
d_divisor2 = 23
$inp s_any, "1 through 10000 second divisor, 23"
$isd d_any, s_any
dift d_any = 1: $tod d_divisor2, s_any
dpow d_maxcount, 10, 5
$inp s_any, "how many? 100000"
$isd d_any, s_any
dift d_any = 1: $tod d_maxcount, s_any
'initialize array
d_index = 1
dwhi d_index <= 200
dtoi d_index, 0
dinc d_index
endw
d_previous = 0
$tod d_big1, "700000001"
$tod d_big2, "612345857"
dran d_number1
d_any = d_number1 * 99999
dpow d_any, d_any, 3
d_number1 = d_any % d_big1
dran d_number2
d_any = d_number2 * 99999
dpow d_any, d_any, 3
d_number2 = d_any % d_big2
d_kicker = 0
d_count = 0
dwhi d_count <= d_maxcount
dinc d_kicker
dift d_kicker > 100: d_kicker = 1
d_number1 = d_number1 * 3 + 17 % d_big1
d_shift = d_number1 \ d_divisor1 % 95 + 1
d_number2 = d_number2 * 3 + 19 % d_big2
d_any = d_number2 \ d_divisor2 % 95 + 1
d_shift = d_shift + d_any + d_kicker % 95 + 1
'add to array element
dift d_previous = d_holdprevious
d_diff = d_shift - d_previous + 95 % 95 + 1
itod d_any, d_diff
dinc d_any
dtoi d_diff, d_any
endi
d_previous = d_shift
dinc d_count
endw
'output counts in array four per line
d_count = 0
$ch$ s_out, " ", 80
d_index = 1
dwhi d_index <= 95
itod d_value, d_index
'only if we have some
dift d_value > 0
dinc d_count
d_dot = d_count - 1 % 5 * 16 + 1
s_dot = d_index + "=" + d_value
$rep s_out, d_dot, s_dot
'output when we have four
d_dot = d_count % 5
dift d_dot = 0
$out s_out
$ch$ s_out, " ", 80
endi
endi
dinc d_index
endw
$out s_out
$out "total good=" + d_count
$inp s_any, "return"
ends sub_next_test_code
subr sub_bad_add_one_to_large_number
'updated 2004/10/18
vari d_any, s_any, d_dot, s_dot
vari d_loop, d_random, d_tell, s_tell, d_10quadrillion
vari d_number1, d_number2, d_new1, d_new2, d_new3, d_new4
vari d_badminimum, d_badcount
vari d_nummin, d_nummax, d_showminmax
vari s_string1, s_string2
vari d_holdmin, d_holdmax, d_numstring
vari d_process, d_goodnumber, d_newnumber, d_holdnumber
vari d_badmininteger, d_badminstring
vari d_holdbadmininteger, d_holdbadminstring
dpow d_10quadrillion, 10, 16
d_process = 1
$inp s_any, "1=find bad add by repeatedly adding one"
$ift s_any = "1"
d_numstring = 2
$inp s_any, "1=compare numbers by string"
$ift s_any = "1": d_numstring = 1
'$out "last good=9,007,199,254,740,991"
$out "last good=5,764,607,523,034,236 for strings"
$tod d_number1, "5,764,607,520,000,000"
ded$ s_any, d_number1, 0, 0
$out "default good start number=" + s_any
$out "enter start number"
$inp s_any, "123456789012345678901"
$ift s_any = "*": dinc d_process
$isd d_any, s_any
dift d_any = 1: $tod d_number1, s_any
d_loop = d_process
dwhi d_loop = 1
d_holdnumber = d_number1
d_newnumber = d_number1 + 1
dift d_numstring = 1
'last good one is 5,764,607,523,034,236 on 2004/10/14
dto$ s_string1, d_newnumber, 0, 0
dto$ s_string2, d_number1, 0, 0
$ift s_string1 = s_string2
s_any = "adding one to ensuing numbers "
$app s_any, "may not change their strings"
ded$ s_any, d_goodnumber, 0, 0
$out "last good number=" + s_any
$inp s_any, "return"
dinc d_loop
dinc d_process
endi
else
dift d_newnumber = d_number1
s_any = "adding one to ensuing numbers "
$app s_any, "may not change them"
ded$ s_any, d_goodnumber, 0, 0
$out "last good number=" + s_any
$inp s_any, "return"
dinc d_loop
dinc d_process
endi
endi
dift d_process = 1
d_any = 1000 * 100
d_any = d_number1 % d_any
dift d_any = 0
ded$ s_any, d_number1, 0, 0
$sho s_any
endi
d_goodnumber = d_number1
dinc d_number1
endi
endw
endi
dift d_process = 1
d_showminmax = 2
$inp s_any, "1=show min max numbers"
$ift s_any = "1": d_showminmax = 1
endi
'find min number where adding one no longer works
d_nummin = d_10quadrillion
d_nummax = 0
dpow d_badmininteger, 10, 16
dpow d_badminstring, 10, 16
$out "bad integer min=9,007,199,254,740,991"
$out "bad string min= 5,764,607,523,034,236"
d_tell = 0
d_badcount = 0
d_loop = d_process
dwhi d_loop = 1
dinc d_tell
d_any = 1000 * 100
d_any = d_tell % d_any
dift d_any = 0
ded$ s_tell, d_tell, 0, 0
dift d_badmininteger <> d_holdbadmininteger
d_holdbadmininteger = d_badmininteger
ded$ s_dot, d_badmininteger, 0, 0
s_any = "badmininteger=" + s_dot
$app s_any, ", tell=" + s_tell
$out s_any
endi
dift d_badminstring <> d_holdbadminstring
d_holdbadminstring = d_badminstring
ded$ s_dot, d_badminstring, 0, 0
s_any = "badminstring= " + s_dot
$app s_any, ", tell=" + s_tell
$out s_any
endi
dift d_showminmax = 1
d_any = 2
dift d_nummin <> d_holdmin: d_any = 1
dift d_nummax <> d_holdmax: d_any = 1
dift d_any = 1
d_holdmin = d_nummin
d_holdmax = d_nummax
ded$ s_any, d_nummin, 0, 0
s_dot = "number min=" + s_any
ded$ s_any, d_nummax, 0, 0
$app s_dot, ", max=" + s_any
$out s_dot
endi
endi
endi
$sho "tell=" + s_tell
dran d_random
d_number1 = d_10quadrillion * d_random \ 1
dift d_showminmax = 1
dift d_number1 < d_nummin: d_nummin = d_number1
dift d_number1 > d_nummax: d_nummax = d_number1
endi
d_number2 = d_number1 + 1
'are strings made from the two numbers the same
dto$ s_string1, d_number1, 0, 0
dto$ s_string2, d_number2, 0, 0
d_dot = 2
$ift s_string1 = s_string2: d_dot = 1
$tod d_new1, s_string1
dift d_new1 <> d_number1: d_dot = 1
$tod d_new2, s_string2
dift d_new2 <> d_number2: d_dot = 1
d_any = d_new2 - d_number1
dift d_any <> 1: d_dot = 1
dift d_dot = 1
dift d_number1 < d_badminstring
d_badminstring = d_number1
endi
endi
'are the two numbers the same
dift d_number1 = d_number2
dift d_number1 < d_badmininteger
d_badmininteger = d_number1
endi
endi
endw
ends sub_bad_add_one
subr sub_make_an_integer
'make a large random number into an integer, then is it one
'updated 2001/09/08
vari d_any, s_any, d_dot, s_dot
vari d_loop, d_random, d_change, d_tell
vari d_number, s_number, d_yesmax, d_badmin
d_yesmax = 0
dpow d_badmin, 10, 25
d_tell = 0
d_change = 2
d_loop = 1
dwhi d_loop = 1
dinc d_tell
dinc d_change
dran d_random
dpow d_any, 10, 18
d_number = d_any * d_random \ 1
s_number = d_number
$lok d_dot, s_number, 1, "."
dift d_dot > 0
dift d_number < d_badmin
d_badmin = d_number
d_change = 1
endi
else
dift d_number > d_yesmax
d_yesmax = d_number
d_change = 1
endi
endi
dift d_change = 1
ded$ s_any, d_yesmax, 0, 0
ded$ s_dot, d_badmin, 0, 0
$out "yesmax=" + s_any + ", badmin=" + s_dot
ded$ s_any, d_tell, 0, 0
$out "make an integer tell=" + s_any
endi
endw
ends sub_make_an_integer
subr sub_non_integers
'find non integer numbers
'updated 2001/09/09
vari d_any, s_any, d_dot, s_dot
vari d_loop, d_random, d_tell, d_lines
vari d_number, s_number, d_count, d_run
vari d_minimum, d_nummin, d_nummax
dpow d_nummin, 10, 25
d_nummax = 0
dpow d_minimum, 10, 25
d_run = 2
d_count = 0
d_lines = 0
d_tell = 0
d_loop = 1
dwhi d_loop = 1
dinc d_tell
d_any = 1000 * 100
d_any = d_tell % d_any
dift d_any = 0
ded$ s_dot, d_tell, 0, 0
s_any = "non-int tell=" + s_dot
ded$ s_dot, d_minimum, 0, 0
$app s_any, ", min=" + s_dot
ded$ s_dot, d_count, 0, 0
$app s_any, ", ct=" + s_dot
$out s_any
ded$ s_any, d_nummin, 0, 0
ded$ s_dot, d_nummax, 0, 0
$out "number min=" + s_any + ", max=" + s_dot
endi
dran d_random
dpow d_any, 10, 18
d_number = d_any * d_random \ 1
dift d_number < d_nummin: d_nummin = d_number
dift d_number > d_nummax: d_nummax = d_number
s_number = d_number
$lok d_dot, s_number, 1, "."
dift d_dot > 0
dinc d_dot
$cut s_any, s_number, d_dot, 1
$ift s_any <> "0"
dift d_number < d_minimum: d_minimum = d_number
dinc d_count
dift d_run <> 1
dinc d_lines
dift d_lines > 20
d_lines = 0
$inp s_any, "return, 1=run, * to end"
$ift s_any = "*": dinc d_loop
$ift s_any = "1": d_run = 1
endi
ded$ s_number, d_number, 0, 0
$out d_count + ". non-integer=" + s_number
endi
endi
endi
endw
ends sub_non_integers
subr sub_random_test
'find non integer numbers
'updated 2001/09/09
vari d_any, s_any, d_dot, s_dot
vari d_loop, d_random, d_tell, d_lines
vari d_number, s_number, d_count, d_run
vari d_minimum, d_nummin, d_nummax
dpow d_nummin, 10, 25
d_nummax = 0
dpow d_minimum, 10, 25
d_run = 2
d_count = 0
d_lines = 0
d_tell = 0
d_loop = 1
dwhi d_loop = 1
dinc d_tell
d_any = 1000 * 100
d_any = d_tell % d_any
dift d_any = 0
ded$ s_dot, d_tell, 0, 0
s_any = "non-int tell=" + s_dot
ded$ s_dot, d_minimum, 0, 0
$app s_any, ", min=" + s_dot
ded$ s_dot, d_count, 0, 0
$app s_any, ", ct=" + d_count
$out s_any
ded$ s_any, d_nummin, 0, 0
ded$ s_dot, d_nummax, 0, 0
$out "number min=" + s_any + ", max=" + s_dot
endi
dinc d_lines
dift d_lines > 0
d_lines = 0
$inp s_any, "return, * to end"
$ift s_any = "*": dinc d_loop
endi
dran d_random
dpow d_dot, 10, 18
d_dot = d_dot * d_random
d_number = d_dot \ 1
ded$ s_any, d_random, 0, 0
$out s_any
ded$ s_any, d_dot, 0, 0
$out s_any
ded$ s_any, d_number, 0, 0
$out s_any
dift d_number < d_nummin: d_nummin = d_number
dift d_number > d_nummax: d_nummax = d_number
endw
ends sub_random_test
subr sub_floating_point_test
'updated 2004/09/25
vari d_any, s_any, d_dot, s_dot
vari s_out
dpow d_any, 10, 15
d_any = d_any / 3
ded$ s_out, d_any, 0, 15
s_out = "10E15/3=" + s_out
s_any = "error: floating point: "
$lok d_dot, s_out, 1, "."
dift d_dot > 0
ddec d_dot
$cut s_dot, s_out, d_dot, 3
$ift s_dot = "3.3": s_any = "ok: floating point: "
endi
$out s_any + s_out
ends sub_floating_point_test
subr sub_test_various_commands1
'updated 2004/10/20
vari d_any, s_any, d_dot, s_dot, s_out
vari d_pick, d_loop
$out "1. test $PAR, character separated variable extract"
$out "2. test $ISP, string versus string by pattern"
$out "3. test $OFF, string end"
$out "4. test DROU and DTRU"
$out "5. test ARRZ and ARRB"
$out "6. test $SWP"
$out "7. test $INS"
$out "9. test $SYS"
$out "10. test DTOF"
$out "11. test DBAD"
$inp s_any, "enter number"
d_pick = 0
$isd d_any, s_any
dift d_any = 1: $tod d_pick, s_any
d_loop = 1
dwhi d_loop = 1
dg_pass1 = d_pick
sub_test_various_commands2
d_loop = dg_pass1
endw
ends sub_test_various_commands1
subr sub_test_various_commands2
'updated 2005/01/19, 2004/10/20
vari d_any, s_any, d_dot, s_dot, s_out
vari s_parm1, s_parm2, s_parm3, s_parm4
vari d_parm1, d_parm2, d_parm3, d_parm4
vari d_number, d_result
vari d_pick, s_char
d_pick = dg_pass1
dift d_pick = 1
$inp s_char, "enter a character to delimit with"
$inp s_dot, "enter a string delimited with the char"
$par s_any, s_dot, s_char, 1
$out "#1=" + s_any
$par s_any, s_dot, s_char, 2
$out "#2=" + s_any
$par s_any, s_dot, s_char, 3
$out "#3=" + s_any
$par s_any, s_dot, s_char, 4
$out "#4=" + s_any
$par s_any, s_dot, s_char, 5
$out "#5=" + s_any
$par s_any, s_dot, s_char, 6
$out "#6=" + s_any
$inp s_any, "done"
endi
dift d_pick = 2
'$isp string versus string by pattern
$inp s_any, "enter first string"
$inp s_dot, "enter second string"
$isp d_dot, s_any, s_dot
$out s_any
$out s_dot
$out "result=" + d_dot
$inp s_any, "done"
endi
dift d_pick = 3
'$off
$inp s_dot, "enter begin string"
$out "string='" + s_dot + "'"
$inp s_any, "enter length to get from end"
d_dot = 0
$isd d_any, s_any
dift d_any = 1: $tod d_dot, s_any
$out "length=" + d_dot
s_any = "qwerty"
$off s_any, s_dot, d_dot
$out "begin string='" + s_dot + "'"
$out "end string ='" + s_any + "'"
$out "length=" + d_dot
endi
dift d_pick = 4
$inp s_any, "enter a number to test DROU and DTRU"
$isd d_any, s_any
d_number = 0
dift d_any = 1
$tod d_number, s_any
$out "DROU d_result, d_number"
drou d_result, d_number
$out "d_result=" + d_result
$out "DTRU d_result, d_number"
dtru d_result, d_number
$out "d_result=" + d_result
else
$out "bad number entered"
endi
endi
dift d_pick = 5
d_dot = 1
dwhi d_dot <= 2000
s_any = "number=" + d_dot
$toi d_dot, s_any
dtoi d_dot, d_dot
dinc d_dot
endw
$inp s_any, "the arrays are full"
arrz
arrb
$inp s_any, "the arrays are zero or blank"
endi
dift d_pick = 6
$inp s_parm1, "$swp, input string to replace in"
$inp s_parm2, "$swp, input string to replace"
$inp s_parm3, "$swp, input string to replace with"
$out "before"
$out "s_parm1=" + s_parm1
$out "s_parm2=" + s_parm2
$out "s_parm3=" + s_parm3
$swp s_parm1, s_parm2, s_parm3
$out "after"
$out "s_parm1=" + s_parm1
$out "s_parm2=" + s_parm2
$out "s_parm3=" + s_parm3
endi
dift d_pick = 7
$inp s_parm1, "enter string to insert into"
$inp s_dot, "enter byte to insert"
$tod d_dot, s_dot
$inp s_parm3, "enter string to insert"
$ins s_parm1, d_dot, s_parm3
$out s_parm1
endi
dift d_pick = 9
'$sys
$inp s_any, "enter parm2 for $sys"
$isd d_any, s_any
dift d_any = 1: $tod d_parm2, s_any
$sys s_any, d_parm2
$out "$sys s_any," + d_parm2
$out "s_any=" + s_any
endi
dift d_pick = 10
'dtof
$inp s_any, "enter decimal number"
$isd d_any, s_any
dift d_any = 1: $tod d_parm2, s_any
$inp s_any, "enter length"
$isd d_any, s_any
dift d_any = 1: $tod d_parm3, s_any
dtof s_parm1, d_parm2, d_parm3
$out "s_parm1=" + s_parm1
endi
dift d_pick = 11
$out "DBAD d_parm1 > d_parm2"
$inp s_any, "DBAD test, enter first number"
$tod d_parm1, s_any
$inp s_any, "DBAD test, enter second number"
$tod d_parm2, s_any
dbad d_parm1 > d_parm2
endi
d_any = 1
$inp s_any, "return for more, * to end"
$ift s_any = "*": dinc d_any
dg_pass1 = d_any
ends sub_test_various_commands2
subr sub_mod_arithmetic_test
'updated 2007/09/12, 2007/09/10
vari d_any, s_any, d_dot, s_dot, s_out
vari d_loop, d_good, d_divisor, d_result
vari d_billpart, d_billmult, d_billone
vari d_mod1, d_mod2, d_mod3
d_divisor = 17
d_billone = 10 ^ 9
d_billpart = 1
d_billmult = 1
d_loop = 1
dwhi d_loop = 1
d_good = 1
dift d_good = 1
$inp s_any, "enter bill mult"
$ift s_any = "*": dinc d_good
$isd d_any, s_any
dift d_any = 1: $tod d_billmult, s_any
endi
dift d_good = 1
$inp s_any, "enter bill part"
$ift s_any = "*": dinc d_good
$isd d_any, s_any
dift d_any = 1: $tod d_billpart, s_any
endi
dift d_good = 1
$inp s_any, "enter mod divisor"
$ift s_any = "*": dinc d_good
$isd d_any, s_any
dift d_any = 1: $tod d_divisor, s_any
endi
dift d_good = 1
d_mod1 = d_billone % d_divisor
d_mod2 = d_billpart % d_divisor
d_mod3 = d_billmult % d_divisor
d_result = d_mod1 * d_mod3 + d_mod2 % d_divisor
$out "billone=" + d_billone
$out "billpart=" + d_billpart
$out "billmult=" + d_billmult
$out "divisor=" + d_divisor
$out "billone % divisor=" + d_mod1
$out "billpart % divisor=" + d_mod2
$out "billmult % divisor=" + d_mod3
$out "result=" + d_result
$inp s_any, "return"
$ift s_any = "*": dinc d_good
endi
d_loop = d_good
endw
ends sub_mod_arithmetic_test
subr sub_xyzmath
'updated 2004/1/4
'solve a multi number math expression in sg_pass1
'the format is: x=123*567+4.6 etc or y=123*567+4.6
'put answer in dg_xvalue, dg_yvalue, dg_zvalue
vari d_any, s_any, d_dot, s_dot, s_out
vari d_good, d_long, d_loop, d_error, d_lines
vari s_line, d_number, s_operator, d_answer, s_xyzvalue
vari s_work, d_byte, s_term, d_process, s_command, s_aster
s_command = sg_pass1
$cup s_line, s_command
$trb s_line, s_line
$ift s_line = "XYZ": s_line = "X=X"
'do we have x=, or y= or z=
d_process = 2
$cut s_any, s_line, 1, 2
$ift s_any = "X=": d_process = 1
$ift s_any = "Y=": d_process = 1
$ift s_any = "Z=": d_process = 1
dwhi d_process = 1
'x is in dg_xvalue, y is in dg_yvalue, z in dg_zvalue
'remove commas and blanks
d_loop = 1
dwhi d_loop = 1
dinc d_loop
$lok d_dot, s_line, 1, ","
dift d_dot > 0
$del s_line, d_dot, 1
d_loop = 1
endi
$lok d_dot, s_line, 1, " "
dift d_dot > 0
$del s_line, d_dot, 1
d_loop = 1
endi
endw
'colon delimited into sg_xyzmath
$app sg_xyzmath, s_line + ":"
'remove the x= or y= at the beginning
$cut s_work, s_line, 3, 100
$cut s_any, s_work, 1, 1
'put on + if needed
$ift s_any <> "+"
$ift s_any <> "-": s_work = "+" + s_work
endi
$app s_work, ";"
$len d_long, s_work
d_error = 2
d_byte = 2
d_answer = 0
d_loop = 1
dwhi d_loop = 1
'do we have the next operator in d_byte
$cut s_dot, s_work, d_byte, 1
s_any = "+-/\^%;"
$lok d_any, s_any, 1, s_dot
dift d_any > 0
'we have the location of the next operator
d_long = d_byte - 2
'the current operator is in 1
'get the number or x or y
$cut s_term, s_work, 2, d_long
'is this string a number
$isd d_good, s_term
dift d_good = 1
$tod d_number, s_term
else
'if X then use the xvalue from previous
$ift s_term = "X"
d_number = dg_xvalue
d_good = 1
endi
$ift s_term = "Y"
d_number = dg_yvalue
d_good = 1
endi
$ift s_term = "Z"
d_number = dg_zvalue
d_good = 1
endi
dift d_good <> 1: d_error = 1
endi
dift d_good = 1
'get current operator
$cut s_operator, s_work, 1, 1
$ift s_operator = "+"
d_answer = d_answer + d_number
endi
$ift s_operator = "-"
d_answer = d_answer - d_number
endi
$ift s_operator = "*"
d_answer = d_answer * d_number
endi
$ift s_operator = "/"
d_answer = d_answer / d_number
endi
$ift s_operator = "\"
d_answer = d_answer \ d_number
endi
$ift s_operator = "^"
dpow d_answer, d_answer, d_number
endi
$ift s_operator = "%"
d_answer = d_answer % d_number
endi
'put next operator in 1
$cut s_work, s_work, d_byte, 99999
d_byte = 1
endi
endi
dinc d_byte
$len d_long, s_work
dift d_byte > d_long: dinc d_loop
dift d_error = 1: dinc d_loop
'we end with a semi-colon
$cut s_any, s_work, 1, 1
$ift s_any = ";": dinc d_loop
endw
dift d_error = 1
s_out = "error in expression: " + s_line
$inp s_any, s_out
s_line = "X=X"
else
$cut s_any, s_line, 1, 1
$ift s_any = "X": dg_xvalue = d_answer
$ift s_any = "Y": dg_yvalue = d_answer
$ift s_any = "Z": dg_zvalue = d_answer
ded$ s_any, dg_xvalue, 0, 15
s_out = "x=" + s_any
ded$ s_any, dg_yvalue, 0, 15
$app s_out, ", y=" + s_any
ded$ s_any, dg_zvalue, 0, 15
$app s_out, ", z=" + s_any
'colon delimited into sg_xyzmath
$app sg_xyzmath, s_out + ":"
$app s_out, ", m=more"
$inp s_line, s_out
$cup s_line, s_line
$trb s_line, s_line
'do we have x=, or y=
d_process = 2
$cut s_any, s_line, 1, 2
$ift s_any = "X=": d_process = 1
$ift s_any = "Y=": d_process = 1
$ift s_any = "Z=": d_process = 1
$ift s_any = "M"
'print or list from sg_xyzmath colon delimited
$ch$ s_aster, "*", 60
s_line = "X=X"
$out s_aster
d_dot = 1
d_loop = 1
dwhi d_loop = 1
$par s_dot, sg_xyzmath, ":", d_dot
$trb s_dot, s_dot
$ift s_dot = sg_nothing
dinc d_loop
else
dinc d_lines
dift d_lines > 40
d_lines = 1
endi
$out s_dot
dinc d_dot
endi
endw
$out s_aster
d_process = 1
endi
endi
s_command = "none"
endw
sg_pass1 = s_command
ends sub_xyzmath
subr sub_teaquad_to_string
'updated 2007/03/30, 2007/02/24, 2006/11/25, 2006/11/12, 2006/10/27
'change a teaquad number in d_teaquadpart,d_teaquadmult to a string
vari d_any, s_any, d_dot, s_dot
vari d_teaquadpart, d_teaquadmult, s_line
vari s_beg, d_beg
d_teaquadpart = dg_pass1
d_teaquadmult = dg_pass2
dift d_teaquadpart < 0
dpow d_any, 10 ,15
d_teaquadpart = d_teaquadpart + d_any
ddec d_teaquadmult
endi
'123456789012345678901234567
'123,456,789,012,345,678,901
'123456789012345678901
dto$ s_line, d_teaquadpart, 0, 0
$ch$ s_any, "0", 30
s_line = s_any + s_line
$off s_line, s_line, 21
$cut s_beg, s_line, 1, 6
$tod d_beg, s_beg
d_beg = d_teaquadmult + d_beg
$ch$ s_any, "0", 6
s_beg = s_any + d_beg
$off s_beg, s_beg, 6
$rep s_line, 1, s_beg
'put in commas in 21 digit number
$ins s_line, 4, ","
$ins s_line, 8, ","
$ins s_line, 12, ","
$ins s_line, 16, ","
$ins s_line, 20, ","
$ins s_line, 24, ","
'take off leading zeros and commas
d_dot = 1
dwhi d_dot = 1
dinc d_dot
$cut s_any, s_line, 1, 1
$ift s_any = "0"
$cut s_line, s_line, 2, 99
d_dot = 1
endi
$ift s_any = ","
$cut s_line, s_line, 2, 99
d_dot = 1
endi
endw
sg_pass1 = s_line
ends sub_teaquad_to_string
subr sub_teaquad_from_string
'updated 2007/02/24, 2006/11/25, 2006/11/12, 2006/10/28
'teaquad string to d_teaquadpart,d_teaquadmult
'1part is the 15 digits on the right,1mult is the left digits
vari d_any, s_any, d_dot, s_dot
vari d_teaquadpart, d_teaquadmult
vari s_line, d_good, d_long, s_beg, d_beg
s_line = sg_pass1
d_teaquadpart = 0
d_teaquadmult = 0
'123456789012345678901234567
'123,456,789,012,345,678,901
'123456789012345678901
d_good = 1
dift d_good = 1
'eliminate commas and validate for all numbers
$trb s_line, s_line
$swp s_line, ",", sg_nothing
$ist d_any, s_line, "9"
dift d_any <> 1: dinc d_good
endi
'123456789012345678901234567
'123,456,789,012,345,678,901
'123456789012345678901
dift d_good = 1
'make 21 long
$ch$ s_any, "0", 30
s_line = s_any + s_line
$off s_line, s_line, 21
$cut s_beg, s_line, 1, 6
$tod d_teaquadmult, s_beg
$cut s_any, s_line, 7, 99
$tod d_teaquadpart, s_any
endi
dg_pass1 = d_teaquadpart
dg_pass2 = d_teaquadmult
ends sub_teaquad_from_string
subr sub_teaquad_prime_speed_test
'updated 2007/09/08, 2007/09/07, 2006/08/27, 2006/08/26
'2006/03/03, 2005/12/11, 2005/10/08, 2004/02/15, 2004/02/14
'find the first 500,000 or 100,000 primes to test for speed
vari d_any, s_any, d_dot, s_dot, s_out
vari d_sec1, d_sec2, d_sec3, d_sec4, d_loop, d_count
vari d_tofind, s_dash, d_process
vari s_number1, s_number2, s_number3, d_factor
vari d_teaquadpart, d_teaquadmult, d_teaquadone
vari d_teaquadtotpart, d_teaquadtotmult
vari d_teaquadbegmult, d_teaquadbegpart
d_process = 1
dift d_process = 1
$inp s_any, "enter 20=20 quadrillion, etc"
$ift s_any = "*": dinc d_process
d_teaquadbegpart = 1
d_teaquadbegmult = 20
$isd d_any, s_any
dift d_any = 1: $tod d_teaquadbegmult, s_any
endi
dift d_process = 1
$ch$ s_dash, "-", 70
dg_pass1 = d_teaquadbegpart
dg_pass1 = d_teaquadbegmult
sub_teaquad_to_string
s_number1 = sg_pass1
d_teaquadpart = d_teaquadbegpart
d_teaquadmult = d_teaquadbegmult
d_teaquadtotpart = 0
d_teaquadtotmult = 0
d_tofind = 10
endi
dsec d_sec1
d_count = 0
d_loop = d_process
dwhi d_loop = 1
'find primes with DFAC
dsec d_sec2
dfak d_factor, d_teaquadpart, d_teaquadmult
dsec d_sec3
dift d_factor = 1
'we have a prime
d_sec4 = d_sec3 - d_sec2
d_teaquadtotpart = d_teaquadtotpart + d_teaquadpart
d_teaquadtotmult = d_teaquadtotmult + d_teaquadmult
dinc d_count
dift d_count >= d_tofind: dinc d_loop
dg_pass1 = d_teaquadpart
dg_pass2 = d_teaquadmult
sub_teaquad_to_string
$out d_count + ". " + sg_pass1 + " sec=" + d_sec4
endi
d_teaquadpart = d_teaquadpart + 2
endw
dsec d_sec2
dift d_process = 1
d_sec3 = d_sec2 - d_sec1
$out s_dash
$out "seconds=" + d_sec3
$out "tot part=" + d_teaquadtotpart
$out s_dash
d_dot = 0
d_any = d_teaquadbegmult
dift d_any = 1: d_dot = 1998
dift d_any = 2: d_dot = 1548
dift d_any = 3: d_dot = 1440
dift d_any = 4: d_dot = 1388
dift d_any = 5: d_dot = 1926
dift d_any = 10: d_dot = 3760
dift d_any = 20: d_dot = 1880
dift d_any = 30: d_dot = 1398
dift d_any = 40: d_dot = 2400
dift d_any = 50: d_dot = 1298
dift d_any = 60: d_dot = 2628
dift d_any = 70: d_dot = 3038
dift d_any = 80: d_dot = 1862
dift d_any = 90: d_dot = 778
dift d_any = 100: d_dot = 944
dift d_any = 200: d_dot = 2986
dift d_any = 300: d_dot = 1182
dift d_any = 400: d_dot = 2744
dift d_any = 500: d_dot = 1766
dift d_any = 600: d_dot = 2956
dift d_any = 700: d_dot = 2762
dift d_any = 800: d_dot = 2474
dift d_any = 900: d_dot = 3392
dift d_any = 1000: d_dot = 1734
dift d_any = 2000: d_dot = 2782
dift d_any = 3000: d_dot = 2700
dift d_any = 4000: d_dot = 1628
dift d_dot > 0: $out "tot part should be=" + d_dot
$out s_dash
$inp s_any, "return"
endi
ends sub_teaquad_prime_speed_test
subr sub_speed_test
'updated 2004/02/15
'speed of computer
vari d_any, s_any, d_dot, s_dot
vari d_sec1, d_sec2, d_sec3, d_count, d_total, s_dash
$ch$ s_dash, "-", 76
$out s_dash
$out "We are looping 10,000,000 times"
d_count = 0
d_total = 10000 * 1000
'loop one million times
dsec d_sec1
dwhi d_count < d_total
dinc d_count
endw
dsec d_sec2
d_sec3 = d_sec2 - d_sec1
$out "The time was " + d_sec3 + " seconds."
$out s_dash
$inp s_any, "return"
ends sub_speed_test